mirrors/doublecmd
2
0
Fork 0
mirror of https://github.com/doublecmd/doublecmd.git synced 2026-06-21 09:58:13 +00:00
Code Issues Projects Releases Packages Wiki Activity

FIX: The height of color ComboBox is too small (fixes #2043)

Browse source
This commit is contained in:
Alexander Koblov 2025-01-03 15:55:03 +03:00
commit 17fb9dcb9d
1 changed files with 32 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

33
components/KASToolBar/kascombobox.pas
View file

@ -180,6 +180,35 @@ begin
end;
end;
function CalculateHeight(ComboBox: TCustomComboBox): Integer;
var
DC: HDC;
R: TRect;
Flags: Cardinal;
OldFont: HGDIOBJ;
LabelText: String;
MaxHeight: Integer;
begin
with ComboBox do
begin
MaxHeight:= Constraints.MinMaxHeight(10000);
DC := GetDC(Parent.Handle);
try
LabelText:= Items.Text;
R := Rect(0, 0, 10000, MaxHeight);
OldFont := SelectObject(DC, HGDIOBJ(Font.Reference.Handle));
Flags := DT_CALCRECT or DT_EXPANDTABS or DT_SINGLELINE;
DrawText(DC, PChar(LabelText), Length(LabelText), R, Flags);
SelectObject(DC, OldFont);
Result := (R.Bottom - R.Top);
finally
ReleaseDC(Parent.Handle, DC);
end;
end;
end;
{ TComboBoxWithDelItems }
procedure TComboBoxWithDelItems.KeyDown(var Key: Word; Shift: TShiftState);
@ -257,6 +286,7 @@ begin
if (csSubComponent in ComponentStyle) then
begin
ItemHeight:= CalculateHeight(Self);
if (Parent.Anchors * [akLeft, akRight] = [akLeft, akRight]) then
Exit;
end;
@ -270,7 +300,8 @@ procedure TKASColorBox.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
begin
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
begin
ColorRectWidth:= Round(ColorRectWidth * AXProportion);
if ColorRectWidthStored then
ColorRectWidth:= Round(ColorRectWidth * AXProportion);
end;
// Don't auto adjust horizontal layout
inherited DoAutoAdjustLayout(AMode, 1.0, AYProportion);