完整的源代码可以在这里找到: 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/