Adjust two controls vertically by their font baseline at runtime

Question

In my applications there are many cases when I have several groups of TLabel followed by a TEdit on my Forms, you know... when some properties needs to be edited. I want to align vertically those controls so that their font baseline will be on the same line. I need to do this at runtime, after I scale the Form and everything is messed up. Do yo know if there is a way to do that ? I saw that Delphi IDE does it verry easy at design time...

Edit: I managed to get the position of the baseline relative to font margins, with GetTextMetrics but now I don't know where the font Top is positioned in the control client area (TLabel and TEdit)...

Answer 1

This is the code that aligns some common controls... I don't know if it covers all the cases, but what I've tried so far has worked perfectly. It works in current Windows versions but God knows what will happen in future versions, when they will change the way controls are drawn.

  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;