12

前几天,我开始开发我的新项目。应该有一个 MDI 表单,上面有一些子表单。但是当我开始开发时,我遇到了一个问题:当主窗体变成MDI窗体时,它在内部绘制了一个可怕的边框(斜角)。我不能把它拿走。您可以在屏幕截图中看到这种情况:

http://s18.postimg.org/k3hqpdocp/mdi_problem.png

相反,MDI-Child 表格绘制时没有相同的斜面。

该项目包含两个表单,Form1 和 Form2。Form1 是一个主要的 MDI 表单。

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源代码:

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

请告诉我如何才能使这个斜面远离主窗体。

4

2 回答 2

20

绘制边框是因为 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;

最后,我感谢你提出的非常有趣的问题。探索这个问题当然很有趣!

于 2013-04-21T08:36:18.143 回答
2

你可以使用我的开源组件NLDExtraMDIProps(可以从这里下载),它有一个ShowClientEdge属性。(代码与大卫的类似,虽然我是拦截WM_NCCALCSIZE,而不是$3F)。

除此之外,该组件还具有以下方便的 MDI 属性:

  • BackgroundPicture:来自磁盘、资源或 DFM 的图像,将在客户端窗口的中心绘制。
  • CleverMaximizing:通过双击标题栏重新排列多个 MDI 客户端,从而将其最大化到 MDI 表单中的最大可用空间。
  • ShowScrollBars:当将客户端拖到 MDI 窗体扩展之外时,打开或关闭 MDI 窗体的滚动条。
于 2013-04-22T19:12:23.787 回答