简体   繁体   English

如何删除 MDI 客户端窗口的凹陷内边缘?

[英]How can I remove the sunken inner edge of an MDI client window?

The other day, I started to develop my new project.前几天,我开始开发我的新项目。 There should be a MDI form with some child forms on it.应该有一个带有一些子表单的 MDI 表单。 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.但是当我开始开发时,我遇到了以下问题:当主窗体变成 MDI 窗体时,它在内部绘制了一个可怕的边框(斜角)。 And I can't take it away.我不能把它拿走。 You can see this situation at the screenshot:您可以在屏幕截图中看到这种情况:

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

Oppositely, a MDI-Child form draws without the same bevel.相反,MDI-Child 窗体绘制时没有相同的斜角。

The project contains two forms, Form1 and Form2.该项目包含两个窗体,Form1 和 Form2。 Form1 is a main MDI form. Form1 是一个主要的 MDI 窗体。

Form1 source code: 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 source code: 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

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 .绘制边框是因为 MDI 客户端窗口具有扩展窗口样式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 .此代码确实删除了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 .但是您看不到任何视觉变化,如果您使用 Spy++ 之类的工具检查窗口,那么您将看到 MDI 客户端窗口保留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.事实证明,MDI 客户端窗口的窗口过程(在 VCL 代码中实现)正在强制显示客户端边缘。 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.因此,您只需覆盖此$3F消息的处理。

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.我不确定这是否会导致其他问题,但其他 MDI 行为很可能会受到影响。 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.我更多地考虑如何实现一个全面的解决方案,以确保为$3F消息调用默认窗口过程,无论该消息是什么。 It's not trivial to achieve since the default window procedure is stored in a private field FDefClientProc .由于默认窗口过程存储在私有字段FDefClientProc ,因此实现起来并不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 .我的方法是让窗口过程保持原样,并将 VCL 代码对SetWindowLong的调用挂钩。 Whenever the VCL tries to add the WS_EX_CLIENTEDGE for an MDI client window, the hooked code can block that style.每当 VCL 尝试为 MDI 客户端窗口添加WS_EX_CLIENTEDGE ,挂钩代码可以阻止该样式。

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.您可以使用我的开源组件NLDExtraMDIProps (可从此处下载),它有一个ShowClientEdge属性。 (The code is similar to that of David's , although I am interception WM_NCCALCSIZE , rather then $3F ). (代码类似于David 的代码,虽然我截取的是WM_NCCALCSIZE ,而不是$3F )。

In addition to that, the component also has the following convenient MDI properties:除此之外,该组件还具有以下方便的 MDI 属性:

  • BackgroundPicture : an image from disk, resources, or DFM to be painted in the center of the client window. BackgroundPicture :来自磁盘、资源或 DFM 的图像,要绘制在客户端窗口的中心。
  • 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. CleverMaximizing :通过双击标题栏重新排列多个 MDI 客户端,从而将其最大化到 MDI 表单中的最大可用空间。
  • ShowScrollBars : turn MDI Form's scroll bars on or off when dragging a client beyond the MDI Form extends. ShowScrollBars :将客户端拖到 MDI 窗体扩展之外时,打开或关闭 MDI 窗体的滚动条。

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM