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