windows - 可以覆盖 CreateParams 过程让我仍然可以完全访问 WS_SYSMENU 吗?

标签 windows delphi createparams

完整的源代码可以在这里找到: http://www.eyeClaxton.com/download/delphi/SkinProject.zip

我正在尝试创建一个没有“标题或边框”的皮肤表单,但仍然让我可以完全访问系统菜单(即:移动、最小化、最大化、恢复和大小)。我可以通过使用 WS_SYSMENU、WS_MAXIMIZEBOX、WS_MINIMIZEBOX 覆盖 CreateParams 过程来实现所有菜单项。使用 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

最佳答案

与其在客户区使用无边框表单并伪造边框和标题,正确的做法是处理 WM_NCPAINT并在非客户区绘制标题和边框。然后,您不必使用 undocumented message在无标题窗口上显示系统菜单,或尝试在没有大小边框的窗口上启用“大小”系统菜单项。

无论如何,如果您想快速解决问题,请自行启用该项目:

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;


附言:

  • 在问题的代码示例中,您排除了 WS_THICKFRAME,但包括了 WS_SIZEBOX。事实上,它们是 same flag .

  • 您的 CreateParams 中有一些奇怪的 try-finally。表单定位与前面的代码无关,你可以在设置'FormStyle'之前或之后放置'Position :='语句并删除try-finally。

关于windows - 可以覆盖 CreateParams 过程让我仍然可以完全访问 WS_SYSMENU 吗?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/4629414/

相关文章:

javascript - 为什么我的 browserify require 路径在 Windows 中无法解析?

delphi - 如何在使用大量内存的程序中使用 AQTime 的内存分配分析器?

delphi - 使用 OLE 调用现有 Excel 文件 - delphi

.net - 闪烁且 "CreateParams"

delphi - 更改 TCreateParams.WinClassName 是否安全或如何查找另一个自己的应用程序的表单句柄?

windows - 在 Windows 上将未提交的更改移动到另一个分支的 Perforce 方法

c++ - 终止 boost 线程 (C++)

c++ - Qt 5.2.0 缺少相机服务

delphi - 在 pascal 中动态分配匿名泛型函数