【问题标题】:How can I remove the sunken inner edge of an MDI client window?如何移除 MDI 客户端窗口的凹陷内边缘?
【发布时间】:2013-04-21 07:50:35
【问题描述】:

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

相反,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

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

【问题讨论】:

    标签: delphi mdi delphi-xe3


    【解决方案1】:

    绘制边框是因为 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 尝试为 MDI 客户端窗口添加 WS_EX_CLIENTEDGE 时,挂钩代码会阻止该样式。

    实现如下所示:

    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 好的,我已经搞定了。
    • 酷。不过不要听起来很惊讶! ;-)
    • 或者(对于最后一部分)您可以在修改框架之前调用inherited,并使用@987654339 删除无关的$3F(显然SetWindowPos 调用导致再次发布) @。这将保存重定向代码。 .. +1 不管..
    • @Sertac 谢谢。多余的 $3F 导致闪烁。我没有追那个。
    【解决方案2】:

    您可以使用我的开源组件NLDExtraMDIProps(可从here 下载),它有一个ShowClientEdge 属性。 (代码和David's类似,虽然我是拦截WM_NCCALCSIZE,而不是$3F)。

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

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

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2023-03-20
      • 1970-01-01
      • 2018-04-18
      • 1970-01-01
      • 2014-09-08
      • 1970-01-01
      相关资源
      最近更新 更多