1{ 2 /*************************************************************************** 3 ComCtrls.pp 4 ----------- 5 Component Library Common Controls 6 Initial Revision : Sat Apr 10 22:49:32 CST 1999 7 8 9 ***************************************************************************/ 10 11 ***************************************************************************** 12 This file is part of the Lazarus Component Library (LCL) 13 14 See the file COPYING.modifiedLGPL.txt, included in this distribution, 15 for details about the license. 16 ***************************************************************************** 17} 18{ 19@abstract(Just a try to provide the same objects as the Delphi comctrls unit) 20@author(TCustomProgressBar - Stefan Hille <stoppok@osibisa.ms.sub.org>) 21@author(TTrackBar - Stefan Hille <stoppok@osibisa.ms.sub.org>) 22@created(1999) 23} 24unit ComCtrls; 25 26{$mode objfpc}{$H+} 27{$I lcl_defines.inc} 28 29interface 30 31uses 32 SysUtils, Types, Classes, Math, Laz_AVL_Tree, 33 // LazUtils 34 LazUTF8, LazUTF8Classes, LazLoggerBase, LazUtilities, 35 // LCL 36 LCLStrConsts, LResources, LCLIntf, LCLType, LMessages, WSLCLClasses, 37 WSReferences, LCLProc, GraphType, Graphics, ImgList, ActnList, Themes, Menus, 38 Controls, Forms, StdCtrls, ExtCtrls, ToolWin, Buttons; 39 40type 41 THitTest = (htAbove, htBelow, htNowhere, htOnItem, htOnButton, htOnIcon, 42 htOnIndent, htOnLabel, htOnRight, htOnStateIcon, htToLeft, htToRight); 43 THitTests = set of THitTest; 44 45 TStatusPanelStyle = (psText, psOwnerDraw); 46 TStatusPanelBevel = (pbNone, pbLowered, pbRaised); 47 48 TStatusBar = class; //forward declaration 49 50 TPanelPart = ( 51 ppText, // for text and text alignment 52 ppBorder, // for bevel and style 53 ppWidth // for width 54 ); 55 TPanelParts = set of TPanelPart; 56 57 { TStatusPanel } 58 59 //added. 60 TStatusPanelClass = class of TStatusPanel; 61 62 TStatusPanel = class(TCollectionItem) 63 private 64 FBidiMode: TBiDiMode; 65 FText: TCaption; 66 FWidth: Integer; 67 FAlignment: TAlignment; 68 FBevel: TStatusPanelBevel; 69 FParentBiDiMode: Boolean; 70 FStyle: TStatusPanelStyle; 71 procedure SetAlignment(Value: TAlignment); 72 procedure SetBevel(Value: TStatusPanelBevel); 73 procedure SetStyle(Value: TStatusPanelStyle); 74 procedure SetText(const Value: TCaption); 75 procedure SetWidth(Value: Integer); 76 protected 77 // field to use by interface. do not use it in the LCL 78 FIntfFlag: Integer; 79 function GetDisplayName: string; override; 80 procedure PanelChanged(const Parts: TPanelParts); 81 procedure SetIndex(Value: Integer); override; 82 public 83 constructor Create(ACollection: TCollection); override; 84 destructor Destroy; override; 85 procedure Assign(Source: TPersistent); override; 86 function StatusBar: TStatusBar; 87 published 88 property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify; 89 property Bevel: TStatusPanelBevel read FBevel write SetBevel default pbLowered; 90 property BidiMode: TBiDiMode read FBidiMode write FBidiMode default bdLeftToRight; 91 property ParentBiDiMode: Boolean read FParentBiDiMode write FParentBiDiMode default True; 92 property Style: TStatusPanelStyle read FStyle write SetStyle default psText; 93 property Text: TCaption read FText write SetText; 94 property Width: Integer read FWidth write SetWidth; 95 end; 96 97 TStatusPanels = class(TCollection) 98 private 99 FStatusBar: TStatusBar; 100 function GetItem(Index: Integer): TStatusPanel; 101 procedure SetItem(Index: Integer; Value: TStatusPanel); 102 protected 103 function GetOwner: TPersistent; override; 104 procedure Update(Item: TCollectionItem); override; 105 public 106 constructor Create(AStatusBar: TStatusBar); 107 function Add: TStatusPanel; 108 property Items[Index: Integer]: TStatusPanel read GetItem write SetItem; default; 109 property StatusBar: TStatusBar read FStatusBar; 110 end; 111 112 TSBCreatePanelClassEvent = procedure(Sender: TStatusBar; 113 var PanelClass: TStatusPanelClass) of object; 114 115 TDrawPanelEvent = procedure(StatusBar: TStatusBar; Panel: TStatusPanel; 116 const Rect: TRect) of object; 117 118 { TStatusBar } 119 120 TStatusBar = class(TWinControl) 121 private 122 FAutoHint: Boolean; 123 FCanvas: TCanvas; 124 FHandlePanelCount: integer; // realized panels in the Handle object 125 FHandleObjectNeedsUpdate: boolean; 126 FHandleUpdatePanelIndex: integer; // which panel in the handle object needs update 127 FOnCreatePanelClass: TSBCreatePanelClassEvent; 128 FSizeGrip: Boolean; 129 FUpdateLock: integer; // set by BeginUpdate/EndUpdate 130 FPanels: TStatusPanels; 131 FSimpleText: TCaption; 132 FSimplePanel: Boolean; 133 FOnDrawPanel: TDrawPanelEvent; 134 FOnHint: TNotifyEvent; 135 FUseSystemFont: Boolean; 136 procedure SetPanels(Value: TStatusPanels); 137 procedure SetSimpleText(const Value : TCaption); 138 procedure SetSimplePanel(Value : Boolean); 139 procedure SetSizeGrip(const AValue: Boolean); 140 protected 141 class procedure WSRegisterClass; override; 142 procedure BoundsChanged; override; 143 procedure CreateWnd; override; 144 procedure DestroyWnd; override; 145 procedure Loaded; override; 146 procedure UpdateHandleObject(PanelIndex: integer; PanelParts: TPanelParts); virtual; 147 procedure CalculatePreferredSize( 148 var PreferredWidth, PreferredHeight: integer; 149 WithThemeSpace: Boolean); override; 150 procedure SetBiDiMode(AValue: TBiDiMode); override; 151 152 //added. 153 function CreatePanel: TStatusPanel; virtual; 154 function CreatePanels: TStatusPanels; virtual; 155 function GetPanelClass: TStatusPanelClass; virtual; 156 157 function DoSetApplicationHint(AHintStr: String): Boolean; virtual; 158 function DoHint: Boolean; virtual; 159 procedure DrawPanel(Panel: TStatusPanel; const Rect: TRect); virtual; 160 procedure LMDrawItem(var Message: TLMDrawItems); message LM_DRAWITEM; 161 162 procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; 163 const AXProportion, AYProportion: Double); override; 164 public 165 constructor Create(TheOwner: TComponent); override; 166 destructor Destroy; override; 167 procedure InvalidatePanel(PanelIndex: integer; PanelParts: TPanelParts); virtual; 168 procedure BeginUpdate; 169 procedure EndUpdate; 170 function ExecuteAction(ExeAction: TBasicAction): Boolean; override; 171 function GetPanelIndexAt(X, Y: Integer): Integer; 172 function SizeGripEnabled: Boolean; 173 function UpdatingStatusBar: boolean; 174 property Canvas: TCanvas read FCanvas; 175 published 176 property Action; 177 property Align default alBottom; 178 property Anchors; 179 property AutoHint: Boolean read FAutoHint write FAutoHint default false; 180 property AutoSize default true; 181 property BiDiMode; 182 property BorderSpacing; 183 property BorderWidth; 184 property Color default {$ifdef UseCLDefault}clDefault{$else}clBtnFace{$endif}; 185 property Constraints; 186 property DragCursor; 187 property DragKind; 188 property DragMode; 189 property Enabled; 190 property Font; 191 property Panels: TStatusPanels read FPanels write SetPanels; 192 property ParentBiDiMode; 193 property ParentColor; 194 property ParentFont; 195 property ParentShowHint; 196 property PopupMenu; 197 property SimpleText: TCaption read FSimpleText write SetSimpleText; 198 property SimplePanel: Boolean read FSimplePanel write SetSimplePanel default True; 199 property SizeGrip: Boolean read FSizeGrip write SetSizeGrip default True; 200 property ShowHint; 201 property UseSystemFont: Boolean read FUseSystemFont write FUseSystemFont default True; 202 property Visible default true; 203 property OnClick; 204 property OnContextPopup; 205 property OnCreatePanelClass: TSBCreatePanelClassEvent read FOnCreatePanelClass write FOnCreatePanelClass; 206 property OnDblClick; 207 property OnDragDrop; 208 property OnDragOver; 209 property OnDrawPanel: TDrawPanelEvent read FOnDrawPanel write FOnDrawPanel; 210 property OnEndDock; 211 property OnEndDrag; 212 property OnHint: TNotifyEvent read FOnHint write FOnHint; 213 property OnMouseDown; 214 property OnMouseEnter; 215 property OnMouseLeave; 216 property OnMouseMove; 217 property OnMouseUp; 218 property OnMouseWheel; 219 property OnMouseWheelDown; 220 property OnMouseWheelUp; 221 property OnResize; 222 property OnStartDock; 223 property OnStartDrag; 224 end; 225 226 { TCustomPage } 227 228 TPageFlag = ( 229 pfAdded, // handle of page added to notebook handle 230 pfAdding, // currently handle of page adding to notebook handle 231 pfRemoving, // currently removing page handle from notebook handle 232 pfInserting // currently inserting page into notebook 233 ); 234 TPageFlags = set of TPageFlag; 235 236 TCustomPage = class(TWinControl) 237 private 238 FTabVisible: Boolean; 239 FFlags: TPageFlags; 240 FImageIndex: TImageIndex; 241 FOnHide: TNotifyEvent; 242 FOnShow: TNotifyEvent; 243 procedure SetImageIndex(const AValue: TImageIndex); 244 procedure SetTabVisible(const AValue: Boolean); 245 protected 246 class procedure WSRegisterClass; override; 247 procedure WMPaint(var Msg: TLMPaint); message LM_PAINT; 248 procedure SetParent(AParent: TWinControl); override; 249 property Flags: TPageFlags read FFlags write FFlags; 250 procedure CMHitTest(var Message: TLMNCHITTEST); message CM_HITTEST; 251 procedure CMVisibleChanged(var Message: TLMessage); message CM_VISIBLECHANGED; 252 function GetPageIndex: integer; virtual; 253 procedure SetPageIndex(AValue: Integer); virtual; 254 function GetTabVisible: Boolean; virtual; 255 function DialogChar(var Message: TLMKey): boolean; override; 256 procedure DoHide; virtual; 257 procedure DoShow; virtual; 258 procedure DestroyHandle; override; 259 procedure RealSetText(const AValue: TCaption); override; 260 public 261 constructor Create(TheOwner: TComponent); override; 262 function CanTab: boolean; override; 263 function IsControlVisible: Boolean; override; 264 function HandleObjectShouldBeVisible: boolean; override; 265 function VisibleIndex: integer; virtual; 266 procedure CheckNewParent(AParent: TWinControl); override; 267 property PageIndex: Integer read GetPageIndex write SetPageIndex; 268 property TabVisible: Boolean read GetTabVisible write SetTabVisible default True; 269 property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1; 270 property Left stored False; 271 property Top stored False; 272 property Width stored False; 273 property Height stored False; 274 property TabOrder stored False; 275 property Visible stored false; 276 property OnHide: TNotifyEvent read FOnHide write FOnHide; 277 property OnShow: TNotifyEvent read FOnShow write FOnShow; 278 end; 279 280 TCustomPageClass = class of TCustomPage; 281 282 { TNBPages } 283 284 TCustomTabControl = class; 285 286 { TNBBasePages } 287 288 TNBBasePages = class(TStrings) 289 protected 290 function IndexOfPage(const AnObject: TPersistent): Integer; virtual; abstract; 291 procedure InsertPage(Index: Integer; const APage: TCustomPage); virtual; abstract; 292 procedure DeletePage(Index: Integer); virtual; abstract; 293 function GetPage(Index: Integer): TCustomPage; virtual; abstract; 294 public 295 constructor Create(theNotebook: TCustomTabControl); virtual; 296 end; 297 298 TNBBasePagesClass = class of TNBBasePages; 299 300 TNBPages = class(TNBBasePages) 301 private 302 FPageList: TListWithEvent; 303 FNotebook: TCustomTabControl; 304 procedure PageListChange(Ptr: Pointer; AnAction: TListNotification); 305 protected 306 function Get(Index: Integer): String; override; 307 function GetCount: Integer; override; 308 function GetObject(Index: Integer): TObject; override; 309 procedure Put(Index: Integer; const S: String); override; 310 function IndexOfPage(const AnObject: TPersistent): Integer; override; 311 procedure InsertPage(Index: Integer; const APage: TCustomPage); override; // Internal Insert, no notification to TabControl 312 procedure DeletePage(Index: Integer); override; // Internal Delete, no notification to TabControl 313 function GetPage(Index: Integer): TCustomPage; override; // Wrapper to GetObj 314 property PageList: TListWithEvent read FPageList; 315 property Notebook: TCustomTabControl read FNotebook; 316 public 317 constructor Create(theNotebook: TCustomTabControl); override; 318 destructor Destroy; override; 319 procedure Clear; override; 320 procedure Delete(Index: Integer); override; 321 procedure Insert(Index: Integer; const S: String); override; 322 procedure Move(CurIndex, NewIndex: Integer); override; 323 end; 324 325 { TNBNoPages } 326 327 TNBNoPages = class(TNBBasePages) 328 private 329 //FNotebook: TCustomTabControl; 330 protected 331 function Get(Index: Integer): String; override; 332 function GetCount: Integer; override; // always 0 333 //function GetObject(Index: Integer): TObject; override; 334 //procedure Put(Index: Integer; const S: String); override; 335 function IndexOfPage(const AnObject: TPersistent): Integer; override; 336 //procedure InsertPage(Index: Integer; const APage: TCustomPage); override; 337 //procedure DeletePage(Index: Integer); override; 338 function GetPage(Index: Integer): TCustomPage; override; 339 public 340 //constructor Create(theNotebook: TCustomTabControl); override; 341 //destructor Destroy; override; 342 //procedure Clear; override; 343 //procedure Delete(Index: Integer); override; 344 //procedure Insert(Index: Integer; const S: String); override; 345 //procedure Move(CurIndex, NewIndex: Integer); override; 346 end; 347 348 { TCustomTabControl } 349 350 TTabChangingEvent = procedure(Sender: TObject; 351 var AllowChange: Boolean) of object; 352 353 TTabPosition = (tpTop, tpBottom, tpLeft, tpRight); 354 355 TTabStyle = (tsTabs, tsButtons, tsFlatButtons); 356 357 TTabGetImageEvent = procedure(Sender: TObject; TabIndex: Integer; 358 var ImageIndex: Integer) of object; 359 360 // These are LCL additions 361 TCTabControlOption = ( 362 nboShowCloseButtons, nboMultiLine, nboHidePageListPopup, 363 nboKeyboardTabSwitch, nboShowAddTabButton, nboDoChangeOnSetIndex); 364 TCTabControlOptions = set of TCTabControlOption; 365 TCTabControlCapability = ( 366 nbcShowCloseButtons, nbcMultiLine, nbcPageListPopup, nbcShowAddTabButton, 367 nbcTabsSizeable); 368 TCTabControlCapabilities = set of TCTabControlCapability; 369 370 TDrawTabEvent = procedure(Control: TCustomTabControl; TabIndex: Integer; 371 const Rect: TRect; AActive: Boolean) of object; 372 373 TCustomTabControl = class(TWinControl) 374 private 375 FAccess: TStrings; // TNBPages 376 FAddingPages: boolean; 377 FHotTrack: Boolean; 378 FImages: TCustomImageList; 379 FImagesWidth: Integer; 380 FImageListChangeLink: TChangeLink; 381 FMultiSelect: Boolean; 382 FOnChanging: TTabChangingEvent; 383 FOnCloseTabClicked: TNotifyEvent; 384 FOnGetImageIndex: TTabGetImageEvent; 385 FOnPageChanged: TNotifyEvent; 386 FOptions: TCTabControlOptions; 387 FOwnerDraw: Boolean; 388 FPageIndex: Integer; 389 FPageIndexOnLastChange: integer;// needed for unique OnChange events 390 FRaggedRight: Boolean; 391 FScrollOpposite: Boolean; 392 FShowTabs: Boolean; 393 FStyle: TTabStyle; 394 FTabHeight: Smallint; 395 FTabPosition: TTabPosition; 396 FTabWidth: Smallint; 397 procedure DoSendPageIndex; 398 procedure DoSendShowTabs; 399 procedure DoSendTabPosition; 400 procedure DoSendTabSize; 401 procedure DoImageListChange(Sender: TObject); 402 function GetActivePage: String; 403 function GetActivePageComponent: TCustomPage; 404 function GetDisplayRect: TRect; 405 function GetMultiLine: Boolean; 406 function FindVisiblePage(Index: Integer): Integer; 407 function IsStoredActivePage: boolean; 408 procedure MoveTab(Sender: TObject; NewIndex: Integer); 409 procedure SetMultiLine(const AValue: Boolean); 410 procedure SetStyle(AValue: TTabStyle); virtual; 411 procedure WSMovePage(APage: TCustomPage; NewIndex: Integer); 412 procedure PageRemoved(Index: Integer); 413 procedure SetActivePage(const Value: String); 414 procedure SetActivePageComponent(const AValue: TCustomPage); 415 procedure SetImages(const AValue: TCustomImageList); 416 procedure SetImagesWidth(const aImagesWidth: Integer); 417 procedure SetPageIndex(AValue: Integer); 418 procedure SetPages(AValue: TStrings); 419 procedure SetShowTabs(AValue: Boolean); 420 procedure SetTabHeight(AValue: Smallint); 421 procedure SetTabPosition(tabPos: TTabPosition); virtual; 422 procedure SetTabWidth(AValue: Smallint); 423 procedure ShowCurrentPage; 424 procedure UpdateAllDesignerFlags; 425 procedure UpdateDesignerFlags(APageIndex: integer); 426 procedure DoImageListDestroyResolutionHandle(Sender: TCustomImageList; 427 AWidth: Integer; AReferenceHandle: TLCLHandle); 428 procedure SetImageListAsync(Data: PtrInt); 429 protected 430 PageClass: TCustomPageClass; 431 procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; 432 const AXProportion, AYProportion: Double); override; 433 function GetPageClass: TCustomPageClass; virtual; 434 function GetListClass: TNBBasePagesClass; virtual; 435 procedure SetOptions(const AValue: TCTabControlOptions); virtual; 436 procedure AddRemovePageHandle(APage: TCustomPage); virtual; 437 procedure CNNotify(var Message: TLMNotify); message CN_NOTIFY; 438 class procedure WSRegisterClass; override; 439 procedure CreateWnd; override; 440 procedure Loaded; override; 441 procedure DoChange; virtual; 442 procedure InitializeWnd; override; 443 procedure Change; virtual; 444 procedure KeyDown(var Key: Word; Shift: TShiftState); override; 445 procedure ReadState(Reader: TReader); override; 446 function DialogChar(var Message: TLMKey): boolean; override; 447 procedure InternalSetPageIndex(AValue: Integer); // No OnChange 448 procedure ShowControl(APage: TControl); override; 449 function IndexOfTabAt(X, Y: Integer): Integer; virtual; overload; 450 function IndexOfTabAt(P: TPoint): Integer; virtual; overload; 451 function IndexOfPageAt(X, Y: Integer): Integer; virtual; overload; 452 function IndexOfPageAt(P: TPoint): Integer; virtual; overload; 453 procedure UpdateTabProperties; virtual; 454 class function GetControlClassDefaultSize: TSize; override; 455 procedure Notification(AComponent: TComponent; Operation: TOperation); override; 456 property ActivePageComponent: TCustomPage read GetActivePageComponent 457 write SetActivePageComponent; 458 property ActivePage: String read GetActivePage write SetActivePage 459 stored IsStoredActivePage; 460 protected //elevated visibility for un/paged 461 function GetPage(AIndex: Integer): TCustomPage; virtual; 462 function GetPageCount : integer; virtual; 463 procedure InsertPage(APage: TCustomPage; Index: Integer); virtual; 464 procedure RemovePage(Index: Integer); virtual; 465 //Delphi compatible properties 466 function CanChange: Boolean; virtual; 467 property DisplayRect: TRect read GetDisplayRect; 468 property HotTrack: Boolean read FHotTrack write FHotTrack default False; 469 property MultiSelect: Boolean read FMultiSelect write FMultiSelect default False; 470 property OwnerDraw: Boolean read FOwnerDraw write FOwnerDraw default False; 471 property RaggedRight: Boolean read FRaggedRight write FRaggedRight default False; 472 property ScrollOpposite: Boolean read FScrollOpposite write FScrollOpposite default False; 473 property Style: TTabStyle read FStyle write SetStyle default tsTabs; 474 property Tabs: TStrings read FAccess write SetPages; 475 property TabIndex: Integer read FPageIndex write SetPageIndex default -1; 476 property OnChange: TNotifyEvent read FOnPageChanged write FOnPageChanged; 477 public 478 constructor Create(TheOwner: TComponent); override; 479 destructor Destroy; override; 480 function TabRect(AIndex: Integer): TRect; 481 function GetImageIndex(ThePageIndex: Integer): Integer; virtual; 482 function IndexOf(APage: TPersistent): integer; virtual; 483 function CustomPage(Index: integer): TCustomPage; 484 function CanChangePageIndex: boolean; virtual; 485 function GetMinimumTabWidth: integer; virtual; 486 function GetMinimumTabHeight: integer; virtual; 487 function GetCapabilities: TCTabControlCapabilities; virtual; 488 function TabToPageIndex(AIndex: integer): integer; 489 function PageToTabIndex(AIndex: integer): integer; 490 public 491 procedure DoCloseTabClicked(APage: TCustomPage); virtual; 492 property Images: TCustomImageList read FImages write SetImages; 493 property ImagesWidth: Integer read FImagesWidth write SetImagesWidth default 0; 494 property MultiLine: Boolean read GetMultiLine write SetMultiLine default False; 495 property OnChanging: TTabChangingEvent read FOnChanging write FOnChanging; 496 property OnCloseTabClicked: TNotifyEvent read FOnCloseTabClicked 497 write FOnCloseTabClicked; 498 property OnGetImageIndex: TTabGetImageEvent read FOnGetImageIndex 499 write FOnGetImageIndex; 500 property Options: TCTabControlOptions read FOptions write SetOptions default []; 501 property Page[Index: Integer]: TCustomPage read GetPage; 502 property PageCount: integer read GetPageCount; 503 property PageIndex: Integer read FPageIndex write SetPageIndex default -1; 504 //property PageList: TList read FPageList; - iff paged 505 property Pages: TStrings read FAccess write SetPages; 506 property ShowTabs: Boolean read FShowTabs write SetShowTabs default True; 507 property TabHeight: Smallint read FTabHeight write SetTabHeight default 0; 508 property TabPosition: TTabPosition read FTabPosition write SetTabPosition default tpTop; 509 property TabWidth: Smallint read FTabWidth write SetTabWidth default 0; 510 published 511 property TabStop default true; 512 end; 513 514 { TTabSheet } 515 516 TPageControl = class; 517 518 TTabSheet = class(TCustomPage) 519 private 520 function GetPageControl: TPageControl; 521 function GetTabIndex: Integer; 522 procedure SetPageControl(APageControl: TPageControl); 523 protected 524 class procedure WSRegisterClass; override; 525 public 526 constructor Create(TheOwner: TComponent); override; 527 destructor Destroy; override; 528 property PageControl: TPageControl read GetPageControl write SetPageControl; 529 property TabIndex: Integer read GetTabIndex; 530 published 531 property BorderWidth; 532 property BiDiMode; 533 property Caption; 534 property ChildSizing; 535 property ClientHeight; 536 property ClientWidth; 537 property Enabled; 538 property Font; 539 property Height stored False; 540 property ImageIndex; 541 property Left stored False; 542 property OnContextPopup; 543 property OnDragDrop; 544 property OnDragOver; 545 property OnEndDrag; 546 property OnEnter; 547 property OnExit; 548 property OnHide; 549 property OnMouseDown; 550 property OnMouseEnter; 551 property OnMouseLeave; 552 property OnMouseMove; 553 property OnMouseUp; 554 property OnMouseWheel; 555 property OnMouseWheelDown; 556 property OnMouseWheelUp; 557 property OnResize; 558 property OnShow; 559 property OnStartDrag; 560 property PageIndex stored False; 561 property ParentBiDiMode; 562 property ParentFont; 563 property ParentShowHint; 564 property PopupMenu; 565 property ShowHint; 566 property TabVisible default True; 567 property Top stored False; 568 property Width stored False; 569 end; 570 571 { TPageControl } 572 573 TPageControl = class(TCustomTabControl) 574 private 575 FPageToUndock: TTabSheet; 576 function GetActivePageIndex: Integer; 577 function GetActiveTabSheet: TTabSheet; 578 function GetTabSheet(Index: Integer): TTabSheet; 579 procedure SetActivePageIndex(const AValue: Integer); 580 procedure SetActiveTabSheet(const AValue: TTabSheet); 581 function FindPageWithDockClient(Client: TControl): TTabSheet; 582 protected 583 class procedure WSRegisterClass; override; 584 function GetPageClass: TCustomPageClass; override; 585 procedure DoAddDockClient(Client: TControl; const ARect: TRect); override; 586 procedure DockOver(Source: TDragDockObject; X, Y: Integer; 587 State: TDragState; var Accept: Boolean); override; 588 procedure DoRemoveDockClient(Client: TControl); override; 589 function DoUndockClientMsg(NewTarget, Client: TControl):boolean; override; 590 function ChildClassAllowed(ChildClass: TClass): boolean; override; 591 public 592 function FindNextPage(CurPage: TTabSheet; 593 GoForward, CheckTabVisible: Boolean): TTabSheet; 594 procedure SelectNextPage(GoForward: Boolean); 595 procedure SelectNextPage(GoForward: Boolean; CheckTabVisible: Boolean); 596 function IndexOfTabAt(X, Y: Integer): Integer; override; 597 function IndexOfTabAt(P: TPoint): Integer; override; 598 function IndexOfPageAt(X, Y: Integer): Integer; override; 599 function IndexOfPageAt(P: TPoint): Integer; override; 600 function AddTabSheet: TTabSheet; 601 property ActivePageIndex: Integer read GetActivePageIndex 602 write SetActivePageIndex; 603 property Pages[Index: Integer]: TTabSheet read GetTabSheet; 604 published 605 property ActivePage: TTabSheet read GetActiveTabSheet write SetActiveTabSheet; 606 property OnGetDockCaption; 607 608 property Align; 609 property Anchors; 610 property BorderSpacing; 611 property BiDiMode; 612 property Constraints; 613 property DockSite; 614 property DragCursor; 615 property DragKind; 616 property DragMode; 617 property Enabled; 618 property Font; 619 //property HotTrack; 620 property Images; 621 property ImagesWidth; 622 property MultiLine; 623 //property OwnerDraw; 624 property ParentBiDiMode; 625 property ParentFont; 626 property ParentShowHint; 627 property PopupMenu; 628 //property RaggedRight; 629 //property ScrollOpposite; 630 property ShowHint; 631 property ShowTabs; 632 //property Style; 633 property TabHeight; 634 property TabIndex; 635 property TabOrder; 636 property TabPosition; 637 property TabStop; 638 property TabWidth; 639 property Visible; 640 property OnChange; 641 property OnChanging; 642 property OnCloseTabClicked; 643 property OnContextPopup; 644 property OnDockDrop; 645 property OnDockOver; 646 property OnDragDrop; 647 property OnDragOver; 648 //property OnDrawTab; 649 property OnEndDock; 650 property OnEndDrag; 651 property OnEnter; 652 property OnExit; 653 property OnGetImageIndex; 654 property OnGetSiteInfo; 655 property OnMouseDown; 656 property OnMouseEnter; 657 property OnMouseLeave; 658 property OnMouseMove; 659 property OnMouseUp; 660 property OnMouseWheel; 661 property OnMouseWheelDown; 662 property OnMouseWheelUp; 663 property OnResize; 664 property OnStartDock; 665 property OnStartDrag; 666 property OnUnDock; 667 property Options; 668 end; 669 670 TTabControl = class; 671 672 { TTabControlStrings } 673 674 TTabControlStrings = class(TStrings) 675 private 676 FHotTrack: Boolean; 677 FImages: TCustomImageList; 678 FMultiLine: Boolean; 679 FMultiSelect: Boolean; 680 FOwnerDraw: Boolean; 681 FRaggedRight: Boolean; 682 FScrollOpposite: Boolean; 683 FTabControl: TTabControl; 684 FUpdateCount: integer; 685 protected 686 function GetTabIndex: integer; virtual; abstract; 687 procedure SetHotTrack(const AValue: Boolean); virtual; 688 procedure SetImages(const AValue: TCustomImageList); virtual; 689 procedure SetMultiLine(const AValue: Boolean); virtual; 690 procedure SetMultiSelect(const AValue: Boolean); virtual; 691 procedure SetOwnerDraw(const AValue: Boolean); virtual; 692 procedure SetRaggedRight(const AValue: Boolean); virtual; 693 procedure SetScrollOpposite(const AValue: Boolean); virtual; 694 procedure SetTabIndex(const AValue: integer); virtual; abstract; 695 public 696 constructor Create(TheTabControl: TTabControl); virtual; 697 function GetHitTestInfoAt(X, Y: Integer): THitTests; virtual; 698 function GetSize: integer; virtual; abstract; 699 function IndexOfTabAt(X, Y: Integer): Integer; virtual; 700 function RowCount: Integer; virtual; 701 function TabRect(Index: Integer): TRect; virtual; 702 procedure ImageListChange(Sender: TObject); virtual; 703 procedure ScrollTabs(Delta: Integer); virtual; 704 procedure TabControlBoundsChange; virtual; 705 procedure UpdateTabImages; virtual; 706 procedure BeginUpdate; virtual; 707 procedure EndUpdate; virtual; 708 function IsUpdating: boolean; virtual; 709 public 710 property TabControl: TTabControl read FTabControl; 711 property TabIndex: integer read GetTabIndex write SetTabIndex; 712 property HotTrack: Boolean read FHotTrack write SetHotTrack; 713 property Images: TCustomImageList read FImages write SetImages; 714 property MultiLine: Boolean read FMultiLine write SetMultiLine; 715 property MultiSelect: Boolean read FMultiSelect write SetMultiSelect; 716 property OwnerDraw: Boolean read FOwnerDraw write SetOwnerDraw; 717 property RaggedRight: Boolean read FRaggedRight write SetRaggedRight; 718 property ScrollOpposite: Boolean read FScrollOpposite 719 write SetScrollOpposite; 720 end; 721 722 { TNoteBookStringsTabControl } 723 724 TNoteBookStringsTabControl = class(TPageControl) // TCustomTabControl, TODO TCustomTabControl, and fix all widgetsets 725 protected 726 FHandleCreated: TNotifyEvent; 727 procedure CreateHandle; override; 728 procedure DoStartDrag(var DragObject: TDragObject); override; 729 procedure DragDrop(Source: TObject; X, Y: Integer); override; 730 procedure DragOver(Source: TObject; X,Y: Integer; State: TDragState; 731 var Accept: Boolean); override; 732 procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override; 733 procedure MouseMove(Shift: TShiftState; X,Y: Integer); override; 734 procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override; 735 procedure MouseEnter; override; 736 procedure MouseLeave; override; 737 function GetPopupMenu: TPopupMenu; override; 738 class procedure WSRegisterClass; override; 739 end; 740 TNoteBookStringsTabControlClass = class of TNoteBookStringsTabControl; 741 742 { TTabControlNoteBookStrings } 743 744 TTabControlNoteBookStrings = class(TTabControlStrings) 745 private 746 FNoteBook: TCustomTabControl{%H-}; 747 FInHandleCreated: Boolean; 748 function GetStyle: TTabStyle; 749 procedure SetStyle(AValue: TTabStyle); 750 protected 751 function GetInternalTabControllClass: TNoteBookStringsTabControlClass; virtual; 752 function Get(Index: Integer): string; override; 753 function GetCount: Integer; override; 754 function GetObject(Index: Integer): TObject; override; 755 function GetTabIndex: integer; override; 756 function GetTabPosition: TTabPosition; 757 procedure NBChanging(Sender: TObject; var AllowChange: Boolean); virtual; 758 procedure NBGetImageIndex(Sender: TObject; TheTabIndex: Integer; 759 var ImageIndex: Integer); virtual; 760 procedure NBPageChanged(Sender: TObject); virtual; 761 procedure NBHandleCreated(Sender: TObject); 762 procedure Put(Index: Integer; const S: string); override; 763 procedure PutObject(Index: Integer; AObject: TObject); override; 764 procedure SetImages(const AValue: TCustomImageList); override; 765 procedure SetMultiLine(const AValue: Boolean); override; 766 procedure SetTabIndex(const AValue: integer); override; 767 procedure SetUpdateState(Updating: Boolean); override; 768 procedure SetTabPosition(AValue: TTabPosition); 769 public 770 constructor Create(TheTabControl: TTabControl); override; 771 destructor Destroy; override; 772 procedure Clear; override; 773 procedure Delete(Index: Integer); override; 774 procedure Insert(Index: Integer; const S: string); override; 775 function GetSize: integer; override; 776 procedure TabControlBoundsChange; override; 777 function IndexOfTabAt(X, Y: Integer): Integer; override; 778 property TabPosition: TTabPosition read GetTabPosition write SetTabPosition; 779 property Style: TTabStyle read GetStyle write SetStyle; 780 public 781 property NoteBook: TCustomTabControl read FNoteBook; 782 end; 783 784(* This is the new TTabControl which replaces the one one. 785 This new one is derived from TCustomTabControl. 786 787 Note: TabControls that do not implement "pages" MUST be derived from TTabControl ! 788*) 789 790 TTabControl = class(TCustomTabControl) 791 private 792 FImageChangeLink: TChangeLink; 793 FOnChange: TNotifyEvent; 794 FOnChangeNeeded: Boolean; 795 FTabControlCreating: Boolean; 796 FTabs: TStrings;// this is a TTabControlNoteBookStrings 797 FCanvas: TCanvas; 798 procedure AdjustDisplayRect(var ARect: TRect); 799 function GetDisplayRect: TRect; 800 function GetHotTrack: Boolean; 801 function GetMultiLine: Boolean; 802 function GetMultiSelect: Boolean; 803 function GetOwnerDraw: Boolean; 804 function GetRaggedRight: Boolean; 805 function GetScrollOpposite: Boolean; 806 function GetTabIndex: Integer; 807 function GetTabRectWithBorder: TRect; 808 function GetTabStop: Boolean; 809 procedure SetHotTrack(const AValue: Boolean); 810 procedure SetImages(const AValue: TCustomImageList); 811 procedure SetMultiLine(const AValue: Boolean); 812 procedure SetMultiSelect(const AValue: Boolean); 813 procedure SetOwnerDraw(const AValue: Boolean); 814 procedure SetRaggedRight(const AValue: Boolean); 815 procedure SetScrollOpposite(const AValue: Boolean); 816 procedure SetStyle(AValue: TTabStyle); override; 817 procedure SetTabHeight(AValue: Smallint); 818 procedure SetTabPosition(AValue: TTabPosition); override; 819 procedure SetTabs(const AValue: TStrings); 820 procedure SetTabStop(const AValue: Boolean); 821 procedure SetTabWidth(AValue: Smallint); 822 protected 823 procedure SetOptions(const AValue: TCTabControlOptions); override; 824 procedure AddRemovePageHandle(APage: TCustomPage); override; 825 function CanChange: Boolean; override; 826 function CanShowTab(ATabIndex: Integer): Boolean; virtual; 827 procedure Change; override; 828 procedure CreateWnd; override; 829 procedure DestroyHandle; override; 830 procedure Notification(AComponent: TComponent; Operation: TOperation); override; 831 procedure SetDragMode(Value: TDragMode); override; 832 procedure SetTabIndex(Value: Integer); virtual; 833 procedure UpdateTabImages; 834 procedure ImageListChange(Sender: TObject); 835 procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override; 836 class function GetControlClassDefaultSize: TSize; override; 837 procedure PaintWindow(DC: HDC); override; 838 procedure Paint; virtual; 839 procedure AdjustDisplayRectWithBorder(var ARect: TRect); virtual; 840 procedure AdjustClientRect(var ARect: TRect); override; 841 function CreateTabNoteBookStrings: TTabControlNoteBookStrings; virtual; 842 public 843 constructor Create(TheOwner: TComponent); override; 844 destructor Destroy; override; 845 function IndexOfTabAt(X, Y: Integer): Integer; override; 846 function IndexOfTabAt(P: TPoint): Integer; override; 847 function GetHitTestInfoAt(X, Y: Integer): THitTests; 848 function GetImageIndex(ATabIndex: Integer): Integer; override; 849 function IndexOfTabWithCaption(const TabCaption: string): Integer; 850 function TabRect(Index: Integer): TRect; 851 function RowCount: Integer; 852 procedure ScrollTabs(Delta: Integer); 853 procedure BeginUpdate; 854 procedure EndUpdate; 855 function IsUpdating: boolean; 856 public 857 property DisplayRect: TRect read GetDisplayRect; 858 published 859 property HotTrack: Boolean read GetHotTrack write SetHotTrack default False; 860 property Images; 861 property ImagesWidth; 862 property MultiLine: Boolean read GetMultiLine write SetMultiLine default False; 863 property MultiSelect: Boolean read GetMultiSelect write SetMultiSelect default False; 864 property OnChange: TNotifyEvent read FOnChange write FOnChange; 865 property OnChanging; 866 property OnGetImageIndex; 867 property OwnerDraw: Boolean read GetOwnerDraw write SetOwnerDraw default False; 868 property RaggedRight: Boolean read GetRaggedRight write SetRaggedRight default False; 869 property ScrollOpposite: Boolean read GetScrollOpposite 870 write SetScrollOpposite default False; 871 property Style default tsTabs; 872 property TabPosition default tpTop; 873 property TabHeight: Smallint read FTabHeight write SetTabHeight default 0; 874 property TabIndex: Integer read GetTabIndex write SetTabIndex default -1; 875 property Tabs: TStrings read FTabs write SetTabs; 876 property TabStop: Boolean read GetTabStop write SetTabStop default true; // workaround, see #30305 877 property TabWidth: Smallint read FTabWidth write SetTabWidth default 0; 878 // 879 property Align; 880 property Anchors; 881 property BiDiMode; 882 property BorderSpacing; 883 property Constraints; 884 property DockSite; 885 property DragCursor; 886 property DragKind; 887 property DragMode; 888 property Enabled; 889 property Font; 890 property OnChangeBounds; 891 property OnContextPopup; 892 property OnDockDrop; 893 property OnDockOver; 894 property OnDragDrop; 895 property OnDragOver; 896 property OnEndDock; 897 property OnEndDrag; 898 property OnEnter; 899 property OnExit; 900 property OnGetSiteInfo; 901 property OnMouseDown; 902 property OnMouseEnter; 903 property OnMouseLeave; 904 property OnMouseMove; 905 property OnMouseUp; 906 property OnMouseWheel; 907 property OnMouseWheelDown; 908 property OnMouseWheelUp; 909 property OnResize; 910 property OnStartDock; 911 property OnStartDrag; 912 property OnUnDock; 913 property Options; 914 property ParentBiDiMode; 915 property ParentFont; 916 property ParentShowHint; 917 property PopupMenu; 918 property ShowHint; 919 property TabOrder; 920 property Visible; 921 end; 922 923 { Custom draw } 924 925 TCustomDrawTarget = ( 926 dtControl, // the whole control 927 dtItem, // one item (= line in report mode) 928 dtSubItem // one subitem, except for subitem 0, this one is drawn by dtItem 929 ); 930 TCustomDrawStage = ( 931 cdPrePaint, 932 cdPostPaint, 933 cdPreErase, 934 cdPostErase 935 ); 936 TCustomDrawStateFlag = ( 937 cdsSelected, 938 cdsGrayed, 939 cdsDisabled, 940 cdsChecked, 941 cdsFocused, 942 cdsDefault, 943 cdsHot, 944 cdsMarked, 945 cdsIndeterminate 946 ); 947 TCustomDrawState = set of TCustomDrawStateFlag; 948 949 TCustomDrawResultFlag = ( 950 cdrSkipDefault, 951 cdrNotifyPostpaint, 952 cdrNotifyItemdraw, 953 cdrNotifySubitemdraw, 954 cdrNotifyPosterase, 955 cdrNotifyItemerase 956 ); 957 TCustomDrawResult = set of TCustomDrawResultFlag; 958 959 960 { TListView } 961 962 TListItems = class; //forward declaration! 963 TCustomListView = class; //forward declaration! 964 TSortType = (stNone, stData, stText, stBoth); 965 966 TListItemState = (lisCut, lisDropTarget, lisFocused, lisSelected); 967 TListItemStates = set of TListItemState; 968 969 TListItemFlag = (lifDestroying, lifCreated); 970 TListItemFlags = set of TListItemFlag; 971 972 TDisplayCode = (drBounds, drIcon, drLabel, drSelectBounds); 973 974{ TIconOptions } 975 976 TIconArrangement = (iaTop, iaLeft); 977 978 TIconOptions = class(TPersistent) 979 private 980 FListView: TCustomListView; 981 FArrangement: TIconArrangement; 982 function GetAutoArrange: Boolean; 983 function GetWrapText: Boolean; 984 procedure SetArrangement(Value: TIconArrangement); 985 procedure SetAutoArrange(Value: Boolean); 986 procedure SetWrapText(Value: Boolean); 987 protected 988 procedure AssignTo(Dest: TPersistent); override; 989 function GetOwner: TPersistent; override; 990 public 991 constructor Create(AOwner: TCustomListView); 992 published 993 property Arrangement: TIconArrangement read FArrangement write SetArrangement default iaTop; 994 property AutoArrange: Boolean read GetAutoArrange write SetAutoArrange default False; 995 property WrapText: Boolean read GetWrapText write SetWrapText default True; 996 end; 997 998 { TListItem } 999 1000 TListItem = class(TPersistent) 1001 private 1002 FOwner: TListItems; 1003 FFlags: TListItemFlags; 1004 FSubItems: TStrings; 1005 FCaption: String; 1006 FData: Pointer; 1007 FImageIndex: TImageIndex; 1008 FStateIndex: TImageIndex; 1009 FStates: TListItemStates; 1010 FChecked: Boolean; 1011 function GetCaption: String; virtual; 1012 function GetChecked: Boolean; 1013 function GetLeft: Integer; 1014 function GetListView: TCustomListView; 1015 function GetPosition: TPoint; 1016 function GetState(const ALisOrd: Integer): Boolean; 1017 function GetImageIndex: TImageIndex; virtual; 1018 function GetIndex: Integer; virtual; 1019 function GetStateIndex: TImageIndex; virtual; 1020 function GetSubItemImages(const AIndex: Integer): Integer; 1021 function GetSubItems: TStrings; virtual; 1022 function GetTop: Integer; 1023 function WSUpdateAllowed: Boolean; 1024 procedure WSUpdateText; 1025 procedure WSUpdateImages; 1026 procedure WSUpdateChecked; 1027 procedure WSSetState; 1028 procedure WSUpdateState; 1029 1030 procedure SetChecked(AValue: Boolean); 1031 procedure SetState(const ALisOrd: Integer; const AIsSet: Boolean); 1032 procedure SetData(const AValue: Pointer); 1033 procedure SetImageIndex(const AValue: TImageIndex); virtual; 1034 procedure SetLeft(Value: Integer); 1035 procedure SetCaption(const AValue : String); virtual; 1036 procedure SetPosition(const AValue: TPoint); 1037 procedure SetStateIndex(const AValue: TImageIndex); virtual; 1038 procedure SetSubItemImages(const AIndex, AValue: Integer); 1039 procedure SetSubItems(const AValue: TStrings); 1040 procedure SetTop(Value: Integer); 1041 protected 1042 function IsEqual(const AItem: TListItem): Boolean; 1043 function IsOwnerData: Boolean; virtual; 1044 function GetCheckedInternal: Boolean; 1045 function GetOwner: TPersistent; override; 1046 public 1047 procedure Assign(ASource: TPersistent); override; 1048 1049 constructor Create(AOwner: TListItems); virtual; 1050 destructor Destroy; override; 1051 procedure Delete; 1052 procedure MakeVisible(PartialOK: Boolean); 1053 function DisplayRect(Code: TDisplayCode): TRect; 1054 function DisplayRectSubItem(subItem: integer;Code: TDisplayCode): TRect; 1055 function EditCaption: Boolean; 1056 1057 property Caption : String read GetCaption write SetCaption; 1058 property Checked : Boolean read GetChecked write SetChecked; 1059 property Cut: Boolean index Ord(lisCut) read GetState write SetState; 1060 property Data: Pointer read FData write SetData; 1061 property DropTarget: Boolean index Ord(lisDropTarget) read GetState write SetState; 1062 property Focused: Boolean index Ord(lisFocused) read GetState write SetState; 1063 property Index: Integer read GetIndex; 1064 property ImageIndex: TImageIndex read GetImageIndex write SetImageIndex default -1; 1065 property Left: Integer read GetLeft write SetLeft; 1066 property ListView: TCustomListView read GetListView; 1067 property Owner: TListItems read FOwner; 1068 property Position: TPoint read GetPosition write SetPosition; 1069 property Selected: Boolean index Ord(lisSelected) read GetState write SetState; 1070 property StateIndex: TImageIndex read GetStateIndex write SetStateIndex; 1071 property SubItems: TStrings read GetSubItems write SetSubItems; 1072 property SubItemImages[const AIndex: Integer]: Integer read GetSubItemImages write SetSubItemImages; 1073 property Top: Integer read GetTop write SetTop; 1074 end; 1075 TListItemClass = class of TListItem; 1076 1077 { TOwnerDataListItem } 1078 1079 TOwnerDataListItem = class(TListItem) 1080 private 1081 FDataIndex: Integer; 1082 FCached: Boolean; 1083 function GetCaption: String; override; 1084 function GetIndex: Integer; override; 1085 function GetImageIndex: TImageIndex; override; 1086 1087 procedure SetCaption(const AValue : String); override; 1088 procedure SetImageIndex(const AValue: TImageIndex); override; 1089 function GetSubItems: TStrings; override; 1090 procedure DoCacheItem; 1091 protected 1092 function IsOwnerData: Boolean; override; 1093 public 1094 procedure SetDataIndex(ADataIndex: Integer); 1095 procedure SetOwner(AOwner: TListItems); 1096 end; 1097 1098 { TListItemsEnumerator } 1099 1100 TListItemsEnumerator = class 1101 private 1102 FItems: TListItems; 1103 FPosition: Integer; 1104 function GetCurrent: TListItem; 1105 public 1106 constructor Create(AItems: TListItems); 1107 function MoveNext: Boolean; 1108 property Current: TListItem read GetCurrent; 1109 end; 1110 1111 TListItemsFlag = (lisfWSItemsCreated); 1112 TListItemsFlags = set of TListItemsFlag; 1113 1114 1115 { TListItems } 1116 { 1117 Listitems have a build in cache of the last accessed item. 1118 This will speed up interface updates since Item.Index is 1119 often used for the same item updating more properties. 1120 If FCacheIndex = -1 then the cache is not valid. 1121 } 1122 1123 TListItems = class(TPersistent) 1124 private 1125 FOwner: TCustomListView; 1126 FItems: TFPList; 1127 FFlags: TListItemsFlags; 1128 FCacheIndex: Integer; // Caches the last used item 1129 FCacheItem: TListItem; // 1130 procedure WSCreateCacheItem; 1131 function WSUpdateAllowed: Boolean; 1132 procedure WSUpdateItem(const AIndex:Integer; const AValue: TListItem); 1133 procedure WSSetItemsCount(const ACount: Integer); 1134 procedure ItemDestroying(const AItem: TListItem); //called by TListItem when freed 1135 procedure ReadData(Stream: TStream); // read data in a Delphi compatible way 1136 procedure ReadLazData(Stream: TStream); // read data in a 64 bits safe way 1137 procedure WriteLazData(Stream: TStream); // write date in a 64 bits safe way 1138 protected 1139 procedure DefineProperties(Filer: TFiler); override; 1140 function GetCount: Integer; virtual; 1141 function GetItem(const AIndex: Integer): TListItem; virtual; 1142 function GetOwner: TPersistent; override; 1143 procedure WSCreateItems; 1144 procedure DoFinalizeWnd; 1145 procedure SetCount(const ACount: Integer); virtual; 1146 procedure SetItem(const AIndex: Integer; const AValue: TListItem); 1147 procedure ClearSelection; 1148 procedure SelectAll; 1149 public 1150 function Add: TListItem; 1151 procedure AddItem(AItem: TListItem); 1152 procedure BeginUpdate; 1153 procedure Clear; virtual; 1154 constructor Create(AOwner : TCustomListView); 1155 destructor Destroy; override; 1156 procedure Delete(const AIndex : Integer); 1157 procedure EndUpdate; 1158 procedure Exchange(const AIndex1, AIndex2: Integer); 1159 procedure Move(const AFromIndex, AToIndex: Integer); 1160 function FindCaption(StartIndex: Integer; Value: string; 1161 Partial, Inclusive, Wrap: Boolean; 1162 PartStart: Boolean = True): TListItem; 1163 function FindData(const AData: Pointer): TListItem; overload; 1164 function FindData(StartIndex: Integer; Value: Pointer; Inclusive, Wrap: Boolean): TListItem; overload; 1165 function GetEnumerator: TListItemsEnumerator; 1166 function IndexOf(const AItem: TListItem): Integer; 1167 function Insert(const AIndex: Integer) : TListItem; 1168 procedure InsertItem(AItem: TListItem; const AIndex: Integer); 1169 property Flags: TListItemsFlags read FFlags; 1170 property Count: Integer read GetCount write SetCount; 1171 property Item[const AIndex: Integer]: TListItem read GetItem write SetItem; default; 1172 property Owner: TCustomListView read FOwner; 1173 end; 1174 1175 { TOwnerDataListItems } 1176 1177 TOwnerDataListItems = class(TListItems) 1178 private 1179 fItemsCount : Integer; 1180 protected 1181 function GetCount: Integer; override; 1182 procedure SetCount(const ACount: Integer); override; 1183 function GetItem(const AIndex: Integer): TListItem; override; 1184 public 1185 procedure Clear; override; 1186 end; 1187 1188 1189 { TListColumn } 1190 1191 TWidth = 0..MaxInt; 1192 1193 TSortIndicator = (siNone, siAscending, siDescending); 1194 1195 TListColumn = class(TCollectionItem) 1196 private 1197 FAlignment: TAlignment; 1198 FAutoSize: Boolean; 1199 FCaption: TTranslateString; 1200 FMinWidth: TWidth; 1201 FMaxWidth: TWidth; 1202 FVisible: Boolean; 1203 FWidth: TWidth; 1204 FImageIndex: TImageIndex; 1205 FTag: PtrInt; 1206 FSortIndicator: TSortIndicator; 1207 function GetWidth: TWidth; 1208 procedure WSCreateColumn; 1209 procedure WSDestroyColumn; 1210 function WSUpdateAllowed: Boolean; 1211 function WSReadAllowed: Boolean; 1212 procedure SetVisible(const AValue: Boolean); 1213 procedure SetAutoSize(const AValue: Boolean); 1214 procedure SetMinWidth(const AValue: TWidth); 1215 procedure SetMaxWidth(const AValue: TWidth); 1216 procedure SetWidth(const AValue: TWidth); 1217 procedure SetCaption(const AValue: TTranslateString); 1218 procedure SetAlignment(const AValue: TAlignment); 1219 procedure SetImageIndex(const AValue: TImageIndex); 1220 procedure SetSortIndicator(AValue: TSortIndicator); 1221 protected 1222 procedure SetIndex(AValue: Integer); override; 1223 function GetDisplayName: string; override; 1224 function GetStoredWidth: Integer; 1225 public 1226 constructor Create(ACollection: TCollection); override; 1227 destructor Destroy; override; 1228 procedure Assign(ASource: TPersistent); override; 1229 property WidthType: TWidth read FWidth; 1230 published 1231 property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify; 1232 property AutoSize: Boolean read FAutoSize write SetAutoSize default False; 1233 property Caption: TTranslateString read FCaption write SetCaption; 1234 property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1; 1235 property MaxWidth: TWidth read FMaxWidth write SetMaxWidth default 0; 1236 property MinWidth: TWidth read FMinWidth write SetMinWidth default 0; 1237 property Tag: PtrInt read FTag write FTag default 0; 1238 property Visible: Boolean read FVisible write SetVisible default true; 1239 property Width: TWidth read GetWidth write SetWidth default 50; 1240 property SortIndicator: TSortIndicator read FSortIndicator write SetSortIndicator default siNone; 1241 end; 1242 1243 1244 { TListColumns } 1245 1246 TListColumns = class(TCollection) 1247 private 1248 FOwner: TCustomListView; 1249 FItemNeedsUpdate: TCollectionItem; 1250 FNeedsUpdate: boolean; 1251 function GetItem(const AIndex: Integer): TListColumn; 1252 procedure WSCreateColumns; 1253 procedure SetItem(const AIndex: Integer; const AValue: TListColumn); 1254 procedure DoFinalizeWnd; 1255 protected 1256 function GetOwner: TPersistent; override; 1257 public 1258 constructor Create(AOwner: TCustomListView); 1259 destructor Destroy; override; 1260 procedure Update(Item: TCollectionItem); override; 1261 function Add: TListColumn; 1262 property Owner: TCustomListView read FOwner; 1263 property Items[const AIndex: Integer]: TListColumn 1264 read GetItem write SetItem; default; 1265 procedure Assign(Source: TPersistent); override; 1266 end; 1267 1268 1269 { TCustomListView } 1270 1271 TItemChange = (ctText, ctImage, ctState); 1272 TViewStyle = (vsIcon, vsSmallIcon, vsList, vsReport); 1273 1274 TItemFind = (ifData, ifPartialString, ifExactString, ifNearest); 1275 TSearchDirection = (sdLeft, sdRight, sdAbove, sdBelow, sdAll); 1276 1277 TLVChangeEvent = procedure(Sender: TObject; Item: TListItem; 1278 Change: TItemChange) of object; 1279 1280 TLVDataFindEvent = procedure(Sender: TObject; AFind: TItemFind; 1281 const AFindString: string; const AFindPosition: TPoint; AFindData: Pointer; 1282 AStartIndex: Integer; ADirection: TSearchDirection; AWrap: Boolean; 1283 var AIndex: Integer) of object; 1284 1285 TLVDataHintEvent = procedure(Sender: TObject; StartIndex, EndIndex: Integer) of object; 1286 TLVDataStateChangeEvent = procedure(Sender: TObject; StartIndex, 1287 EndIndex: Integer; OldState, NewState: TListItemStates) of object; 1288 1289 TLVColumnClickEvent = procedure(Sender: TObject; 1290 Column: TListColumn) of object; 1291 TLVColumnRClickEvent = procedure(Sender: TObject; Column: TListColumn; 1292 Point: TPoint) of object; 1293 TLVCompare = function(Item1, Item2: TListItem; AOptionalParam: PtrInt): Integer stdcall; 1294 TLVCompareEvent = procedure(Sender: TObject; Item1, Item2: TListItem; 1295 Data: Integer; var Compare: Integer) of object; 1296 TLVDeletedEvent = procedure(Sender: TObject; Item: TListItem) of object; 1297 1298 TLVEditingEvent = procedure(Sender: TObject; Item: TListItem; 1299 var AllowEdit: Boolean) of object; 1300 TLVEditedEvent = procedure(Sender: TObject; Item: TListItem; 1301 var AValue: string) of object; 1302 1303 TLVInsertEvent = TLVDeletedEvent; 1304 TLVDataEvent = TLVDeletedEvent; 1305 TLVCheckedItemEvent = procedure (Sender: TObject; Item: TListItem) of object; 1306 TLVSelectItemEvent = procedure(Sender: TObject; Item: TListItem; 1307 Selected: Boolean) of object; 1308 TLVCustomDrawEvent = procedure(Sender: TCustomListView; const ARect: TRect; 1309 var DefaultDraw: Boolean) of object; 1310 TLVCustomDrawItemEvent = procedure(Sender: TCustomListView; Item: TListItem; 1311 State: TCustomDrawState; var DefaultDraw: Boolean) of object; 1312 TLVCustomDrawSubItemEvent=procedure(Sender: TCustomListView; Item: TListItem; 1313 SubItem: Integer; State: TCustomDrawState; 1314 var DefaultDraw: Boolean) of object; 1315 TLVDrawItemEvent = procedure(Sender: TCustomListView; AItem: TListItem; ARect: TRect; 1316 AState: TOwnerDrawState) of object; 1317 TLVAdvancedCustomDrawEvent = procedure(Sender: TCustomListView; const ARect: TRect; 1318 Stage: TCustomDrawStage; var DefaultDraw: Boolean) of object; 1319 TLVAdvancedCustomDrawItemEvent = procedure(Sender: TCustomListView; Item: TListItem; 1320 State: TCustomDrawState; Stage: TCustomDrawStage; 1321 var DefaultDraw: Boolean) of object; 1322 TLVAdvancedCustomDrawSubItemEvent=procedure(Sender: TCustomListView; Item: TListItem; 1323 SubItem: Integer; State: TCustomDrawState; 1324 Stage: TCustomDrawStage; var DefaultDraw: Boolean) of object; 1325 TLVCreateItemClassEvent = procedure(Sender: TCustomListView; var ItemClass: TListItemClass) of object; 1326 1327 TListViewProperty = ( 1328 lvpAutoArrange, 1329 lvpCheckboxes, 1330 lvpColumnClick, 1331 lvpFlatScrollBars, 1332 lvpFullDrag, 1333 lvpGridLines, 1334 lvpHideSelection, 1335 lvpHotTrack, 1336 lvpMultiSelect, 1337 lvpOwnerDraw, 1338 lvpReadOnly, 1339 lvpRowSelect, 1340 lvpShowColumnHeaders, 1341 lvpShowWorkAreas, 1342 lvpWrapText, 1343 lvpToolTips 1344 ); 1345 TListViewProperties = set of TListViewProperty; 1346 1347 TListViewImageList = (lvilSmall, lvilLarge, lvilState); 1348 1349 TListHotTrackStyle = (htHandPoint, htUnderlineCold, htUnderlineHot); 1350 TListHotTrackStyles = set of TListHotTrackStyle; 1351 1352 TListViewFlag = ( 1353 lffSelectedValid, 1354 lffItemsMoving, 1355 lffItemsSorting, 1356 lffPreparingSorting // do not trigger when we are setting more rules 1357 ); 1358 TListViewFlags = set of TListViewFlag; 1359 1360 TSortDirection = (sdAscending, sdDescending); 1361 1362 { TCustomListViewEditor } 1363 {used to provide multiplatform TCustomListView editing ability} 1364 TCustomListViewEditor = class(TCustomEdit) 1365 private 1366 FItem: TListItem; 1367 procedure ListViewEditorKeyDown(Sender: TObject; var Key: Word; 1368 Shift: TShiftState); 1369 protected 1370 procedure DoExit; override; 1371 public 1372 constructor Create(AOwner: TComponent); override; 1373 property Item: TListItem read FItem write FItem; 1374 end; 1375 1376 { TCustomListView } 1377 1378 TCustomListView = class(TWinControl) 1379 private 1380 FEditor: TCustomListViewEditor; 1381 FAllocBy: Integer; 1382 FAutoSort: Boolean; 1383 FAutoSortIndicator: Boolean; 1384 FAutoWidthLastColumn: Boolean; 1385 FCanvas: TCanvas; 1386 FDefaultItemHeight: integer; 1387 FHotTrackStyles: TListHotTrackStyles; 1388 FIconOptions: TIconOptions; 1389 FOnEdited: TLVEditedEvent; 1390 FOnEditing: TLVEditingEvent; 1391 1392 FOwnerData: Boolean; 1393 FOwnerDataItem: TOwnerDataListItem; 1394 FListItems: TListItems; 1395 FColumns: TListColumns; 1396 FImages: array[TListViewImageList] of TCustomImageList; 1397 FImagesWidth: array[TListViewImageList] of Integer; 1398 FImageChangeLinks: array[TListViewImageList] of TChangeLink; 1399 FFlags: TListViewFlags; 1400 FShowEditorQueued: boolean; 1401 FSortDirection: TSortDirection; 1402 1403 FViewStyle: TViewStyle; 1404 FSortType: TSortType; 1405 FSortColumn: Integer; 1406 FCustomSort_Func: TLVCompare; 1407 FCustomSort_Param: PtrInt; 1408 FScrollBars: TScrollStyle; 1409 FViewOriginCache: TPoint; // scrolled originwhile handle is not created 1410 FSelected: TListItem; // temp copy of the selected item 1411 FFocused: TListItem; // temp copy of the focused item 1412 FSelectedIdx: Integer; // Index of Selected item, used if OwnerData = True; 1413 FHoverTime: Integer; // temp copy of the hover time (the time a mouse must be over a item to auto select) 1414 // MWE: not used: see updateScrollbars 1415 // FLastHorzScrollInfo: TScrollInfo; 1416 // FLastVertScrollInfo: TScrollInfo; 1417 FUpdateCount: integer; 1418 FOnChange: TLVChangeEvent; 1419 FOnColumnClick: TLVColumnClickEvent; 1420 FOnCompare: TLVCompareEvent; 1421 FOnData: TLVDataEvent; 1422 FOnDataFind: TLVDataFindEvent; 1423 FOnDataHint: TLVDataHintEvent; 1424 FOnDataStateChange: TLVDataStateChangeEvent; 1425 FOnDeletion: TLVDeletedEvent; 1426 FOnInsert: TLVInsertEvent; 1427 FOnItemChecked: TLVCheckedItemEvent; 1428 FOnSelectItem: TLVSelectItemEvent; 1429 FOnCustomDraw: TLVCustomDrawEvent; 1430 FOnCustomDrawItem: TLVCustomDrawItemEvent; 1431 FOnCustomDrawSubItem: TLVCustomDrawSubItemEvent; 1432 FOnAdvancedCustomDraw: TLVAdvancedCustomDrawEvent; 1433 FOnAdvancedCustomDrawItem: TLVAdvancedCustomDrawItemEvent; 1434 FOnAdvancedCustomDrawSubItem: TLVAdvancedCustomDrawSubItemEvent; 1435 FProperties: TListViewProperties; 1436 function GetBoundingRect: TRect; 1437 function GetColumnCount: Integer; 1438 function GetColumnFromIndex(AIndex: Integer): TListColumn; 1439 function GetDropTarget: TListItem; 1440 function GetFocused: TListItem; 1441 function GetImageList(const ALvilOrd: Integer): TCustomImageList; 1442 function GetImageListWidth(const ALvilOrd: Integer): Integer; 1443 function GetHoverTime: Integer; 1444 function GetItemIndex: Integer; 1445 function GetProperty(const ALvpOrd: Integer): Boolean; 1446 function GetSelCount: Integer; 1447 function GetSelection: TListItem; 1448 function GetTopItem: TListItem; 1449 function GetViewOrigin: TPoint; 1450 function GetVisibleRowCount: Integer; 1451 1452 procedure ResizeLastColumn; 1453 procedure SetAllocBy(const AValue: Integer); 1454 procedure SetAutoWidthLastColumn(AValue: Boolean); 1455 procedure SetColumns(const AValue: TListColumns); 1456 procedure SetDefaultItemHeight(AValue: Integer); 1457 procedure SetDropTarget(const AValue: TListItem); 1458 procedure SetFocused(const AValue: TListItem); 1459 procedure SetHotTrackStyles(const AValue: TListHotTrackStyles); 1460 procedure SetHoverTime(const AValue: Integer); 1461 procedure SetIconOptions(const AValue: TIconOptions); 1462 procedure SetImageList(const ALvilOrd: Integer; const AValue: TCustomImageList); 1463 procedure SetImageListWidth(const ALvilOrd: Integer; const AValue: Integer); 1464 procedure SetImageListWS(const ALvil: TListViewImageList); 1465 procedure SetItemIndex(const AValue: Integer); 1466 procedure SetItems(const AValue : TListItems); 1467 procedure SetItemVisible(const AValue: TListItem; const APartialOK: Boolean); 1468 procedure SetOwnerData(const AValue: Boolean); 1469 procedure SetProperty(const ALvpOrd: Integer; const AIsSet: Boolean); 1470 procedure SetScrollBars(const AValue: TScrollStyle); 1471 procedure SetSelection(const AValue: TListItem); 1472 procedure SetShowEditorQueued(AValue: boolean); 1473 procedure SetSortColumn(const AValue: Integer); 1474 procedure SetSortDirection(const AValue: TSortDirection); 1475 procedure SetSortType(const AValue: TSortType); 1476 procedure SetViewOrigin(AValue: TPoint); 1477 procedure SetViewStyle(const Avalue: TViewStyle); 1478 procedure QueuedShowEditor(Data: PtrInt); 1479 procedure SortWithParams(ACompareFunc: TListSortCompare); 1480 procedure UpdateScrollbars; 1481 procedure CNNotify(var AMessage: TLMNotify); message CN_NOTIFY; 1482 procedure CNDrawItem(var Message: TLMDrawListItem); message CN_DRAWITEM; 1483 procedure InvalidateSelected; 1484 procedure ImageResolutionHandleDestroyed(Sender: TCustomImageList; 1485 AWidth: Integer; AReferenceHandle: TLCLHandle); 1486 procedure SetImageListAsync(Data: PtrInt); 1487 private 1488 FOnCreateItemClass: TLVCreateItemClassEvent; 1489 FOnDrawItem: TLVDrawItemEvent; 1490 procedure HideEditor; 1491 procedure ShowEditor; 1492 procedure WMHScroll(var message : TLMHScroll); message LM_HSCROLL; 1493 procedure WMVScroll(var message : TLMVScroll); message LM_VSCROLL; 1494 property ShowEditorQueued: boolean read FShowEditorQueued write SetShowEditorQueued; 1495 protected 1496 //called by TListItems 1497 procedure ItemDeleted(const AItem: TListItem); 1498 procedure ItemInserted(const AItem: TListItem); 1499 1500 protected 1501 class procedure WSRegisterClass; override; 1502 class function GetControlClassDefaultSize: TSize; override; 1503 procedure InitializeWnd; override; 1504 procedure FinalizeWnd; override; 1505 procedure DestroyWnd; override; 1506 procedure BeginAutoDrag; override; 1507 1508 function CreateListItem: TListItem; virtual; 1509 function CreateListItems: TListItems; virtual; 1510 function CanEdit(Item: TListItem): Boolean; virtual; 1511 procedure Change(AItem: TListItem; AChange: Integer); virtual; 1512 procedure ColClick(AColumn: TListColumn); virtual; 1513 1514 procedure Delete(Item : TListItem); 1515 procedure DoDeletion(AItem: TListItem); virtual; 1516 procedure DoInsert(AItem: TListItem); virtual; 1517 procedure DoItemChecked(AItem: TListItem); 1518 procedure DoSelectItem(AItem: TListItem; ASelected: Boolean); virtual; 1519 procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; 1520 const AXProportion, AYProportion: Double); override; 1521 procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override; 1522 1523 procedure DoEndEdit(AItem: TListItem; const AValue: String); virtual; 1524 1525 procedure InsertItem(Item : TListItem); 1526 procedure ImageChanged(Sender : TObject); 1527 procedure Loaded; override; 1528 procedure Notification(AComponent: TComponent; Operation: TOperation); override; 1529 1530 function IsCustomDrawn(ATarget: TCustomDrawTarget; AStage: TCustomDrawStage): Boolean; virtual; 1531 function CustomDraw(const ARect: TRect; AStage: TCustomDrawStage): Boolean; virtual; // Return True if default drawing should be done 1532 function CustomDrawItem(AItem: TListItem; AState: TCustomDrawState; AStage: TCustomDrawStage): Boolean; virtual; // 1533 function CustomDrawSubItem(AItem: TListItem; ASubItem: Integer; AState: TCustomDrawState; AStage: TCustomDrawStage): Boolean; virtual; // 1534 function IntfCustomDraw(ATarget: TCustomDrawTarget; AStage: TCustomDrawStage; AItem, ASubItem: Integer; AState: TCustomDrawState; const ARect: PRect): TCustomDrawResult; 1535 function GetUpdateCount: Integer; 1536 procedure DrawItem(AItem: TListItem; ARect: TRect; AState: TOwnerDrawState); 1537 1538 procedure DoGetOwnerData(Item: TListItem); virtual; 1539 function DoOwnerDataHint(AStartIndex, AEndIndex: Integer): Boolean; virtual; 1540 function DoOwnerDataStateChange(AStartIndex, AEndIndex: Integer; AOldState, 1541 ANewState: TListItemStates): Boolean; virtual; 1542 protected 1543 procedure DblClick; override; 1544 procedure KeyDown(var Key: Word; Shift: TShiftState); override; 1545 protected 1546 property AllocBy: Integer read FAllocBy write SetAllocBy default 0; 1547 property AutoSort: Boolean read FAutoSort write FAutoSort default True; 1548 property AutoSortIndicator: Boolean read FAutoSortIndicator write FAutoSortIndicator default False; 1549 property AutoWidthLastColumn: Boolean read FAutoWidthLastColumn write SetAutoWidthLastColumn default False; 1550 property ColumnClick: Boolean index Ord(lvpColumnClick) read GetProperty write SetProperty default True; 1551 property Columns: TListColumns read FColumns write SetColumns; 1552 property DefaultItemHeight: integer read FDefaultItemHeight write SetDefaultItemHeight; 1553 property HideSelection: Boolean index Ord(lvpHideSelection) read GetProperty write SetProperty default True; 1554 property HoverTime: Integer read GetHoverTime write SetHoverTime default -1; 1555 property LargeImages: TCustomImageList index Ord(lvilLarge) read GetImageList write SetImageList; 1556 property LargeImagesWidth: Integer index Ord(lvilLarge) read GetImageListWidth write SetImageListWidth default 0; 1557 property OwnerDraw: Boolean index Ord(lvpOwnerDraw) read GetProperty write SetProperty default False; 1558 property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssBoth; 1559 property ShowColumnHeaders: Boolean index Ord(lvpShowColumnHeaders) read GetProperty write SetProperty default True; 1560 property ShowWorkAreas: Boolean index Ord(lvpShowWorkAreas) read GetProperty write SetProperty default False; 1561 property SmallImages: TCustomImageList index Ord(lvilSmall) read GetImageList write SetImageList; 1562 property SmallImagesWidth: Integer index Ord(lvilSmall) read GetImageListWidth write SetImageListWidth default 0; 1563 property SortType: TSortType read FSortType write SetSortType default stNone; 1564 property SortColumn: Integer read FSortColumn write SetSortColumn default -1; 1565 property SortDirection: TSortDirection read FSortDirection write SetSortDirection default sdAscending; 1566 property StateImages: TCustomImageList index Ord(lvilState) read GetImageList write SetImageList; 1567 property StateImagesWidth: Integer index Ord(lvilState) read GetImageListWidth write SetImageListWidth default 0; 1568 property ToolTips: Boolean index Ord(lvpToolTips) read GetProperty write SetProperty default True; 1569 property ViewStyle: TViewStyle read FViewStyle write SetViewStyle default vsList; 1570 property OnChange: TLVChangeEvent read FOnChange write FOnChange; 1571 property OnColumnClick: TLVColumnClickEvent read FOnColumnClick write FOnColumnClick; 1572 property OnCompare: TLVCompareEvent read FOnCompare write FOnCompare; 1573 property OnCreateItemClass: TLVCreateItemClassEvent read FOnCreateItemClass write FOnCreateItemClass; 1574 property OnData: TLVDataEvent read FOnData write FOnData; 1575 property OnDataFind: TLVDataFindEvent read FOnDataFind write FOnDataFind; 1576 property OnDataHint: TLVDataHintEvent read FOnDataHint write FOnDataHint; 1577 property OnDataStateChange: TLVDataStateChangeEvent read FOnDataStateChange write FOnDataStateChange; 1578 property OnDeletion: TLVDeletedEvent read FOnDeletion write FOnDeletion; 1579 property OnEdited: TLVEditedEvent read FOnEdited write FOnEdited; 1580 property OnEditing: TLVEditingEvent read FOnEditing write FOnEditing; 1581 property OnInsert: TLVInsertEvent read FOnInsert write FOnInsert; 1582 property OnItemChecked: TLVCheckedItemEvent read FOnItemChecked write FOnItemChecked; 1583 property OnSelectItem: TLVSelectItemEvent read FOnSelectItem write FOnSelectItem; 1584 property OnCustomDraw: TLVCustomDrawEvent read FOnCustomDraw write FOnCustomDraw; 1585 property OnCustomDrawItem: TLVCustomDrawItemEvent read FOnCustomDrawItem write FOnCustomDrawItem; 1586 property OnCustomDrawSubItem: TLVCustomDrawSubItemEvent read FOnCustomDrawSubItem write FOnCustomDrawSubItem; 1587 property OnDrawItem: TLVDrawItemEvent read FOnDrawItem write FOnDrawItem; // Owner drawn item.Event triggers only when OwnerDraw=True and ListStyle=vsReport 1588 property OnAdvancedCustomDraw: TLVAdvancedCustomDrawEvent read FOnAdvancedCustomDraw write FOnAdvancedCustomDraw; 1589 property OnAdvancedCustomDrawItem: TLVAdvancedCustomDrawItemEvent read FOnAdvancedCustomDrawItem write FOnAdvancedCustomDrawItem; 1590 property OnAdvancedCustomDrawSubItem: TLVAdvancedCustomDrawSubItemEvent read FOnAdvancedCustomDrawSubItem write FOnAdvancedCustomDrawSubItem; 1591 public 1592 constructor Create(AOwner: TComponent); override; 1593 destructor Destroy; override; 1594 procedure AddItem(Item: string; AObject: TObject); 1595 function AlphaSort: Boolean; // always sorts column 0 in sdAscending order 1596 procedure Sort; 1597 function CustomSort(ASortProc: TLVCompare; AOptionalParam: PtrInt): Boolean; 1598 procedure BeginUpdate; 1599 procedure Clear; 1600 procedure EndUpdate; 1601 procedure Repaint; override; 1602 function FindCaption(StartIndex: Integer; Value: string; 1603 Partial, Inclusive, Wrap: Boolean; PartStart: Boolean = True): TListItem; 1604 function FindData(StartIndex: Integer; Value: Pointer; Inclusive, Wrap: Boolean): TListItem; 1605 function GetHitTestInfoAt(X, Y: Integer): THitTests; 1606 function GetItemAt(x,y: integer): TListItem; 1607 1608 1609 {GetNearestItem is used to locate a list item from a position specified in 1610 pixel coordinates relative to the top left corner of the list view. 1611 It starts looking at the position specified by the Point parameter, 1612 and moves in the direction indicated by the Direction parameter 1613 until it locates a list item.If no item is found Nil is returned.} 1614 function GetNearestItem(APoint: TPoint; Direction: TSearchDirection): TListItem; 1615 1616 {Used to find the next list item after StartItem in the direction 1617 given by the Direction parameter. 1618 Only items in the state indicated by the States parameter are considered. 1619 If no item is found Nil is returned.} 1620 function GetNextItem(StartItem: TListItem; Direction: TSearchDirection; States: TListItemStates): TListItem; 1621 1622 procedure ClearSelection; 1623 procedure SelectAll; 1624 1625 function IsEditing: Boolean; // Delphi compatibile function which returns if our listview editor is active 1626 property BoundingRect: TRect read GetBoundingRect; 1627 property BorderStyle default bsSingle; 1628 property Canvas: TCanvas read FCanvas; 1629 property Checkboxes: Boolean index Ord(lvpCheckboxes) read GetProperty write SetProperty default False; 1630 property Column[AIndex: Integer]: TListColumn read GetColumnFromIndex; 1631 property ColumnCount: Integer read GetColumnCount; 1632 property DropTarget: TListItem read GetDropTarget write SetDropTarget; 1633 property FlatScrollBars: Boolean index Ord(lvpFlatScrollBars) read GetProperty write SetProperty default False; 1634 property FullDrag: Boolean index Ord(lvpFullDrag) read GetProperty write SetProperty default False; 1635 property GridLines: Boolean index Ord(lvpGridLines) read GetProperty write SetProperty default False; 1636 property HotTrack: Boolean index Ord(lvpHotTrack) read GetProperty write SetProperty default False; 1637 property HotTrackStyles: TListHotTrackStyles read FHotTrackStyles write SetHotTrackStyles default []; 1638 property IconOptions: TIconOptions read FIconOptions write SetIconOptions; 1639 property ItemFocused: TListItem read GetFocused write SetFocused; 1640 property ItemIndex: Integer read GetItemIndex write SetItemIndex; 1641 property Items: TListItems read FListItems write SetItems; 1642 // MultiSelect and ReadOnly should be protected, but can't because Carbon Interface 1643 // needs to access this property and it cannot cast to TListItem, because we have 1644 // other classes descending from TCustomListItem which need to work too 1645 property MultiSelect: Boolean index Ord(lvpMultiselect) read GetProperty write SetProperty default False; 1646 property OwnerData: Boolean read FOwnerData write SetOwnerData default False; 1647 property ReadOnly: Boolean index Ord(lvpReadOnly) read GetProperty write SetProperty default False; 1648 property RowSelect: Boolean index Ord(lvpRowSelect) read GetProperty write SetProperty default False; 1649 property SelCount: Integer read GetSelCount; 1650 property Selected: TListItem read GetSelection write SetSelection; 1651 property LastSelected: TListItem read FSelected; 1652 property TabStop default true; 1653 property TopItem: TListItem read GetTopItem; 1654 property ViewOrigin: TPoint read GetViewOrigin write SetViewOrigin; 1655 property VisibleRowCount: Integer read GetVisibleRowCount; 1656 end; 1657 1658 1659 { TListView } 1660 1661 TListView = class(TCustomListView) 1662 published 1663 property Align; 1664 property AllocBy; 1665 property Anchors; 1666 property AutoSort; 1667 property AutoSortIndicator; 1668 property AutoWidthLastColumn: Boolean read FAutoWidthLastColumn write SetAutoWidthLastColumn default False; // resize last column to fit width of TListView 1669 property BorderSpacing; 1670 property BorderStyle; 1671 property BorderWidth; 1672 property Checkboxes; 1673 property Color default {$ifdef UseCLDefault}clDefault{$else}clWindow{$endif}; 1674 property Columns; 1675 property ColumnClick; 1676 property Constraints; 1677 property DragCursor; 1678 property DragKind; 1679 property DragMode; 1680 property Enabled; 1681 property Font; 1682 property GridLines; 1683 property HideSelection; 1684 property IconOptions; 1685 // ItemIndex shouldn't be published, see bug 16367 1686 1687 property Items; 1688 property LargeImages; 1689 property LargeImagesWidth; 1690 property MultiSelect; 1691 property OwnerData; 1692 property OwnerDraw; 1693 property ParentColor default False; 1694 property ParentFont; 1695 property ParentShowHint; 1696 property PopupMenu; 1697 property ReadOnly; 1698 property RowSelect; 1699 property ScrollBars; 1700 property ShowColumnHeaders; 1701 property ShowHint; 1702 property SmallImages; 1703 property SmallImagesWidth; 1704 property SortColumn; 1705 property SortDirection; 1706 property SortType; 1707 property StateImages; 1708 property StateImagesWidth; 1709 property TabStop; 1710 property TabOrder; 1711 property ToolTips; 1712 property Visible; 1713 property ViewStyle; 1714 property OnAdvancedCustomDraw; 1715 property OnAdvancedCustomDrawItem; 1716 property OnAdvancedCustomDrawSubItem; 1717 property OnChange; 1718 property OnClick; 1719 property OnColumnClick; 1720 property OnCompare; 1721 property OnContextPopup; 1722 property OnCreateItemClass; 1723 property OnCustomDraw; 1724 property OnCustomDrawItem; 1725 property OnCustomDrawSubItem; 1726 property OnData; 1727 property OnDataFind; 1728 property OnDataHint; 1729 property OnDataStateChange; 1730 property OnDblClick; 1731 property OnDeletion; 1732 property OnDragDrop; 1733 property OnDragOver; 1734 property OnDrawItem; 1735 property OnEdited; 1736 property OnEditing; 1737 property OnEndDock; 1738 property OnEndDrag; 1739 property OnEnter; 1740 property OnExit; 1741 property OnInsert; 1742 property OnItemChecked; 1743 property OnKeyDown; 1744 property OnKeyPress; 1745 property OnKeyUp; 1746 property OnMouseDown; 1747 property OnMouseEnter; 1748 property OnMouseLeave; 1749 property OnMouseMove; 1750 property OnMouseUp; 1751 property OnMouseWheel; 1752 property OnMouseWheelDown; 1753 property OnMouseWheelUp; 1754 property OnResize; 1755 property OnSelectItem; 1756 property OnShowHint; 1757 property OnStartDock; 1758 property OnStartDrag; 1759 property OnUTF8KeyPress; 1760 end; 1761 1762 TProgressBarOrientation = (pbHorizontal, pbVertical, pbRightToLeft, pbTopDown); 1763 1764 TProgressBarStyle = (pbstNormal, pbstMarquee); 1765 1766 { TCustomProgressBar } 1767 { 1768 @abstract(Simple progressbar.) 1769 Introduced by Author Name <stoppok@osibisa.ms.sub.org> 1770 Currently maintained by Maintainer Name <stoppok@osibisa.ms.sub.org> 1771 } 1772 TCustomProgressBar = class(TWinControl) 1773 private 1774 FMin: Integer; 1775 FMax: Integer; 1776 FStep: Integer; 1777 FPosition: Integer; 1778 FSmooth: boolean; 1779 FBarShowText: boolean; 1780 FBarTextFormat: string; 1781 FOrientation: TProgressBarOrientation; 1782 FStyle: TProgressBarStyle; 1783 function GetMin: Integer; 1784 function GetMax: Integer; 1785 function GetPosition: Integer; 1786 procedure SetParams(AMin, AMax: Integer); 1787 procedure SetMin(Value: Integer); 1788 procedure SetMax(Value: Integer); 1789 procedure SetPosition(Value: Integer); 1790 procedure SetStep(Value: Integer); 1791 procedure SetSmooth (Value : boolean); 1792 procedure SetBarShowText (Value : boolean); 1793 procedure SetOrientation (Value : TProgressBarOrientation); 1794 procedure SetStyle(const AValue: TProgressBarStyle); 1795 protected 1796 class procedure WSRegisterClass; override; 1797 procedure ApplyChanges; 1798 procedure InitializeWnd; override; 1799 procedure Loaded; override; 1800 class function GetControlClassDefaultSize: TSize; override; 1801 public 1802 constructor Create(AOwner: TComponent); override; 1803 procedure StepIt; 1804 procedure StepBy(Delta: Integer); 1805 public 1806 property Max: Integer read GetMax write SetMax default 100; 1807 property Min: Integer read GetMin write SetMin default 0; 1808 property Orientation: TProgressBarOrientation read FOrientation write SetOrientation default pbHorizontal; 1809 property Position: Integer read GetPosition write SetPosition default 0; 1810 property Smooth : boolean read FSmooth write SetSmooth default False; 1811 property Step: Integer read FStep write SetStep default 10; 1812 property Style: TProgressBarStyle read FStyle write SetStyle default pbstNormal; 1813 property BarShowText : boolean read FBarShowText write SetBarShowText default False; 1814 end; 1815 1816 1817 { TProgressBar } 1818 1819 TProgressBar = class(TCustomProgressBar) 1820 published 1821 property Align; 1822 property Anchors; 1823 property BorderSpacing; 1824 property BorderWidth; 1825 property Color; 1826 property Constraints; 1827 property DragCursor; 1828 property DragKind; 1829 property DragMode; 1830 property Enabled; 1831 property Font; 1832 property Hint; 1833 property Max; 1834 property Min; 1835 property OnContextPopup; 1836 property OnDragDrop; 1837 property OnDragOver; 1838 property OnEndDrag; 1839 property OnEnter; 1840 property OnExit; 1841 property OnMouseDown; 1842 property OnMouseEnter; 1843 property OnMouseLeave; 1844 property OnMouseMove; 1845 property OnMouseUp; 1846 property OnMouseWheel; 1847 property OnMouseWheelDown; 1848 property OnMouseWheelUp; 1849 property OnStartDock; 1850 property OnStartDrag; 1851 property Orientation; 1852 property ParentColor; 1853 property ParentFont; 1854 property ParentShowHint; 1855 property PopupMenu; 1856 property Position; 1857 property ShowHint; 1858 property Smooth; 1859 property Step; 1860 property Style; 1861 property TabOrder; 1862 property TabStop; 1863 property Visible; 1864 property BarShowText; 1865 end; 1866 1867 1868 TUDAlignButton = (udLeft, udRight, udTop, udBottom); 1869 TUDOrientation = (udHorizontal, udVertical); 1870 TUpDownDirection = (updNone, updUp, updDown); 1871 TUDBtnType = (btNext, btPrev); 1872 TUDClickEvent = procedure (Sender: TObject; Button: TUDBtnType) of object; 1873 TUDChangingEvent = procedure (Sender: TObject; var AllowChange: Boolean) of object; 1874 TUDChangingEventEx = procedure (Sender: TObject; var AllowChange: Boolean; NewValue: SmallInt; Direction: TUpDownDirection) of object; 1875 1876 { TCustomUpDown } 1877 1878 1879 TCustomUpDown = class(TCustomControl) 1880 private 1881 FAlignButton: TUDAlignButton; 1882 FArrowKeys: Boolean; 1883 FAssociate: TWinControl; 1884 FCanChangeDir: TUpDownDirection; 1885 FCanChangePos: SmallInt; 1886 FIncrement: Integer; 1887 FMax: SmallInt; 1888 FMaxBtn: TControl; // TSpeedButton (TUpDownButton) 1889 FMin: SmallInt; 1890 FMinBtn: TControl; // TSpeedButton (TUpDownButton) 1891 FMinRepeatInterval: Byte; //Interval starts at 300 and this must be smaller always 1892 FMouseDownBounds : TRect; 1893 FMouseTimerEvent: TProcedureOfObject; // the Min/MaxBtn's Click method 1894 FOnChanging: TUDChangingEvent; 1895 FOnChangingEx: TUDChangingEventEx; 1896 FOnClick: TUDClickEvent; 1897 FOrientation: TUDOrientation; 1898 FPosition: SmallInt; 1899 FThousands: Boolean; 1900 FWrap: Boolean; 1901 FUseWS: Boolean; 1902 function GetPosition: SmallInt; 1903 procedure BTimerExec(Sender : TObject); 1904 function GetFlat: Boolean; 1905 procedure SetAlignButton(Value: TUDAlignButton); 1906 procedure SetArrowKeys(Value: Boolean); 1907 procedure SetAssociate(Value: TWinControl); 1908 procedure SetIncrement(Value: Integer); 1909 procedure SetMax(Value: SmallInt); 1910 procedure SetMin(Value: SmallInt); 1911 procedure SetMinRepeatInterval(AValue: Byte); 1912 procedure SetOrientation(Value: TUDOrientation); 1913 procedure SetPosition(Value: SmallInt); 1914 procedure SetThousands(Value: Boolean); 1915 procedure SetFlat(Value: Boolean); 1916 procedure SetWrap(Value: Boolean); 1917 procedure UpdateAlignButtonPos; 1918 procedure UpdateOrientation; 1919 procedure UpdateUpDownPositionText; 1920 protected 1921 class procedure WSRegisterClass; override; 1922 procedure AdjustPos(incPos: Boolean); 1923 procedure InitializeWnd; override; 1924 procedure AssociateKeyDown(Sender: TObject; var Key: Word; ShiftState : TShiftState); 1925 procedure AssociateMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; 1926 MousePos: TPoint; var Handled: Boolean); 1927 procedure OnAssociateChangeBounds(Sender: TObject); 1928 procedure OnAssociateChangeEnabled(Sender: TObject); 1929 procedure OnAssociateChangeVisible(Sender: TObject); 1930 function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override; 1931 function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override; 1932 function DoMouseWheelLeft(Shift: TShiftState; MousePos: TPoint): Boolean; override; 1933 function DoMouseWheelRight(Shift: TShiftState; MousePos: TPoint): Boolean; override; 1934 procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override; 1935 procedure SetEnabled(Value: Boolean); override; 1936 class function GetControlClassDefaultSize: TSize; override; 1937 procedure CalculatePreferredSize(var PreferredWidth, 1938 PreferredHeight: integer; WithThemeSpace: Boolean); override; 1939 function CanChange: Boolean; virtual; 1940 procedure Notification(AComponent: TComponent; Operation: TOperation); override; 1941 procedure Click(Button: TUDBtnType); virtual; overload; 1942 protected 1943 property AlignButton: TUDAlignButton read FAlignButton write SetAlignButton default udRight; 1944 property ArrowKeys: Boolean read FArrowKeys write SetArrowKeys default True; 1945 property Associate: TWinControl read FAssociate write SetAssociate; 1946 property Increment: Integer read FIncrement write SetIncrement default 1; 1947 property Max: SmallInt read FMax write SetMax default 100; 1948 property Min: SmallInt read FMin write SetMin; 1949 property MinRepeatInterval: Byte read FMinRepeatInterval write SetMinRepeatInterval default 100; 1950 property OnChanging: TUDChangingEvent read FOnChanging write FOnChanging; 1951 property OnChangingEx: TUDChangingEventEx read FOnChangingEx write FOnChangingEx; 1952 property OnClick: TUDClickEvent read FOnClick write FOnClick; 1953 property Orientation: TUDOrientation read FOrientation write SetOrientation default udVertical; 1954 property Position: SmallInt read GetPosition write SetPosition; 1955 property Thousands: Boolean read FThousands write SetThousands default True; 1956 property Flat: Boolean read GetFlat write SetFlat default False; 1957 property Wrap: Boolean read FWrap write SetWrap default False; 1958 public 1959 constructor Create(AOwner: TComponent); override; 1960 destructor Destroy; Override; 1961 end; 1962 1963 1964 { TUpDown } 1965 1966 TUpDown = class(TCustomUpDown) 1967 published 1968 property Align; 1969 property AlignButton; 1970 property Anchors; 1971 property ArrowKeys; 1972 property Associate; 1973 property BorderSpacing; 1974 property Color; 1975 property Constraints; 1976 property Enabled; 1977 property Hint; 1978 property Increment; 1979 property Max; 1980 property Min; 1981 property MinRepeatInterval; 1982 property OnChanging; 1983 property OnChangingEx; 1984 property OnClick; 1985 property OnContextPopup; 1986 property OnEnter; 1987 property OnExit; 1988 property OnMouseDown; 1989 property OnMouseEnter; 1990 property OnMouseLeave; 1991 property OnMouseMove; 1992 property OnMouseUp; 1993 property OnMouseWheel; 1994 property OnMouseWheelDown; 1995 property OnMouseWheelUp; 1996 property OnMouseWheelHorz; 1997 property OnMouseWheelLeft; 1998 property OnMouseWheelRight; 1999 property Orientation; 2000 property ParentColor; 2001 property ParentShowHint; 2002 property PopupMenu; 2003 property Position; 2004 property ShowHint; 2005 property TabOrder; 2006 property TabStop; 2007 property Thousands; 2008 property Flat; 2009 property Visible; 2010 property Wrap; 2011 end; 2012 2013 2014 { TToolButton } 2015 2016const 2017 CN_DROPDOWNCLOSED = LM_USER + $1000; 2018 2019type 2020 TToolButtonStyle = 2021 ( 2022 tbsButton, // button (can be clicked) 2023 tbsCheck, // check item (click to toggle state, can be grouped) 2024 tbsDropDown, // button with dropdown button to show a popup menu 2025 tbsSeparator, // space holder 2026 tbsDivider, // space holder with line 2027 tbsButtonDrop // button with arrow (not separated from each other) 2028 ); 2029 2030 TToolButtonFlag = 2031 ( 2032 tbfPressed, // set while mouse is pressed on button 2033 tbfArrowPressed,// set while mouse is pressed on arrow button 2034 tbfMouseInArrow,// set while mouse is on arrow button 2035 tbfDropDownMenuShown // set while dropdownmenu is shown 2036 ); 2037 TToolButtonFlags = set of TToolButtonFlag; 2038 2039 { TToolButtonActionLink } 2040 2041 TToolButtonActionLink = class(TControlActionLink) 2042 protected 2043 procedure AssignClient(AClient: TObject); override; 2044 procedure SetChecked(Value: Boolean); override; 2045 procedure SetImageIndex(Value: Integer); override; 2046 public 2047 function IsCheckedLinked: Boolean; override; 2048 function IsImageIndexLinked: Boolean; override; 2049 end; 2050 2051 TToolButtonActionLinkClass = class of TToolButtonActionLink; 2052 2053 TToolBar = class; 2054 2055 TToolButton = class(TGraphicControl) 2056 private 2057 FAllowAllUp: Boolean; 2058 FDown: Boolean; 2059 FDropdownMenu: TPopupMenu; 2060 FGrouped: Boolean; 2061 FImageIndex: TImageIndex; 2062 FIndeterminate: Boolean; 2063 FMarked: Boolean; 2064 FMenuItem: TMenuItem; 2065 FMouseInControl: boolean; 2066 FOnArrowClick: TNotifyEvent; 2067 FShowCaption: boolean; 2068 FStyle: TToolButtonStyle; 2069 FToolButtonFlags: TToolButtonFlags; 2070 FUpdateCount: Integer; 2071 FWrap: Boolean; 2072 FLastDropDownTick: QWord; 2073 FLastDown: Boolean; 2074 procedure GetGroupBounds(var StartIndex, EndIndex: integer); 2075 function GetIndex: Integer; 2076 function GetTextSize: TSize; 2077 function IsCheckedStored: Boolean; 2078 function IsHeightStored: Boolean; 2079 function IsImageIndexStored: Boolean; 2080 function IsWidthStored: Boolean; 2081 procedure SetDown(Value: Boolean); 2082 procedure SetDropdownMenu(Value: TPopupMenu); 2083 procedure SetGrouped(Value: Boolean); 2084 procedure SetImageIndex(Value: TImageIndex); 2085 procedure SetIndeterminate(Value: Boolean); 2086 procedure SetMarked(Value: Boolean); 2087 procedure SetMenuItem(Value: TMenuItem); 2088 procedure SetShowCaption(const AValue: boolean); 2089 procedure SetStyle(Value: TToolButtonStyle); 2090 procedure SetWrap(Value: Boolean); 2091 procedure SetMouseInControl(NewMouseInControl: Boolean); 2092 procedure CMEnabledChanged(var Message: TLMEssage); message CM_ENABLEDCHANGED; 2093 procedure CMVisibleChanged(var Message: TLMessage); message CM_VISIBLECHANGED; 2094 procedure CMHitTest(var Message: TCMHitTest); message CM_HITTEST; 2095 protected const 2096 cDefSeparatorWidth = 8; 2097 cDefDividerWidth = 5; 2098 cDefButtonDropDecArrowWidth = 2; 2099 protected 2100 FToolBar: TToolBar; 2101 class procedure WSRegisterClass; override; 2102 procedure CopyPropertiesFromMenuItem(const Value: TMenuItem); 2103 function GetActionLinkClass: TControlActionLinkClass; override; 2104 procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override; 2105 procedure AssignTo(Dest: TPersistent); override; 2106 procedure BeginUpdate; virtual; 2107 procedure EndUpdate; virtual; 2108 procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; 2109 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 2110 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 2111 procedure MouseEnter; override; 2112 procedure MouseLeave; override; 2113 procedure Notification(AComponent: TComponent; Operation: TOperation); override; 2114 procedure Paint; override; 2115 procedure TextChanged; override; 2116 procedure CalculatePreferredSize( 2117 var PreferredWidth, PreferredHeight: integer; 2118 WithThemeSpace: Boolean); override; 2119 class function GetControlClassDefaultSize: TSize; override; 2120 procedure Loaded; override; 2121 procedure RefreshControl; virtual; 2122 procedure SetToolBar(NewToolBar: TToolBar); 2123 procedure UpdateControl; virtual; 2124 function GetButtonDrawDetail: TThemedElementDetails; virtual; 2125 procedure SetParent(AParent: TWinControl); override; 2126 procedure UpdateVisibleToolbar; 2127 function GroupAllUpAllowed: boolean; 2128 function DialogChar(var Message: TLMKey): boolean; override; 2129 procedure SetAutoSize(Value: Boolean); override; 2130 procedure RealSetText(const AValue: TCaption); override; 2131 public 2132 constructor Create(TheOwner: TComponent); override; 2133 function CheckMenuDropdown: Boolean; virtual; 2134 procedure Click; override; 2135 procedure ArrowClick; virtual; 2136 procedure GetCurrentIcon(var ImageList: TCustomImageList; 2137 var TheIndex: integer; 2138 var TheEffect: TGraphicsDrawEffect); virtual; 2139 procedure GetPreferredSize(var PreferredWidth, PreferredHeight: integer; 2140 Raw: boolean = false; 2141 WithThemeSpace: boolean = true); override; 2142 property Index: Integer read GetIndex; 2143 function PointInArrow(const X, Y: Integer): Boolean; 2144 published 2145 property Action; 2146 property AllowAllUp: Boolean read FAllowAllUp write FAllowAllUp default False; 2147 property AutoSize default False; 2148 property Caption; 2149 property Down: Boolean read FDown write SetDown stored IsCheckedStored default False; 2150 property DragCursor; 2151 property DragKind; 2152 property DragMode; 2153 property DropdownMenu: TPopupMenu read FDropdownMenu write SetDropdownMenu; 2154 property Enabled; 2155 property Grouped: Boolean read FGrouped write SetGrouped default False; 2156 property Height stored IsHeightStored; 2157 property ImageIndex: TImageIndex read FImageIndex write SetImageIndex stored IsImageIndexStored default -1; 2158 property Indeterminate: Boolean read FIndeterminate write SetIndeterminate default False; 2159 property Marked: Boolean read FMarked write SetMarked default False; 2160 property MenuItem: TMenuItem read FMenuItem write SetMenuItem; 2161 property OnArrowClick: TNotifyEvent read FOnArrowClick write FOnArrowClick; 2162 property OnClick; 2163 property OnContextPopup; 2164 property OnDragDrop; 2165 property OnDragOver; 2166 property OnEndDock; 2167 property OnEndDrag; 2168 property OnMouseDown; 2169 property OnMouseEnter; 2170 property OnMouseLeave; 2171 property OnMouseMove; 2172 property OnMouseUp; 2173 property OnMouseWheel; 2174 property OnMouseWheelDown; 2175 property OnMouseWheelUp; 2176 property OnStartDock; 2177 property OnStartDrag; 2178 property ParentShowHint; 2179 property PopupMenu; 2180 property ShowCaption: boolean read FShowCaption write SetShowCaption default true; 2181 property ShowHint; 2182 property Style: TToolButtonStyle read FStyle write SetStyle default tbsButton; 2183 property Visible; 2184 property Width stored IsWidthStored; 2185 property Wrap: Boolean read FWrap write SetWrap default False; 2186 end; 2187 2188 { TToolBarEnumerator } 2189 2190 TToolBarEnumerator = class 2191 private 2192 FToolBar: TToolBar; 2193 FPosition: Integer; 2194 function GetCurrent: TToolButton; 2195 public 2196 constructor Create(AToolBar: TToolBar); 2197 function MoveNext: Boolean; 2198 property Current: TToolButton read GetCurrent; 2199 end; 2200 2201 { TToolBar } 2202 2203 TToolBarOnPaintButton = procedure(Sender: TToolButton; State: integer) of object; 2204 2205 TToolBarFlag = ( 2206 tbfUpdateVisibleBarNeeded, 2207 tbfPlacingControls 2208 ); 2209 2210 TToolBarFlags = set of TToolBarFlag; 2211 2212 TToolBar = class(TToolWindow) 2213 private 2214 FOnPaint: TNotifyEvent; 2215 FOnPaintButton: TToolBarOnPaintButton; 2216 FButtonHeight: Integer; 2217 FRealizedButtonHeight, 2218 FRealizedButtonWidth, 2219 FRealizedDropDownWidth, 2220 FRealizedButtonDropWidth: integer; 2221 FButtons: TList; 2222 FButtonWidth: Integer; 2223 FDisabledImageChangeLink: TChangeLink; 2224 FDisabledImages: TCustomImageList; 2225 FDropDownWidth: integer; 2226 FThemeDropDownWidth: integer; 2227 FThemeButtonDropWidth: integer; 2228 FDropDownButton: TToolButton; 2229 FFlat: Boolean; 2230 FHotImageChangeLink: TChangeLink; 2231 FHotImages: TCustomImageList; 2232 FImageChangeLink: TChangeLink; 2233 FImages: TCustomImageList; 2234 FIndent: Integer; 2235 FList: Boolean; 2236 FNewStyle: Boolean; 2237 FRowCount: integer; 2238 FShowCaptions: Boolean; 2239 FCurrentMenu: TPopupMenu; 2240 FCurrentMenuAutoFree: boolean; 2241 FSrcMenu: TMenu; 2242 FSrcMenuItem: TMenuItem; 2243 FToolBarFlags: TToolBarFlags; 2244 FWrapable: Boolean; 2245 FImagesWidth: Integer; 2246 procedure ApplyFontForButtons; 2247 procedure CloseCurrentMenu; 2248 function GetButton(Index: Integer): TToolButton; 2249 function GetButtonCount: Integer; 2250 function GetButtonDropWidth: Integer; 2251 function GetButtonWidth: Integer; 2252 function GetButtonHeight: Integer; 2253 function GetDropDownWidth: Integer; 2254 function GetTransparent: Boolean; 2255 procedure SetButtonHeight(const AValue: Integer); 2256 procedure SetButtonWidth(const AValue: Integer); 2257 procedure SetDisabledImages(const AValue: TCustomImageList); 2258 procedure SetDropDownWidth(const ADropDownWidth: Integer); 2259 procedure SetFlat(const AValue: Boolean); 2260 procedure SetHotImages(const AValue: TCustomImageList); 2261 procedure SetImages(const AValue: TCustomImageList); 2262 procedure SetImagesWidth(const aImagesWidth: Integer); 2263 procedure SetIndent(const AValue: Integer); 2264 procedure SetList(const AValue: Boolean); 2265 procedure SetShowCaptions(const AValue: Boolean); 2266 procedure SetTransparent(const AValue: Boolean); 2267 procedure SetWrapable(const AValue: Boolean); 2268 procedure ToolButtonDown(AButton: TToolButton; NewDown: Boolean); 2269 procedure ImageListChange(Sender: TObject); 2270 procedure DisabledImageListChange(Sender: TObject); 2271 procedure HotImageListChange(Sender: TObject); 2272 procedure UpdateVisibleBar; 2273 procedure MoveSubMenuItems(SrcMenuItem, DestMenuItem: TMenuItem); 2274 procedure AddButton(Button: TToolButton); 2275 procedure RemoveButton(Button: TToolButton); 2276 protected const 2277 cDefButtonWidth = 23; 2278 cDefButtonHeight = 22; 2279 protected 2280 FPrevVertical: Boolean; 2281 function IsVertical: Boolean; virtual; 2282 class procedure WSRegisterClass; override; 2283 procedure AdjustClientRect(var ARect: TRect); override; 2284 function ButtonHeightIsStored: Boolean; 2285 function ButtonWidthIsStored: Boolean; 2286 function DropDownWidthIsStored: Boolean; 2287 class function GetControlClassDefaultSize: TSize; override; 2288 procedure DoAutoSize; override; 2289 procedure CalculatePreferredSize(var PreferredWidth, 2290 PreferredHeight: integer; WithThemeSpace: Boolean); override; 2291 function CheckMenuDropdown(Button: TToolButton): Boolean; virtual; 2292 procedure ClickButton(Button: TToolButton); virtual; 2293 procedure CreateWnd; override; 2294 procedure AlignControls(AControl: TControl; var RemainingClientRect: TRect); override; 2295 function FindButtonFromAccel(Accel: Word): TToolButton; 2296 procedure FontChanged(Sender: TObject); override; 2297 procedure Loaded; override; 2298 procedure Notification(AComponent: TComponent; Operation: TOperation); override; 2299 procedure Paint; override; 2300 procedure RepositionButton(Index: Integer); 2301 procedure RepositionButtons(Index: Integer); 2302 function WrapButtons(UseSize: integer; 2303 out NewWidth, NewHeight: Integer; 2304 Simulate: boolean): Boolean; 2305 procedure CNDropDownClosed(var Message: TLMessage); message CN_DROPDOWNCLOSED; 2306 procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; 2307 const AXProportion, AYProportion: Double); override; 2308 public 2309 constructor Create(TheOwner: TComponent); override; 2310 destructor Destroy; override; 2311 procedure EndUpdate; override; 2312 procedure FlipChildren(AllLevels: Boolean); override; 2313 function GetEnumerator: TToolBarEnumerator; 2314 procedure SetButtonSize(NewButtonWidth, NewButtonHeight: integer); 2315 function CanFocus: Boolean; override; 2316 public 2317 property ButtonCount: Integer read GetButtonCount; 2318 property Buttons[Index: Integer]: TToolButton read GetButton; 2319 property ButtonList: TList read FButtons; 2320 property RowCount: Integer read FRowCount; 2321 property ButtonDropWidth: Integer read GetButtonDropWidth; 2322 published 2323 property Align default alTop; 2324 property Anchors; 2325 property AutoSize; 2326 property BorderSpacing; 2327 property BorderWidth; 2328 property ButtonHeight: Integer read GetButtonHeight write SetButtonHeight stored ButtonHeightIsStored; 2329 property ButtonWidth: Integer read GetButtonWidth write SetButtonWidth stored ButtonWidthIsStored; 2330 property Caption; 2331 property ChildSizing; 2332 property Constraints; 2333 property Color; 2334 property DisabledImages: TCustomImageList read FDisabledImages write SetDisabledImages; 2335 property DragCursor; 2336 property DragKind; 2337 property DragMode; 2338 property DropDownWidth: Integer read GetDropDownWidth write SetDropDownWidth stored DropDownWidthIsStored; 2339 property EdgeBorders default [ebTop]; 2340 property EdgeInner; 2341 property EdgeOuter; 2342 property Enabled; 2343 property Flat: Boolean read FFlat write SetFlat default True; 2344 property Font; 2345 property Height default 32; 2346 property HotImages: TCustomImageList read FHotImages write SetHotImages; 2347 property Images: TCustomImageList read FImages write SetImages; 2348 property ImagesWidth: Integer read FImagesWidth write SetImagesWidth default 0; 2349 property Indent: Integer read FIndent write SetIndent default 1; 2350 property List: Boolean read FList write SetList default False; 2351 property ParentColor; 2352 property ParentFont; 2353 property ParentShowHint; 2354 property PopupMenu; 2355 property ShowCaptions: Boolean read FShowCaptions write SetShowCaptions default False; 2356 property ShowHint; 2357 property TabOrder; 2358 property TabStop; 2359 property Transparent: Boolean read GetTransparent write SetTransparent default False; 2360 property Visible; 2361 property Wrapable: Boolean read FWrapable write SetWrapable default True; 2362 property OnClick; 2363 property OnContextPopup; 2364 property OnDblClick; 2365 property OnDragDrop; 2366 property OnDragOver; 2367 property OnPaintButton: TToolBarOnPaintButton read FOnPaintButton write FOnPaintButton; 2368 property OnEndDrag; 2369 property OnEnter; 2370 property OnExit; 2371 property OnMouseDown; 2372 property OnMouseEnter; 2373 property OnMouseLeave; 2374 property OnMouseMove; 2375 property OnMouseUp; 2376 property OnMouseWheel; 2377 property OnMouseWheelDown; 2378 property OnMouseWheelUp; 2379 property OnPaint: TNotifyEvent read FOnPaint write FOnPaint; 2380 property OnResize; 2381 property OnChangeBounds; 2382 property OnStartDrag; 2383 end; 2384 2385 { TCoolBar } 2386 2387 TGrabStyle = (gsSimple, gsDouble, gsHorLines, gsVerLines, gsGripper, gsButton); 2388 TDragBand = (dbNone, dbMove, dbResize); 2389 2390 TCustomCoolBar = class; 2391 2392 { TCoolBand } 2393 2394 TCoolBand = class(TCollectionItem) 2395 private 2396 FCoolBar: TCustomCoolBar; 2397 FControl: TControl; // Associated control 2398 FBitmap: TBitmap; 2399 FBorderStyle: TBorderStyle; 2400 FBreak: Boolean; 2401 FColor: TColor; 2402 FFixedBackground: Boolean; 2403 FFixedSize: Boolean; 2404 FHeight: Integer; 2405 FHorizontalOnly: Boolean; 2406 FImageIndex: TImageIndex; 2407 FMinHeight: Integer; 2408 FMinWidth: Integer; 2409 FParentBitmap: Boolean; 2410 FParentColor: Boolean; 2411 FRealLeft: Integer; 2412 FRealWidth: Integer; 2413 FText: TTranslateString; 2414 FVisible: Boolean; 2415 FWidth: Integer; 2416 FLeft: Integer; 2417 FTop: Integer; 2418 function IsBitmapStored: Boolean; 2419 function IsColorStored: Boolean; 2420 function GetRight: Integer; 2421 function GetVisible: Boolean; 2422 procedure SetBitmap(AValue: TBitmap); 2423 procedure SetBorderStyle(AValue: TBorderStyle); 2424 procedure SetBreak(AValue: Boolean); 2425 procedure SetColor(AValue: TColor); 2426 procedure SetControl(AValue: TControl); 2427 procedure SetFixedBackground(AValue: Boolean); 2428 procedure SetHorizontalOnly(AValue: Boolean); 2429 procedure SetImageIndex(AValue: TImageIndex); 2430 procedure SetMinHeight(AValue: Integer); 2431 procedure SetMinWidth(AValue: Integer); 2432 procedure SetParentBitmap(AValue: Boolean); 2433 procedure SetParentColor(AValue: Boolean); 2434 procedure SetText(const AValue: TTranslateString); 2435 procedure SetVisible(AValue: Boolean); 2436 procedure SetWidth(AValue: Integer); 2437 protected const 2438 cDefMinHeight = 25; 2439 cDefMinWidth = 100; 2440 cDefWidth = 180; 2441 cDivider: SmallInt = 2; 2442 cGrabIndent: SmallInt = 2; 2443 protected 2444 FControlLeft: Integer; 2445 FControlTop: Integer; 2446 FTextWidth: Integer; 2447 function CalcControlLeft: Integer; 2448 function CalcPreferredHeight: Integer; 2449 function CalcPreferredWidth: Integer; 2450 procedure CalcTextWidth; 2451 function GetDisplayName: string; override; 2452 public 2453 constructor Create(aCollection: TCollection); override; 2454 destructor Destroy; override; 2455 procedure Assign(aSource: TPersistent); override; 2456 procedure AutosizeWidth; 2457 procedure InvalidateCoolBar(Sender: TObject); 2458 property Height: Integer read FHeight; 2459 property Left: Integer read FLeft; 2460 property Right: Integer read GetRight; 2461 property Top: Integer read FTop; 2462 published 2463 property Bitmap: TBitmap read FBitmap write SetBitmap stored IsBitmapStored; 2464 property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone; 2465 property Break: Boolean read FBreak write SetBreak default True; 2466 property Color: TColor read FColor write SetColor stored IsColorStored default clDefault; 2467 property Control: TControl read FControl write SetControl; 2468 property FixedBackground: Boolean read FFixedBackground write SetFixedBackground default True; 2469 property FixedSize: Boolean read FFixedSize write FFixedSize default False; 2470 property HorizontalOnly: Boolean read FHorizontalOnly write SetHorizontalOnly default False; 2471 property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1; 2472 property MinHeight: Integer read FMinHeight write SetMinHeight default cDefMinHeight; 2473 property MinWidth: Integer read FMinWidth write SetMinWidth default cDefMinWidth; 2474 property ParentColor: Boolean read FParentColor write SetParentColor default True; 2475 property ParentBitmap: Boolean read FParentBitmap write SetParentBitmap default True; 2476 property Text: TTranslateString read FText write SetText; 2477 property Visible: Boolean read GetVisible write SetVisible default True; 2478 property Width: Integer read FWidth write SetWidth default cDefWidth; 2479 end; 2480 2481 { TCoolBands } 2482 2483 TCoolBands = class(TCollection) 2484 private 2485 FCoolBar: TCustomCoolBar; 2486 function GetItem(Index: Integer): TCoolBand; 2487 procedure SetItem(Index: Integer; Value: TCoolBand); 2488 protected 2489 function GetOwner: TPersistent; override; 2490 procedure Update(aItem: TCollectionItem); override; 2491 procedure Notify(aItem: TCollectionItem; aAction: TCollectionNotification); override; 2492 public 2493 constructor Create(ACoolBar: TCustomCoolBar); 2494 function Add: TCoolBand; 2495 function FindBand(AControl: TControl): TCoolBand; 2496 function FindBandIndex(AControl: TControl): Integer; 2497 public 2498 property Items[Index: Integer]: TCoolBand read GetItem write SetItem; default; 2499 end; 2500 2501 // BandMaximize is not used now but is needed for Delphi compatibility. 2502 // It is not used in Delphi's TCoolBar either. 2503 TCoolBandMaximize = (bmNone, bmClick, bmDblClick); 2504 2505 { TCustomCoolBar } 2506 2507 TCustomCoolBar = class(TToolWindow) 2508 private 2509 FBands: TCoolBands; 2510 FBandBorderStyle: TBorderStyle; 2511 FBandMaximize: TCoolBandMaximize; 2512 FBitmap: TBitmap; 2513 FFixedSize: Boolean; 2514 FFixedOrder: Boolean; 2515 FGrabStyle: TGrabStyle; 2516 FGrabWidth: Integer; 2517 FHorizontalSpacing: Integer; 2518 FImages: TCustomImageList; 2519 FImageChangeLink: TChangeLink; 2520 FOnChange: TNotifyEvent; 2521 FShowText: Boolean; 2522 FThemed: Boolean; 2523 FVertical: Boolean; 2524 FVerticalSpacing: Integer; 2525 FImagesWidth: Integer; 2526 function GetAlign: TAlign; 2527 function RowEndHelper(ALeft, AVisibleIdx: Integer): Boolean; 2528 procedure SetBandBorderStyle(AValue: TBorderStyle); 2529 procedure SetBands(AValue: TCoolBands); 2530 procedure SetBitmap(AValue: TBitmap); 2531 procedure SetGrabStyle(AValue: TGrabStyle); 2532 procedure SetGrabWidth(AValue: Integer); 2533 procedure SetHorizontalSpacing(AValue: Integer); 2534 procedure SetImages(AValue: TCustomImageList); 2535 procedure SetImagesWidth(const aImagesWidth: Integer); 2536 procedure SetShowText(AValue: Boolean); 2537 procedure SetThemed(AValue: Boolean); 2538 procedure SetVertical(AValue: Boolean); 2539 procedure SetVerticalSpacing(AValue: Integer); 2540 protected const 2541 cDefGrabStyle = gsDouble; 2542 cDefGrabWidth = 10; 2543 cDefHorSpacing = 5; 2544 cDefVertSpacing = 3; 2545 cNewRowBelow: SmallInt = -1; 2546 cNewRowAbove: SmallInt = -2; 2547 protected 2548 FBorderEdges: TEdgeBorders; 2549 FBorderLeft, FBorderTop, FBorderRight, FBorderBottom: SmallInt; 2550 FBorderWidth: SmallInt; 2551 FCursorBkgnd: TCursor; 2552 FDragBand: TDragBand; 2553 FDraggedBandIndex: Integer; // -1 .. space below the last row; other negative .. invalid area 2554 FDragInitPos: Integer; // Initial mouse X - position (for resizing Bands) 2555 FLockCursor: Boolean; 2556 FRightToLeft: Boolean; 2557 FTextHeight: Integer; 2558 FVisiBands: array of TCoolBand; 2559 procedure AlignControls(AControl: TControl; var RemainingClientRect: TRect); override; 2560 procedure BitmapOrImageListChange(Sender: TObject); 2561 procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; 2562 {%H-}WithThemeSpace: Boolean); override; 2563 procedure CalculateAndAlign; 2564 function CalculateRealIndex(AVisibleIndex: Integer): Integer; 2565 procedure ChangeCursor(ABand, AGrabber: Boolean); 2566 procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED; 2567 procedure CreateWnd; override; 2568 procedure DoFontChanged; 2569 procedure DrawTiledBitmap(ARect: TRect; ABitmap: TBitmap); 2570 procedure FontChanged(Sender: TObject); override; 2571 function IsFirstAtRow(ABand: Integer): Boolean; 2572 function IsRowEnd(ALeft, AVisibleIndex: Integer): Boolean; 2573 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 2574 procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; 2575 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 2576 procedure Notification(AComponent: TComponent; Operation: TOperation); override; 2577 procedure Paint; override; 2578 procedure SetAlign(aValue: TAlign); reintroduce; 2579 procedure SetAutoSize(Value: Boolean); override; 2580 procedure SetCursor(Value: TCursor); override; 2581 procedure WMSize(var Message: TLMSize); message LM_SIZE; 2582 public 2583 constructor Create(AOwner: TComponent); override; 2584 destructor Destroy; override; 2585 procedure AutosizeBands; 2586 procedure EndUpdate; override; 2587 procedure Invalidate; override; 2588 procedure InsertControl(AControl: TControl; Index: integer); override; 2589 procedure MouseToBandPos(X, Y: Integer; out ABand: Integer; out AGrabber: Boolean); 2590 procedure RemoveControl(AControl: TControl); override; 2591 public 2592 property Align read GetAlign write SetAlign default alTop; 2593 property BandBorderStyle: TBorderStyle read FBandBorderStyle write SetBandBorderStyle default bsSingle; 2594 property BandMaximize: TCoolBandMaximize read FBandMaximize write FBandMaximize default bmClick; 2595 property Bands: TCoolBands read FBands write SetBands; 2596 property Bitmap: TBitmap read FBitmap write SetBitmap; 2597 property FixedSize: Boolean read FFixedSize write FFixedSize default False; 2598 property FixedOrder: Boolean read FFixedOrder write FFixedOrder default False; 2599 property GrabStyle: TGrabStyle read FGrabStyle write SetGrabStyle default cDefGrabStyle; 2600 property GrabWidth: Integer read FGrabWidth write SetGrabWidth default cDefGrabWidth; 2601 property HorizontalSpacing: Integer read FHorizontalSpacing write SetHorizontalSpacing default cDefHorSpacing; 2602 property Images: TCustomImageList read FImages write SetImages; 2603 property ImagesWidth: Integer read FImagesWidth write SetImagesWidth default 0; 2604 property ShowText: Boolean read FShowText write SetShowText default True; 2605 property Themed: Boolean read FThemed write SetThemed default True; 2606 property Vertical: Boolean read FVertical write SetVertical default False; 2607 property VerticalSpacing: Integer read FVerticalSpacing write SetVerticalSpacing default cDefVertSpacing; 2608 property OnChange: TNotifyEvent read FOnChange write FOnChange; 2609 end; 2610 2611 { TCoolBar } 2612 2613 TCoolBar = class(TCustomCoolBar) 2614 published 2615 property Align; 2616 property Anchors; 2617 property AutoSize; 2618 property BandBorderStyle; 2619 property BandMaximize; 2620 property Bands; 2621 property BiDiMode; 2622 property BorderWidth; 2623 property Color; 2624 property Constraints; 2625 property DockSite; 2626 property DragCursor; 2627 property DragKind; 2628 property DragMode; 2629 property EdgeBorders; 2630 property EdgeInner; 2631 property EdgeOuter; 2632 property Enabled; 2633 property FixedSize; 2634 property FixedOrder; 2635 property Font; 2636 property GrabStyle; 2637 property GrabWidth; 2638 property HorizontalSpacing; 2639 property Images; 2640 property ImagesWidth; 2641 property ParentColor; 2642 property ParentFont; 2643 property ParentShowHint; 2644 property Bitmap; 2645 property PopupMenu; 2646 property ShowHint; 2647 property ShowText; 2648 property Themed; 2649 property Vertical; 2650 property VerticalSpacing; 2651 property Visible; 2652 property OnChange; 2653 property OnClick; 2654 property OnContextPopup; 2655 property OnDblClick; 2656 property OnDockDrop; 2657 property OnDockOver; 2658 property OnDragDrop; 2659 property OnDragOver; 2660 property OnEndDock; 2661 property OnEndDrag; 2662 property OnGetSiteInfo; 2663 property OnMouseDown; 2664 property OnMouseEnter; 2665 property OnMouseLeave; 2666 property OnMouseMove; 2667 property OnMouseUp; 2668 property OnMouseWheel; 2669 property OnMouseWheelDown; 2670 property OnMouseWheelUp; 2671 property OnResize; 2672 property OnStartDock; 2673 property OnStartDrag; 2674 property OnUnDock; 2675 end; 2676 2677 { TCustomTrackBar } 2678 2679 TTrackBarOrientation = (trHorizontal, trVertical); 2680 TTickMark = (tmBottomRight, tmTopLeft, tmBoth); 2681 TTickStyle = (tsNone, tsAuto, tsManual); 2682 TTrackBarScalePos = (trLeft, trRight, trTop, trBottom); 2683 2684 TCustomTrackBar = class(TWinControl) 2685 private 2686 FOrientation: TTrackBarOrientation; 2687 FReversed: Boolean; 2688 FSelEnd: Integer; 2689 FSelStart: Integer; 2690 FShowSelRange: Boolean; 2691 FTickMarks: TTickMark; 2692 FTickStyle: TTickStyle; 2693 FLineSize: Integer; 2694 FPageSize: Integer; 2695 FMin: Integer; 2696 FMax: Integer; 2697 FFrequency: Integer; 2698 FPosition: Integer; 2699 FScalePos: TTrackBarScalePos; 2700 FScaleDigits: integer; 2701 FOnChange: TNotifyEvent; 2702 procedure SetFrequency(Value: Integer); 2703 procedure SetLineSize(Value: Integer); 2704 procedure SetMax(Value: Integer); 2705 procedure SetMin(Value: Integer); 2706 procedure SetOrientation(Value: TTrackBarOrientation); 2707 procedure SetPageSize(Value: Integer); 2708 procedure SetParams(APosition, AMin, AMax: Integer); 2709 procedure SetPosition(Value: Integer); 2710 procedure SetReversed(const AValue: Boolean); 2711 procedure SetScalePos(Value: TTrackBarScalePos); 2712 procedure SetSelEnd(const AValue: Integer); 2713 procedure SetSelStart(const AValue: Integer); 2714 procedure SetShowSelRange(const AValue: Boolean); 2715 procedure SetTickMarks(Value: TTickMark); 2716 procedure SetTickStyle(Value: TTickStyle); 2717 procedure UpdateSelection; 2718 protected 2719 class procedure WSRegisterClass; override; 2720 procedure ApplyChanges; 2721 procedure Changed; virtual; 2722 procedure DoChange(var msg); message LM_CHANGED; 2723 procedure FixParams(var APosition, AMin, AMax: Integer); 2724 class function GetControlClassDefaultSize: TSize; override; 2725 procedure InitializeWnd; override; 2726 procedure Loaded; override; 2727 public 2728 constructor Create(AOwner: TComponent); override; 2729 procedure SetTick(Value: Integer); 2730 published 2731 property Frequency: Integer read FFrequency write SetFrequency default 1; 2732 property LineSize: Integer read FLineSize write SetLineSize default 1; 2733 property Max: Integer read FMax write SetMax default 10; 2734 property Min: Integer read FMin write SetMin default 0; 2735 property OnChange: TNotifyEvent read FOnChange write FOnChange; 2736 property Orientation: TTrackBarOrientation read FOrientation write SetOrientation default trHorizontal; 2737 property PageSize: Integer read FPageSize write SetPageSize default 2; 2738 property Position: Integer read FPosition write SetPosition; 2739 property Reversed: Boolean read FReversed write SetReversed default False; 2740 property ScalePos: TTrackBarScalePos read FScalePos write SetScalePos default trTop; 2741 property SelEnd: Integer read FSelEnd write SetSelEnd default 0; 2742 property SelStart: Integer read FSelStart write SetSelStart default 0; 2743 property ShowSelRange: Boolean read FShowSelRange write SetShowSelRange default True; 2744 property TabStop default True; 2745 property TickMarks: TTickMark read FTickMarks write SetTickMarks default tmBottomRight; 2746 property TickStyle: TTickStyle read FTickStyle write SetTickStyle default tsAuto; 2747 end; 2748 2749 2750 { TTrackBar } 2751 2752 TTrackBar = class(TCustomTrackBar) 2753 published 2754 property Align; 2755 property Anchors; 2756 property BorderSpacing; 2757 property Color; 2758 property Constraints; 2759 property DragCursor; 2760 property DragMode; 2761 property Enabled; 2762 property Font; 2763 property Frequency; 2764 property Hint; 2765 property LineSize; 2766 property Max; 2767 property Min; 2768 property OnChange; 2769 property OnChangeBounds; 2770 property OnClick; 2771 property OnContextPopup; 2772 property OnDragDrop; 2773 property OnDragOver; 2774 property OnEndDrag; 2775 property OnEnter; 2776 property OnExit; 2777 property OnMouseDown; 2778 property OnMouseEnter; 2779 property OnMouseLeave; 2780 property OnMouseMove; 2781 property OnMouseUp; 2782 property OnMouseWheel; 2783 property OnMouseWheelDown; 2784 property OnMouseWheelUp; 2785 property OnKeyDown; 2786 property OnKeyPress; 2787 property OnKeyUp; 2788 property OnResize; 2789 property OnStartDrag; 2790 property OnUTF8KeyPress; 2791 property Orientation; 2792 property PageSize; 2793 property ParentColor; 2794 property ParentFont; 2795 property ParentShowHint; 2796 property PopupMenu; 2797 property Position; 2798 property Reversed; 2799 property ScalePos; 2800 property SelEnd; 2801 property SelStart; 2802 property ShowHint; 2803 property ShowSelRange; 2804 property TabOrder; 2805 property TabStop; 2806 property TickMarks; 2807 property TickStyle; 2808 property Visible; 2809 end; 2810 2811{ TTreeNode } 2812 2813type 2814 TCustomTreeView = class; 2815 TTreeNodes = class; 2816 TTreeNode = class; 2817 TTreeNodeClass = class of TTreeNode; 2818 2819 TNodeState = ( 2820 nsCut, // = Node.Cut 2821 nsDropHilited, // = Node.DropTarget 2822 nsFocused, // = Node.Focused 2823 nsSelected, // = Node.Selected 2824 nsMultiSelected, // = Node.MultiSelected 2825 nsExpanded, // = Node.Expanded 2826 nsHasChildren, // = Node.HasChildren 2827 nsDeleting, // = Node.Deleting, set on Destroy 2828 nsVisible, // = Node.Visible 2829 nsBound // bound to a tree, e.g. has Parent or is top lvl node 2830 ); 2831 TNodeStates = set of TNodeState; 2832 2833 TNodeAttachMode = ( 2834 naAdd, // add as last sibling of Destination 2835 naAddFirst, // add as first sibling of Destination 2836 naAddChild, // add as last child of Destination 2837 naAddChildFirst, // add as first child of Destination 2838 naInsert, // insert in front of Destination 2839 naInsertBehind // insert behind Destination 2840 ); 2841 2842 TAddMode = (taAddFirst, taAdd, taInsert); 2843 2844 TMultiSelectStyles = (msControlSelect, msShiftSelect, msVisibleOnly, msSiblingOnly); 2845 TMultiSelectStyle = set of TMultiSelectStyles; 2846 2847 TTreeNodeArray = ^TTreeNode; 2848 2849 ETreeNodeError = class(Exception); 2850 ETreeViewError = class(ETreeNodeError); 2851 2852 TTreeNodeChangeReason = ( 2853 ncTextChanged, //The Node's Text has changed 2854 ncDataChanged, //The Node's Data has changed 2855 ncHeightChanged, //The Node's Height has changed 2856 ncImageEffect, //The Node's Image Effect has changed 2857 ncImageIndex, //The Node's Image Index has changed 2858 ncParentChanged, //The Node's Parent has changed 2859 ncVisibility, //The Node's Visibility has changed 2860 ncOverlayIndex, //The Node's Overlay Index has Changed 2861 ncStateIndex, //The Node's State Index has Changed 2862 ncSelectedIndex //The Node's Selected Index has Changed 2863 ); 2864 2865const 2866 LCLStreamID = -7; 2867 2868type 2869 TTVChangingEvent = procedure(Sender: TObject; Node: TTreeNode; 2870 var AllowChange: Boolean) of object; 2871 TTVChangedEvent = procedure(Sender: TObject; Node: TTreeNode) of object; 2872 TTVNodeChangedEvent = procedure(Sender: TObject; Node: TTreeNode; 2873 ChangeReason: TTreeNodeChangeReason) of object; 2874 TTVEditingEvent = procedure(Sender: TObject; Node: TTreeNode; 2875 var AllowEdit: Boolean) of object; 2876 TTVEditingEndEvent = procedure(Sender: TObject; Node: TTreeNode; 2877 Cancel: Boolean) of object; 2878 TTVEditedEvent = procedure(Sender: TObject; Node: TTreeNode; 2879 var S: string) of object; 2880 TTVExpandingEvent = procedure(Sender: TObject; Node: TTreeNode; 2881 var AllowExpansion: Boolean) of object; 2882 TTVCollapsingEvent = procedure(Sender: TObject; Node: TTreeNode; 2883 var AllowCollapse: Boolean) of object; 2884 TTVExpandedEvent = procedure(Sender: TObject; Node: TTreeNode) of object; 2885 TTVCompareEvent = procedure(Sender: TObject; Node1, Node2: TTreeNode; 2886 var Compare: Integer) of object; 2887 TTVCustomDrawEvent = procedure(Sender: TCustomTreeView; const ARect: TRect; 2888 var DefaultDraw: Boolean) of object; 2889 TTVCustomDrawItemEvent = procedure(Sender: TCustomTreeView; Node: TTreeNode; 2890 State: TCustomDrawState; var DefaultDraw: Boolean) of object; 2891 TTVCustomDrawArrowEvent = procedure(Sender: TCustomTreeView; 2892 const ARect: TRect; ACollapsed: Boolean) of object; 2893 TTVAdvancedCustomDrawEvent = procedure(Sender: TCustomTreeView; 2894 const ARect: TRect; Stage: TCustomDrawStage; 2895 var DefaultDraw: Boolean) of object; 2896 TTVAdvancedCustomDrawItemEvent = procedure(Sender: TCustomTreeView; 2897 Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage; 2898 var PaintImages, DefaultDraw: Boolean) of object; 2899 TTVCustomCreateNodeEvent = procedure(Sender: TCustomTreeView; 2900 var ATreeNode: TTreenode) of object; 2901 TTVCreateNodeClassEvent = procedure(Sender: TCustomTreeView; 2902 var NodeClass: TTreeNodeClass) of object; 2903 2904 TTreeNodeCompare = function(Node1, Node2: TTreeNode): integer of object; 2905 2906 TOldTreeNodeInfo = packed record 2907 ImageIndex: Integer; 2908 SelectedIndex: Integer; 2909 StateIndex: Integer; 2910 OverlayIndex: Integer; 2911 Data: PtrUInt; 2912 Count: Integer; 2913 Height: integer; 2914 Expanded: boolean; 2915 TextLen: integer; 2916 // here follows the text 2917 end; 2918 2919 TTreeNodeInfo = packed record 2920 ImageIndex: Integer; 2921 SelectedIndex: Integer; 2922 StateIndex: Integer; 2923 OverlayIndex: Integer; 2924 Count: Integer; 2925 Height: integer; 2926 Expanded: boolean; 2927 TextLen: integer; 2928 // here follows the text 2929 end; 2930 2931 // this is the delphi node stream record 2932 PDelphiNodeInfo = ^TDelphiNodeInfo; 2933 TDelphiNodeInfo = packed record 2934 ImageIndex: Integer; 2935 SelectedIndex: Integer; 2936 StateIndex: Integer; 2937 OverlayIndex: Integer; 2938 Data: Cardinal; // Always 32-bit, assigned to a Pointer. 2939 Count: Integer; 2940 Text: string[255]; 2941 end; 2942 2943 { TTreeNode } 2944 2945 TTreeNode = class(TPersistent) 2946 private 2947 FOwner: TTreeNodes; // the object, which contains all nodes of the tree 2948 FCapacity: integer; // size of FItems 2949 FCount: integer; // # of first level children in FItems 2950 FData: Pointer; // custom data 2951 FHeight: integer; // height in pixels 2952 FNodeEffect: TGraphicsDrawEffect; 2953 FImageIndex: TImageIndex; 2954 FIndex: integer; // index in parent 2955 FItems: TTreeNodeArray; // first level child nodes 2956 FNextBrother: TTreeNode; // next sibling 2957 FNextMultiSelected: TTreeNode; 2958 FOverlayIndex: Integer; 2959 FParent: TTreeNode; 2960 FPrevBrother: TTreeNode; // previous sibling 2961 FPrevMultiSelected: TTreeNode; 2962 FSelectedIndex: Integer; 2963 FStateIndex: Integer; 2964 FStates: TNodeStates; 2965 FSubTreeCount: integer;// total of all child nodes and self 2966 FText: string; 2967 FTop: integer; // top coordinate 2968 function AreParentsExpandedAndVisible: Boolean; 2969 procedure BindToMultiSelected; 2970 function CompareCount(CompareMe: Integer): Boolean; 2971 function DoCanExpand(ExpandIt: Boolean): Boolean; 2972 procedure DoExpand(ExpandIt: Boolean); 2973 procedure ExpandItem(ExpandIt, Recurse: Boolean); 2974 function GetAbsoluteIndex: Integer; 2975 function GetDeleting: Boolean; 2976 function GetHasChildren: Boolean; 2977 function GetCount: Integer; 2978 function GetCut: boolean; 2979 function GetDropTarget: Boolean; 2980 function GetExpanded: Boolean; 2981 function GetFocused: Boolean; 2982 function GetHeight: integer; 2983 function GetIndex: Integer; 2984 function GetItems(AnIndex: Integer): TTreeNode; 2985 function GetLevel: Integer; 2986 function GetMultiSelected: Boolean; 2987 function GetSelected: Boolean; 2988 function GetState(NodeState: TNodeState): Boolean; 2989 function GetTreeNodes: TTreeNodes; 2990 function GetTreeView: TCustomTreeView; 2991 function GetTop: integer; 2992 function GetVisible: Boolean; 2993 procedure InternalMove(ANode: TTreeNode; AddMode: TAddMode); 2994 function IsEqual(Node: TTreeNode): Boolean; 2995 function IsNodeVisible: Boolean; 2996 function IsNodeHeightFullVisible: Boolean; 2997 procedure ReadData(Stream: TStream; StreamVersion: integer); 2998 procedure ReadDelphiData(Stream: TStream; Info: PDelphiNodeInfo); 2999 procedure SetCut(AValue: Boolean); 3000 procedure SetData(AValue: Pointer); 3001 procedure SetDropTarget(AValue: Boolean); 3002 procedure SetExpanded(AValue: Boolean); 3003 procedure SetFocused(AValue: Boolean); 3004 procedure SetHasChildren(AValue: Boolean); 3005 procedure SetHeight(AValue: integer); 3006 procedure SetImageEffect(AValue: TGraphicsDrawEffect); 3007 procedure SetImageIndex(AValue: TImageIndex); 3008 procedure SetIndex(const AValue: Integer); 3009 procedure SetItems(AnIndex: Integer; AValue: TTreeNode); 3010 procedure SetMultiSelected(const AValue: Boolean); 3011 procedure SetOverlayIndex(AValue: Integer); 3012 procedure SetSelected(AValue: Boolean); 3013 procedure SetSelectedIndex(AValue: Integer); 3014 procedure SetStateIndex(AValue: Integer); 3015 procedure SetText(const S: string); 3016 procedure SetVisible(const AValue: Boolean); 3017 procedure Unbind; 3018 procedure UnbindFromMultiSelected; 3019 procedure WriteData(Stream: TStream; StreamVersion: integer); 3020 procedure WriteDelphiData(Stream: TStream; Info: PDelphiNodeInfo); 3021 protected 3022 procedure Changed(ChangeReason: TTreeNodeChangeReason); 3023 function GetOwner: TPersistent; override; 3024 public 3025 constructor Create(AnOwner: TTreeNodes); virtual; 3026 destructor Destroy; override; 3027 function AlphaSort: Boolean; 3028 function Bottom: integer; 3029 function BottomExpanded: integer; 3030 function CustomSort(SortProc: TTreeNodeCompare): Boolean; 3031 function DefaultTreeViewSort(Node1, Node2: TTreeNode): Integer; 3032 function DisplayExpandSignLeft: integer; 3033 function DisplayExpandSignRect: TRect; 3034 function DisplayExpandSignRight: integer; 3035 function DisplayIconLeft: integer; 3036 function DisplayRect(TextOnly: Boolean): TRect; 3037 function DisplayStateIconLeft: integer; 3038 function DisplayTextLeft: integer; 3039 function DisplayTextRight: integer; 3040 function EditText: Boolean; 3041 function FindNode(const NodeText: string): TTreeNode; 3042 function GetFirstChild: TTreeNode; 3043 function GetFirstVisibleChild: TTreeNode; 3044 function GetHandle: THandle; 3045 function GetLastChild: TTreeNode; 3046 function GetLastSibling: TTreeNode; 3047 function GetLastSubChild: TTreeNode; 3048 function GetLastVisibleChild: TTreeNode; 3049 function GetNext: TTreeNode; 3050 function GetNextChild(AValue: TTreeNode): TTreeNode; 3051 function GetNextExpanded: TTreeNode; 3052 function GetNextMultiSelected: TTreeNode; 3053 function GetNextSibling: TTreeNode; 3054 function GetNextSkipChildren: TTreeNode; 3055 function GetNextVisible: TTreeNode; 3056 function GetNextVisibleSibling: TTreeNode; 3057 function GetParentNodeOfAbsoluteLevel(TheAbsoluteLevel: integer): TTreeNode; 3058 function GetPrev: TTreeNode; 3059 function GetPrevChild(AValue: TTreeNode): TTreeNode; 3060 function GetPrevExpanded: TTreeNode; 3061 function GetPrevMultiSelected: TTreeNode; 3062 function GetPrevSibling: TTreeNode; 3063 function GetPrevVisible: TTreeNode; 3064 function GetPrevVisibleSibling: TTreeNode; 3065 function GetTextPath: string; 3066 function HasAsParent(AValue: TTreeNode): Boolean; 3067 function IndexOf(AValue: TTreeNode): Integer; 3068 function IndexOfText(const NodeText: string): Integer; 3069 procedure Assign(Source: TPersistent); override; 3070 procedure Collapse(Recurse: Boolean); 3071 procedure ConsistencyCheck; 3072 procedure Delete; 3073 procedure DeleteChildren; 3074 procedure EndEdit(Cancel: Boolean); 3075 procedure Expand(Recurse: Boolean); 3076 procedure ExpandParents; 3077 procedure FreeAllNodeData; 3078 procedure MakeVisible; 3079 procedure MoveTo(Destination: TTreeNode; Mode: TNodeAttachMode); virtual; 3080 procedure MultiSelectGroup; 3081 procedure Update; 3082 procedure WriteDebugReport(const Prefix: string; Recurse: boolean); 3083 property AbsoluteIndex: Integer read GetAbsoluteIndex; 3084 property Count: Integer read GetCount; 3085 property Cut: Boolean read GetCut write SetCut; 3086 property Data: Pointer read FData write SetData; 3087 property Deleting: Boolean read GetDeleting; 3088 property DropTarget: Boolean read GetDropTarget write SetDropTarget; 3089 property Expanded: Boolean read GetExpanded write SetExpanded; 3090 property Focused: Boolean read GetFocused write SetFocused; 3091 property Handle: THandle read GetHandle; 3092 property HasChildren: Boolean read GetHasChildren write SetHasChildren; 3093 property Height: integer read GetHeight write SetHeight; 3094 property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1; 3095 property Index: Integer read GetIndex write SetIndex; 3096 property IsFullHeightVisible: Boolean read IsNodeHeightFullVisible; 3097 property IsVisible: Boolean read IsNodeVisible; 3098 property Items[ItemIndex: Integer]: TTreeNode read GetItems write SetItems; default; 3099 property Level: Integer read GetLevel; 3100 property MultiSelected: Boolean read GetMultiSelected write SetMultiSelected; 3101 property NodeEffect: TGraphicsDrawEffect read FNodeEffect write SetImageEffect; 3102 property OverlayIndex: Integer read FOverlayIndex write SetOverlayIndex default -1; 3103 property Owner: TTreeNodes read FOwner; 3104 property Parent: TTreeNode read FParent; 3105 property Selected: Boolean read GetSelected write SetSelected; 3106 property SelectedIndex: Integer read FSelectedIndex write SetSelectedIndex default -1; 3107 property StateIndex: Integer read FStateIndex write SetStateIndex default -1; 3108 property States: TNodeStates read FStates; 3109 property SubTreeCount: integer read FSubTreeCount; 3110 property Text: string read FText write SetText; 3111 property Top: integer read GetTop; 3112 property TreeNodes: TTreeNodes read GetTreeNodes; 3113 property TreeView: TCustomTreeView read GetTreeView; 3114 property Visible: Boolean read GetVisible write SetVisible default True; 3115 end; 3116 3117 { TTreeNodesEnumerator } 3118 3119 TTreeNodesEnumerator = class 3120 private 3121 FNodes: TTreeNodes; 3122 FPosition: Integer; 3123 function GetCurrent: TTreeNode; 3124 public 3125 constructor Create(ANodes: TTreeNodes); 3126 function MoveNext: Boolean; 3127 property Current: TTreeNode read GetCurrent; 3128 end; 3129 3130 { TTreeNodes } 3131 3132 PNodeCache = ^TNodeCache; 3133 TNodeCache = record 3134 CacheNode: TTreeNode; 3135 CacheIndex: Integer; 3136 end; 3137 3138 { TTreeNodes } 3139 3140 TTreeNodes = class(TPersistent) 3141 private 3142 FCount: integer; 3143 FSelection: TFPList; 3144 FStartMultiSelected: TTreeNode; // node where user started multiselection 3145 FFirstMultiSelected: TTreeNode; 3146 FLastMultiSelected: TTreeNode; 3147 FKeepCollapsedNodes: boolean; 3148 FNodeCache: TNodeCache; 3149 FOwner: TCustomTreeView; 3150 FTopLvlCapacity: integer; 3151 FTopLvlCount: integer; 3152 FTopLvlItems: TTreeNodeArray; // root and root siblings 3153 FUpdateCount: Integer; 3154 fNewNodeToBeAdded: TTreeNode; 3155 procedure ClearCache; 3156 function GetHandle: THandle; 3157 function GetNodeFromIndex(Index: Integer): TTreeNode; 3158 function GetSelectionCount: Cardinal; 3159 function GetTopLvlItems(Index: integer): TTreeNode; 3160 procedure GrowTopLvlItems; 3161 function IndexOfTopLvlItem(Node: TTreeNode): integer; 3162 procedure MoveTopLvlNode(TopLvlFromIndex, TopLvlToIndex: integer; 3163 Node: TTreeNode); 3164 procedure ReadData(Stream: TStream); 3165 procedure ReadExpandedState(Stream: TStream); 3166 procedure Repaint(ANode: TTreeNode); 3167 procedure ShrinkTopLvlItems; 3168 procedure SetTopLvlItems(Index: integer; AValue: TTreeNode); 3169 procedure WriteData(Stream: TStream); overload; 3170 procedure WriteData(Stream: TStream; WriteDataPointer: boolean); overload; 3171 procedure WriteExpandedState(Stream: TStream); 3172 protected 3173 function InternalAddObject(Node: TTreeNode; const S: string; 3174 Data: Pointer; AddMode: TAddMode): TTreeNode; 3175 procedure DefineProperties(Filer: TFiler); override; 3176 function GetCount: Integer; 3177 function GetOwner: TPersistent; override; 3178 procedure SetItem(Index: Integer; AValue: TTreeNode); 3179 procedure SetUpdateState(Updating: Boolean); 3180 public 3181 constructor Create(AnOwner: TCustomTreeView); 3182 destructor Destroy; override; 3183 function Add(SiblingNode: TTreeNode; const S: string): TTreeNode; 3184 function AddChild(ParentNode: TTreeNode; const S: string): TTreeNode; 3185 function AddChildFirst(ParentNode: TTreeNode; const S: string): TTreeNode; 3186 function AddChildObject(ParentNode: TTreeNode; const S: string; 3187 Data: Pointer): TTreeNode; 3188 function AddChildObjectFirst(ParentNode: TTreeNode; const S: string; 3189 Data: Pointer): TTreeNode; 3190 function AddFirst(SiblingNode: TTreeNode; const S: string): TTreeNode; 3191 function AddNode(Node: TTreeNode; Relative: TTreeNode; const S: string; 3192 Ptr: Pointer; Method: TNodeAttachMode): TTreeNode; 3193 function AddObject(SiblingNode: TTreeNode; const S: string; 3194 Data: Pointer): TTreeNode; 3195 function AddObjectFirst(SiblingNode: TTreeNode; const S: string; 3196 Data: Pointer): TTreeNode; 3197 function FindNodeWithData(const NodeData: Pointer): TTreeNode; 3198 function FindNodeWithText(const NodeText: string): TTreeNode; 3199 function FindNodeWithTextPath(TextPath: string): TTreeNode; 3200 function FindTopLvlNode(const NodeText: string): TTreeNode; 3201 function GetEnumerator: TTreeNodesEnumerator; 3202 function GetFirstNode: TTreeNode; 3203 function GetFirstVisibleNode: TTreeNode; 3204 function GetLastExpandedSubNode: TTreeNode; // absolute last node 3205 function GetLastNode: TTreeNode; // last top level node 3206 function GetLastSubNode: TTreeNode; // absolute last node 3207 function GetLastVisibleNode: TTreeNode; 3208 function GetSelections(const AIndex: Integer): TTreeNode; 3209 function Insert(NextNode: TTreeNode; const S: string): TTreeNode; 3210 function InsertBehind(PrevNode: TTreeNode; const S: string): TTreeNode; 3211 function InsertObject(NextNode: TTreeNode; const S: string; 3212 Data: Pointer): TTreeNode; 3213 function InsertObjectBehind(PrevNode: TTreeNode; const S: string; 3214 Data: Pointer): TTreeNode; 3215 function IsMultiSelection: boolean; 3216 procedure Assign(Source: TPersistent); override; 3217 procedure BeginUpdate; 3218 procedure Clear; 3219 procedure ClearMultiSelection(ClearSelected: boolean = false); 3220 procedure ConsistencyCheck; 3221 procedure Delete(Node: TTreeNode); 3222 procedure EndUpdate; 3223 procedure FreeAllNodeData; 3224 procedure SelectionsChanged(ANode: TTreeNode; const AIsSelected: Boolean); 3225 procedure SelectOnlyThis(Node: TTreeNode); 3226 procedure MultiSelect(Node: TTreeNode; ClearWholeSelection: Boolean); 3227 procedure SortTopLevelNodes(SortProc: TTreeNodeCompare); 3228 procedure WriteDebugReport(const Prefix: string; AllNodes: boolean); 3229 property Count: Integer read GetCount; 3230 property Item[Index: Integer]: TTreeNode read GetNodeFromIndex; default; 3231 property KeepCollapsedNodes: boolean 3232 read FKeepCollapsedNodes write FKeepCollapsedNodes; 3233 property Owner: TCustomTreeView read FOwner; 3234 property SelectionCount: Cardinal read GetSelectionCount; 3235 property TopLvlCount: integer read FTopLvlCount; 3236 property TopLvlItems[Index: integer]: TTreeNode 3237 read GetTopLvlItems write SetTopLvlItems; 3238 end; 3239 3240 3241 { TCustomTreeView } 3242 3243 TTreeViewState = ( 3244 tvsScrollbarChanged, 3245 tvsMaxRightNeedsUpdate, 3246 tvsTopsNeedsUpdate, 3247 tvsMaxLvlNeedsUpdate, 3248 tvsTopItemNeedsUpdate, 3249 tvsBottomItemNeedsUpdate, 3250 tvsCanvasChanged, 3251 tvsDragged, 3252 tvsIsEditing, 3253 tvsStateChanging, 3254 tvsManualNotify, 3255 tvsUpdating, 3256 tvsPainting, 3257 tvoFocusedPainting, 3258 tvsDblClicked, 3259 tvsTripleClicked, 3260 tvsQuadClicked, 3261 tvsSelectionChanged, 3262 tvsEditOnMouseUp, // if mouse up occurs on mouse down node: activate editing 3263 tvsSingleSelectOnMouseUp // if mouse up occurs on mouse down node: single select this node 3264 ); 3265 TTreeViewStates = set of TTreeViewState; 3266 3267 TTreeViewOption = ( 3268 tvoAllowMultiselect, 3269 tvoAutoExpand, 3270 tvoAutoInsertMark, 3271 tvoAutoItemHeight, 3272 tvoHideSelection, 3273 tvoHotTrack, 3274 tvoKeepCollapsedNodes, 3275 tvoReadOnly, 3276 tvoRightClickSelect, 3277 tvoRowSelect, 3278 tvoShowButtons, 3279 tvoShowLines, 3280 tvoShowRoot, 3281 tvoShowSeparators, 3282 tvoToolTips, 3283 tvoNoDoubleClickExpand, 3284 tvoThemedDraw, 3285 tvoEmptySpaceUnselect 3286 ); 3287 TTreeViewOptions = set of TTreeViewOption; 3288 3289const 3290 DefaultTreeViewOptions = [tvoShowRoot, tvoShowLines, tvoShowButtons, 3291 tvoHideSelection, tvoToolTips, 3292 tvoKeepCollapsedNodes, tvoAutoItemHeight, tvoThemedDraw]; 3293 DefaultMultiSelectStyle = [msControlSelect]; 3294 DefaultTreeNodeHeight = 20; 3295 DefaultTreeNodeExpandSignSize = 9; 3296 3297type 3298 TTreeViewExpandSignType = ( 3299 tvestTheme, // use themed sign 3300 tvestPlusMinus, // use +/- sign 3301 tvestArrow, // use blank arrow 3302 tvestArrowFill // use filled arrow 3303 ); 3304 3305 TTreeViewInsertMarkType = ( 3306 tvimNone, 3307 tvimAsFirstChild, // or as root 3308 tvimAsNextSibling, 3309 tvimAsPrevSibling 3310 ); 3311 3312 3313 TCustomTreeView = class(TCustomControl) 3314 private 3315 FAccessibilityOn: Boolean; 3316 FBottomItem: TTreeNode; 3317 FCallingChange: Boolean; 3318 FEditingItem: TTreeNode; 3319 FExpandSignType: TTreeViewExpandSignType; 3320 FExpandSignSize: integer; 3321 FThemeExpandSignSize: integer; 3322 FDefItemHeight: integer; 3323 FDefItemSpace: Integer; 3324 FDragImage: TDragImageList; 3325 FDragNode: TTreeNode; 3326 FIndent: integer; 3327 FImageChangeLink: TChangeLink; 3328 FImages: TCustomImageList; 3329 FImagesWidth: Integer; 3330 FInsertMarkNode: TTreeNode; 3331 FInsertMarkType: TTreeViewInsertMarkType; 3332 FLastDropTarget: TTreeNode; 3333 FLastHorzScrollInfo: TScrollInfo; 3334 FLastVertScrollInfo: TScrollInfo; 3335 FMaxLvl: integer; // maximum level of all nodes 3336 FMaxRight: integer; // maximum text width of all nodes (needed for horizontal scrolling) 3337 FMouseDownPos: TPoint; 3338 FMouseDownOnFoldingSign: Boolean; 3339 FMultiSelectStyle: TMultiSelectStyle; 3340 FHotTrackColor: TColor; 3341 FOnAddition: TTVExpandedEvent; 3342 FOnAdvancedCustomDraw: TTVAdvancedCustomDrawEvent; 3343 FOnAdvancedCustomDrawItem: TTVAdvancedCustomDrawItemEvent; 3344 FOnChange: TTVChangedEvent; 3345 FOnChanging: TTVChangingEvent; 3346 FOnCollapsed: TTVExpandedEvent; 3347 FOnCollapsing: TTVCollapsingEvent; 3348 FOnCompare: TTVCompareEvent; 3349 FOnCreateNodeClass: TTVCreateNodeClassEvent; 3350 FOnCustomCreateItem: TTVCustomCreateNodeEvent; 3351 FOnCustomDraw: TTVCustomDrawEvent; 3352 FOnCustomDrawItem: TTVCustomDrawItemEvent; 3353 FOnCustomDrawArrow: TTVCustomDrawArrowEvent; 3354 FOnDeletion: TTVExpandedEvent; 3355 FOnEditing: TTVEditingEvent; 3356 FOnEditingEnd: TTVEditingEndEvent; 3357 FOnEdited: TTVEditedEvent; 3358 FOnExpanded: TTVExpandedEvent; 3359 FOnExpanding: TTVExpandingEvent; 3360 FOnGetImageIndex: TTVExpandedEvent; 3361 FOnGetSelectedIndex: TTVExpandedEvent; 3362 FOnNodeChanged: TTVNodeChangedEvent; 3363 FOnSelectionChanged: TNotifyEvent; 3364 FOptions: TTreeViewOptions; 3365 FRClickNode: TTreeNode; 3366 FSaveItems: TStringList; 3367 FScrollBars: TScrollStyle; 3368 FScrolledLeft: integer; // horizontal scrolled pixels (hidden pixels at left) 3369 FScrolledTop: integer; // vertical scrolled pixels (hidden pixels at top) 3370 FSBHorzShowing: ShortInt; 3371 FSBVertShowing: ShortInt; 3372 FSelectedColor: TColor; 3373 FSelectedFontColor: TColor; 3374 FSelectedFontColorUsed: boolean; 3375 FSelectedNode: TTreeNode; 3376 FSelectionChangeEventLock: integer; 3377 fSeparatorColor: TColor; 3378 FSortType: TSortType; 3379 FStateChangeLink: TChangeLink; 3380 FStateImages: TCustomImageList; 3381 FStateImagesWidth: Integer; 3382 FStates: TTreeViewStates; 3383 FTopItem: TTreeNode; 3384 FTreeLineColor: TColor; 3385 FTreeLinePenStyle: TPenStyle; 3386 FTreeLinePenPattern: TPenPattern; 3387 FExpandSignColor : TColor; 3388 FTreeNodes: TTreeNodes; 3389 FHintWnd: THintWindow; 3390 FNodeUnderCursor: TTreeNode; 3391 FPrevToolTips: boolean; 3392 FDragScrollMargin: integer; 3393 FDragScrollTimer: TTimer; 3394 procedure DragScrollTimerTick(Sender: TObject); 3395 procedure CanvasChanged(Sender: TObject); 3396 function GetAutoExpand: boolean; 3397 function GetBackgroundColor: TColor; 3398 function GetBottomItem: TTreeNode; 3399 function GetDropTarget: TTreeNode; 3400 function GetExpandSignSize: integer; 3401 function GetHideSelection: boolean; 3402 function GetHotTrack: boolean; 3403 function GetIndent: Integer; 3404 function GetKeepCollapsedNodes: boolean; 3405 function GetMultiSelect: Boolean; 3406 function GetReadOnly: boolean; 3407 function GetRightClickSelect: boolean; 3408 function GetRowSelect: boolean; 3409 function GetSelection: TTreeNode; 3410 function GetSelectionCount: Cardinal; 3411 function GetSelections(AIndex: Integer): TTreeNode; 3412 function GetShowButtons: boolean; 3413 function GetShowLines: boolean; 3414 function GetShowRoot: boolean; 3415 function GetShowSeparators: boolean; 3416 function GetToolTips: boolean; 3417 function GetTopItem: TTreeNode; 3418 function IsStoredBackgroundColor: Boolean; 3419 procedure HintMouseLeave(Sender: TObject); 3420 procedure ImageListChange(Sender: TObject); 3421 function NodeIsSelected(aNode: TTreeNode): Boolean; 3422 procedure OnChangeTimer(Sender: TObject); 3423 procedure SetAutoExpand(Value: Boolean); 3424 procedure SetBackgroundColor(Value: TColor); 3425 procedure SetBottomItem(Value: TTreeNode); 3426 procedure SetDefaultItemHeight(Value: integer); 3427 procedure SetExpandSignType(Value: TTreeViewExpandSignType); 3428 procedure SetDropTarget(Value: TTreeNode); 3429 procedure SetHideSelection(Value: Boolean); 3430 procedure SetHotTrack(Value: Boolean); 3431 procedure SetIndent(Value: Integer); 3432 procedure SetImages(Value: TCustomImageList); 3433 procedure SetImagesWidth(const aImagesWidth: Integer); 3434 procedure SetInsertMarkNode(const AValue: TTreeNode); 3435 procedure SetInsertMarkType(const AValue: TTreeViewInsertMarkType); 3436 procedure SetKeepCollapsedNodes(Value: Boolean); 3437 procedure SetMultiSelect(const AValue: Boolean); 3438 procedure SetMultiSelectStyle(const AValue: TMultiSelectStyle); 3439 procedure SetReadOnly(Value: Boolean); 3440 procedure SetRightClickSelect(Value: Boolean); 3441 procedure SetRowSelect(Value: Boolean); 3442 procedure SetScrollBars(const Value: TScrollStyle); 3443 procedure SetScrolledLeft(AValue: integer); 3444 procedure SetScrolledTop(AValue: integer); 3445 procedure SetSelectedColor(Value: TColor); 3446 procedure SetSelectedFontColor(Value: TColor); 3447 procedure SetSelection(Value: TTreeNode); 3448 procedure SetSeparatorColor(const AValue: TColor); 3449 procedure SetShowButton(Value: Boolean); 3450 procedure SetShowLines(Value: Boolean); 3451 procedure SetShowRoot(Value: Boolean); 3452 procedure SetShowScrollBar(Which: Integer; AShow: Boolean); 3453 procedure SetShowSeparators(Value: Boolean); 3454 procedure SetSortType(Value: TSortType); 3455 procedure SetStateImages(Value: TCustomImageList); 3456 procedure SetStateImagesWidth(const aStateImagesWidth: Integer); 3457 procedure SetToolTips(Value: Boolean); 3458 procedure SetTreeLineColor(Value: TColor); 3459 procedure SetTreeNodes(Value: TTreeNodes); 3460 procedure SetTopItem(Value: TTreeNode); 3461 procedure UpdateAllTops; 3462 procedure UpdateBottomItem; 3463 procedure UpdateHotTrack(X, Y: Integer); 3464 procedure UpdateMaxLvl; 3465 procedure UpdateMaxRight; 3466 procedure UpdateTopItem; 3467 procedure UpdateScrollbars; 3468 procedure UpdateTooltip(X, Y: integer); 3469 procedure InternalSelectionChanged; 3470 function AllowMultiSelectWithCtrl(AState: TShiftState): Boolean; 3471 function AllowMultiSelectWithShift(AState: TShiftState): Boolean; 3472 procedure SetExpandSignSize(const AExpandSignSize: integer); 3473 protected 3474 FChangeTimer: TTimer; 3475 FEditor: TEdit; 3476 class procedure WSRegisterClass; override; 3477 class function GetControlClassDefaultSize: TSize; override; 3478 procedure Added(Node: TTreeNode); virtual; 3479 procedure EditorEditingDone(Sender: TObject); virtual; 3480 procedure EditorKeyDown(Sender: TObject; var Key : Word; Shift : TShiftState); virtual; 3481 procedure BeginAutoDrag; override; 3482 procedure BeginEditing(ANode: TTreeNode); virtual; 3483 function DoDragMsg(ADragMessage: TDragMessage; APosition: TPoint; ADragObject: TDragObject; ATarget: TControl; ADocking: Boolean): LRESULT; override; 3484 function CanChange(Node: TTreeNode): Boolean; virtual; 3485 function CanCollapse(Node: TTreeNode): Boolean; virtual; 3486 function CanEdit(Node: TTreeNode): Boolean; virtual; 3487 function CanExpand(Node: TTreeNode): Boolean; virtual; 3488 function CreateNode: TTreeNode; virtual; 3489 function CreateNodes: TTreeNodes; virtual; 3490 function CustomDraw(const ARect: TRect; 3491 Stage: TCustomDrawStage): Boolean; virtual; 3492 function CustomDrawItem(Node: TTreeNode; State: TCustomDrawState; 3493 Stage: TCustomDrawStage; var PaintImages: Boolean): Boolean; virtual; 3494 function DefaultItemHeightIsStored: Boolean; 3495 procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; 3496 const AXProportion, AYProportion: Double); override; 3497 function ExpandSignSizeIsStored: Boolean; 3498 function GetDragImages: TDragImageList; override; 3499 function GetMaxLvl: integer; 3500 function GetMaxScrollLeft: integer; 3501 function GetMaxScrollTop: integer; 3502 function GetNodeAtY(Y: Integer): TTreeNode; 3503 function GetNodeDrawAreaHeight: integer; 3504 function GetNodeDrawAreaWidth: integer; 3505 function IndentIsStored: Boolean; 3506 function IsCustomDrawn(Target: TCustomDrawTarget; 3507 Stage: TCustomDrawStage): Boolean; virtual; 3508 function IsNodeVisible(ANode: TTreeNode): Boolean; 3509 function IsNodeHeightFullVisible(ANode: TTreeNode): Boolean; 3510 function IsInsertMarkVisible: boolean; virtual; 3511 procedure MoveSelection(ANewNode: TTreeNode; ASelect: Boolean); 3512 procedure Change(Node: TTreeNode); virtual; 3513 procedure Collapse(Node: TTreeNode); virtual; 3514 procedure CreateWnd; override; 3515 procedure Click; override; 3516 procedure DblClick; override; 3517 procedure TripleClick; override; 3518 procedure QuadClick; override; 3519 procedure Delete(Node: TTreeNode); virtual; 3520 procedure DestroyWnd; override; 3521 procedure DoCreateNodeClass(var NewNodeClass: TTreeNodeClass); virtual; 3522 procedure DoEndDrag(Target: TObject; X, Y: Integer); override; 3523 function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; 3524 MousePos: TPoint): Boolean; override; 3525 function DoMouseWheelHorz(Shift: TShiftState; WheelDelta: Integer; 3526 MousePos: TPoint): Boolean; override; 3527 procedure DoPaint; virtual; 3528 procedure DoPaintNode(Node: TTreeNode); virtual; 3529 procedure DoStartDrag(var DragObject: TDragObject); override; 3530 procedure DragOver(Source: TObject; X,Y: Integer; State: TDragState; 3531 var Accept: Boolean); override; 3532 procedure EndEditing(Cancel: boolean = false); virtual; 3533 procedure EnsureNodeIsVisible(ANode: TTreeNode); 3534 procedure Expand(Node: TTreeNode); virtual; 3535 procedure GetImageIndex(Node: TTreeNode); virtual; 3536 procedure GetSelectedIndex(Node: TTreeNode); virtual; 3537 procedure InitializeWnd; override; 3538 procedure KeyDown(var Key : Word; Shift : TShiftState); override; 3539 procedure Loaded; override; 3540 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 3541 procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; 3542 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 3543 procedure MouseLeave; override; 3544 procedure NodeChanged(Node: TTreeNode; ChangeReason: TTreeNodeChangeReason); virtual; 3545 procedure Notification(AComponent: TComponent; Operation: TOperation); override; 3546 procedure Paint; override; 3547 procedure ScrollView(DeltaX, DeltaY: Integer); 3548 procedure SetDragMode(Value: TDragMode); override; 3549 procedure SetOptions(NewOptions: TTreeViewOptions); virtual; 3550 procedure UpdateDefaultItemHeight; virtual; 3551 procedure UpdateInsertMark(X,Y: integer); virtual; 3552 procedure DoSelectionChanged; virtual; 3553 procedure WMHScroll(var Msg: TLMScroll); message LM_HSCROLL; 3554 procedure WMVScroll(var Msg: TLMScroll); message LM_VSCROLL; 3555 procedure WMLButtonDown(var AMessage: TLMLButtonDown); message LM_LBUTTONDOWN; 3556 procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS; 3557 procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS; 3558 procedure Resize; override; 3559 property EditingItem: TTreeNode read FEditingItem; 3560 property States: TTreeViewStates read FStates; 3561 public 3562 // Accessibility 3563 function GetSelectedChildAccessibleObject: TLazAccessibleObject; override; 3564 function GetChildAccessibleObjectAtPos(APos: TPoint): TLazAccessibleObject; override; 3565 // This property is provided for the case when a tree view contains a huge amount of items, 3566 // lets say 10.000+. In this case accessibility might slow the tree down, so turning 3567 // it off might make things faster 3568 property AccessibilityOn: Boolean read FAccessibilityOn write FAccessibilityOn default True; 3569 protected 3570 property AutoExpand: Boolean read GetAutoExpand write SetAutoExpand default False; 3571 property BorderStyle default bsSingle; 3572 property HideSelection: Boolean 3573 read GetHideSelection write SetHideSelection default True; 3574 property HotTrack: Boolean read GetHotTrack write SetHotTrack default False; 3575 property HotTrackColor: TColor read FHotTrackColor write FHotTrackColor default clNone; 3576 property Indent: Integer read GetIndent write SetIndent stored IndentIsStored; 3577 property MultiSelect: Boolean read GetMultiSelect write SetMultiSelect default False; 3578 property OnAddition: TTVExpandedEvent read FOnAddition write FOnAddition; 3579 property OnAdvancedCustomDraw: TTVAdvancedCustomDrawEvent 3580 read FOnAdvancedCustomDraw write FOnAdvancedCustomDraw; 3581 property OnAdvancedCustomDrawItem: TTVAdvancedCustomDrawItemEvent 3582 read FOnAdvancedCustomDrawItem write FOnAdvancedCustomDrawItem; 3583 property OnChange: TTVChangedEvent read FOnChange write FOnChange; 3584 property OnChanging: TTVChangingEvent read FOnChanging write FOnChanging; 3585 property OnCollapsed: TTVExpandedEvent read FOnCollapsed write FOnCollapsed; 3586 property OnCollapsing: TTVCollapsingEvent read FOnCollapsing write FOnCollapsing; 3587 property OnCompare: TTVCompareEvent read FOnCompare write FOnCompare; 3588 property OnCreateNodeClass: TTVCreateNodeClassEvent read FOnCreateNodeClass write FOnCreateNodeClass; 3589 property OnCustomCreateItem: TTVCustomCreateNodeEvent read FOnCustomCreateItem write FOnCustomCreateItem; 3590 property OnCustomDraw: TTVCustomDrawEvent read FOnCustomDraw write FOnCustomDraw; 3591 property OnCustomDrawItem: TTVCustomDrawItemEvent read FOnCustomDrawItem write FOnCustomDrawItem; 3592 property OnCustomDrawArrow: TTVCustomDrawArrowEvent read FOnCustomDrawArrow write FOnCustomDrawArrow; 3593 property OnDeletion: TTVExpandedEvent read FOnDeletion write FOnDeletion; 3594 property OnEdited: TTVEditedEvent read FOnEdited write FOnEdited; 3595 property OnEditing: TTVEditingEvent read FOnEditing write FOnEditing; 3596 property OnEditingEnd: TTVEditingEndEvent read FOnEditingEnd write FOnEditingEnd; 3597 property OnExpanded: TTVExpandedEvent read FOnExpanded write FOnExpanded; 3598 property OnExpanding: TTVExpandingEvent read FOnExpanding write FOnExpanding; 3599 property OnGetImageIndex: TTVExpandedEvent 3600 read FOnGetImageIndex write FOnGetImageIndex; 3601 property OnGetSelectedIndex: TTVExpandedEvent 3602 read FOnGetSelectedIndex write FOnGetSelectedIndex; 3603 property OnNodeChanged: TTVNodeChangedEvent read FOnNodeChanged write FOnNodeChanged; 3604 property OnSelectionChanged: TNotifyEvent 3605 read FOnSelectionChanged write FOnSelectionChanged; 3606 property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False; 3607 property RightClickSelect: Boolean 3608 read GetRightClickSelect write SetRightClickSelect default False; 3609 property RowSelect: Boolean read GetRowSelect write SetRowSelect default False; 3610 property ScrolledLeft: integer read FScrolledLeft write SetScrolledLeft; 3611 property ScrolledTop: integer read FScrolledTop write SetScrolledTop; 3612 property ShowButtons: Boolean read GetShowButtons write SetShowButton default True; 3613 property ShowLines: Boolean read GetShowLines write SetShowLines default True; 3614 property ShowRoot: Boolean read GetShowRoot write SetShowRoot default True; 3615 property ShowSeparators: Boolean read GetShowSeparators write SetShowSeparators default True; 3616 property SortType: TSortType read FSortType write SetSortType default stNone; 3617 property ToolTips: Boolean read GetToolTips write SetToolTips default True; 3618 public 3619 constructor Create(AnOwner: TComponent); override; 3620 destructor Destroy; override; 3621 function AlphaSort: Boolean; 3622 procedure ClearSelection(KeepPrimary: Boolean = false); virtual; 3623 procedure ConsistencyCheck; 3624 function CustomSort(SortProc: TTreeNodeCompare): Boolean; 3625 function DefaultTreeViewSort(Node1, Node2: TTreeNode): Integer; 3626 procedure EraseBackground(DC: HDC); override; 3627 function GetHitTestInfoAt(X, Y: Integer): THitTests; 3628 function GetNodeAt(X, Y: Integer): TTreeNode; 3629 function GetNodeWithExpandSignAt(X, Y: Integer): TTreeNode; 3630 procedure GetInsertMarkAt(X, Y: Integer; out AnInsertMarkNode: TTreeNode; 3631 out AnInsertMarkType: TTreeViewInsertMarkType); 3632 procedure SetInsertMark(AnInsertMarkNode: TTreeNode; 3633 AnInsertMarkType: TTreeViewInsertMarkType); 3634 procedure SetInsertMarkAt(X,Y: integer); virtual; 3635 procedure Invalidate; override; 3636 function IsEditing: Boolean; 3637 procedure BeginUpdate; 3638 procedure EndUpdate; 3639 procedure FullCollapse; 3640 procedure FullExpand; 3641 procedure LoadFromFile(const FileName: string); 3642 procedure LoadFromStream(Stream: TStream); 3643 procedure SaveToFile(const FileName: string); 3644 procedure SaveToStream(Stream: TStream); 3645 procedure WriteDebugReport(const Prefix: string; AllNodes: boolean); 3646 procedure LockSelectionChangeEvent; 3647 procedure UnlockSelectionChangeEvent; 3648 function GetFirstMultiSelected: TTreeNode; 3649 function GetLastMultiSelected: TTreeNode; 3650 procedure Select(Node: TTreeNode; ShiftState: TShiftState = []); 3651 procedure Select(const Nodes: array of TTreeNode); virtual; 3652 procedure Select(Nodes: TList); virtual; 3653 function SelectionVisible: boolean; 3654 procedure MakeSelectionVisible; 3655 procedure ClearInvisibleSelection; 3656 function StoreCurrentSelection: TStringList; 3657 procedure ApplyStoredSelection(ASelection: TStringList; FreeList: boolean = True); 3658 procedure MoveToNextNode(ASelect: Boolean = False); 3659 procedure MoveToPrevNode(ASelect: Boolean = False); 3660 procedure MovePageDown(ASelect: Boolean = False); 3661 procedure MovePageUp(ASelect: Boolean = False); 3662 procedure MoveHome(ASelect: Boolean = False); 3663 procedure MoveEnd(ASelect: Boolean = False); 3664 public 3665 property BackgroundColor: TColor read GetBackgroundColor write SetBackgroundColor stored IsStoredBackgroundColor; 3666 property BorderWidth default 0; 3667 property BottomItem: TTreeNode read GetBottomItem write SetBottomItem; 3668 property Color default clWindow; 3669 property DefaultItemHeight: integer read FDefItemHeight write SetDefaultItemHeight stored DefaultItemHeightIsStored; 3670 property DropTarget: TTreeNode read GetDropTarget write SetDropTarget; 3671 property ExpandSignColor: TColor read FExpandSignColor write FExpandSignColor default clWindowFrame; 3672 property ExpandSignSize: integer read GetExpandSignSize write SetExpandSignSize stored ExpandSignSizeIsStored; 3673 property ExpandSignType: TTreeViewExpandSignType 3674 read FExpandSignType write SetExpandSignType default tvestTheme; 3675 property Images: TCustomImageList read FImages write SetImages; 3676 property ImagesWidth: Integer read FImagesWidth write SetImagesWidth default 0; 3677 property InsertMarkNode: TTreeNode read FInsertMarkNode write SetInsertMarkNode; 3678 property InsertMarkType: TTreeViewInsertMarkType read FInsertMarkType write SetInsertMarkType; 3679 property Items: TTreeNodes read FTreeNodes write SetTreeNodes; 3680 property KeepCollapsedNodes: boolean read GetKeepCollapsedNodes write SetKeepCollapsedNodes; 3681 property MultiSelectStyle: TMultiSelectStyle read FMultiSelectStyle 3682 write SetMultiSelectStyle default DefaultMultiSelectStyle; 3683 property Options: TTreeViewOptions read FOptions write SetOptions default DefaultTreeViewOptions; 3684 property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssBoth; 3685 property Selected: TTreeNode read GetSelection write SetSelection; 3686 property SelectionColor: TColor read FSelectedColor write SetSelectedColor default clHighlight; 3687 property SelectionCount: Cardinal read GetSelectionCount; 3688 property SelectionFontColor: TColor read FSelectedFontColor write SetSelectedFontColor default clWhite; 3689 property SelectionFontColorUsed: boolean read FSelectedFontColorUsed write FSelectedFontColorUsed default False; 3690 property Selections[AIndex: Integer]: TTreeNode read GetSelections; 3691 property SeparatorColor: TColor read fSeparatorColor write SetSeparatorColor default clGray; 3692 property StateImages: TCustomImageList read FStateImages write SetStateImages; 3693 property StateImagesWidth: Integer read FStateImagesWidth write SetStateImagesWidth default 0; 3694 property TopItem: TTreeNode read GetTopItem write SetTopItem; 3695 property TreeLineColor: TColor read FTreeLineColor write FTreeLineColor default clWindowFrame; 3696 property TreeLinePenStyle: TPenStyle read FTreeLinePenStyle write FTreeLinePenStyle default psPattern; 3697 published 3698 property TabStop default true; 3699 end; 3700 3701 3702 { TTreeView } 3703 3704 TTreeView = class(TCustomTreeView) 3705 published 3706 property Align; 3707 property Anchors; 3708 property AutoExpand; 3709 property BorderSpacing; 3710 property BackgroundColor; 3711 property BorderStyle; 3712 property BorderWidth; 3713 property Color; 3714 property Constraints; 3715 property DefaultItemHeight; 3716 property DragKind; 3717 property DragCursor; 3718 property DragMode; 3719 property Enabled; 3720 property ExpandSignColor; 3721 property ExpandSignSize; 3722 property ExpandSignType; 3723 property Font; 3724 property HideSelection; 3725 property HotTrack; 3726 property HotTrackColor; 3727 property Images; 3728 property ImagesWidth; 3729 property Indent; 3730 property MultiSelect; 3731 property MultiSelectStyle; 3732 property ParentColor default False; 3733 property ParentFont; 3734 property ParentShowHint; 3735 property PopupMenu; 3736 property ReadOnly; 3737 property RightClickSelect; 3738 property RowSelect; 3739 property ScrollBars; 3740 property SelectionColor; 3741 property SelectionFontColor; 3742 property SelectionFontColorUsed; 3743 property SeparatorColor; 3744 property ShowButtons; 3745 property ShowHint; 3746 property ShowLines; 3747 property ShowRoot; 3748 property SortType; 3749 property StateImages; 3750 property StateImagesWidth; 3751 property TabOrder; 3752 property TabStop default True; 3753 property Tag; 3754 property ToolTips; 3755 property Visible; 3756 property OnAddition; 3757 property OnAdvancedCustomDraw; 3758 property OnAdvancedCustomDrawItem; 3759 property OnChange; 3760 property OnChanging; 3761 property OnClick; 3762 property OnCollapsed; 3763 property OnCollapsing; 3764 property OnCompare; 3765 property OnContextPopup; 3766 property OnCreateNodeClass; 3767 property OnCustomCreateItem; 3768 property OnCustomDraw; 3769 property OnCustomDrawItem; 3770 property OnCustomDrawArrow; 3771 property OnDblClick; 3772 property OnDeletion; 3773 property OnDragDrop; 3774 property OnDragOver; 3775 property OnEdited; 3776 property OnEditing; 3777 property OnEditingEnd; 3778 property OnEndDrag; 3779 property OnEnter; 3780 property OnExit; 3781 property OnExpanded; 3782 property OnExpanding; 3783 property OnGetImageIndex; 3784 property OnGetSelectedIndex; 3785 property OnKeyDown; 3786 property OnKeyPress; 3787 property OnKeyUp; 3788 property OnMouseDown; 3789 property OnMouseEnter; 3790 property OnMouseLeave; 3791 property OnMouseMove; 3792 property OnMouseUp; 3793 property OnMouseWheel; 3794 property OnMouseWheelDown; 3795 property OnMouseWheelUp; 3796 property OnNodeChanged; 3797 property OnResize; 3798 property OnSelectionChanged; 3799 property OnShowHint; 3800 property OnStartDrag; 3801 property OnUTF8KeyPress; 3802 property Options; 3803 property Items; 3804 property TreeLineColor; 3805 property TreeLinePenStyle; 3806 end; 3807 3808 3809 TTVGetNodeText = function(Node: TTreeNode): string of object; 3810 3811 { TTreeNodeExpandedState } 3812 { class to store and restore the expanded state of a TTreeView 3813 The nodes are identified by their Text property. 3814 3815 Usage example: 3816 // save old expanded state 3817 OldExpanded:=TTreeNodeExpandedState.Create(ATreeView); 3818 ... change a lot of nodes ... 3819 // restore old expanded state 3820 OldExpanded.Apply(ATreeView); 3821 OldExpanded.Free; 3822 } 3823 3824 TTreeNodeExpandedState = class 3825 private 3826 FOnGetNodeText: TTVGetNodeText; 3827 function DefaultGetNodeText(Node: TTreeNode): string; 3828 public 3829 NodeText: string; 3830 Children: TAvlTree; 3831 constructor Create(FirstTreeNode: TTreeNode; const GetNodeTextEvent: TTVGetNodeText = nil); 3832 constructor Create(TreeView: TCustomTreeView; const GetNodeTextEvent: TTVGetNodeText = nil); 3833 destructor Destroy; override; 3834 procedure Clear; 3835 procedure CreateChildNodes(FirstTreeNode: TTreeNode); 3836 procedure Apply(FirstTreeNode: TTreeNode; CollapseToo: boolean = true); 3837 procedure Apply(TreeView: TCustomTreeView; CollapseToo: boolean = true); 3838 property OnGetNodeText: TTVGetNodeText read FOnGetNodeText write FOnGetNodeText; 3839 end; 3840 3841 3842 3843 TCustomHeaderControl = class; 3844 3845 3846 { THeaderSection } 3847 THeaderSectionState = 3848 ( 3849 hsNormal, 3850 hsHot, 3851 hsPressed 3852 ); 3853 THeaderSection = class(TCollectionItem) 3854 private 3855 FAlignment: TAlignment; 3856 FImageIndex: TImageIndex; 3857 FMinWidth: Integer; 3858 FMaxWidth: Integer; 3859 FState: THeaderSectionState; 3860 FText: TCaption; 3861 FVisible: Boolean; 3862 FWidth: Integer; 3863 FOriginalIndex: Integer; 3864 function GetWidth: Integer; 3865 function GetLeft: Integer; 3866 function GetRight: Integer; 3867 procedure SetAlignment(const AValue: TAlignment); 3868 procedure SetMaxWidth(AValue: Integer); 3869 procedure SetMinWidth(AValue: Integer); 3870 procedure SetState(const AValue: THeaderSectionState); 3871 procedure SetText(const Value: TCaption); 3872 procedure SetVisible(const AValue: Boolean); 3873 procedure SetWidth(Value: Integer); 3874 procedure SetImageIndex(const Value: TImageIndex); 3875 procedure CheckConstraints; 3876 protected 3877 function GetDisplayName: string; override; 3878 public 3879 constructor Create(ACollection: TCollection); override; 3880 procedure Assign(Source: TPersistent); override; 3881 property Left: Integer read GetLeft; 3882 property Right: Integer read GetRight; 3883 property State: THeaderSectionState read FState write SetState; 3884 published 3885 property Alignment: TAlignment read FAlignment write SetAlignment; 3886 property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1; 3887 property MaxWidth: Integer read FMaxWidth write SetMaxWidth default 10000; 3888 property MinWidth: Integer read FMinWidth write SetMinWidth default 0; 3889 property Text: TCaption read FText write SetText; 3890 property Width: Integer read GetWidth write SetWidth; 3891 property Visible: Boolean read FVisible write SetVisible; 3892 //index which doesn't change when the user reorders the sections 3893 property OriginalIndex: Integer read FOriginalIndex; 3894 end; 3895 3896 THeaderSectionClass = class of THeaderSection; 3897 3898 3899 { THeaderSections } 3900 3901 THeaderSections = class(TCollection) 3902 private 3903 FHeaderControl: TCustomHeaderControl; 3904 function GetItem(Index: Integer): THeaderSection; 3905 procedure SetItem(Index: Integer; Value: THeaderSection); 3906 protected 3907 function GetOwner: TPersistent; override; 3908 procedure Update(Item: TCollectionItem); override; 3909 public 3910 constructor Create(HeaderControl: TCustomHeaderControl); 3911 function Add: THeaderSection; 3912 function AddItem(Item: THeaderSection; Index: Integer): THeaderSection; 3913 function Insert(Index: Integer): THeaderSection; 3914 procedure Delete(Index: Integer); 3915 property Items[Index: Integer]: THeaderSection read GetItem write SetItem; default; 3916 end; 3917 3918 TSectionTrackState = (tsTrackBegin, tsTrackMove, tsTrackEnd); 3919 TCustomSectionTrackEvent = procedure(HeaderControl: TCustomHeaderControl; Section: THeaderSection; Width: Integer; State: TSectionTrackState) of object; 3920 TSectionDragEvent = procedure (Sender: TObject; FromSection, ToSection: THeaderSection; 3921 var AllowDrag: Boolean) of object; 3922 TCustomSectionNotifyEvent = procedure(HeaderControl: TCustomHeaderControl; 3923 Section: THeaderSection) of object; 3924 TCustomHCCreateSectionClassEvent = procedure(Sender: TCustomHeaderControl; 3925 var SectionClass: THeaderSectionClass) of object; 3926 3927 3928 { TCustomHeaderControl } 3929 3930 TCustomHeaderControl = class(TCustomControl) 3931 private 3932 FDragReorder: boolean; 3933 FSections: THeaderSections; 3934 FImages: TCustomImageList; 3935 FImagesWidth: Integer; 3936 FPaintRect: TRect; 3937 FDown: Boolean; 3938 FDownPoint: TPoint; 3939 FTracking, FDragging: Boolean; 3940 FEndDragSectionIndex: longint; 3941 FSelectedSection: longint; 3942 FMouseInControl: Boolean; 3943 FSavedCursor: TCursor; 3944 3945 FOnSectionClick: TCustomSectionNotifyEvent; 3946 FOnSectionResize: TCustomSectionNotifyEvent; 3947 FOnSectionTrack: TCustomSectionTrackEvent; 3948 FOnSectionSeparatorDblClick: TCustomSectionNotifyEvent; 3949 FOnSectionDrag: TSectionDragEvent; 3950 FOnSectionEndDrag: TNotifyEvent; 3951 FOnCreateSectionClass: TCustomHCCreateSectionClassEvent; 3952 function GetSectionFromOriginalIndex(OriginalIndex: Integer): THeaderSection; 3953 procedure SetImages(const AValue: TCustomImageList); 3954 procedure SetImagesWidth(const aImagesWidth: Integer); 3955 procedure SetSections(const AValue: THeaderSections); 3956 procedure UpdateSection(Index: Integer); 3957 procedure UpdateSections; 3958 protected 3959 function CreateSection: THeaderSection; virtual; 3960 function CreateSections: THeaderSections; virtual; 3961 procedure Loaded; override; 3962 procedure Notification(AComponent: TComponent; Operation: TOperation); override; 3963 procedure SectionClick(Section: THeaderSection); virtual; 3964 procedure SectionResize(Section: THeaderSection); virtual; 3965 procedure SectionTrack(Section: THeaderSection; State: TSectionTrackState); virtual; 3966 procedure SectionSeparatorDblClick(Section: THeaderSection); virtual; 3967 procedure SectionEndDrag; virtual; 3968 function SectionDrag(FromSection, ToSection: THeaderSection): Boolean; virtual; 3969 procedure MouseEnter; override; 3970 procedure MouseLeave; override; 3971 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; 3972 X, Y: Integer); override; 3973 procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; 3974 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; 3975 X, Y: Integer); override; 3976 procedure UpdateState; 3977 class function GetControlClassDefaultSize: TSize; override; 3978 procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; 3979 const AXProportion, AYProportion: Double); override; 3980 public 3981 property SectionFromOriginalIndex[OriginalIndex: Integer]: THeaderSection read GetSectionFromOriginalIndex; 3982 3983 constructor Create(AOwner: TComponent); override; 3984 destructor Destroy; override; 3985 3986 procedure Click; override; 3987 procedure DblClick; override; 3988 function GetSectionAt(P: TPoint): Integer; 3989 procedure Paint; override; 3990 procedure PaintSection(Index: Integer); virtual; 3991 procedure ChangeScale(M, D: Integer);override; 3992 published 3993 property DragReorder: boolean read FDragReorder write FDragReorder; 3994 property Images: TCustomImageList read FImages write SetImages; 3995 property ImagesWidth: Integer read FImagesWidth write SetImagesWidth default 0; 3996 property Sections: THeaderSections read FSections write SetSections; 3997 3998 property OnSectionDrag: TSectionDragEvent read FOnSectionDrag 3999 write FOnSectionDrag; 4000 property OnSectionEndDrag: TNotifyEvent read FOnSectionEndDrag write FOnSectionEndDrag; 4001 property OnSectionClick: TCustomSectionNotifyEvent read FOnSectionClick 4002 write FOnSectionClick; 4003 property OnSectionResize: TCustomSectionNotifyEvent read FOnSectionResize 4004 write FOnSectionResize; 4005 property OnSectionTrack: TCustomSectionTrackEvent read FOnSectionTrack 4006 write FOnSectionTrack; 4007 property OnSectionSeparatorDblClick: TCustomSectionNotifyEvent read FOnSectionSeparatorDblClick 4008 write FOnSectionSeparatorDblClick; 4009 property OnCreateSectionClass: TCustomHCCreateSectionClassEvent read FOnCreateSectionClass 4010 write FOnCreateSectionClass; 4011 end; 4012 4013 4014 { THeaderControl } 4015 4016 THeaderControl = class(TCustomHeaderControl) 4017 published 4018 property Align; 4019 property Anchors; 4020 property BiDiMode; 4021 property BorderWidth; 4022 property BorderSpacing; 4023 property DragCursor; 4024 property DragKind; 4025 property DragMode; 4026 property Enabled; 4027 property Font; 4028 property Images; 4029 property ImagesWidth; 4030 property Constraints; 4031 property Sections; 4032 property ShowHint; 4033 property ParentBiDiMode; 4034 property ParentFont; 4035 property ParentShowHint; 4036 property PopupMenu; 4037 property Visible; 4038 // events 4039 property OnContextPopup; 4040 property OnCreateSectionClass; 4041 property OnDragDrop; 4042 property OnDragOver; 4043 property OnEndDock; 4044 property OnEndDrag; 4045 property OnMouseDown; 4046 property OnMouseEnter; 4047 property OnMouseLeave; 4048 property OnMouseMove; 4049 property OnMouseUp; 4050 property OnMouseWheel; 4051 property OnMouseWheelDown; 4052 property OnMouseWheelUp; 4053 property OnResize; 4054 property OnSectionClick; 4055 property OnSectionResize; 4056 property OnSectionTrack; 4057 end; 4058 4059const 4060 TCN_First = 0-550; 4061 TCN_SELCHANGE = TCN_FIRST - 1; 4062 TCN_SELCHANGING = TCN_FIRST - 2; 4063 4064function CompareExpandedNodes(Data1, Data2: Pointer): integer; 4065function CompareTextWithExpandedNode(Key, Data: Pointer): integer; 4066function DbgS(Opt: TCTabControlOptions): String; overload; 4067 4068procedure Register; 4069 4070{ WidgetSetRegistration } 4071 4072procedure RegisterCustomPage; 4073procedure RegisterCustomTabControl; 4074 4075implementation 4076 4077// !!! Avoid unit circles. Only add units if really needed. 4078uses 4079 InterfaceBase, WSComCtrls, WSFactory; 4080 4081const 4082 AllPanelsParts = [Low(TPanelPart)..High(TPanelPart)]; 4083 4084{ TNBBasePages } 4085 4086constructor TNBBasePages.Create(theNotebook: TCustomTabControl); 4087begin 4088 inherited Create; 4089end; 4090 4091{$I custompage.inc} 4092{$I customnotebook.inc} 4093{$I statusbar.inc} 4094{$I statuspanel.inc} 4095{$I statuspanels.inc} 4096{$I tabsheet.inc} 4097{$I pagecontrol.inc} 4098{$I tabcontrol.inc} 4099{$I listcolumns.inc} 4100{$I listcolumn.inc} 4101{$I listitem.inc} 4102{$I listitems.inc} 4103{$I customlistview.inc} 4104{$I progressbar.inc} 4105{$I customupdown.inc} 4106{$I toolbutton.inc} 4107{$I toolbar.inc} 4108{$I coolbar.inc} 4109{$I trackbar.inc} 4110{$I treeview.inc} 4111{$I headercontrol.inc} 4112 4113{ TTreeNodesEnumerator } 4114 4115function TTreeNodesEnumerator.GetCurrent: TTreeNode; 4116begin 4117 Result := FNodes[FPosition]; 4118end; 4119 4120constructor TTreeNodesEnumerator.Create(ANodes: TTreeNodes); 4121begin 4122 inherited Create; 4123 FNodes := ANodes; 4124 FPosition := -1; 4125end; 4126 4127function TTreeNodesEnumerator.MoveNext: Boolean; 4128begin 4129 inc(FPosition); 4130 Result := FPosition < FNodes.Count; 4131end; 4132 4133{ TListItemsEnumerator } 4134 4135function TListItemsEnumerator.GetCurrent: TListItem; 4136begin 4137 Result := FItems[FPosition]; 4138end; 4139 4140constructor TListItemsEnumerator.Create(AItems: TListItems); 4141begin 4142 inherited Create; 4143 FItems := AItems; 4144 FPosition := -1; 4145end; 4146 4147function TListItemsEnumerator.MoveNext: Boolean; 4148begin 4149 inc(FPosition); 4150 Result := FPosition < FItems.Count; 4151end; 4152 4153{ TToolBarEnumerator } 4154 4155function TToolBarEnumerator.GetCurrent: TToolButton; 4156begin 4157 Result := FToolBar.Buttons[FPosition]; 4158end; 4159 4160constructor TToolBarEnumerator.Create(AToolBar: TToolBar); 4161begin 4162 inherited Create; 4163 FToolBar := AToolBar; 4164 FPosition := -1; 4165end; 4166 4167function TToolBarEnumerator.MoveNext: Boolean; 4168begin 4169 inc(FPosition); 4170 Result := FPosition < FToolBar.ButtonCount; 4171end; 4172 4173procedure Register; 4174begin 4175 RegisterComponents('Common Controls',[TTrackbar,TProgressBar,TTreeView, 4176 TListView,TStatusBar,TToolBar,TCoolBar,TUpDown,TPageControl,TTabControl, 4177 THeaderControl]); 4178 RegisterNoIcon([TToolButton,TTabSheet]); 4179end; 4180 4181{ WidgetSetRegistration } 4182 4183procedure RegisterCustomPage; 4184const 4185 Done: Boolean = False; 4186begin 4187 if Done then exit; 4188 WSRegisterCustomPage; 4189// if not WSRegisterCustomPage then 4190// RegisterWSComponent(TCustomPage, TWSCustomPage); 4191 Done := True; 4192end; 4193 4194procedure RegisterCustomTabControl; 4195const 4196 Done: Boolean = False; 4197begin 4198 if Done then exit; 4199 if not WSRegisterCustomNotebook then 4200 RegisterWSComponent(TCustomTabControl, TWSCustomTabControl); 4201 Done := True; 4202end; 4203 4204initialization 4205 RegisterPropertyToSkip(TTabControl, 'OnDrawTab', 'Property streamed in older Lazarus revision',''); 4206 4207end. 4208