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

ExCtrls: Fix CheckComboBoxEx not closing up when button is clicked in dropped-down state.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8145 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2021-11-05 22:22:36 +00:00
parent 8f89ccc7f4
commit 35e4b8de27
2 changed files with 30 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
components/exctrls/examples/CheckComboBoxEx/main.pas
View File

@ -52,7 +52,6 @@ begin
FCombo := TCheckComboBoxEx.Create(self); FCombo := TCheckComboBoxEx.Create(self);
FCombo.Align := alTop; FCombo.Align := alTop;
FCombo.BorderSpacing.Around := 6; FCombo.BorderSpacing.Around := 6;
//FCombo.AutoDropDown := true;
FCombo.Items.Add('Item 1'); FCombo.Items.Add('Item 1');
FCombo.Items.Add('Item 2'); FCombo.Items.Add('Item 2');
FCombo.Items.Add('Item 3'); FCombo.Items.Add('Item 3');

32
components/exctrls/source/excheckcombo.pas
View File

@ -66,6 +66,7 @@ type
FAutoDropDown: Boolean; FAutoDropDown: Boolean;
FButtonWidth: Integer; FButtonWidth: Integer;
FCheckListBox: TCheckListBox; FCheckListBox: TCheckListBox;
FCloseUpTime: TDateTime;
FDelimiter: Char; FDelimiter: Char;
FDropDownCount: Integer; FDropDownCount: Integer;
FDropDownImageIndex: TCheckComboBoxExImageIndex; FDropDownImageIndex: TCheckComboBoxExImageIndex;
@ -82,6 +83,8 @@ type
FOnDropDown: TNotifyEvent; FOnDropDown: TNotifyEvent;
FOnItemChange: TCheckItemChange; FOnItemChange: TCheckItemChange;
FOnItemClick: TCheckListClicked; FOnItemClick: TCheckListClicked;
procedure ButtonMouseDownHandler(Sender: TObject;
AButton: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure CheckComboBoxFormCloseHandler(Sender: TObject; var CloseAction: TCloseAction); procedure CheckComboBoxFormCloseHandler(Sender: TObject; var CloseAction: TCloseAction);
function GetButtonWidth: Integer; function GetButtonWidth: Integer;
function GetChecked(AIndex: Integer): Boolean; function GetChecked(AIndex: Integer): Boolean;
@ -108,6 +111,7 @@ type
protected protected
procedure ButtonClick; override; procedure ButtonClick; override;
procedure CloseUp; procedure CloseUp;
function CreateBuddy: TControl; override;
procedure CreateHandle; override; procedure CreateHandle; override;
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); override; const AXProportion, AYProportion: Double); override;
@ -661,13 +665,24 @@ begin
end; end;
procedure TCheckComboBoxEx.ButtonClick; procedure TCheckComboBoxEx.ButtonClick;
begin
{
if DroppedDown then
CloseUp
else
ShowPopup;
}
end;
procedure TCheckComboBoxEx.ButtonMouseDownHandler(Sender: TObject;
AButton: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin begin
if DroppedDown then if DroppedDown then
CloseUp CloseUp
else else
ShowPopup; ShowPopup;
end; end;
procedure TCheckComboBoxEx.CheckAll(AState: TCheckBoxState; procedure TCheckComboBoxEx.CheckAll(AState: TCheckBoxState;
AAllowGrayed: Boolean = true; AAllowDisabled: Boolean = true); AAllowGrayed: Boolean = true; AAllowDisabled: Boolean = true);
var var
@ -720,6 +735,13 @@ begin
InvalidateButton; InvalidateButton;
UpdateCaption; UpdateCaption;
DoCloseUp; DoCloseUp;
FCloseUpTime := Now();
end;
function TCheckComboBoxEx.CreateBuddy: TControl;
begin
Result := inherited;
TSpeedButton(Result).OnMouseDown := @ButtonMouseDownHandler;
end; end;
procedure TCheckComboBoxEx.CreateHandle; procedure TCheckComboBoxEx.CreateHandle;
@ -1041,6 +1063,9 @@ begin
end; end;
procedure TCheckComboBoxEx.ShowPopup; procedure TCheckComboBoxEx.ShowPopup;
const
MILLISECOND = 1.0/(24*60*60*100);
DELAY = 10*MILLISECOND;
var var
PopupOrigin: TPoint; PopupOrigin: TPoint;
PopupWidth: Integer; PopupWidth: Integer;
@ -1048,7 +1073,10 @@ var
begin begin
if FItems.Count = 0 then if FItems.Count = 0 then
exit; exit;
if Now() - FCloseUpTime < DELAY then
exit;
F := TCheckComboBoxForm.CreateNew(Application); F := TCheckComboBoxForm.CreateNew(Application);
F.FCaller := Self; F.FCaller := Self;
F.BiDiMode := BiDiMode; F.BiDiMode := BiDiMode;