windowsdelphicreateparams

Can overriding the CreateParams procedure allow me to still have full access to the WS_SYSMENU?

Complete source code can be found here: http://www.eyeClaxton.com/download/delphi/SkinProject.zip

I'm trying to create a skinned form with no "Caption or Borders", but still leaving me with the full access to System Menu (I.E: Move, Minimize, Maximize, Restore and Size). I can achieve all of the menu items by overriding the CreateParams procedure by using WS_SYSMENU, WS_MAXIMIZEBOX, WS_MINIMIZEBOX. Using the WS_SIZEBOX gives me access to the menu "Size" command but paints a border I do not want. I have included a complete (Delphi 7) example in the link above. If more information is needed, please feel free to ask.

procedure TMainFrm.CreateParams(var Params: TCreateParams);
begin
  FormStyle := fsNormal;
  try
    if (BorderIcons <> []) then BorderIcons := [];
    if (BorderStyle <> bsNone) then BorderStyle := bsNone;

    inherited CreateParams(Params);
    Params.ExStyle := (Params.ExStyle and (not WS_EX_WINDOWEDGE)
      and (not WS_EX_STATICEDGE) and (not WS_EX_DLGMODALFRAME) and (not WS_EX_CLIENTEDGE));
    Params.Style := (Params.Style and (not WS_CAPTION) and (not DS_MODALFRAME)
      and (not WS_DLGFRAME) and (not WS_THICKFRAME));
    Params.Style := (Params.Style or WS_SYSMENU or WS_MAXIMIZEBOX or WS_MINIMIZEBOX or WS_SIZEBOX);
  finally
    Position := poScreenCenter;
  end;
end;

SOLUTION:

unit WndProcUnit;

interface

uses
  Windows, Messages, Classes, Controls, Forms, SysUtils;

type
  EWndProc = class(Exception);

  TWndProcMessages = class(TComponent)
  private
    { Private declarations }
    FOwnerWndProc: TFarProc;
    FNewWndProc: TFarProc;
  protected
    { Protected declarations }
    procedure WndProc(var theMessage: TMessage); virtual;
  public
    { Public declarations }
    constructor Create(theOwner: TComponent); override;
    destructor Destroy(); override;
    procedure DefaultHandler(var theMessage); override;
  end;

  TWndProc = class(TWndProcMessages)
  private
    { Private declarations }
  protected
    { Protected declarations }
    procedure Loaded(); override;
  public
    { Public declarations }
    constructor Create(theOwner: TComponent); override;
    destructor Destroy(); override;
  published
    { Published declarations }
  end;

implementation

{ TWndProcMessages }
constructor TWndProcMessages.Create(theOwner: TComponent);
var
  X, I: Integer;
begin
  inherited Create(theOwner);
  if (not (Owner is TForm)) then
    raise EWndProc.Create('TWndProc parent must be a form!');

  I := 0;
  for X := 0 to (Owner.ComponentCount - 1) do
  begin
    if (Owner.Components[X] is TWndProc) then Inc(I);
    if (I > 1) then Break;
  end;

  if (I > 1) then
  begin
    raise EWndProc.Create('The form already contains a TWndProc!');
  end
  else begin
    FOwnerWndProc := TFarProc(GetWindowLong((Owner as TForm).Handle, GWL_WNDPROC));
    FNewWndProc := Classes.MakeObjectInstance(WndProc);
    if (not (csDesigning in ComponentState)) then
      SetWindowLong((Owner as TForm).Handle, GWL_WNDPROC, LongInt(FNewWndProc));
  end;
end;

destructor TWndProcMessages.Destroy();
begin
  if Assigned(FNewWndProc) then
  try
    Classes.FreeObjectInstance(FNewWndProc);
  finally
    if (Pointer(FNewWndProc) <> nil) then Pointer(FNewWndProc) := nil;
  end;
  if Assigned(FOwnerWndProc) then Pointer(FOwnerWndProc) := nil;

  inherited Destroy();
end;

procedure TWndProcMessages.DefaultHandler(var theMessage);
begin
  if ((Owner as TForm).Handle <> 0) then
  begin
    case TMessage(theMessage).Msg of
      WM_DESTROY:
        SetWindowLong((Owner as TForm).Handle, GWL_WNDPROC, LongInt(FOwnerWndProc));
      WM_INITMENU:
        EnableMenuItem(TMessage(theMessage).WParam, SC_SIZE, MF_BYCOMMAND or MF_ENABLED);
    else
      with TMessage(theMessage) do
        Result := CallWindowProc(FOwnerWndProc, (Owner as TForm).Handle, Msg, WParam, LParam);
    end;
  end
  else
    inherited DefaultHandler(theMessage);
end;

procedure TWndProcMessages.WndProc(var theMessage: TMessage);
begin
  Dispatch(theMessage);
end;

{ TWndProc }
constructor TWndProc.Create(theOwner: TComponent);
begin
  inherited Create(theOwner);
end;

destructor TWndProc.Destroy();
begin
  inherited Destroy();
end;

procedure TWndProc.Loaded();
begin
  inherited Loaded();
  if (not (csDesigning in ComponentState)) then
    GetSystemMenu((Owner as TForm).Handle, False);
end;

end.

Complete "updated" source code can be found here: http://www.eyeClaxton.com/download/delphi/SkinProject.zip

Solution

  • Instead of having a border-less form and faking borders and caption all in the client area, the correct way to do this would be to handle WM_NCPAINT and draw your caption and border in the non-client area. Then, you wouldn't have to use an undocumented message to show the system menu on a caption-less window, or try to have the 'size' system menu item enabled on a window without a sizing border.

    Anyway, if you want a quick workaround, enable the item yourself:

    type
  TMainFrm = class(TForm)
    [...]
    procedure FormCreate(Sender: TObject);
  private
    procedure WmInitMenuPopup(var Msg: TWMInitMenuPopup); message WM_INITMENUPOPUP;
    [...]

procedure TMainFrm.FormCreate(Sender: TObject);
begin
  GetSystemMenu(Handle, False);  // force a copy of the system menu
  [...]
end;

procedure TMainFrm.WmInitMenuPopup(var Msg: TWMInitMenuPopup);
begin
  inherited;
  if Msg.SystemMenu then
    EnableMenuItem(Msg.MenuPopup, SC_SIZE, MF_BYCOMMAND or MF_ENABLED);
end;


    PS: