在运行时通过字体基线垂直调整两个控件

Question

在我的应用程序中，很多情况下我的表单上有几组 TLabel 后跟一个 TEdit，您知道......当某些属性需要编辑时。我想垂直对齐这些控件，以便它们的字体 baseline 位于同一行。我需要在运行时执行此操作，在我缩放表单并且一切都搞砸之后。你知道有没有办法做到这一点？我看到 Delphi IDE 在设计时很容易...

编辑：我通过 GetTextMetrics 设法获得了相对于字体边距的基线位置，但现在我不知道字体 Top 在控件客户区（TLabel 和 TEdit）中的位置...

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;

Answer 2

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

在运行时通过字体基线垂直调整两个控件

Adjust two controls vertically by their font baseline at runtime

delphi

fonts

delphi-10.3-rio

baseline