Граница рисуется, потому что окно клиента 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;
Наконец, я спасибо за очень интересный вопрос. Было, конечно, очень весело изучать эту проблему!
Кажется, что вам нужно вызвать процедуру окна по умолчанию. – kobik
@kobik Ya, работая над ним –
@kobik ОК, я прибил его сейчас. –