1 { Visual components TComboBoxEx and TCheckComboBox
2 
3   Copyright (C) 2014 Vojtěch Čihák, e-mail: cihakvjtch@seznam.cz
4 
5   This library is free software; you can redistribute it and/or modify it under the terms of the
6   GNU Library General Public License as published by the Free Software Foundation; either version
7   2 of the License, or (at your option) any later version with the following modification:
8 
9   As a special exception, the copyright holders of this library give you permission to link this
10   library with independent modules to produce an executable, regardless of the license terms of
11   these independent modules,and to copy and distribute the resulting executable under terms of
12   your choice, provided that you also meet, for each linked independent module, the terms and
13   conditions of the license of that module. An independent module is a module which is not derived
14   from or based on this library. If you modify this library, you may extend this exception to your
15   version of the library, but you are not obligated to do so. If you do not wish to do so, delete
16   this exception statement from your version.
17 
18   This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
19   without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See
20   the GNU Library General Public License for more details.
21 
22   You should have received a copy of the GNU Library General Public License along with this
23   library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street - Fifth
24   Floor, Boston, MA 02110-1335, USA.
25 }
26 
27 unit ComboEx;
28 {$mode objfpc}{$H+}
29 
30 interface
31 
32 uses
33   Classes, SysUtils, types,
34   LCLIntf, LCLType, LMessages, LResources, LazLoggerBase,
35   ImgList, Controls, StdCtrls, ComCtrls, ExtCtrls, Graphics, GraphUtil,
36   Themes, Forms;
37 
38 type
39   {$PACKENUM 2}
40   TAutoCompleteOption = (acoAutoSuggest, acoAutoAppend, acoSearch, acoFilterPrefixes,
41                          acoUseTab, acoUpDownKeyDropsList, acoRtlReading);
42   TAutoCompleteOptions = set of TAutoCompleteOption;
43   TComboBoxExStyle = (csExDropDown, csExSimple, csExDropDownList);
44   TComboBoxExStyleEx = (csExCaseSensitive, csExNoEditImage, csExNoEditImageIndent,
45                         csExNoSizeLimit, csExPathWordBreak);
46   TComboBoxExStyles = set of TComboBoxExStyleEx;
47   TCustomData = Pointer;
48   TListControlItems = class;  { forward }
49   TListItemsCompare = function (AList: TListControlItems; AItem1, AItem2: Integer): Integer;
50   TListItemsSortType = TSortType;
51   { Events }
52   TCheckItemChange = procedure(Sender: TObject; AIndex: Integer) of object;
53   TListControlItem = class;  { forward }
Listnull54   TListCompareEvent = function(AList: TListControlItems; AItem1, AItem2: TListControlItem): Integer of object;
55 
56   { TListControlItem }
57   TListControlItem = class(TCollectionItem)
58   private
59     FCaption: TTranslateString;
60     FData: TCustomData;
61     FImageIndex: TImageIndex;
62     procedure SetCaption(const AValue: TTranslateString);
63     procedure SetImageIndex(AValue: TImageIndex);
64   public
65     property Data: TCustomData read FData write FData;
66     constructor Create(ACollection: TCollection); override;
67   published
68     property Caption: TTranslateString read FCaption write SetCaption;
69     property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
70   end;
71 
72   { TComboExItem }
73   TComboExItem = class(TListControlItem)
74   private
75     FIndent: Integer;
76     FOverlayImageIndex: TImageIndex;
77     FSelectedImageIndex: TImageIndex;
78     procedure SetIndent(AValue: Integer);
79     procedure SetOverlayImageIndex(AValue: TImageIndex);
80     procedure SetSelectedImageIndex(AValue: TImageIndex);
81   protected const
82     cDefCaption = 'ItemEx';
83   public
84     constructor Create(ACollection: TCollection); override;
85     destructor Destroy; override;
86   published
87     property Indent: Integer read FIndent write SetIndent default -1;
88     property OverlayImageIndex: TImageIndex read FOverlayImageIndex write SetOverlayImageIndex default -1;
89     property SelectedImageIndex: TImageIndex read FSelectedImageIndex write SetSelectedImageIndex default -1;
90   end;
91 
92   { TListControlItems }
93   TListControlItems = class(TOwnedCollection)
94   private
95     FCaseSensitive: Boolean;
96     FSortType: TListItemsSortType;
97     FOnCompare: TListCompareEvent;
98     FCompare: TListItemsCompare;
GetItemsnull99     function GetItems(AIndex: Integer): TListControlItem;
100     procedure SetCaseSensitive(AValue: Boolean);
101     procedure SetSortType(AValue: TListItemsSortType);
102   protected
CompareItemsnull103     function CompareItems(AItem1, AItem2: TListControlItem): Integer; virtual;
DoCustomSortnull104     function DoCustomSort(AItem1, AItem2: TListControlItem): Integer;
DoOnComparenull105     function DoOnCompare(AItem1, AItem2: TListControlItem): Integer;
106     procedure Update(AItem: TCollectionItem); override;
107   public
Addnull108     function Add: TListControlItem;
109     procedure CustomSort(ACompare: TListItemsCompare);
110     procedure Sort;
111     property Items[AIndex: Integer]: TListControlItem read GetItems; default;
112   published
113     property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive default False;
114     property SortType: TListItemsSortType read FSortType write SetSortType default stNone;
115     property OnCompare: TListCompareEvent read FOnCompare write FOnCompare;
116   end;
117 
118   { TComboExItems }
119   TComboExItems = class(TListControlItems)
120   private
GetComboItemsnull121     function GetComboItems(AIndex: Integer): TComboExItem;
122   protected
123     FAddingOrDeletingItem: Boolean;
124     procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); override;
125     procedure Update(Item: TCollectionItem); override;
126   public
Addnull127     function Add: TComboExItem;
AddItemnull128     function AddItem(const ACaption: string; AImageIndex: SmallInt = -1;
129                  AOverlayImageIndex: SmallInt = -1; ASelectedImageIndex: SmallInt = -1;
130                  AIndent: SmallInt = -1; AData: TCustomData = nil): TComboExItem;
Insertnull131     function Insert(AIndex: Integer): TComboExItem;
132     property ComboItems[AIndex: Integer]: TComboExItem read GetComboItems; default;
133   end;
134 
135   { TCustomComboBoxEx }
136   TCustomComboBoxEx = class(TCustomComboBox)
137   private
138     FAutoCompleteOptions: TAutoCompleteOptions;
139     FImages: TCustomImageList;
140     FItemsEx: TComboExItems;
141     FStyle: TComboBoxExStyle;
142     FStyleEx: TComboBoxExStyles;
143     FImagesWidth: Integer;
144     procedure SetImages(AValue: TCustomImageList);
145     procedure SetImagesWidth(const aImagesWidth: Integer);
146     procedure SetStyle(AValue: TComboBoxExStyle); reintroduce;
147     procedure SetStyleEx(AValue: TComboBoxExStyles);
148   protected const
149     cDefAutoCompOpts = [acoAutoAppend];
150     cDefStyle = csExDropDown;
151   protected
152     FNeedMeasure: Boolean;
153     FRightToLeft: Boolean;
154     FTextHeight: SmallInt;
155     procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED;
156     procedure DrawItem(Index: Integer; ARect: TRect; State: TOwnerDrawState); override;
157     procedure FontChanged(Sender: TObject); override;
158     procedure InitializeWnd; override;
159     procedure SetItemHeight(const AValue: Integer); override;
160   public
161     constructor Create(TheOwner: TComponent); override;
162     destructor Destroy; override;
Addnull163     function Add: Integer; overload;
164     procedure Add(const ACaption: string; AIndent: Integer = -1;
165                   AImgIdx: TImageIndex = -1; AOverlayImgIdx: TImageIndex = -1;
166                   ASelectedImgIdx: TImageIndex = -1); overload;
167     procedure AddItem(const Item: String; AnObject: TObject); override;
168     procedure AssignItemsEx(AItems: TStrings); overload;
169     procedure AssignItemsEx(AItemsEx: TComboExItems); overload;
170     procedure Clear; override;
171     procedure Delete(AIndex: Integer);
172     procedure DeleteSelected;
173     procedure Insert(AIndex: Integer; const ACaption: string; AIndent: Integer = -1;
174                      AImgIdx: TImageIndex = -1; AOverlayImgIdx: TImageIndex = -1;
175                      ASelectedImgIdx: TImageIndex = -1);
176     property AutoCompleteOptions: TAutoCompleteOptions read FAutoCompleteOptions
177              write FAutoCompleteOptions default cDefAutoCompOpts;
178     property Images: TCustomImageList read FImages write SetImages;
179     property ImagesWidth: Integer read FImagesWidth write SetImagesWidth default 0;
180     property ItemsEx: TComboExItems read FItemsEx write FItemsEx;
181     property Style: TComboBoxExStyle read FStyle write SetStyle default cDefStyle;
182     property StyleEx: TComboBoxExStyles read FStyleEx write SetStyleEx default [];
183   end;
184 
185   { TComboBoxEx }
186   TComboBoxEx = class(TCustomComboBoxEx)
187   published
188     property Align;
189     property Anchors;
190     property ArrowKeysTraverseList;
191     property AutoComplete;
192     property AutoCompleteOptions;
193     property AutoCompleteText;
194     property AutoDropDown;
195     property AutoSelect;
196     property AutoSize;
197     property BidiMode;
198     property BorderSpacing;
199     property BorderStyle;
200     property CharCase;
201     property Color;
202     property Constraints;
203     property DragCursor;
204     property DragKind;
205     property DragMode;
206     property DropDownCount;
207     property Enabled;
208     property Font;
209     property Images;
210     property ImagesWidth;
211     property ItemHeight;
212     property ItemsEx;  { do not change order; ItemsEx must be before ItemIndex }
213     property ItemIndex;
214     property ItemWidth;
215     property MaxLength;
216     property OnChange;
217     property OnChangeBounds;
218     property OnClick;
219     property OnCloseUp;
220     property OnContextPopup;
221     property OnDblClick;
222     property OnDragDrop;
223     property OnDragOver;
224     property OnDropDown;
225     property OnEditingDone;
226     property OnEndDock;
227     property OnEndDrag;
228     property OnEnter;
229     property OnExit;
230     property OnGetItems;
231     property OnKeyDown;
232     property OnKeyPress;
233     property OnKeyUp;
234     property OnMouseDown;
235     property OnMouseEnter;
236     property OnMouseLeave;
237     property OnMouseMove;
238     property OnMouseUp;
239     property OnMouseWheel;
240     property OnMouseWheelDown;
241     property OnMouseWheelUp;
242     property OnSelect;
243     property OnStartDock;
244     property OnStartDrag;
245     property OnUTF8KeyPress;
246     property ParentBidiMode;
247     property ParentColor;
248     property ParentFont;
249     property ParentShowHint;
250     property PopupMenu;
251     property ReadOnly;
252     property ShowHint;
253     property Style;
254     property StyleEx;
255     property TabOrder;
256     property TabStop;
257     property Text;
258     property Visible;
259   end;
260 
261   { TCheckComboItemState }
262   TCheckComboItemState = class
263   public
264     State: TCheckBoxState;
265     Enabled: Boolean;
266     Data: TObject;
267   end;
268 
269   { TCustomCheckCombo }
270   TCustomCheckCombo = class(TCustomComboBox)
271   private
272     FAllowGrayed: Boolean;
273     FOnItemChange: TCheckItemChange;
274     procedure AsyncCheckItemStates(Data: PtrInt);
GetCheckednull275     function GetChecked(AIndex: Integer): Boolean;
GetCountnull276     function GetCount: Integer;
GetItemEnablednull277     function GetItemEnabled(AIndex: Integer): Boolean;
GetObjectnull278     function GetObject(AIndex: Integer): TObject;
GetStatenull279     function GetState(AIndex: Integer): TCheckBoxState;
280     procedure SetChecked(AIndex: Integer; AValue: Boolean);
281     procedure SetItemEnabled(AIndex: Integer; AValue: Boolean);
282     procedure SetObject(AIndex: Integer; AValue: TObject);
283     procedure SetState(AIndex: Integer; AValue: TCheckBoxState);
284   protected
285     FCheckHighlight: Boolean;
286     FCheckSize: TSize;
287     FDropped: Boolean;
288     FHilightedIndex: Integer;
289     FHiLiteLeft: Integer;
290     FHiLiteRight: Integer;
291     FNeedMeasure: Boolean;
292     FRejectDropDown: Boolean;
293     FRejectToggleOnSelect: Boolean;
294     FRightToLeft: Boolean;
295     FTextHeight: SmallInt;
296     procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED;
297     procedure ClearItemStates;
298     procedure CloseUp; override;
299     procedure DrawItem(Index: Integer; ARect: TRect; State: TOwnerDrawState); override;
300     procedure DropDown; override;
301     procedure FontChanged(Sender: TObject); override;
302     procedure InitializeWnd; override;
303     procedure InitItemStates;
304     procedure CheckItemStates;
305     procedure QueueCheckItemStates;
306     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
307     procedure Loaded; override;
308     procedure MouseLeave; override;
309     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
310     procedure SetItemHeight(const AValue: Integer); override;
311     procedure SetItems(const Value: TStrings); override;
312     procedure Select; override;
313   public
314     constructor Create(AOwner: TComponent); override;
315     destructor Destroy; override;
316     procedure AddItem(const AItem: string; AState: TCheckBoxState; AEnabled: Boolean = True); reintroduce;
317     procedure AssignItems(AItems: TStrings);
318     procedure Clear; override;
319     procedure DeleteItem(AIndex: Integer);
320     procedure CheckAll(AState: TCheckBoxState; AAllowGrayed: Boolean = True; AAllowDisabled: Boolean = True);
321     procedure Toggle(AIndex: Integer);
322     property AllowGrayed: Boolean read FAllowGrayed write FAllowGrayed default False;
323     property Count: Integer read GetCount;
324     property Checked[AIndex: Integer]: Boolean read GetChecked write SetChecked;
325     property ItemEnabled[AIndex: Integer]: Boolean read GetItemEnabled write SetItemEnabled;
326     property Objects[AIndex: Integer]: TObject read GetObject write SetObject;
327     property State[AIndex: Integer]: TCheckBoxState read GetState write SetState;
328     property OnItemChange: TCheckItemChange read FOnItemChange write FOnItemChange;
329   end;
330 
331   { TCheckComboBox }
332   TCheckComboBox = class(TCustomCheckCombo)
333   published
334     property Align;
335     property AllowGrayed;
336     property Anchors;
337     property ArrowKeysTraverseList;
338     property AutoDropDown;
339     property AutoSize;
340     property BidiMode;
341     property BorderSpacing;
342     property BorderStyle;
343     property Color;
344     property Constraints;
345     property Count;
346     property DragCursor;
347     property DragKind;
348     property DragMode;
349     property DropDownCount;
350     property Enabled;
351     property Font;
352     property ItemHeight;
353     property ItemIndex;
354     property Items;
355     property ItemWidth;
356     property MaxLength;
357     property OnChange;
358     property OnChangeBounds;
359     property OnClick;
360     property OnCloseUp;
361     property OnContextPopup;
362     property OnDblClick;
363     property OnDragDrop;
364     property OnDragOver;
365     property OnEndDrag;
366     property OnDropDown;
367     property OnEditingDone;
368     property OnEnter;
369     property OnExit;
370     property OnGetItems;
371     property OnItemChange;
372     property OnKeyDown;
373     property OnKeyPress;
374     property OnKeyUp;
375     property OnMouseDown;
376     property OnMouseEnter;
377     property OnMouseLeave;
378     property OnMouseMove;
379     property OnMouseUp;
380     property OnMouseWheel;
381     property OnMouseWheelDown;
382     property OnMouseWheelUp;
383     property OnStartDrag;
384     property OnSelect;
385     property OnUTF8KeyPress;
386     property ParentBidiMode;
387     property ParentColor;
388     property ParentFont;
389     property ParentShowHint;
390     property PopupMenu;
391     property ShowHint;
392     property Sorted;
393     property TabOrder;
394     property TabStop;
395     property Text;
396     property Visible;
397   end;
398 
399 procedure Register;
400 
401 implementation
402 
403 {$include comboex.inc}
404 
405 procedure Register;
406 begin
407   RegisterComponents('Misc', [TComboBoxEx, TCheckComboBox]);
408 end;
409 
410 end.
411 
412 
413