在我的应用程序中,很多情况下我的表单上有几组 TLabel
后跟一个 TEdit
,你知道......当某些属性需要编辑。我想垂直对齐这些控件,以便它们的字体 baseline将在同一条线上。我需要在运行时执行此操作,在我缩放表单并且一切都搞砸之后。你知道有没有办法做到这一点?我看到 Delphi IDE 在设计时非常容易...
编辑:我使用 GetTextMetrics
设法获得了相对于字体边距的基线位置,但现在我不知道字体 Top 在控件客户区中的位置(TLabel 和 TEdit )...
最佳答案
这是对齐一些常用控件的代码...我不知道它是否涵盖了所有情况,但到目前为止我已经尝试过,效果很好。它适用于当前的 Windows 版本,但天知道 future 版本会发生什么,届时它们将改变控件的绘制方式。
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;
关于delphi - 在运行时通过字体基线垂直调整两个控件,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/70918268/