在运行时通过字体基线垂直调整两个控件
Adjust two controls vertically by their font baseline at runtime
在我的应用程序中,很多情况下我的表单上有几组 TLabel
后跟一个 TEdit
,您知道......当某些属性需要编辑时。我想垂直对齐这些控件,以便它们的字体 baseline 位于同一行。我需要在运行时执行此操作,在我缩放表单并且一切都搞砸之后。你知道有没有办法做到这一点?我看到 Delphi IDE 在设计时很容易...
编辑:我通过 GetTextMetrics
设法获得了相对于字体边距的基线位置,但现在我不知道字体 Top 在控件客户区(TLabel 和 TEdit)中的位置...
这是对齐一些常用控件的代码...我不知道它是否涵盖了所有情况,但到目前为止我已经尝试过,效果很好。它适用于当前 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;
您是否考虑过将标签放在编辑框上方(或改用 TLabeledEdit)?这不仅使它们更容易对齐,而且还涵盖了翻译(例如标签标题)在某些语言中比在英语中长得多的情况。
在我的应用程序中,很多情况下我的表单上有几组 TLabel
后跟一个 TEdit
,您知道......当某些属性需要编辑时。我想垂直对齐这些控件,以便它们的字体 baseline 位于同一行。我需要在运行时执行此操作,在我缩放表单并且一切都搞砸之后。你知道有没有办法做到这一点?我看到 Delphi IDE 在设计时很容易...
编辑:我通过 GetTextMetrics
设法获得了相对于字体边距的基线位置,但现在我不知道字体 Top 在控件客户区(TLabel 和 TEdit)中的位置...
这是对齐一些常用控件的代码...我不知道它是否涵盖了所有情况,但到目前为止我已经尝试过,效果很好。它适用于当前 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;
您是否考虑过将标签放在编辑框上方(或改用 TLabeledEdit)?这不仅使它们更容易对齐,而且还涵盖了翻译(例如标签标题)在某些语言中比在英语中长得多的情况。