ExCtrls: Fix CheckComboboxEx having a zero-height dropdown after Laz commit e4043024. Minor optimization in MeasureItem.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8679 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-01-15 17:18:52 +00:00
parent 04a58a17c7
commit b01341302f

View File

@ -5,7 +5,8 @@ unit ExCheckCombo;
interface
uses
LCLIntf, LCLType, Classes, SysUtils, Controls, StdCtrls, ImgList,
LCLIntf, LCLType,
Classes, SysUtils, Controls, StdCtrls, ImgList,
GroupedEdit, EditBtn, CheckLst, Forms;
type
@ -215,6 +216,17 @@ implementation
uses
Buttons, Themes, WSForms;
type
TCustomListboxHelper = class helper for TCustomListbox
public
function CalculateStandardItemHeight: Integer;
end;
function TCustomListboxHelper.CalculateStandardItemHeight: Integer;
begin
Result := inherited;
end;
{ TCCBItem } // CCB = CheckComboBox
type
TCCBItem = class
@ -481,6 +493,7 @@ type
FCaller: TControl;
FCheckListBox: TCheckListBox;
FDropDownCount: Integer;
FStdItemHeight: Integer;
protected
procedure ActivateDoubleBuffered;
procedure DblClickHandler(Sender: TObject);
@ -503,6 +516,7 @@ begin
FCheckListbox.OnDblClick := @DblClickHandler;
FCheckListbox.OnKeyDown := @KeyDownHandler;
FDropDownCount := 8;
FStdItemHeight := FCheckListbox.CalculateStandardItemHeight;
end;
procedure TCheckComboBoxForm.ActivateDoubleBuffered;
@ -578,16 +592,20 @@ end;
procedure TCheckComboBoxForm.MeasureHeight(out AHeight: Integer);
var
i: Integer;
h: Integer = 0;
i, h, n: Integer;
begin
AHeight := 0;
for i := 0 to FCheckListbox.Items.Count-1 do
if i < FDropDownCount then
begin
FCheckListbox.MeasureItem(i, h);
inc(AHeight,h);
end;
n := FCheckListbox.Items.Count;
if FDropDownCount < n then
n := FDropDownCount;
for i := 0 to n-1 do
begin
h := -1;
FCheckListbox.MeasureItem(i, h);
if h = -1 then
h := FStdItemHeight;
inc(AHeight, h);
end;
inc(AHeight, 6);
end;