Может ли переопределение процедуры CreateParams позволить мне по-прежнему иметь полный доступ к WS_SYSMENU?

Question

Полный исходный код можно найти здесь: http://www.eyeClaxton.com/download/delphi/SkinProject.zip

Я пытаюсь создать скин-форму без «Заголовка или границ», но все равно оставляю мне полный доступ к системному меню (I.E: Переместить, Свернуть, Развернуть, Восстановить и изменить размер). Я могу достичь всех пунктов меню, переопределив процедуру CreateParams с помощью WS_SYSMENU, WS_MAXIMIZEBOX, WS_MINIMIZEBOX. Использование WS_SIZEBOX дает мне доступ к команде меню «Размер», но закрашивает границу, которую я не хочу. Я включил полный (Delphi 7) пример в ссылку выше. Если вам нужна дополнительная информация, пожалуйста, не стесняйтесь спрашивать.

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;

РЕШЕНИЕ:

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.

Полный «обновленный» исходный код можно найти здесь: http://www.eyeClaxton.com/download/delphi/SkinProject.zip

Answer 1

Вместо того, чтобы иметь форму без полей и фальшивые границы и заголовки в клиентской области, правильный способ сделать это - обработать WM_NCPAINT и нарисовать заголовок и границу вКлиентовТогда вам не нужно было бы использовать недокументированное сообщение , чтобы отобразить системное меню в окне без заголовков, или попытаться включить пункт системного меню «size» в окне без границы размера.

В любом случае, если вы хотите быстро обойти эту проблему, включите элемент самостоятельно:

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:

• В примере кода в вопросе вы исключаете WS_THICKFRAME, но включаете WS_SIZEBOX.На самом деле они тот же флаг .

• У вас есть странная попытка, наконец, в вашем CreateParams.Позиционирование формы не имеет ничего общего с предыдущим кодом, вы можете поместить оператор «Position: =» непосредственно перед или после установки «FormStyle» и отбросить try-finally.