Как я могу удалить затонувший внутренний край окна клиента MDI?

Ответ 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 пытается добавить 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);

Или, если вы предпочитаете версию, использующую хелперную трещину класса private, выглядит следующим образом:

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;

Наконец, я благодарю вас за очень интересный вопрос. Это было, конечно, очень весело, исследуя эту проблему!

Ответ 2

Вы можете использовать мой компонент с открытым исходным кодом NLDExtraMDIProps (можно загрузить из here), который имеет свойство ShowClientEdge только для этого. (Код похож на код David, хотя я перехват WM_NCCALCSIZE, а не $3F).

В дополнение к этому компонент также обладает следующими удобными свойствами MDI:

• BackgroundPicture: изображение с диска, ресурсов или DFM будет раскрашено в центре окна клиента.
• CleverMaximizing: переупорядочение нескольких клиентов MDI двойным щелчком по их заголовкам и, таким образом, максимизация его до самого большого свободного пространства в форме MDI.
• ShowScrollBars: включить или выключить полосы прокрутки формы MDI при перетаскивании клиента за пределы формы MDI.