运行时根据字体基线调整两个控件的垂直位置。

Question

在我的应用程序中，有许多情况下我需要在表单上使用几组TLabel和一个TEdit，你知道的...当需要编辑某些属性时。我想要将这些控件在垂直方向上对齐，使它们的字体基线位于同一行。在运行时，我需要在缩放表单后执行此操作，因为此时所有内容都混乱了。你知道是否有方法可以实现这一点吗？我看到Delphi IDE在设计时非常容易做到这一点...

编辑：我使用了GetTextMetrics来获取相对于字体边距的基线位置，但现在我不知道字体Top在控件客户区域（TLabel和TEdit）的位置...

- Marus Gradinaru

---

是的，就像你说的，在设计时这非常容易：粉色的指南确保基线对齐。关于如何在运行时最好实现这一点的问题很好。我会先查看TLabel源代码。 - Andreas Rejbrand

关于 TEdit，我在源代码中找到了高度是如何计算的，但我找不到文本绘制的坐标。TCustomEdit 没有 Paint 方法，我不明白是谁绘制它的。 - Marus Gradinaru

Marus: TEdit仅仅是操作系统（=Microsoft Windows）EDIT控件的一个包装器。因此，TEdit VCL控件只是请求Windows创建其EDIT控件之一。这就是为什么TEdit看起来与其他Win32应用程序中的编辑框完全相同，但与（有缺陷的）FMX编辑控件不同的原因。 - Andreas Rejbrand

相关：https://dev59.com/zGw05IYBdhLWcg3w9mZW - Uli Gerhardt

使用面板，让Delphi为您完成工作 :) - whosrdaddy

我正在认真考虑从零开始制作自己的控件...我一直被Delphi默认控件困扰着，这些控件存在各种缺陷... - Marus Gradinaru

Answer 1

这是用于对齐一些常见控件的代码...我不知道它是否覆盖了所有情况，但到目前为止，我尝试过的都完美运行。它适用于当前的Windows版本，但谁知道在未来版本中，当他们改变控件绘制方式时会发生什么。

  TControlWithFont = class (TControl)
  public
    property Font;
  end;

procedure FontBaselineAlign(Control, FixedControl: TControl);
var DC: HDC;
    SaveFont: HFont;
    CtrlBL, FixBL, BV: Integer;
    CtrlTM, FixTM: TTextMetric;

 function GetControlBaseLine(Ctrl: Tcontrol; const TM: TTextMetric; out BL: Integer): Boolean;
 begin
  Result:= False; BL:= -1;

  if Ctrl is TLabel then with Ctrl as TLabel do begin
   if Layout = tlTop then BL:= TM.tmAscent
    else if Layout = tlBottom then BL:= Height - TM.tmDescent
     else BL:= ((Height - TM.tmHeight) div 2 + TM.tmAscent);
   Result:= True;
  end

  else if Ctrl is TEdit then with Ctrl as TEdit do begin
   BL:= TM.tmAscent;
   if BorderStyle = bsSingle then
   Inc(BL, GetSystemMetrics(SM_CYEDGE)+1);
   Result:= True;
  end

  else if (Ctrl is TSpinEdit) or (Ctrl is TComboBox) then begin
   BL:= TM.tmAscent + GetSystemMetrics(SM_CYEDGE)+1;
   Result:= True;
  end

  else if (Ctrl is TComboBoxEx) then begin
   BL:= TM.tmAscent + GetSystemMetrics(SM_CYEDGE)+3;
   Result:= True;
  end

  else if (Ctrl is TCheckBox) or (Ctrl is TRadioButton) then begin
   BL:= ((Ctrl.Height - TM.tmHeight) div 2) + TM.tmAscent;
   Result:= True;
  end

  else if (Ctrl is TColorBox) then begin
   BL:= Round((Ctrl.Height - TM.tmHeight) / 2) + TM.tmAscent;
   Result:= True;
  end

  else if (Ctrl is TPanel) then with Ctrl as TPanel do begin
   BV:= BorderWidth;
   if BevelInner <> bvNone then Inc(BV, BevelWidth);
   if BevelOuter <> bvNone then Inc(BV, BevelWidth);
   if BorderStyle = bsSingle then Inc(BV, GetSystemMetrics(SM_CYEDGE));
   if VerticalAlignment = taAlignTop then begin
    if (BevelKind <> bkNone) and (beTop in BevelEdges) then Inc(BV, GetSystemMetrics(SM_CYEDGE));
    BL:= BV + TM.tmAscent;
   end
    else if VerticalAlignment = taAlignBottom then begin
     if (BevelKind <> bkNone) and (beBottom in BevelEdges) then Inc(BV, GetSystemMetrics(SM_CYEDGE));
     BL:= Height - TM.tmDescent - BV;
    end
     else BL:= ((Height - TM.tmHeight) div 2 + TM.tmAscent);
   Result:= True;
  end;
 end;

begin
 DC:= GetDC(0);
 try
  SaveFont:= SelectObject(DC, TControlWithFont(Control).Font.Handle);
  GetTextMetrics(DC, CtrlTM);
  SelectObject(DC, TControlWithFont(FixedControl).Font.Handle);
  GetTextMetrics(DC, FixTM);
  SelectObject(DC, SaveFont);
 finally
  ReleaseDC(0, DC);
 end;

 if GetControlBaseLine(Control, CtrlTM, CtrlBL) and
  GetControlBaseLine(FixedControl, FixTM, FixBL) then
   Control.Top:= FixedControl.Top + (FixBL - CtrlBL);
end;

- Marus Gradinaru

Answer 2

你有没有考虑把标签放在编辑框上方（或者使用TLabeledEdit）？这不仅使它们更容易对齐，而且还涵盖了某些语言中翻译（例如标签标题）比英语长得多的情况。

- dummzeuch

---

一个好主意，特别是针对不同长度的翻译。但这并没有真正回答问题。也许你应该把它发布为评论。 - Tom Brunberg

在 TLabeledEdit 中，标签只是放置在编辑框旁边，但没有进行基线对齐。 - Marus Gradinaru

@Marus 重点不在基线对齐，而是出于提到的原因将标签置于编辑框上方。 - Tom Brunberg

我不喜欢上面的标签... :) - Marus Gradinaru

我也喜欢我的标签在左边。 - Andreas Rejbrand