在我的應用程式中,有很多情況下,我的表單上有幾組TLabel后跟 a TEdit,你知道……當需要編輯某些屬性時。我想垂直對齊這些控制元件,以便它們的字體基線位于同一行。在我縮放表單并且一切都搞砸之后,我需要在運行時執行此操作。你知道是否有辦法做到這一點?我看到 Delphi IDE 在設計時非常容易......
編輯:我設法獲得了基線相對于字體邊距的位置,GetTextMetrics但現在我不知道字體 Top 在控制客戶區(TLabel 和 TEdit)中的位置...
uj5u.com熱心網友回復:
這是對齊一些常用控制元件的代碼......我不知道它是否涵蓋了所有情況,但到目前為止我嘗試過的效果很好。它適用于當前的 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;
uj5u.com熱心網友回復:
您是否考慮過將標簽放在編輯框上方(或使用 TLabeledEdit)?這不僅使它們更容易對齊,而且還涵蓋了某些語言中的翻譯(例如標簽標題)比英語長得多的情況。
轉載請註明出處,本文鏈接:https://www.uj5u.com/yidong/424530.html
標籤:德尔福 字体 delphi-10.3-rio 基线
