绘制边框是因为 MDI 客户端窗口具有扩展窗口样式WS_EX_CLIENTEDGE
。这种风格是这样描述的:
窗口有一个边缘凹陷的边框。
但是,我第一次尝试删除该样式的简单尝试失败了。例如,您可以尝试以下代码:
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;
这段代码确实删除了WS_EX_CLIENTEDGE
. 但是您看不到任何视觉变化,如果您使用 Spy++ 之类的工具检查窗口,您将看到 MDI 客户端窗口保留WS_EX_CLIENTEDGE
.
那么,什么给了?事实证明,MDI 客户端窗口的窗口过程(在 VCL 代码中实现)正在强制显示客户端边缘。这会覆盖您为删除样式所做的任何尝试。
有问题的代码如下所示:
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;
因此,您只需要覆盖此$3F
消息的处理。
这样做:
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;
最终结果如下所示:
注意上面的代码没有调用默认的窗口过程。我不确定这是否会导致其他问题,但其他 MDI 行为很可能会受到影响。因此,您可能需要实施功能更强大的行为补丁。希望这个答案为您提供使您的应用程序按照您希望的方式运行所需的知识。
我在考虑如何实现一个全面的解决方案,以确保为$3F
消息调用默认窗口过程,无论该消息是什么。由于默认窗口过程存储在私有字段中,因此实现这一目标并非易事FDefClientProc
。这使得它很难到达。
我想您可以使用类助手来破解私有成员。但我更喜欢不同的方法。我的方法是让窗口过程保持原样,并将 VCL 代码对SetWindowLong
. 每当 VCL 尝试WS_EX_CLIENTEDGE
为 MDI 客户端窗口添加 时,挂钩代码都会阻止该样式。
实现如下所示:
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);
或者,如果您更喜欢使用私有成员类帮助程序破解的版本,看起来像这样:
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;
最后,我感谢你提出的非常有趣的问题。探索这个问题当然很有趣!