delphi - VCL Styles - 客户端尺寸减小

Question

我不知道这是否是一个错误......但是当我设置除“Windows”之外的任何其他 VCL 样式时，窗口宽度会减小。

-

有什么解决办法吗？

更新 我将此提交给 QC： http://qc.embarcadero.com/wc/qcmain.aspx?d= 103697 希望他们能修复它...

Answer 1

这不是 vcl 样式错误，这是 vcl 样式的工作原理，每种样式（皮肤）都有自己的边框宽度和高度，有时与本机窗口边框大小不匹配。

检查下一个图像

carbon 样式的边框宽度和高度为 5 像素

Amakrits 样式的边框宽度和高度为 6 像素

您可以使用VCL Styles Designer

• 对象 -> 表格 -> 图像 -> 左边框 -> 宽度
• 对象 -> 表单 -> 图像 -> RigthBorder -> 宽度
• 对象 -> 表格 -> 图像 -> 底部边框 -> 高度

因此，根据上述属性，表单的样式挂钩会重新计算客户区域的边界。

Answer 2

好的 - 我做了更多调查，发现了这个错误的根本问题（跳到最后寻找解决方法）。大多数/所有散布在 Internet 上并在此消息之前讨论的其他解决方法似乎只是掩盖了错误的症状，而没有真正找到根本原因 - 并且这些其他解决方法可能有其他不希望的副作用或限制（正如他们的一些作者所指出的那样）。

根本问题是，当参数为时，TFormStyleHook.WMNCCalcSize消息不提供对消息的任何处理。WM_NCCALCSIZEwParamFALSE 功能基本不完整。因此，调用了默认窗口处理程序——Windows 提供的默认处理程序——它当然会返回 Windows 默认样式的客户端矩形，而不是用户指定的 VCL 样式。为了修复这个错误，Embarcadero 必须添加对WM_NCCALCSIZEwhen wParamis的处理，FALSE以便仍然返回 VCL 样式信息。这对他们来说将是一个非常容易修复的问题，现在我已经调查并发现了他们的问题，我希望该修复可以应用于 VCL 的下一个版本。

为了证明这是问题的原因，我记录了发送到表单的所有消息（通过覆盖WndProc），并为每条消息记录 Win32 提供的客户端 rectGetClientRect对于 VCL 样式是否正确。我还注意到了WM_NCCALCSIZE函数调用的类型（的值wParam）。最后，我注意到WM_NCCALCSIZE处理程序返回的新客户端矩形。

我发现在应用程序运行时，几乎每条WM_NCCALCSIZE消息都wParam设置为TRUE（确实可以正常工作），因此该错误被隐藏并且不会发生。这就是为什么 Embarcadero 到目前为止已经摆脱了这个错误。然而，消息被发送一次并wParam设置为FALSE，这发生在一个关键时刻：就在ClientWidth/ClientHeight属性被设置为DFM文件中的值之前TCustomForm.ReadState。并且该TControl.SetClientSize函数通过GetClientRect从当前整体窗口宽度中减去当前客户端宽度（由 Windows 测量）来运行，然后添加新的客户端宽度。 换句话说，TControl.SetClientSize要求当前窗口客户端矩形准确，因为它使用它来计算新客户端矩形。 既然不是，表单的宽度设置错误，剩下的就是历史了。

哦，你想知道为什么宽度会受到影响，而不是高度？这很容易证明——结果ClientWidth是在设置之后但在设置之前ClientHeight，发送了另一个WM_NCCALCSIZE——这次是wParamof TRUE。VCL Styles 正确处理它并将客户端大小设置回正确的值 - 因此计算ClientHeight结果是正确的。

请注意，Windows 的未来版本可能会出现更严重的问题：如果 Microsoft 决定更频繁地发送设置为的WM_NCCALCSIZE消息，即使表单可见，VCL 的情况也会非常糟糕。wParamFALSE

该错误很容易通过手动发送WM_NCCALCSIZE到表单来证明。重现步骤：

1. 在 C++ Builder 中创建一个新的VCL Forms 应用程序。
2. 从Project Options的Appearance部分将当前/默认 VCL 样式设置为Carbon VCL 样式。
3. 向窗体添加一个新TButton控件。

4. 将以下代码添加到按钮的OnClick事件中：

   void __fastcall TForm1::Button1Click(TObject *Sender)
   {
       // Compute the current cumulative width of the form borders:
       int CurrentNonClientWidth = Width - ClientWidth;
       // Get the current rectangle for the form:
       TRect rect;
       ::GetWindowRect(Handle, &rect);
       // Ask the window to calculate client area from the window rect:
       SendMessage(Handle, WM_NCCALCSIZE, FALSE, (LPARAM)&rect);
       // Calculate the new non-client area given by WM_NCCALCSIZE.  It *should*
       // match the value of CurrentNonClientWidth.
       int NewNonClientWidth = Width - rect.Width();
       if (CurrentNonClientWidth == NewNonClientWidth) {
           ShowMessage("Test pass: WM_NCCALCSIZE with wParam FALSE gave "
               "the right result.");
       } else {
           ShowMessage(UnicodeString::Format(L"Test fail: WM_NCCALCSIZE with "
               "wParam FALSE gave a different result.\r\n\r\nCurrent NC width: %d"
               "\r\n\r\nNew NC width: %d", ARRAYOFCONST((
               CurrentNonClientWidth, NewNonClientWidth))));
       }
   }
   

