The other day, I started to develop my new project. There should be a MDI form with some child forms on it. 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. 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.
The project contains two forms, Form1 and Form2. Form1 is a main MDI form.
Form1 source code:
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:
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
. 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
. 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
.
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. 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.
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. 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. It's not trivial to achieve since the default window procedure is stored in a private field 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
. Whenever the VCL tries to add the WS_EX_CLIENTEDGE
for an MDI client window, the hooked code can block that style.
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. (The code is similar to that of David's, although I am interception WM_NCCALCSIZE
, rather then $3F
).
In addition to that, the component also has the following convenient MDI properties:
BackgroundPicture
: an image from disk, resources, or DFM to be painted in the center of the client window.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.ShowScrollBars
: turn MDI Form's scroll bars on or off when dragging a client beyond the MDI Form extends.If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With