Al fin luego de tanto luchar hemos dado con la solución de este atascamiento que muchos los lectores de este sitio han presentado. Si quieres aportar algún detalle puedes dejar tu información.
Solución:
El borde se dibuja porque la ventana del cliente MDI tiene el estilo de ventana extendida WS_EX_CLIENTEDGE
. Este estilo se describe así:
La ventana tiene un borde con un borde hundido.
Sin embargo, mis primeros intentos sencillos de eliminar ese estilo fracasaron. Por ejemplo, puede probar este código:
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;
De hecho, este código elimina WS_EX_CLIENTEDGE
. Pero no puede ver ningún cambio visual y si inspecciona la ventana con una herramienta como Spy ++, verá que la ventana del cliente MDI conserva WS_EX_CLIENTEDGE
.
Entonces, ¿qué pasa? Resulta que el procedimiento de la ventana del cliente MDI (implementado en el código VCL) está obligando a que se muestre el borde del cliente. Y esto anula cualquier intento que realice para eliminar el estilo.
El código en cuestión se ve así:
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;
Entonces, simplemente necesita anular el manejo de este $3F
mensaje.
Haz eso así:
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;
El resultado final se ve así:
Tenga en cuenta que el código anterior no llama al procedimiento de ventana predeterminado. No estoy seguro de si eso causará o no otros problemas, pero es muy plausible que otros comportamientos de MDI se vean afectados. Por lo tanto, es posible que deba implementar un parche de comportamiento más capaz. Con suerte, esta respuesta le brinda el conocimiento que necesita para que su aplicación se comporte de la manera que desea.
Estaba pensando un poco más en cómo implementar una solución integral que garantizara que se llamara al procedimiento de ventana predeterminado para el $3F
mensaje, cualquiera que sea ese mensaje. No es trivial de lograr ya que el procedimiento de ventana predeterminado se almacena en un campo privado FDefClientProc
. Lo que hace que sea bastante difícil de alcanzar.
Supongo que podrías usar un ayudante de clase para descifrar los miembros privados. Pero prefiero un enfoque diferente. Mi enfoque sería dejar el procedimiento de la ventana exactamente como está y conectar las llamadas que hace el código VCL a SetWindowLong
. Siempre que el VCL intente agregar el WS_EX_CLIENTEDGE
para una ventana de cliente MDI, el código enganchado puede bloquear ese estilo.
La implementación se ve así:
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);
O si prefiere la versión que usa un crack auxiliar de clase de miembro privado, se ve así:
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;
Finalmente, les agradezco la muy interesante pregunta. ¡Sin duda fue muy divertido explorar este problema!
Podrías usar mi componente de código abierto NLDExtraMDIProps
(descargable desde aquí), que tiene un ShowClientEdge
propiedad solo por eso. (El código es similar al de David, aunque soy interceptación WM_NCCALCSIZE
, en lugar $3F
).
Además de eso, el componente también tiene las siguientes propiedades MDI convenientes:
BackgroundPicture
: una imagen del disco, recursos o DFM para pintar en el centro de la ventana del cliente.CleverMaximizing
: reorganizar varios clientes MDI haciendo doble clic en sus barras de título, y así maximizando al espacio libre más grande en el formulario MDI.ShowScrollBars
: activa o desactiva las barras de desplazamiento del formulario MDI al arrastrar un cliente más allá de la extensión del formulario MDI.
valoraciones y reseñas
Te invitamos a ayudar nuestra faena escribiendo un comentario o puntuándolo te damos la bienvenida.