From 87a33ca6b07431c8f87981f137fbe710fe61ae01 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sat, 30 Oct 2021 22:11:28 +0000 Subject: [PATCH] ExCtrls: Fix CheckComboBoxEx at designtime. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8134 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/exctrls/source/excheckcombo.pas | 360 +++++++++++++++++---- 1 file changed, 293 insertions(+), 67 deletions(-) diff --git a/components/exctrls/source/excheckcombo.pas b/components/exctrls/source/excheckcombo.pas index 1d6cf48f5..a5042b197 100644 --- a/components/exctrls/source/excheckcombo.pas +++ b/components/exctrls/source/excheckcombo.pas @@ -5,42 +5,67 @@ unit ExCheckCombo; interface uses - LCLIntf, LCLType, - Classes, SysUtils, Controls, StdCtrls, GroupedEdit, EditBtn, CheckLst, Forms; + LCLIntf, LCLType, Classes, SysUtils, Contnrs, + Controls, StdCtrls, GroupedEdit, EditBtn, CheckLst, Forms; type { TCheckComboBoxEx } TCheckItemChange = procedure(Sender: TObject; AIndex: Integer) of object; TCheckComboBoxHintMode = (cbhmDefault, cbhmItems); - + + TCheckComboBoxExStrings = class(TStringList) + private + function GetChecked(AIndex: Integer): Boolean; + function GetEnabled(AIndex: Integer): Boolean; + function GetObj(AIndex: Integer): TObject; + function GetState(AIndex: Integer): TCheckboxState; + procedure SetChecked(AIndex: Integer; AValue: Boolean); + procedure SetEnabled(AIndex: Integer; AValue: Boolean); + procedure SetObj(AIndex: Integer; AValue: TObject); + procedure SetState(AIndex: Integer; AValue: TCheckboxState); + protected + procedure InsertItem(AIndex: Integer; const AText: string); override; + procedure InsertItem(AIndex: Integer; const AText: string; Obj: TObject); override; + + public + procedure Assign(ASource: TPersistent); override; + procedure Clear; override; + procedure Delete(AIndex: Integer); override; + property Checked[AIndex: Integer]: Boolean read GetChecked write SetChecked; + property Enabled[AIndex: Integer]: boolean read GetEnabled write SetEnabled; + property Objects[AIndex: Integer]: TObject read GetObj write SetObj; + property State[AIndex: Integer]: TCheckboxState read GetState write SetState; + end; + TCheckComboBoxEx = class(TEditButton) private + FAllowGrayed: Boolean; FAutoDropDown: Boolean; FCheckListBox: TCheckListBox; FDelimiter: Char; FDropDownCount: Integer; - FDropDownForm: TForm; + //FDropDownForm: TForm; FDroppedDown: Boolean; FEscCancels: Boolean; FItemIndex: Integer; + FItems: TCheckComboBoxExStrings; FItemWidth: Integer; FHintMode: TCheckComboBoxHintMode; FSavedChecks: array of Integer; + FSorted: Boolean; FOnChange: TNotifyEvent; FOnCloseUp: TNotifyEvent; FOnDropDown: TNotifyEvent; FOnItemChange: TCheckItemChange; FOnItemClick: TCheckListClicked; procedure CloseUpHandler(Sender: TObject); - function GetAllowGrayed: Boolean; function GetChecked(AIndex: Integer): Boolean; function GetItemEnabled(AIndex: Integer): Boolean; - function GetItemIndex: Integer; function GetItems: TStrings; - function GetSorted: Boolean; function GetState(AIndex: Integer): TCheckBoxState; procedure ItemClickHandler(Sender: TObject; AIndex: Integer); + procedure ItemsToCheckListbox(ACheckListbox: TCheckListbox); procedure SetAllowGrayed(AValue: Boolean); procedure SetChecked(AIndex: Integer; const AValue: Boolean); procedure SetDelimiter(AValue: Char); @@ -73,7 +98,7 @@ type constructor Create(AOwner: TComponent); override; destructor Destroy; override; function AddItem(AText: String; AChecked: Boolean = false; AEnabled: Boolean = true): Integer; - procedure CheckAll(AState: TCheckBoxState; aAllowGrayed: Boolean = true; aAllowDisabled: Boolean = true); + procedure CheckAll(AState: TCheckBoxState; AAllowGrayed: Boolean = true; AAllowDisabled: Boolean = true); procedure Clear; procedure Toggle(AIndex: Integer); // public properties @@ -82,7 +107,7 @@ type property ItemEnabled[AIndex: Integer]: Boolean read GetItemEnabled write SetItemEnabled; property Text; published - property AllowGrayed: Boolean read GetAllowGrayed write SetAllowGrayed default false; + property AllowGrayed: Boolean read FAllowGrayed write SetAllowGrayed default false; property AutoDropDown: Boolean read FAutoDropDown write FAutoDropDown default false; property Delimiter: char read FDelimiter write SetDelimiter default ';'; property DropDownCount: Integer read FDropDownCount write SetDropDownCount default 8; @@ -91,7 +116,7 @@ type property ItemIndex: Integer read FItemIndex write SetItemIndex default -1; property Items: TStrings read GetItems write SetItems; property ItemWidth: Integer read FItemWidth write FItemWidth default 0; - property Sorted: Boolean read GetSorted write SetSorted default false; + property Sorted: Boolean read FSorted write SetSorted default false; property OnChange: TNotifyEvent read FOnChange write FOnChange; property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp; property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown; @@ -149,7 +174,118 @@ implementation uses Buttons, Themes, WSForms; -{ TCCBEdit } // CCB = CheckComboBox +{ TCCBItem } // CCB = CheckComboBox +type + TCCBItem = class + Caption: String; + State: TCheckboxState; + Enabled: Boolean; + Obj: TObject; + constructor Create; + end; + +constructor TCCBItem.Create; +begin + State := cbUnchecked; + Enabled := true; +end; + + +{ TCheckComboBoxExStrings } + +procedure TCheckComboBoxExStrings.Assign(ASource: TPersistent); +var + i: Integer; +begin + inherited Assign(ASource); + if (ASource is TCheckComboBoxExStrings) then + for i := 0 to Count-1 do + begin + State[i] := TCheckComboBoxExStrings(ASource).State[i]; + Enabled[i] := TCheckComboBoxExStrings(ASource).Enabled[i]; + end; +end; + +procedure TCheckComboBoxExStrings.Clear; +var + i: Integer; +begin + for i := 0 to Count-1 do + TCCBItem(inherited Objects[i]).Free; + inherited; +end; + +procedure TCheckComboBoxExStrings.Delete(AIndex: Integer); +begin + TCCBItem(inherited Objects[AIndex]).Free; + inherited; +end; + +function TCheckComboBoxExStrings.GetChecked(AIndex: Integer): Boolean; +begin + Result := GetState(AIndex) = cbChecked; +end; + +function TCheckComboBoxExStrings.GetEnabled(AIndex: Integer): Boolean; +begin + Result := TCCBItem(inherited Objects[AIndex]).Enabled; +end; + +function TCheckComboBoxExStrings.GetObj(AIndex: Integer): TObject; +begin + Result := TCCBItem(inherited Objects[AIndex]).Obj; +end; + +function TCheckComboBoxExStrings.GetState(AIndex: Integer): TCheckboxState; +begin + Result := TCCBItem(inherited Objects[AIndex]).State; +end; + +procedure TCheckComboBoxExStrings.InsertItem(AIndex: Integer; const AText: String); +begin + inherited InsertItem(AIndex, AText, TCCBItem.Create); +end; + +procedure TCheckComboBoxExStrings.InsertItem(AIndex: Integer; const AText: String; + Obj: TObject); +begin + InsertItem(AIndex, AText); + TCCBItem(inherited Objects[AIndex]).Obj := Obj; +end; + +procedure TCheckComboBoxExStrings.SetChecked(AIndex: Integer; AValue: Boolean); +begin + if AValue then + SetState(AIndex, cbChecked) + else + SetState(AIndex, cbUnchecked); +end; + +procedure TCheckComboBoxExStrings.SetEnabled(AIndex: Integer; AValue: Boolean); +var + item: TCCBItem; +begin + item := TCCBItem(inherited Objects[AIndex]); + if item.Enabled = AValue then exit; + item.Enabled := AValue; +end; + +procedure TCheckComboBoxExStrings.SetObj(AIndex: Integer; AValue: TObject); +begin + TCCBItem(inherited Objects[AIndex]).Obj := AValue; +end; + +procedure TCheckComboBoxExStrings.SetState(AIndex: Integer; AValue: TCheckBoxState); +var + item: TCCBItem; +begin + item := TCCBItem(inherited Objects[AIndex]); + if item.State = AValue then exit; + item.State := AValue; +end; + + +{ TCCBEdit } type TCCBEdit = class(TEbEdit) protected @@ -317,6 +453,8 @@ begin Button.Width := GetSystemMetrics(SM_CXVSCROLL); FDelimiter := ';'; FDropDownCount := 8; + FItems := TCheckComboBoxExStrings.Create; + (* FDropDownForm := TCheckComboBoxForm.CreateNew(Self); with TCheckComboBoxForm(FDropDownForm) do begin @@ -324,24 +462,38 @@ begin FCaller := self; OnHide := @CloseUpHandler; FCheckListbox.OnItemClick := @ItemClickHandler; + Visible := false; end; + *) FEscCancels := true; end; destructor TCheckComboBoxEx.Destroy; begin + FItems.Free; inherited Destroy; end; function TCheckComboBoxEx.AddItem(AText: String; AChecked: Boolean = false; AEnabled: Boolean = true): Integer; +var + j: Integer; begin - with FCheckListBox do - begin - Result := Items.Add(AText); - Checked[Result] := AChecked; - ItemEnabled[Result] := AEnabled; - end; + j := FItems.Add(AText); + if AChecked then + FItems.State[j] := cbChecked + else + FItems.State[j] := cbUnchecked; + FItems.Enabled[j] := AEnabled; + + if FDroppedDown then + with FCheckListBox do + begin + Result := Items.Add(AText); + Checked[Result] := AChecked; + ItemEnabled[Result] := AEnabled; + end; + UpdateCaption; end; @@ -352,16 +504,38 @@ end; procedure TCheckComboBoxEx.CheckAll(AState: TCheckBoxState; AAllowGrayed: Boolean = true; AAllowDisabled: Boolean = true); +var + i: Integer; begin - with FCheckListBox do - CheckAll(AState, AAllowGrayed, AAllowDisabled); + for i := 0 to FItems.Count-1 do + begin + if not FItems.Enabled[i] and not AAllowDisabled then + Continue; + if AState in [cbChecked, cbUnchecked] then + FItems.State[i] := AState + else if (AState = cbGrayed) then + begin + if AAllowGrayed then + FItems.State[i] := cbGrayed + else + FItems.State[i] := cbUnChecked; + end; + end; + + if FDroppedDown then + with FCheckListBox do + CheckAll(AState, AAllowGrayed, AAllowDisabled); + UpdateCaption; DoChange; end; procedure TCheckComboBoxEx.Clear; begin - FCheckListBox.Clear; + FItems.Clear; + + if FDroppedDown then + FCheckListBox.Clear; UpdateCaption; DoChange; end; @@ -435,11 +609,6 @@ begin Key := 0; end; -function TCheckComboBoxEx.GetAllowGrayed: Boolean; -begin - Result := FCheckListbox.AllowGrayed; -end; - function TCheckComboBoxEx.GetBuddyClassType: TControlClass; begin Result := TCCBButton; @@ -447,7 +616,7 @@ end; function TCheckComboBoxEx.GetChecked(AIndex: Integer): Boolean; begin - Result := FCheckListBox.Checked[AIndex]; + Result := FItems.Checked[AIndex]; end; function TCheckComboBoxEx.GetEditorClassType: TGEEditClass; @@ -457,27 +626,17 @@ end; function TCheckComboBoxEx.GetItemEnabled(AIndex: Integer): Boolean; begin - Result := FCheckListbox.ItemEnabled[AIndex]; -end; - -function TCheckComboBoxEx.GetItemIndex: Integer; -begin - Result := TCheckComboBoxForm(FDropDownForm).FCheckListBox.ItemIndex; + Result := FItems.Enabled[AIndex]; end; function TCheckComboBoxEx.GetItems: TStrings; begin - Result := FCheckListBox.Items; -end; - -function TCheckComboBoxEx.GetSorted: Boolean; -begin - Result := FCheckListbox.Sorted; + Result := FItems; end; function TCheckComboBoxEx.GetState(AIndex: Integer): TCheckboxState; begin - Result := FCheckListBox.State[AIndex]; + Result := FItems.State[AIndex]; end; procedure TCheckComboBoxEx.ItemClickHandler(Sender: TObject; AIndex: Integer); @@ -488,24 +647,44 @@ begin DoItemClick(AIndex); end; +procedure TCheckComboBoxEx.ItemsToCheckListbox(ACheckListbox: TCheckListbox); +var + i: Integer; +begin + ACheckListbox.Items.BeginUpdate; + try + ACheckListbox.Items.Clear; + for i := 0 to FItems.Count-1 do + begin + ACheckListbox.Items.Add(FItems[i]); + ACheckListbox.State[i] := FItems.State[i]; + ACheckListbox.ItemEnabled[i] := FItems.Enabled[i]; + end; + if (FItemIndex > -1) and (FItemIndex < ACheckListbox.Count) then + ACheckListbox.ItemIndex := FItemIndex; + finally + ACheckListbox.Items.EndUpdate; + end; +end; + procedure TCheckComboBoxEx.RestoreInitialChecks; var i: Integer; begin - for i := 0 to FCheckListbox.Items.Count-1 do - FCheckListbox.Checked[i] := false; + for i := 0 to FItems.Count-1 do + FItems.Checked[i] := false; for i := 0 to High(FSavedChecks) do - FCheckListbox.Checked[FSavedChecks[i]] := true; + FItems.Checked[FSavedChecks[i]] := true; end; procedure TCheckComboBoxEx.SaveInitialChecks; var i, n: Integer; begin - SetLength(FSavedChecks, FCheckListbox.Items.Count); + SetLength(FSavedChecks, FItems.Count); n := 0; - for i := 0 to FCheckListbox.Items.Count-1 do - if FCheckListbox.Checked[i] then + for i := 0 to FItems.Count-1 do + if FItems.Checked[i] then begin FSavedChecks[n] := i; inc(n); @@ -515,27 +694,41 @@ end; procedure TCheckComboBoxEx.SetAllowGrayed(AValue: Boolean); begin - if GetAllowGrayed = AValue then exit; - FCheckListBox.AllowGrayed := AValue; + if FAllowGrayed = AValue then exit; + FAllowGrayed := AValue; + + if FDroppedDown then + FCheckListBox.AllowGrayed := AValue; end; procedure TCheckComboBoxEx.SetBiDiMode(AValue: TBiDiMode); begin if AValue = BiDiMode then exit; + inherited SetBiDiMode(AValue); - FDropDownForm.BiDiMode := AValue; + + if FDroppedDown then + FCheckListBox.BiDiMode := AValue; if IsRightToLeft then Buddy.Align := alLeft else Buddy.Align := alRight; + UpdateCaption; end; procedure TCheckComboBoxEx.SetChecked(AIndex: Integer; const AValue: Boolean); begin - if GetChecked(AIndex) = AValue then + if FItems.Checked[AIndex] = AValue then exit; - FCheckListBox.Checked[AIndex] := AValue; + if AValue then + FItems.State[AIndex] := cbChecked + else + FItems.State[AIndex] := cbUnchecked; + + if FDroppedDown then + FCheckListBox.Checked[AIndex] := AValue; + UpdateCaption; DoChange; DoItemChange(AIndex); @@ -556,20 +749,26 @@ end; procedure TCheckComboBoxEx.SetItemEnabled(AIndex: Integer; const AValue: Boolean); begin - if GetItemEnabled(AIndex) = AValue then exit; - FCheckListbox.ItemEnabled[AIndex] := AValue; + if FItems.Enabled[AIndex] = AValue then exit; + FItems.Enabled[AIndex] := AValue; + + if FDroppedDown then + FCheckListbox.ItemEnabled[AIndex] := AValue; end; procedure TCheckComboBoxEx.SetItemIndex(AValue: Integer); begin - if GetItemIndex() = AValue then exit; - FCheckListBox.ItemIndex := AValue; - // todo: scroll in view + if FItemIndex = AValue then exit; + FItemIndex := AValue; + if FDroppedDown then + FCheckListBox.ItemIndex := AValue; end; procedure TCheckComboBoxEx.SetItems(const AValue: TStrings); begin - FCheckListBox.Items.Assign(AValue); + FItems.Assign(AValue); + if FDroppedDown then + FCheckListBox.Items.Assign(AValue); end; procedure TCheckComboBoxEx.SetItemWidth(AValue: Integer); @@ -583,13 +782,25 @@ end; procedure TCheckComboBoxEx.SetSorted(AValue: Boolean); begin - FCheckListbox.Sorted := AValue; + if AValue = FSorted then + exit; + + FSorted := AValue; + if FSorted then + FItems.Sort; + UpdateCaption; end; procedure TCheckComboBoxEx.SetState(AIndex: Integer; const AValue: TCheckBoxState); begin - FCheckListbox.State[AIndex] := AValue; + if FItems.State[AIndex] = AValue then + exit; + + FItems.State[AIndex] := AValue; + if FDroppedDown then + FCheckListbox.State[AIndex] := AValue; + DoChange; DoItemChange(AIndex); end; @@ -598,18 +809,29 @@ procedure TCheckComboBoxEx.ShowPopup; var PopupOrigin: TPoint; PopupWidth: Integer; + F: TCheckComboBoxForm; begin + if FItems.Count = 0 then + exit; + + F := TCheckComboBoxForm.CreateNew(Application); + F.FCaller := Self; + F.BiDiMode := BiDiMode; if DoubleBuffered then - TCheckComboBoxForm(FDropDownForm).ActivateDoubleBuffered; + F.ActivateDoubleBuffered; + F.FCheckListBox.AllowGrayed := FAllowGrayed; PopupOrigin := ControlToScreen(Point(0, Height)); if FItemWidth > 0 then PopupWidth := FItemWidth else PopupWidth := Self.Width; - TCheckComboBoxForm(FDropDownForm).Initialize(FDropDownCount, PopupOrigin, PopupWidth); + ItemsToCheckListbox(F.FCheckListbox); + F.Initialize(FDropDownCount, PopupOrigin, PopupWidth); SaveInitialChecks; - FDropDownForm.Show; + F.FCheckListbox.OnItemClick := @ItemClickHandler; + F.Show; FDroppedDown := true; + FCheckListbox := F.FCheckListbox; DoDropDown; end; @@ -623,17 +845,21 @@ var i: Integer; s: String; begin + if FDroppedDown then + for i := 0 to FCheckListBox.Items.Count - 1 do + FItems.State[i] := FCheckListbox.State[i]; + s := ''; if IsRightToLeft then begin - for i := FCheckListBox.Count-1 downto 0 do - if FCheckListbox.Checked[i] then - s := s + FCheckListbox.items[i] + FDelimiter + ' ' + for i := FItems.Count-1 downto 0 do + if FItems.Checked[i] then + s := s + FItems[i] + FDelimiter + ' ' end else begin - for i := 0 to FCheckListbox.Count-1 do - if FCheckListbox.Checked[i] then - s := s + FCheckListbox.Items[i] + FDelimiter + ' '; + for i := 0 to FItems.Count-1 do + if FItems.Checked[i] then + s := s + FItems[i] + FDelimiter + ' '; end; if s <> '' then SetLength(s, Length(s)-2);