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