5. 运行项目并单击按钮。如果通过测试，则意味着 VCL 样式的 NC 宽度恰好与默认的 Windows NC 宽度一致。更改表单的边框样式或将 VCL 样式更改为其他样式，然后重试。

变通的方法当然是想办法拦截WM_NCCALCSIZE消息 where wParamis FALSE，然后将其转换为消息 where wParamis TRUE。这实际上可以在全局基础上完成：我们可以从中创建一个派生类来TFormStyleHook修复问题，然后全局使用钩子 - 这将修复所有表单的问题，包括 VCL 创建的表单（例如来自 Vcl.Dialogs 单元）。在上图示例项目中，修改mainProject1.cpp如下：

//---------------------------------------------------------------------------

#include <vcl.h>
#pragma hdrstop
#include <tchar.h>
#include <string.h>
#include <Vcl.Forms.hpp>
//---------------------------------------------------------------------------
#include <Vcl.Styles.hpp>
#include <Vcl.Themes.hpp>
USEFORM("Unit1.cpp", Form1);
//---------------------------------------------------------------------------
class TFixedFormStyleHook : public TFormStyleHook
{
public:
    __fastcall virtual TFixedFormStyleHook(TWinControl* AControl)
        : TFormStyleHook(AControl) {}
protected:
    virtual void __fastcall WndProc(TMessage &Message)
    {
        if (Message.Msg == WM_NCCALCSIZE && !Message.WParam) {
            // Convert message to format with WPARAM == TRUE due to VCL styles
            // failure to handle it when WPARAM == FALSE.  Note that currently,
            // TFormStyleHook only ever makes use of rgrc[0] and the rest of the
            // structure is ignored.  (Which is a good thing, because that's all
            // the information we have...)
            NCCALCSIZE_PARAMS ncParams;
            memset(&ncParams, 0, sizeof(ncParams));
            ncParams.rgrc[0] = *reinterpret_cast<RECT*>(Message.LParam);

            TMessage newMsg;
            newMsg.Msg = WM_NCCALCSIZE;
            newMsg.WParam = TRUE;
            newMsg.LParam = reinterpret_cast<LPARAM>(&ncParams);
            newMsg.Result = 0;
            this->TFormStyleHook::WndProc(newMsg);

            if (this->Handled) {
                *reinterpret_cast<RECT*>(Message.LParam) = ncParams.rgrc[0];
                Message.Result = 0;
            }
        } else {
            this->TFormStyleHook::WndProc(Message);
        }
    }
};
//---------------------------------------------------------------------------
int WINAPI _tWinMain(HINSTANCE, HINSTANCE, LPTSTR, int)
{
    // Register our style hook.  An audit of C++ Builder XE8 VCL source code
    // for registration of the existing TFormStyleHook shows that these are
    // the only two classes we need to register for.
    TCustomStyleEngine::RegisterStyleHook(__classid(TForm),
        __classid(TFixedFormStyleHook));
    TCustomStyleEngine::RegisterStyleHook(__classid(TCustomForm),
        __classid(TFixedFormStyleHook));

    Application->Initialize();
    Application->MainFormOnTaskBar = true;
    TStyleManager::TrySetStyle("Carbon");
    Application->CreateForm(__classid(TForm1), &Form1);
    Application->Run();
    return 0;
}
//---------------------------------------------------------------------------

现在运行项目并单击按钮；您会看到 WM_NCCALCSIZE 现在已正确处理。您还将看到，如果您ClientWidth在DFM文件中明确设置 a，它现在将被正确使用。

Answer 3

对于那些为这种非常奇怪的行为寻找真正聪明的解决方案的人，请查看 James Johnston 的答案。我已经将它应用到我的项目中，并且运行良好。以下是詹姆斯答案的德尔福翻译。谢谢詹姆斯！

program Solve;

uses
  Vcl.Forms,
  Unit1 in 'Unit1.pas' {Form1},
  Windows,
  Messages,
  Vcl.Themes,
  Vcl.Styles;

type
  TFixedFormStyleHook = class(TFormStyleHook)
  protected
    procedure WndProc(var AMessage: TMessage); override;
  end;

{ TFixedFormStyleHook }

procedure TFixedFormStyleHook.WndProc(var AMessage: TMessage);
var
  NewMessage: TMessage;
  ncParams: NCCALCSIZE_PARAMS;
