重写 CreateParams 过程是否允许我仍然拥有对 WS_SYSMENU 的完全访问权限?
完整的源代码可以在这里找到: 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
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
如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。
绑定邮箱获取回复消息
由于您还没有绑定你的真实邮箱,如果其他用户或者作者回复了您的评论,将不能在第一时间通知您!
发布评论
评论(1)
正确的方法是处理
WM_NCPAINT
并在非客户区域绘制标题和边框。然后,您就不必使用未记录的消息来显示无标题窗口上的系统菜单,或尝试在没有大小边框的窗口上启用“大小”系统菜单项。无论如何,如果您想要快速解决方法,请自行启用该项目:
PS:
在问题的代码示例中,您排除了
WS_THICKFRAME
,但包括WS_SIZEBOX< /代码>。事实上,它们是相同的标志.
您的
CreateParams
中有一点奇怪的 try-finally。表单定位与前面的代码无关,您可以将 'Position := ' 语句放在设置 'FormStyle' 之前或之后,并删除 try-finally。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:
PS:
In the code sample in the question, you're excluding
WS_THICKFRAME
, but includingWS_SIZEBOX
. They're, in fact, the same flag.You've got a bit of a weird try-finally in your
CreateParams
. Form positioning have got nothing to do with the preceding code, you can put the 'Position := ' statement just before or after setting 'FormStyle' and drop the try-finally.