[英]How can I remove the sunken inner edge of an MDI client window?
The other day, I started to develop my new project.前几天,我开始开发我的新项目。 There should be a MDI form with some child forms on it.应该有一个带有一些子表单的 MDI 表单。 But when I started to develop, I ran into a following problem: when the main form becomes MDI-form, it draws with а terrible border (bevel) inside.但是当我开始开发时,我遇到了以下问题:当主窗体变成 MDI 窗体时,它在内部绘制了一个可怕的边框(斜角)。 And I can't take it away.我不能把它拿走。 You can see this situation at the screenshot:您可以在屏幕截图中看到这种情况:
Oppositely, a MDI-Child form draws without the same bevel.相反,MDI-Child 窗体绘制时没有相同的斜角。
The project contains two forms, Form1 and Form2.该项目包含两个窗体,Form1 和 Form2。 Form1 is a main MDI form. Form1 是一个主要的 MDI 窗体。
Form1 source code: Form1源代码:
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 346
ClientWidth = 439
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
FormStyle = fsMDIForm
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
end
Form2 source code: Form2源代码:
object Form2: TForm2
Left = 0
Top = 0
Caption = 'Form2'
ClientHeight = 202
ClientWidth = 331
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
FormStyle = fsMDIChild
OldCreateOrder = False
Visible = True
PixelsPerInch = 96
TextHeight = 13
end
Please, tell me how can I take this bevel away from the main form.请告诉我如何将这个斜角从主窗体上移开。
The border is drawn because the MDI client window has the extended window style WS_EX_CLIENTEDGE
.绘制边框是因为 MDI 客户端窗口具有扩展窗口样式WS_EX_CLIENTEDGE
。 This style is described thus:这种风格是这样描述的:
The window has a border with a sunken edge.窗户有一个带有凹陷边缘的边框。
However, my first simple attempts to remove that style failed.但是,我第一次简单地尝试删除该样式失败了。 For example you can try this code:例如你可以试试这个代码:
procedure TMyMDIForm.CreateWnd;
var
ExStyle: DWORD;
begin
inherited;
ExStyle := GetWindowLongPtr(ClientHandle, GWL_EXSTYLE);
SetWindowLongPtr(ClientHandle, GWL_EXSTYLE,
ExStyle and not WS_EX_CLIENTEDGE);
SetWindowPos(ClientHandle, 0, 0,0,0,0, SWP_FRAMECHANGED or
SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
end;
This code does indeed remove WS_EX_CLIENTEDGE
.此代码确实删除了WS_EX_CLIENTEDGE
。 But you cannot see any visual change and if you inspect the window using a tool like Spy++ then you will see that the MDI client window retains WS_EX_CLIENTEDGE
.但是您看不到任何视觉变化,如果您使用 Spy++ 之类的工具检查窗口,那么您将看到 MDI 客户端窗口保留WS_EX_CLIENTEDGE
。
So, what gives?那么,什么给? It turns out that the MDI client window's window procedure (implemented in the VCL code) is forcing the client edge to be shown.事实证明,MDI 客户端窗口的窗口过程(在 VCL 代码中实现)正在强制显示客户端边缘。 And this overrides any attempts that you make to remove the style.这会覆盖您为删除样式所做的任何尝试。
The code in question looks like this:有问题的代码如下所示:
procedure ShowMDIClientEdge(ClientHandle: THandle; ShowEdge: Boolean);
var
Style: Longint;
begin
if ClientHandle <> 0 then
begin
Style := GetWindowLong(ClientHandle, GWL_EXSTYLE);
if ShowEdge then
if Style and WS_EX_CLIENTEDGE = 0 then
Style := Style or WS_EX_CLIENTEDGE
else
Exit
else if Style and WS_EX_CLIENTEDGE <> 0 then
Style := Style and not WS_EX_CLIENTEDGE
else
Exit;
SetWindowLong(ClientHandle, GWL_EXSTYLE, Style);
SetWindowPos(ClientHandle, 0, 0,0,0,0, SWP_FRAMECHANGED or
SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
end;
end;
....
procedure TCustomForm.ClientWndProc(var Message: TMessage);
....
begin
with Message do
case Msg of
....
$3F://!
begin
Default;
if FFormStyle = fsMDIForm then
ShowMDIClientEdge(ClientHandle, (MDIChildCount = 0) or
not MaximizedChildren);
end;
So, you simply need to override the handling of this $3F
message.因此,您只需覆盖此$3F
消息的处理。
Do that like this:这样做:
type
TMyMDIForm = class(TForm)
protected
procedure ClientWndProc(var Message: TMessage); override;
end;
procedure TMyMDIForm.ClientWndProc(var Message: TMessage);
var
ExStyle: DWORD;
begin
case Message.Msg of
$3F:
begin
ExStyle := GetWindowLongPtr(ClientHandle, GWL_EXSTYLE);
ExStyle := ExStyle and not WS_EX_CLIENTEDGE;
SetWindowLongPtr(ClientHandle, GWL_EXSTYLE, ExStyle);
SetWindowPos(ClientHandle, 0, 0,0,0,0, SWP_FRAMECHANGED or
SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
end;
else
inherited;
end;
end;
The end result looks like this:最终结果如下所示:
Note that the code above does not call the default window procedure.请注意,上面的代码不会调用默认窗口过程。 I'm not sure whether or not that will cause other problems but it's very plausible that other MDI behaviour will be affected.我不确定这是否会导致其他问题,但其他 MDI 行为很可能会受到影响。 So, you may need to implement a more capable behaviour patch.因此,您可能需要实现功能更强大的行为补丁。 Hopefully this answer gives you the knowledge you need to make your application behave the way you desire.希望这个答案为您提供了使您的应用程序按照您希望的方式运行所需的知识。
I was thinking a bit more about how to implement a comprehensive solution that ensured the default window procedure was called for the $3F
message, whatever that message happens to be.我更多地考虑如何实现一个全面的解决方案,以确保为$3F
消息调用默认窗口过程,无论该消息是什么。 It's not trivial to achieve since the default window procedure is stored in a private field FDefClientProc
.由于默认窗口过程存储在私有字段FDefClientProc
,因此实现起来并不FDefClientProc
。 Which makes it rather hard to reach.这使得它很难到达。
I suppose you could use a class helper to crack the private members.我想您可以使用类助手来破解私有成员。 But I prefer a different approach.但我更喜欢不同的方法。 My approach would be to leave the window procedure exactly as it is, and hook the calls that the VCL code makes to SetWindowLong
.我的方法是让窗口过程保持原样,并将 VCL 代码对SetWindowLong
的调用挂钩。 Whenever the VCL tries to add the WS_EX_CLIENTEDGE
for an MDI client window, the hooked code can block that style.每当 VCL 尝试为 MDI 客户端窗口添加WS_EX_CLIENTEDGE
,挂钩代码可以阻止该样式。
The implementation looks like this:实现如下所示:
type
TMyMDIForm = class(TForm)
protected
procedure CreateWnd; override;
end;
procedure PatchCode(Address: Pointer; const NewCode; Size: Integer);
var
OldProtect: DWORD;
begin
if VirtualProtect(Address, Size, PAGE_EXECUTE_READWRITE, OldProtect) then
begin
Move(NewCode, Address^, Size);
FlushInstructionCache(GetCurrentProcess, Address, Size);
VirtualProtect(Address, Size, OldProtect, @OldProtect);
end;
end;
type
PInstruction = ^TInstruction;
TInstruction = packed record
Opcode: Byte;
Offset: Integer;
end;
procedure RedirectProcedure(OldAddress, NewAddress: Pointer);
var
NewCode: TInstruction;
begin
NewCode.Opcode := $E9;//jump relative
NewCode.Offset := NativeInt(NewAddress)-NativeInt(OldAddress)-SizeOf(NewCode);
PatchCode(OldAddress, NewCode, SizeOf(NewCode));
end;
function SetWindowLongPtr(hWnd: HWND; nIndex: Integer; dwNewLong: LONG_PTR): LONG_PTR; stdcall; external user32 name 'SetWindowLongW';
function MySetWindowLongPtr(hWnd: HWND; nIndex: Integer; dwNewLong: LONG_PTR): LONG_PTR; stdcall;
var
ClassName: array [0..63] of Char;
begin
if GetClassName(hWnd, ClassName, Length(ClassName))>0 then
if (ClassName='MDIClient') and (nIndex=GWL_EXSTYLE) then
dwNewLong := dwNewLong and not WS_EX_CLIENTEDGE;
Result := SetWindowLongPtr(hWnd, nIndex, dwNewLong);
end;
procedure TMyMDIForm.CreateWnd;
var
ExStyle: DWORD;
begin
inherited;
// unless we remove WS_EX_CLIENTEDGE here, ShowMDIClientEdge never calls SetWindowLong
ExStyle := GetWindowLongPtr(ClientHandle, GWL_EXSTYLE);
SetWindowLongPtr(ClientHandle, GWL_EXSTYLE, ExStyle and not WS_EX_CLIENTEDGE);
end;
initialization
RedirectProcedure(@Winapi.Windows.SetWindowLongPtr, @MySetWindowLongPtr);
Or if you prefer the version that uses a private member class helper crack, that looks like this:或者,如果您更喜欢使用私有成员类助手破解的版本,则如下所示:
type
TFormHelper = class helper for TCustomForm
function DefClientProc: TFarProc;
end;
function TFormHelper.DefClientProc: TFarProc;
begin
Result := Self.FDefClientProc;
end;
type
TMyMDIForm = class(TForm)
protected
procedure ClientWndProc(var Message: TMessage); override;
end;
procedure TMyMDIForm.ClientWndProc(var Message: TMessage);
var
ExStyle: DWORD;
begin
case Message.Msg of
$3F:
begin
Message.Result := CallWindowProc(DefClientProc, ClientHandle, Message.Msg, Message.wParam, Message.lParam);
ExStyle := GetWindowLongPtr(ClientHandle, GWL_EXSTYLE);
ExStyle := ExStyle and not WS_EX_CLIENTEDGE;
SetWindowLongPtr(ClientHandle, GWL_EXSTYLE, ExStyle);
SetWindowPos(ClientHandle, 0, 0,0,0,0, SWP_FRAMECHANGED or
SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
end;
else
inherited;
end;
end;
Finally, I thank you for the very interesting question.最后,感谢您提出非常有趣的问题。 It was certainly a lot of fun exploring this problem!探索这个问题当然很有趣!
You could use my open source component NLDExtraMDIProps
(downloadable from here ), which has a ShowClientEdge
property for just that.您可以使用我的开源组件NLDExtraMDIProps
(可从此处下载),它有一个ShowClientEdge
属性。 (The code is similar to that of David's , although I am interception WM_NCCALCSIZE
, rather then $3F
). (代码类似于David 的代码,虽然我截取的是WM_NCCALCSIZE
,而不是$3F
)。
In addition to that, the component also has the following convenient MDI properties:除此之外,该组件还具有以下方便的 MDI 属性:
BackgroundPicture
: an image from disk, resources, or DFM to be painted in the center of the client window. BackgroundPicture
:来自磁盘、资源或 DFM 的图像,要绘制在客户端窗口的中心。CleverMaximizing
: rearranging multiple MDI clients by double clicking on their title bars, and thus maximizing it to the largest free space in the MDI Form. CleverMaximizing
:通过双击标题栏重新排列多个 MDI 客户端,从而将其最大化到 MDI 表单中的最大可用空间。ShowScrollBars
: turn MDI Form's scroll bars on or off when dragging a client beyond the MDI Form extends. ShowScrollBars
:将客户端拖到 MDI 窗体扩展之外时,打开或关闭 MDI 窗体的滚动条。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.