ExCtrls: Fix text measuring in TColumnComboBoxEx.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8140 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2021-11-01 18:59:23 +00:00
parent 1e3713b3b2
commit bd0f7165d6

View File

@ -48,8 +48,8 @@ type
FSelectedColor: TColor; FSelectedColor: TColor;
FSelectedTextColor: TColor; FSelectedTextColor: TColor;
FTextHeight: Integer; FTextHeight: Integer;
FNeedMeasure: Boolean;
function ColumnMarginStored: Boolean; function ColumnMarginStored: Boolean;
function GetTextSize(const aText: String): TSize;
function GetColumnCount: Integer; function GetColumnCount: Integer;
function GetDelimiteds(const aLine: String): TStringArray; function GetDelimiteds(const aLine: String): TStringArray;
procedure SetColSeparatorColor(AValue: TColor); procedure SetColSeparatorColor(AValue: TColor);
@ -157,6 +157,7 @@ uses
const const
DEFAULT_COLUMN_MARGIN = 4; DEFAULT_COLUMN_MARGIN = 4;
TEXT_SAMPLE = 'TgjÜ';
{ TColumnCombo } { TColumnCombo }
@ -176,6 +177,7 @@ begin
SetStyle(csOwnerDrawFixed); SetStyle(csOwnerDrawFixed);
FOffsets := nil; FOffsets := nil;
FColumnCount := 0; FColumnCount := 0;
FNeedMeasure := true;
end; end;
destructor TColumnComboBoxEx.Destroy; destructor TColumnComboBoxEx.Destroy;
@ -186,13 +188,13 @@ end;
function TColumnComboBoxEx.ColumnMarginStored: Boolean; function TColumnComboBoxEx.ColumnMarginStored: Boolean;
begin begin
Result := FColumnMargin <> Scale96ToFont(DEFAULT_COLUMN_MARGIN); Result := FColumnMargin <> DEFAULT_COLUMN_MARGIN;
end; end;
procedure TColumnComboBoxEx.CreateHandle; procedure TColumnComboBoxEx.CreateHandle;
begin begin
inherited; inherited;
SetOffsets; FNeedMeasure := true;
end; end;
procedure TColumnComboBoxEx.DoAutoAdjustLayout( procedure TColumnComboBoxEx.DoAutoAdjustLayout(
@ -224,6 +226,13 @@ begin
savedColor := Canvas.Brush.Color; savedColor := Canvas.Brush.Color;
savedFontColor := Canvas.Font.Color; savedFontColor := Canvas.Font.Color;
Canvas.Font.Assign(Font);
if FNeedMeasure then begin
FTextHeight := Canvas.TextHeight(TEXT_SAMPLE);
SetOffsets;
FNeedMeasure := false;
end;
if DroppedDown then if DroppedDown then
begin begin
if (odSelected in State) then if (odSelected in State) then
@ -247,7 +256,7 @@ begin
FParser.Delimiter := FDelimiter; FParser.Delimiter := FDelimiter;
FParser.DelimitedText := txt; FParser.DelimitedText := txt;
y := ARect.Top + (ARect.Height - FTextHeight) shr 1; y := (ARect.Top + ARect.Bottom - FTextHeight) div 2;
Canvas.Brush.Style := bsClear; // transparent text background Canvas.Brush.Style := bsClear; // transparent text background
if Assigned(FOffsets) then if Assigned(FOffsets) then
begin begin
@ -278,7 +287,7 @@ end;
procedure TColumnComboBoxEx.FontChanged(Sender: TObject); procedure TColumnComboBoxEx.FontChanged(Sender: TObject);
begin begin
inherited FontChanged(Sender); inherited FontChanged(Sender);
FTextHeight := Canvas.TextHeight('ŢÜ'); FNeedMeasure := true;
end; end;
function TColumnComboBoxEx.GetColumnCount: Integer; function TColumnComboBoxEx.GetColumnCount: Integer;
@ -339,36 +348,12 @@ end;
procedure TColumnComboBoxEx.GetItems; procedure TColumnComboBoxEx.GetItems;
begin begin
inherited GetItems; inherited GetItems;
// SetOffsets;
end;
function TColumnComboBoxEx.GetTextSize(const aText: String): TSize;
var
drawFlags: LongWord = DT_CALCRECT or DT_NOPREFIX or DT_SINGLELINE;
r: TRect;
dc: HDC;
begin
r.Left := 0;
r.Top := 0;
dc := GetDC(GetParentForm(Self).Handle);
try
r.Right := 1000;
r.Bottom := 100;
DrawText(dc, PChar(aText), Length(aText), r, drawFlags);
if r.Right = 1000 then
r.Right := 0;
if r.Bottom = 100 then
r.Bottom := 0;
Result.Create(r.Width, r.Height);
finally
ReleaseDC(Parent.Handle, dc);
end;
end; end;
procedure TColumnComboBoxEx.InitializeWnd; procedure TColumnComboBoxEx.InitializeWnd;
begin begin
inherited; inherited;
SetOffsets; FNeedMeasure := true;
end; end;
procedure TColumnComboBoxEx.SetColSeparatorColor(AValue: TColor); procedure TColumnComboBoxEx.SetColSeparatorColor(AValue: TColor);
@ -401,31 +386,30 @@ end;
procedure TColumnComboBoxEx.SetItems(const Value: TStrings); procedure TColumnComboBoxEx.SetItems(const Value: TStrings);
begin begin
inherited SetItems(Value); inherited SetItems(Value);
SetOffsets; FNeedMeasure := true;
end; end;
procedure TColumnComboBoxEx.SetOffsets; procedure TColumnComboBoxEx.SetOffsets;
var var
widths: TIntegerDynArray; widths: TIntegerDynArray = nil;
i, j: Integer; i, j: Integer;
sa: TStringArray; sa: TStringArray;
sz: TSize; w: Integer;
begin begin
if not Assigned(Parent) or (Items.Count = 0) then if not Assigned(Parent) or (Items.Count = 0) then
Exit; Exit;
FColumnCount := GetColumnCount; FColumnCount := GetColumnCount;
SetLength({%H-}widths, FColumnCount); SetLength(widths, FColumnCount);
for i := 0 to Items.Count-1 do for i := 0 to Items.Count-1 do
begin begin
sa := GetDelimiteds(Items[i]); sa := GetDelimiteds(Items[i]);
FTextHeight := GetTextSize('ŢÜ').cy;
for j := 0 to High(sa) do for j := 0 to High(sa) do
begin begin
sz := GetTextSize(sa[j]); w := Canvas.TextWidth(sa[j]);
if widths[j] < sz.cx then if widths[j] < w then
widths[j] := sz.cx; widths[j] := w;
end; end;
end; end;
SetLength(FOffsets, FColumnCount); SetLength(FOffsets, FColumnCount);