当我的表单比我的屏幕大时,为什么我的Delphi表单控件会被裁剪?

Dun*_*can 5 delphi delphi-xe2

场景是这样的:

  • 我创建了一个Delphi(XE2)表单.
  • 在它上面是一个拉伸的单个TGroupBox(或其他控件),因此它占据了顶部窗体的整个宽度.
  • 设置了TGroupBox上的右锚点(除了左侧和顶部).
  • 表格宽度设置为1200px(以说明要点).

如果我在Screen.Width属性大于1200px 的监视器上运行此应用程序(我在没有任何DPI虚拟化AFAIK的情况下运行),那么TGroupBox渲染就像您期望的那样.

但是..如果显示器的宽度小于1200px,则无论您如何调整窗体大小,屏幕上都会丢失控件的右手部分.

我已经Create()override;指令覆盖了我的表单方法并验证我width正确设置了属性,但是控件仍然被裁剪.

任何人都可以建议如何:

a)设置表单的width属性,使其影响子组件的定位或...

b)建议在表单呈现后强制重新布局所有子组件的方法?

Ser*_*yuz 3

跟踪代码看看会发生什么,我提出了以下调整。

procedure TForm1.WMWindowPosChanging(var Message: TWMWindowPosChanging);
var
  MessageWidth: Integer;
begin
  MessageWidth := Message.WindowPos.cx;
  inherited;
  if MessageWidth > Message.WindowPos.cx then
    GroupBox1.Width := GroupBox1.Width - MessageWidth + Message.WindowPos.cx;
end;
Run Code Online (Sandbox Code Playgroud)

这不是一个通用的解决方案,但它清楚地表明了问题所在。VCL 要求其窗体的窗口大小,但操作系统未授予该窗口大小,因为它比桌面大。从那时起,窗体恢复锚定子控件,其设计时指定的宽度大于窗体的客户端宽度,因此子控件的右侧溢出。

另一种解决方案是覆盖WM_GETMINMAXINFO消息处理,让操作系统授予所请求的宽度。

procedure TForm1.WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
begin
  inherited;
  Message.MinMaxInfo.ptMaxTrackSize.X := 1200;
end;
Run Code Online (Sandbox Code Playgroud)

这可能不是一个好的解决方案,因为这样表单将比桌面大。

关于你的“a”和“b”项,我认为“b”是不可能的 - 或者至少不可能自行进行VCL重新布局 - 因为VCL推迟应用锚定规则,直到组件(表单)完成之后加载中。那时,窗体的宽度与设计时宽度不同,但子控件的放置不受影响。再多的强制布局也不会让它们再次同步。

但是,如果您自己的代码保留对设计时间宽度的引用,则应该可以从头开始重新计算所有内容。下面是不完整的代码。

type
  TForm1 = class(TForm)
    ..
  private
    FAdjustShrinkWidth, FAdjustShrinkHeight: Integer;
  protected
    procedure Loaded; override;
  public
    procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer;
      AHeight: Integer); override;
  end;

...

procedure TForm1.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
  TrackWidth, TrackHeight: Boolean;
begin
  TrackWidth := AWidth = 1200;
  TrackHeight := AHeight = ??;
  inherited;
  if TrackWidth and (Width < AWidth) then
    FAdjustShrinkWidth := AWidth - Width;
  if TrackHeight and (Height < AHeight) then
    FAdjustShrinkHeight := AHeight - Height;
end;

procedure TForm1.Loaded;

  procedure ReadjustControlAnchors(Control: TWinControl);
  var
    i: Integer;
  begin
    for i := 0 to Control.ControlCount - 1 do
      if (akRight in Control.Controls[i].Anchors) or (akBottom in Control.Controls[i].Anchors) then begin
        Control.Controls[i].Left := // some complex calculation depending on the anchors set;
        Control.Controls[i].Top := // same as above;
        Control.Controls[i].Width := // same as above;
        Control.Controls[i].Height := // same as above;
        if (Control.Controls[i] is TWinControl) and (TWinControl(Control.Controls[i]).ControlCount > 0) then
          ReadjustControlAnchors(TWinControl(Control.Controls[i]));
      end;
  end;

begin
  inherited;
  ReadjustControlAnchors(Self);
end;
Run Code Online (Sandbox Code Playgroud)

我不知道如何填写上面代码中的空白。为了模仿 VCL 锚定,可能必须读取和跟踪 VCL 代码。

我想不出“a”的任何内容。


更新:

VCL 实际上留下了一个后门,让控件可以在锚定时向其直系子级谎报其父级的大小。文档的解释有点不同:

UpdateControlOriginalParentSize 是一个受保护的方法,用于更新父控件的原始大小。它在内部用于更新控件的锚定规则。

我们可以用它来告诉分组框预期的原始大小。

type
  TForm1 = class(TForm)
    ..
  private
    FWidthChange, FHeightChange: Integer;
  protected
    procedure UpdateControlOriginalParentSize(AControl: TControl;
      var AOriginalParentSize: TPoint); override;
  public
    procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer;
      AHeight: Integer); override;
  end;

...

procedure TForm1.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
  RequestedWidth, RequestedHeight: Integer;
begin
  RequestedWidth := AWidth;
  RequestedHeight := AHeight;
  inherited;
  if csLoading in ComponentState then begin
    if RequestedWidth <> Width then
      FWidthChange := Width - AWidth;
    if RequestedHeight <> Height then
      FHeightChange := Height - AHeight;
  end;
end;

procedure TForm1.UpdateControlOriginalParentSize(AControl: TControl;
  var AOriginalParentSize: TPoint);
begin
  inherited;
  if akRight in AControl.Anchors then
    AOriginalParentSize.X := AOriginalParentSize.X - FWidthChange;
  if akBottom in AControl.Anchors then
    AOriginalParentSize.Y := AOriginalParentSize.Y - FHeightChange;
end;
Run Code Online (Sandbox Code Playgroud)


我再次指出,这只会影响该表单的直接子级。如果组框托管锚定右侧和底部的控件,它也必须重写相同的方法。

另请注意,这不会撤销表单宽度已更改的事实。也就是说,如果窗体最右侧有一个左锚定控件,它不会将自身替换为客户端边界。它将表现得好像表单的宽度已减小,即保持在视线之外。