pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

ExCtrls: Fix text measuring in TColumnComboBoxEx.

Browse Source 
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
1 changed files with 30 additions and 46 deletions
Download Patch File Download Diff File Expand all files Collapse all files

76
components/exctrls/source/excombo.pas
View File

@ -48,8 +48,8 @@ type
FSelectedColor: TColor;
FSelectedTextColor: TColor;
FTextHeight: Integer;
FNeedMeasure: Boolean;
function ColumnMarginStored: Boolean;
function GetTextSize(const aText: String): TSize;
function GetColumnCount: Integer;
function GetDelimiteds(const aLine: String): TStringArray;
procedure SetColSeparatorColor(AValue: TColor);
@ -157,6 +157,7 @@ uses
const
DEFAULT_COLUMN_MARGIN = 4;
TEXT_SAMPLE = 'TgjÜ';
{ TColumnCombo }
@ -176,6 +177,7 @@ begin
SetStyle(csOwnerDrawFixed);
FOffsets := nil;
FColumnCount := 0;
FNeedMeasure := true;
end;
destructor TColumnComboBoxEx.Destroy;
@ -186,13 +188,13 @@ end;
function TColumnComboBoxEx.ColumnMarginStored: Boolean;
begin
Result := FColumnMargin <> Scale96ToFont(DEFAULT_COLUMN_MARGIN);
Result := FColumnMargin <> DEFAULT_COLUMN_MARGIN;
end;
procedure TColumnComboBoxEx.CreateHandle;
begin
inherited;
SetOffsets;
FNeedMeasure := true;
end;
procedure TColumnComboBoxEx.DoAutoAdjustLayout(
@ -224,6 +226,13 @@ begin
savedColor := Canvas.Brush.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
begin
if (odSelected in State) then
@ -247,7 +256,7 @@ begin
FParser.Delimiter := FDelimiter;
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
if Assigned(FOffsets) then
begin
@ -278,7 +287,7 @@ end;
procedure TColumnComboBoxEx.FontChanged(Sender: TObject);
begin
inherited FontChanged(Sender);
FTextHeight := Canvas.TextHeight('ŢÜ');
FNeedMeasure := true;
end;
function TColumnComboBoxEx.GetColumnCount: Integer;
@ -339,36 +348,12 @@ end;
procedure TColumnComboBoxEx.GetItems;
begin
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;
procedure TColumnComboBoxEx.InitializeWnd;
begin
inherited;
SetOffsets;
FNeedMeasure := true;
end;
procedure TColumnComboBoxEx.SetColSeparatorColor(AValue: TColor);
@ -383,49 +368,48 @@ end;
procedure TColumnComboBoxEx.SetColumnMargin(aValue: Integer);
begin
if FColumnMargin <> aValue then
begin
FColumnMargin := aValue;
Invalidate;
end;
begin
FColumnMargin := aValue;
Invalidate;
end;
end;
procedure TColumnComboBoxEx.SetDelimiter(aValue: AnsiChar);
begin
if FDelimiter <> aValue then
begin
FDelimiter := aValue;
FColumnCount := GetColumnCount;
end;
begin
FDelimiter := aValue;
FColumnCount := GetColumnCount;
end;
end;
procedure TColumnComboBoxEx.SetItems(const Value: TStrings);
begin
inherited SetItems(Value);
SetOffsets;
FNeedMeasure := true;
end;
procedure TColumnComboBoxEx.SetOffsets;
var
widths: TIntegerDynArray;
widths: TIntegerDynArray = nil;
i, j: Integer;
sa: TStringArray;
sz: TSize;
w: Integer;
begin
if not Assigned(Parent) or (Items.Count = 0) then
Exit;
FColumnCount := GetColumnCount;
SetLength({%H-}widths, FColumnCount);
SetLength(widths, FColumnCount);
for i := 0 to Items.Count-1 do
begin
sa := GetDelimiteds(Items[i]);
FTextHeight := GetTextSize('ŢÜ').cy;
for j := 0 to High(sa) do
begin
sz := GetTextSize(sa[j]);
if widths[j] < sz.cx then
widths[j] := sz.cx;
w := Canvas.TextWidth(sa[j]);
if widths[j] < w then
widths[j] := w;
end;
end;
SetLength(FOffsets, FColumnCount);