begin
  if (AMessage.Msg = WM_NCCALCSIZE) and (AMessage.WParam = 0) then
  begin
    // Convert message to format with WPARAM = TRUE due to VCL styles
    // failure to handle it when WPARAM = FALSE.  Note that currently,
    // TFormStyleHook only ever makes use of rgrc[0] and the rest of the
    // structure is ignored. (Which is a good thing, because that's all
    // the information we have...)
    ZeroMemory(@ncParams,SizeOf(NCCALCSIZE_PARAMS));
    ncParams.rgrc[0] := TRect(Pointer(AMessage.LParam)^);

    NewMessage.Msg := WM_NCCALCSIZE;
    NewMessage.WParam := 1;
    NewMessage.LParam := Integer(@ncParams);
    NewMessage.Result := 0;
    inherited WndProc(NewMessage);

    if Handled then
    begin
      TRect(Pointer(AMessage.LParam)^) := ncParams.rgrc[0];
      AMessage.Result := 0;
    end;
  end
  else
    inherited;
end;

{$R *.res}

begin
  // Register our style hook. An audit of Delphi XE8 VCL source code
  // for registration of the existing TFormStyleHook shows that these are
  // the only two classes we need to register for.
  TCustomStyleEngine.RegisterStyleHook(TForm,TFixedFormStyleHook);
  TCustomStyleEngine.RegisterStyleHook(TCustomForm,TFixedFormStyleHook);

  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  TStyleManager.TrySetStyle('Glossy Light');
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

使用此代码，ClientWidth / ClientHeight 尺寸得到尊重，并且内部内容正确显示。当然 Window 的外部尺寸会更大以适应 ClientWidth / ClientHeight 尺寸，但这并没有那么糟糕，因为通常窗口内容更重要。

您可能希望将代码放在一个单独的单元中，以便在任何项目中使用它。这里只是直接的原始解决方案。

Answer 4

它确实似乎是一个 VCL 错误。当项目选项中的样式设置为非系统样式时，该ClientWidth属性未从 .dfm 文件正确流式传输。

我建议您向QualityCentral提交报告。同时，您可以通过在创建表单后在 .dpr 文件中设置样式来解决此问题。

Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TMainForm, MainForm);
TStyleManager.SetStyle('Amakrits');//after CreateForm, rather than before
Application.Run;

但是，我认为这不会让您走得太远，因为您可能希望能够动态创建表单，而不必在启动时创建所有内容。

Answer 5

这个错误在 Delphi Rio 10.3.3 中仍然存在。我以为我通过使用 Carlos Feitoza Filho 的代码解决了这个问题。但是，当 Windows Scaling 打开时（高 DPI 显示器），它不起作用。许多用户抱怨它。

这是我一直有效的解决方案：使用 FormResize 事件！

procedure TForm1.FormResize(Sender: TObject);
begin
  ClientHeight := Button1.Top  + Button1.Height + Button1.Top; // whatever you want
  ClientWidth  := Button1.Left + Button1.Width  + Button1.Left; // whatever you want
end;

Answer 6

这里没有 XE2，但这听起来很熟悉。尝试设置AutoScroll为 True （奇怪的是，与此答案相反）以存储客户端表单大小而不是边框​​大小。

Answer 7

这个问题在 Delphi XE8 中仍然存在。一个简单的解决方法是使用以下代码，它只是恢复设计时ClientWidth/ ClientHeight，但有一些注意事项（最重要的是，AutoScroll必须设置为False）：

type
  TFormHelper = class helper for Vcl.Forms.TCustomForm
  private
    procedure RestoreDesignClientSize;
  end;

procedure TfrmTestSize.FormCreate(Sender: TObject);
begin
  RestoreDesignClientSize;
end;

{ TFormHelper }

procedure TFormHelper.RestoreDesignClientSize;
begin
  if BorderStyle in [bsSingle, bsDialog] then
  begin
    if Self.FClientWidth > 0 then ClientWidth := Self.FClientWidth;
    if Self.FClientHeight > 0 then ClientHeight := Self.FClientHeight;
  end;
end;

给定以下设计时间形式：

这更正了运行时：

到：

我的博客上有更多细节和图片：http: //marc.durdin.net/2015/07/fixing-the-incorrect-client-size-for-delphi-vcl-forms-that-use-styles/

Answer 8

我在我的 C++Builder VCL 应用程序中通过将以下代码添加到表单的 FormResize 函数中解决了这个问题，无论选择的样式如何，它似乎都可以工作并监视该程序正在最大化。我认为这段代码应该可以继续工作如果 Embarcadero 最终解决了这个错误：

void __fastcall TForm1::FormResize(TObject *Sender)
{
 if(( WindowState == wsMaximized )  
  &&( UserPrefStyle != "Windows" ))
  {
   OnResize = NULL;
   int hAdj = Height - ClientHeight;
   hAdj -= ( Width - ClientWidth );
   ClientHeight = Monitor->WorkareaRect.Height() - hAdj;
   OnResize = FormResize;
   }
}