-
Notifications
You must be signed in to change notification settings - Fork 18
/
TreeListView.pas
3994 lines (3564 loc) · 149 KB
/
TreeListView.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
{**
This unit contains the TTreeListView which is a combination of a TreeView and a
ListView. This means that you can organize the items in a tree and show
additional information in columns.
@author Benito van der Zander (http://www.benibela.de)
@author Thanks to: Bruce Christensen
}
unit TreeListView;
{$ifdef fpc}
{$mode delphi}
{$COperators on}
{$endif}
{$ifdef clr}
{$UNSAFECODE ON}
{$endif}
{$ifdef lcl}
{$define allowHeaderDragging} //header section can only be dragged by the user if this is defined,
//it needs at least lazarus 9.26
{$define allowHeaderVisible} //the visibility of header section can only be changed by the user if this
//is defined; it needs at least lazarus 9.27 (SVN, r16817)
{$endif}
{$ifdef lcl}
{$define openOwnPopupMenu} //disable if you get 2 popupmenus (it is necessary in some lcl versions)
{$define useRealClipping} //old Lazarus/fpc don't support clipping (should work with (Lazarus >= 19742 (0.9.27) and fpc >2.3.1) or (Lazarus > 20731 (0.9.27)))
{$endif}
interface
uses
SysUtils, Classes, Graphics, Controls, Forms, Dialogs,comctrls,stdctrls,ExtCtrls, Menus,math,
findControl
{$ifdef lclqt}, qtwidgets{$endif}
{$ifdef clr},types{$endif}
{$ifdef lcl},LCLType,LCLIntf, LMessages{$else},windows,messages{$endif};
const PACKAGE_VERSION = '1.0.0.repo';
type
{$TYPEINFO ON}
//Forward
TObjectList=class;
TTreeListRecordItem=class;
TTreeListItem=class;
TTreeListView = class;
TListEventTyp=(levBeginEdit,levEndEdit,levAdd,levInsert,levClear,levDelete,levExchange,levMove,levSort,levAssign);
TListEvent = procedure (list: TObjectList; typ: TListEventTyp) of object;
{** @abstract This is a list storing TObjects for the TreeListView
The list supports change notifications and automatically deletes the items}
TObjectList= class(TList)
public
procedure BeginEdit;
procedure EndEdit;
function AddObject(Item: TObject): Integer;
procedure InsertObject(Index: Integer; Item: TObject);
function RemoveObject(Item: TObject): Integer;
procedure Clear; override;
procedure Delete(Index: Integer);
procedure Exchange(Index1, Index2: Integer);
procedure Move(CurIndex, NewIndex: Integer);
procedure Sort(Compare: TListSortCompare);
procedure Assign(list:TList);
constructor Create(listEvent: TListEvent);
destructor Destroy;override;
protected
onListEvent: TListEvent;
procedure FreeObjects;
function Add(Item: TObject): Integer;
procedure Insert(Index: Integer; Item: TObject);
function Remove(Item: TObject): Integer;
end;
//**This specifies if invisible/collapsed items are counted
TRealItemCounting=set of (ricCountCollapsedsubItems{,ricCountExpandItems,ricCountEndNodes});
{ TTreeListItems }
{$ifdef fpc}pbool=pboolean;{$endif}
//**This is a typical compare function
TTreeListItemCompare = function (i1, i2: TTreeListItem): longint of object;
{** @abstract This is the list used for storing (sub)-items
}
TTreeListItems=class(TObjectList)
private
procedure Put(Index: Integer; const AValue: TTreeListItem);
protected
F_Parent:TtreeListItem;
F_TreeListView:TTreeListView;
function Get(Index: Integer): TTreeListItem;
procedure Sort(CompareFunc: TTreeListItemCompare);
public
constructor create(parent:TTreeListItem;const TreeListView:TTreeListView);
//**This adds an item with the given caption to this list
function Add(caption:string=''):TTreelistItem;overload;
//**This adds an item with the given record texts
function Add(captions:array of string):TTreelistItem;overload;
//**This adds an item with the given parent and caption @br
//**If parent is @nil the item is added to this list, otherwise to the list parent.subitems
function Add(Parent:TTreeListItem;caption:string=''):TTreelistItem;overload;
//**This counts all (direct and indirect) children of this item
function GetRealItemCount(const countTyp:TRealItemCounting ) :integer;
//**This retrieve the real index of the given item @br
//**The real index tells you how many items (including all children) are between item and self @br
//**This also finds indirect children
function RealIndexOf(const item:ttreeListItem;const countTyp:TRealItemCounting):integer;
//**This get the item which are certain real index @seealso RealIndexOf
function GetItemWithRealIndex(index:integer;const countTyp:TRealItemCounting):TTreeListItem;
//**This searches recursive for a item with the given caption
//**@return the first matching item or nil if nothing is found
function FindItemWithText(caption: string): TTreeListItem;
//**This searches recursive for a item with text in the column pos (if pos = 0 this is the same as FindItemWithText)
//**@return the first matching item or nil if nothing is found
function FindItemWithRecordText(text: string;pos: longint=0):TTreeListItem;
//**This searches the text searchFor in searchFields.
//**@param searchFields Bit-wise combination of column numbers. Use @code(1 shl i) for column i. (you can only use the first 32 columns)
//**@param backward Specifies search direction
function find(searchFor: string; searchFields:cardinal; backward: boolean=false; loopAround: PBOOL=nil; startItem: TTreeListItem=nil; startColumn: longint=0; startTextPosition:longint=0): TTreeListRecordItem;overload;
//** access to the direct sub items
property Items[Index: Integer]: TTreeListItem read Get write Put; default;
end;
{ TRecordItemList }
{** @abstract This list stores the items in the detail columns }
TRecordItemList=class(TObjectList)
private
Owner: TTreeListItem;
function Get(Index: Integer): TTreeListRecordItem;
procedure Put(Index: Integer; const AValue: TTreeListRecordItem);
public
property Items[Index: Integer]: TTreeListRecordItem read Get write Put; default;
function Add:TTreeListRecordItem;overload;
function Add(s: string):TTreeListRecordItem;overload;
procedure AddItem(recordItem: TTreeListRecordItem);
end;
{ TTreeListRecordItem }
{** @abstract This is a item shown in the detail columns}
TTreeListRecordItem=class(TPersistent)
private
protected
F_Parent: TTreeListItem;
F_Text:string;
{F_HotTrackFont:TFont;
F_HotTrack:boolean;
F_ParentHotTrack:boolean;
F_ParentHotTrackFont:boolean; }
procedure SetText(caption:string);
function getIndex(): longint;
public
//** This selects the font used to draw this item (useful when owner drawing)
procedure selectFont(can: TCanvas);
//procedure PaintTo(const listView:TTreeListView;x:integer;const y,xColumn:integer;const parentItem:TTreeListItem);
//** This returns the size of this item
function GetNecessaryWidth(listView:TTreeListView=nil): longint;
constructor Create(aparent:TTreeListItem);overload; //**<Creates an item
constructor Create(aparent:TTreeListItem;caption:string);overload; //**<Creates an item with given caption
destructor Destroy;override;
published
property Text:string read F_Text write setText;
property Index: longint read getIndex;
property Parent:TTreeListItem read F_Parent;
end;
//**stores the parent items of an item, don't use the members
TItemHierarchyStack=record
size:longint;
stack:array of record
list: TTreeListItems;
index: longint;
end;
end;
//**can be used to store abitrary 64 bit data in every item (will be removed as soon as the generics are really usable)
TItemDataRec = packed record //inspired by int64rec
case integer of
0 : (i64: int64);
1 : (lo32, hi32 : Cardinal);
2 : (Words : Array[0..3] of Word);
3 : (Bytes : Array[0..7] of Byte);
4 : (p : pointer);
5 : (obj : TObject);
end;
{** @abstract This is an item which can contain subitems and items in the detail columns }
TTreeListItem=class(TPersistent)
private
function GetText: string;
procedure SetText(const AValue: string);
protected
F_ImageIndex:longint;
F_ImageBitmap:graphics.TBitmap;
F_SubItems:TTreeListItems;
F_RecordItems:TRecordItemList;
F_Expanded,F_Selected,F_MouseSelected:boolean;
F_Indent:integer; //Gibt an, wieoft, das Item eingerückt wurde, diese Eigenschaft wird von PaintTo und GetItemAtPosWithIndentSet gesetzt, und muss *nicht* stimmmen
F_Parent:Ttreelistitem;
F_TreeListView:TTreeListView;
// F_ParentFont:boolean;
// F_Font:TFont;
function GetExtraTextIndentation(column: longint): longint; //mainly tree width
function GetExtendingButtonPos: longint;
procedure SetSelected(newSelected: boolean);
procedure SetMouseSelected(newSelected: boolean);
procedure SetSelections(realSelected, mouseSelection:boolean);
procedure SetSubItems(const value:TtreeListItems);
procedure SetRecordItems(const value:TRecordItemList); overload;
procedure SetRecordItems(const texts: array of string); overload;
procedure SetExpand(const expanded:boolean);
function GetRecordItemsText(i: Integer): string;
procedure SetRecordItemsText(i: Integer; const AValue: string);
procedure SheduleInternRepaint();
public
data:TItemDataRec; //**< This value can be used to store arbitrary integer values
//**This creates an item with given parent and caption in the given TreeListView
constructor Create(const parent:TTreeListItem;const TreeListView:TTreeListView;const ACaption:string='');overload;
//**This returns the size of the displayed item @br
//** @return if column = -1 the size of the whole line is returned, otherwise the size of the given column
function getBounds(column: longint):TRect; //-1 => whole line
//**This returns the maximal size of the displayed text @br This is like getBounds but subtracts indentation and padding
function getMaxTextBounds(column: longint):TRect; //-1 => whole line
//**This returns the item in the given TreeListView at the position TestY which is a sub item (or/of) self @br
//**startY returns the top position of the found item @seealso TTreeListView.GetItemAtPos
function GetItemAtPos(const listView:TTreeListView;const TestY:integer;var startY:integer):TTreeListItem;
//**This returns the record item at the given position @seealso TTreeListView.GetRecordItemAtPos
function GetRecordItemAtPos(const listView:TTreeListView;TestX:integer):TTreeListRecordItem;
//**This returns the width of the largest record item in the column id of any sub item
function GetMaxColumnWidth(const id:longint): longint;
//**This expands this item, to show all subitems
procedure Expand;
//**This collapses this item, to hide all subitems
procedure Collapse;
function GetNextItemIgnoringChildren:TTreeListItem; //**<Returns the next item which is no sub item of this @br Notice that this runs in O(m), so don't use it in a loop
function GetLastVisibleSubSubItem:TTreeListItem; //**<Returns the latest visible item which is an (indirect) children of this
function GetLastSubSubItem:TTreeListItem; //**<Returns the latest item which is an (indirect) children of this
//If the item doesn't exists the current item is returned!
function GetNextVisibleItem(Delta:longint=1):TTreeListItem;//**<Returns the next visible item, or the Delta-th next item. Is Delta < 0 this is like a call to GetPrevVisibleItem @br Notice that this runs in O(m), so don't use it in a loop. If the item doesn't exists the current item is returned!
function GetPrevVisibleItem(Delta:longint=1):TTreeListItem;//**<Returns the previous visible item, or the Delta-th previous item. Is Delta < 0 this is like a call to GetNextVisibleItem @br Notice that this runs in O(m), so don't use it in a loop. If the item doesn't exists the current item is returned!
function GetNextItem():TTreeListItem;//**< Returns the next item @br Notice that this runs in O(m), so don't use it in a loop. If the item doesn't exists the current item is returned!
function GetPrevItem():TTreeListItem;//**< Returns the previous item @br Notice that this runs in O(m), so don't use it in a loop. If the item doesn't exists the current item is returned!
function GetParentInList(List: TTreeListItems=nil):TTreeListItem;//**< Returns the parent which is in the given list, or nil. @br If List = nil then it takes TreeListView.Items @br If self is in the list it returns self
procedure GetParentHierarchyStack(out stack:TItemHierarchyStack); //**returns a stack you can use to enumerate all item iterative
function GetNextFromHierarchyStack(var stack: TItemHierarchyStack; const mustBeVisible: boolean=false): TTreeListItem;//<** get the (visible) next item, using a hierarchy stack
property Parent:TTreeListItem read F_parent; //**< This is a parent of this item @br This is @nil if the item is in @noAutoLink TreeListView.Items
property TreeListView:TTreeListView read F_TreeListview; //**< This is the TreeListView showing this item
function ParentItems: TTreeListItems; //**< This returns the list containing the item @br It is either @noAutoLink TreeListView.Items or @noAutoLink Parent.SubItems
//**This draws the item @br Don't call it direct
//**@param hierarchyStack list of parents
procedure Paint(const hierarchyStack: TItemHierarchyStack);
//**Destroy
destructor Destroy;override;
property Indent:integer read F_Indent;//**< Level of indentation @br This value is not guaranteed to be correct (but it is during paint events)
function SeemsSelected:boolean;//**< Returns if the items is drawn selected @br When the user selects new items there new selection state can be previewed
property Expanded:boolean read F_expanded write SetExpand; //**< Specifies if the sub items are currently visible
property MouseSelected: boolean read F_MouseSelected write SetMouseSelected; //**< Controls if this item is selected or not
property RecordItemsText[i: Integer]:string read GetRecordItemsText write SetRecordItemsText; //**< Sets the value of the given column @br Notice that this array is 0-based and RecordItemsText[0] is always the same as Text @br Getting a not existing item will give you '', setting will create it
published
property RecordItems:TRecordItemList read F_RecordItems write SetRecordItems; //**< Items in the columns @br Normally you can use RecordItemsText for easier access
property SubItems:TTreeListItems read F_SubItems write SetSubItems; //**< Indented child items
property ImageIndex:longint read F_ImageIndex write F_ImageIndex; //**< If this is > -1 then the image of the TreeListView.Images will be painted before this item @br This property is ignored if ImageBitmap <> @nil or TreeListView.Images = @nil @br Use ImageBitmap if you are in doubt (a image list may be better with regards to caching issues, but clipping is slower)
property ImageBitmap:graphics.TBitmap read F_ImageBitmap write F_ImageBitmap; //**< Bitmap which should be drawn before the item @br This image is not freed when the item is destroyed, so you can use the same bitmap for multiple items
property Text:string read GetText write SetText; //**< Text in the first column of this item @br This is always equal to RecordItemsText[0]
property Selected: boolean read F_Selected write SetSelected; //**< Controls if this item is selected or not
end;
//**General appearance/behaviour options
TTreeListViewOption = ( tlvoMultiSelect, //**<Specifies if multiple items can be selected
tlvoToolTips, //**<Specifies if tooltips are shown when item text is longer than the column
tlvoRightMouseSelects, //**< Determines if you can select items using the right mouse button
tlvoHotTrackRecordTextItems, //**< Determines if the record items are hot tracked
tlvoStriped, //**< Determines if the item background is drawn alternating
tlvoStripInvisibleItems, //**< Controls if invisible items are counted when the control determines if a item is odd or even (if on items are striped, if off positions are striped)
tlvoColumnsDragable, //**< Controls if the columns of the header control can be reordered (needs FPC)
tlvoSorted, //**< Controls of the items should be @noAutoLink sorted @br Notice that items are only sorted in endUpdate (and the first time tlvoSorted is set), so new inserted or changed items are not automatically sorted until you call endUpdate
tlvoAlwaysFullRepaint, //** repaints everything even after a small change
tlvoDragScrolling //** The list can be scrolled by dragging an item up and down (like standard Android lists)
);
TTreeListViewOptions=set of TTreeListViewOption;
TTreeListInternOptions=set of (tlioDeleting, tlioUpdating); //**<@exclude
TExpandMode=(emExpandByClick,emExpandByDoubleClick,emExpandNot);
TLineMode=(lmNone,lmSolid,lmDot);
TExpandItemEvent = procedure (Sender: TObject; Item: TTreeListItem);
TCustomDrawEventTyp=(cdetPrePaint,cdetPostPaint);
TCustomBackgroundDrawEvent=procedure (sender:TObject;eventTyp_cdet:TCustomDrawEventTyp;var defaultDraw:Boolean) of object;
TCustomItemDrawEvent=procedure (sender:TObject;eventTyp_cdet:TCustomDrawEventTyp;item:TTreeListItem;var defaultDraw:Boolean) of object;
TCustomRecordItemDrawEvent=procedure (sender:TObject;eventTyp_cdet:TCustomDrawEventTyp;recordItem:TTreeListRecordItem;var defaultDraw:Boolean) of object;
TCustomRecordItemPositioningEvent = procedure (sender:TObject; visualColumnIndex: integer; recordItem:TTreeListRecordItem; var aposition: TRect) of object;
TItemEvent=procedure (sender:TObject;item:TTreeListItem) of object;
TRecordItemEvent=procedure (sender:TObject;recorditem:TTreeListRecordItem) of object;
TCompareTreeListItemsEvent=procedure (sender: TObject; item1, item2: TTreeListItem; var result: longint)of object;
TUserSortItemsEvent=procedure (sender: TObject; var sortColumn: longint; var invertSorting: boolean) of object;
{ TTreeListView }
{$ifndef fpc}
TEventHeaderControl=THeaderControl; //**<@exclude
{$else}
TEventHeaderControl=TCustomHeaderControl; //**<@exclude
{$endif}
{** @abstract This is the main TreeListView-class and the only class you need to @noAutoLink create yourself. @br
Simple Example (use in FormCreate), which creates two @noAutoLink(items) one called 'Item' and one called
'Child' where latter shows the value 'Property' in the second column (the tree with the
names will be in the first column):
@longCode(#
//Standard component creation
List:=TTreeListView.create(self);
List.Parent:=self;
List.Align:=alClient;
//Create Columns
List.Columns.Clear;
List.Columns.Add.Text:='A';
List.Columns.Add.Text:='B';
//Create Items
List.BeginUpdate;
List.Items.Add('Item').SubItems.Add('Child').RecordItemsText[1]:='Property';
List.EndUpdate;
#)
@br@br
Generally, the treelistview shows its @noAutoLink(items) in a 2d record layout, with
the vertical @noAutoLink(items) of a treeview and the horizontal @noAutoLink(items) of a listview. @br
Former are just called "@noAutoLink(items)", latter are called "record @noAutoLink(items)"; and each
record item is associated to a normal item.
@br@br
Creating normal @noAutoLink(items)
@br@br
The simplest way to @noAutoLink(create) a new item is by calling the method @code(treelistview.Items.Add('text')).@br
This will add a new item with text "text" to the first level of the tree.@br
If you want to @noAutoLink(create) an item on a deeper level of the tree i.e. as sub item to a given parent item, you can call
either @code(treelistview.Items.Add(parent, 'text')) or @code(parent.subitems.add('text');)@br
If you're going to add several @noAutoLink(items), you should call @code(treelistview.BeginUpdate) and @code(treelistview.EndUpdate).
@br@br
Creating record @noAutoLink(items)
@br@br
To add a record item to a given @code(item) e.g. to set its text in column @code(i), you can just call @code(item.RecordItemsText[i]:='text';)
}
TTreeListView = class(TCustomControl)
private
F_HeaderVisible: boolean;
F_ScrollStyle: TScrollStyle;
function GetTopItemVisualIndex: integer;
procedure SetBgColor(const AValue: TColor);
procedure SetButtonColor(const AValue: TColor);
procedure SetColorSearchMark(const AValue: tcolor);
procedure SetColorSearchMarkField(const AValue: tcolor);
procedure SetExpandMode(const AValue: TExpandMode);
procedure SetHeaderVisible(AValue: boolean);
procedure SetHorizontalLineColor(const AValue: TColor);
procedure SetHorizontalLines(const AValue: TLineMode);
procedure SetRootLineColor(const AValue: TColor);
procedure SetRootLines(const AValue: TLineMode);
procedure SetScrollStyle(AValue: TScrollStyle);
procedure SetSelectBackColor(const AValue: TColor);
procedure SetStripedEvenColor(const AValue: TColor);
procedure SetStripedOddColor(const AValue: TColor);
procedure SetVerticalLineColor(const AValue: TColor);
procedure SetVerticalLines(const AValue: TLineMode);
protected
{ Protected-Deklarationen}
InternOptions_tlio:TTreeListInternOptions;
doubleBuffer:graphics.TBitmap;
F_LastPaintedWidth, F_LastPaintedHeight: integer;
f_RedrawBlock: longint;
f_invalidatedItems: TList;
f_invalidateAll: boolean;
f_bufferComplete: boolean;//This is true if the buffer contains the recent state of all items (= the last drawing was called with f_invalidateAll)
TreeColumnIndentation:integer;
F_TopItem: TTreeListItem;
F_TopItemEven: boolean;
F_SortColumn: longint;
F_SortColumnInverted: boolean;
F_OnCompareItems: TCompareTreeListItemsEvent;
F_OnUserSortItems: TUserSortItemsEvent;
F_Items:TTreeListItems;
F_Header:THeaderControl;
F_HeaderColumnPopupMenu: TPopupMenu;
F_VScroll:TScrollBar; //vertikale, rechte scrollbar, in listeinträgen
F_HScroll:TScrollBar; //horizontale, untere scrollbar, in pixeln
F_RowHeight:integer;
F_ImageList:TImageList;
F_ExpandMode:TExpandMode;
//Selection
F_SelCount: longint;
F_Focused: TTreeListItem;
F_BaseSelect: TTreeListItem; //last item selected without shift
//appearance
F_Options: TTreeListViewOptions;
F_TreeSectionPos: TRect;
F_HotTrackFont:TFont;
F_SelectedFont:TFont;
F_SelectedHotTrackFont:TFont;
F_SelectBackColor:TColor;
F_ButtonColor:TColor;
F_BgColor:TColor;
F_Striped:boolean;
F_StripedOddColor:TColor;
F_StripedEvenColor:TColor;
F_StripInvisibleItems: boolean;
F_HorizontalLines:TLineMode;
F_HorizontalLineColor:TColor;
F_VerticalLines:TLineMode;
F_VerticalLineColor:TColor;
F_RootLines:TLineMode;
F_RootLineColor:TColor;
//Events
//Headerevents
{$ifdef FPC}
F_HeaderSectionResize:TCustomSectionNotifyEvent;
F_HeaderSectionTrack:TCustomSectionTrackEvent;
{$else}
F_HeaderSectionResize:TSectionNotifyEvent;
F_HeaderSectionTrack:TSectionTrackEvent;
{$endif}
//Scrollbarevents
F_VScrollBarChange:TNotifyEvent;
F_HScrollBarChange:TNotifyEvent;
F_MouseWheelDelta: longint;
//CustomDrawEvents
F_CustomBgDraw:TCustomBackgroundDrawEvent;
F_CustomItemDraw:TCustomItemDrawEvent;
F_CustomRecordItemDraw:TCustomRecordItemDrawEvent;
F_CustomRecordItemPositioningEvent: TCustomRecordItemPositioningEvent;
//details
F_DrawingEvenItem: boolean;
F_DrawingYPos: longint;
F_DrawingRecordItemRect: TRect;
F_SheduledRepaint: DWord;
F_SheduledHScroll: DWord;
//Inputevents
F_RealClickPos, F_RealMousePos: TPoint;
F_ScrollClickPos: integer; //v_scroll.position, when the mouse button was pressed
F_LastMouseMove: cardinal;
F_ClickedItem: TTreeListItem;
F_MouseSelecting: (msNone,msLeft,msRight);
F_MouseSelectingFocusRectDraw: boolean;
F_MouseSelectingFocusRect: TRect;
F_ClickAtItem:TItemEvent;
F_ItemCollapsed:TItemEvent;
F_ItemExpanded:TItemEvent;
F_ClickAtRecordItem:TRecordItemEvent;
F_OnSelect:TItemEvent;
F_OnItemExpanded: TItemEvent;
F_OnItemCollapsed: TItemEvent;
F_OnItemsSorted: TNotifyEvent;
//Search
f_searchMarkItem: TTreeListItem;
f_searchMarkCol,f_searchMarkStart,f_searchMarkLen: longint;
f_searchMarkVisible,f_searchActivated:boolean;
f_colorSearchMark: tcolor;
f_colorSearchMarkField: tcolor;
F_SearchBar: TSearchBar;
F_NewSearchBarFindState: TFindState;
F_HighlightAll: boolean;
procedure SearchBarSearch(sender: TObject; incremental, backwards: boolean);
procedure SearchBarClose(Sender: TObject);
procedure SearchBarShow(Sender: TObject);
procedure SearchBarKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
procedure F_SearchBarHighlightChanged(Sender: TObject);
//Ereignissausösungen
function DoCustomBackgroundDrawEvent (eventTyp_cdet:TCustomDrawEventTyp):boolean;
function DoCustomItemDrawEvent(const eventTyp_cdet:TCustomDrawEventTyp;const item:TTreeListItem):boolean;
function DoCustomRecordItemDrawEvent(const eventTyp_cdet:TCustomDrawEventTyp;const RecordItem:TTreeListRecordItem;const outrec: TRect):boolean;
procedure removeSelection(list: TTreeListItems);
procedure removeMouseSelection(list: TTreeListItems);
procedure setMouseSelection(list: TTreeListItems);
procedure DoSelect(item: TTreeListItem);virtual;
procedure selectRange(a,b: TTreeListItem;mouseSelect:boolean=false);
//Kommunikationsroutinen (Set- und Getfunktionen)
procedure SetOptions(const AValue: TTreeListViewOptions);
procedure SetOption(const Option: TTreeListViewOption; const active:boolean);
procedure SetItems(const value:TTreeListItems);
procedure SetFocused(const AValue: TTreeListItem);
procedure SetSelected(const AValue: TTreeListItem);
procedure setTopItem(item: TTreeListItem);
function GetTopItem:TTreeListItem;
function GetTopItemEven: boolean;
function GetTopPos:integer;
procedure SetSortColumn(const AValue: longint);
procedure SetColumns(const value:THeaderSections);
function GetColumns: THeaderSections;
procedure setImageList(const images:TImageList);
procedure SetRowHeight(newHeight:integer);
procedure SetHotTrackFont(const value:TFont); //< Set the font used to draw a hottracked item
procedure SetSelectedFont(const value:TFont); //< Set the font used to draw a selected item
procedure SetSelectedHotTrackFont(const value:TFont);//< Set the font used to draw a selected and hottracked item
//Sonstiges
function RealControlHeight(c: Twincontrol): longint;
function RealBaseClientWidth: longint;
function RealBaseClientHeight: longint;
function RealClientHeight: longint;
procedure DrawAlignDotLine(x,y:integer;const x2,y2:integer;const color:TColor);
procedure drawTextRect(s:string;extraIndentation:longint;align:TAlignment; const rec: TRect; searchDraw: boolean);
function CompareItems(i1, i2: TTreeListItem): longint;
procedure BeginMultipleUpdate;
procedure EndMultipleUpdate;
//Interne Kommunikation mit Unterkomponenten
procedure updateAll();
procedure _SubItemListEvent(list: TObjectList; typ: TListEventTyp);
procedure _RecordItemListEvent(list: TObjectList; typ: TListEventTyp);
procedure _HeaderSectionTrack( HeaderControl: TEventHeaderControl; Section: THeaderSection; Width: Integer; State: TSectionTrackState);
procedure _HeaderSectionResize( HeaderControl: TEventHeaderControl; Section: THeaderSection);
procedure _HeaderSectionClick( HeaderControl: TEventHeaderControl; Section: THeaderSection);
procedure _HeaderSectionDblClick( HeaderControl: TEventHeaderControl; Section: THeaderSection);
procedure _HeaderSectionEndDrag(Sender: TObject);
{$ifdef allowHeaderVisible}procedure ColumnPopupMenuClick(Sender: TObject);{$endif}
procedure _HScrollChange(Sender: TObject);
procedure _VScrollChange(Sender: TObject);
procedure UpdateScrollBarPos; virtual;
protected
{$ifdef android}
F_PostMessage: TLMessage;
F_PostMessageTimer: TTimer;
procedure PostMessageTimerTimer(Sender: TObject);
{$endif}
procedure internPostMessage(Msg: Cardinal; WParam: WParam); //**< Wrapper around PostMessage. PM does not seem to work on Android
public
{ Public-Deklarationen}
hotTrackedRecordItem:TTreeListRecordItem; //**<Item currently touched by the mouse
property selCount: longint read F_SelCount; //**<Count of selected items
{$warnings off}
property focused:TTreeListItem read F_Focused write SetFocused; //**<Currently focused item, it is not necessarily selected. @br Setting this property will not select the new item
{$warnings on}
property Selected:TTreeListItem read F_Focused write SetSelected; //**<This is the same as Focused, but setting this property will select the item and deselect every other one
property SortColumn: longint read F_SortColumn write SetSortColumn; //**<Column currently used for sorting
procedure UpdateScrollSizeH; //**<@deprecated Recalculates the necessary scrollbar properties @br Normally you don't need to call this
procedure UpdateScrollSizeV; //**<@deprecated Recalculates the necessary scrollbar properties @br Normally you don't need to call this
procedure UpdateScrollSize; //**<@deprecated Recalculates the necessary scrollbar properties @br Normally you don't need to call this
//**Create
constructor Create(aowner:TComponent);override;
procedure loaded;override;
function GetItemAtPos(const y:integer):TTreeListItem;//**<Returns the item at position y
function GetRecordItemAtPos(const x,y:integer):TTreeListRecordItem;//**<Returns the record item at position x,y @br Notice that it doesn't check for visibility, e.g you can use negative coordinates or find items hidden by the scrollbars
//Items
procedure BeginUpdate; //**< Notifies the control that the @noAutoLink items are changed, so it will not redrawn itself. @br Never forget to use this, otherwise it will be very slow.
procedure EndUpdate; //**< Stops the redraw block and redraws everything
function VisibleRowCount:longint; //**< Count of visible lines
procedure sort; //**< Sorts the items according to the current sorting options
procedure ensureVisibility(item: TTreeListItem;column: longint=-1); //**< Makes item visible, this includes scrolling and expanding of items @br If column is not -1 it scroll horizontally to the beginning/ending of this column if it isn't visible
//**This searches the text searchFor in searchFields and marks it.
//**@param searchFields Bit-wise combination of column numbers. Use @code(1 shl i) for column i. (you can only use the first 32 columns)
//**@param backward Specifies search direction
//**@param extendSelection set this to true for an incremental search
function search(searchFor: string; searchFields:cardinal; backward: boolean=false;extendSelection: boolean=false): TFindState;overload;
//Header
function ColumnFromOriginalIndex(index: longint): THeaderSection; //**< If the columns can be dragged this will return them in the old order
procedure ColumnsAutoSize;
procedure CreateUserColumnVisibilityPopupMenu(); //**< Creates a popupmenu to hide/show columns @br You need to call this method after every removing/creating of columns, because the TreeListView doesn't known when the columns are changed, since you have direct access to the headercontrol sections.@br This needs FPC
function serializeColumnWidths: string; //**<save the widths of the columns in a string @seealso deserializeColumnWidths
function serializeColumnOrder: string; //**<save the order of the columns in a string (needs FPC) @seealso deserializeColumnOrder
function serializeColumnVisibility: string; //**<save the visibility of the columns in a string (needs FPC) @seealso deserializeColumnVisibility
procedure deserializeColumnWidths(s: string); //**<load the widths of the columns from a string @seealso serializeColumnWidths
procedure deserializeColumnOrder(s: string); //**<load the order of the columns from a string (needs FPC) @seealso serializeColumnOrder
procedure deserializeColumnVisibility(s: string); //**<load the visibility of the columns from a string (needs FPC) @seealso serializeColumnVisibility
procedure CreateSearchBar(); //**< Creates a FireFox like SearchBar
property SearchBar: TSearchBar read F_SearchBar; //**< This a FireFox like search bar, call createSearchBar before using (this property)
//Messages
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure WndProc(var message:{$IFDEF LCL}TLMessage{$else}TMessage{$endif});override;
//elements drawing
//**This method will soon repaint all items.
//**This means as soon as the calling functions finished (= returns to the application message loop) and all pending messages are processed, internRepaint will be called
//**@seealso(internPaint) @seealso(sheduleInternRepaint) @seealso(invalidateAll) @seealso(invalidateItem)
procedure sheduleInternRepaint();
//**This method forces a redraw of all items (=invalidateAll and internPaint)
//**@seealso(internPaint) @seealso(sheduleInternRepaint) @seealso(invalidateAll) @seealso(invalidateItem)
procedure internRepaint();
//**This invalidates the passed item, so that it will be redrawn if the next painting occurs
//**@seealso(internPaint) @seealso(sheduleInternRepaint) @seealso(internRepaint) @seealso(invalidateAll)
procedure invalidateItem(item: TTreeListItem=nil);
//**This invalidates all items, so the whole control will be redrawn if next painting occurs
//**@seealso(internPaint) @seealso(sheduleInternRepaint) @seealso(internRepaint) @seealso(invalidateItem)
procedure invalidateAll();
//**This method draws all changed (=invalidated) items in the double buffer. There should never be a reason to call this
//**@seealso(internPaint) @seealso(sheduleInternRepaint) @seealso(internRepaint) @seealso(invalidateAll) @seealso(invalidateItem)
procedure internDraw();
//**This method will paint all changed items on the screen. This means it will call internDraw to draw all changed item in the double buffer and then copy the changed areas of the double buffer on the screen
//**@seealso(sheduleInternRepaint) @seealso(internRepaint) @seealso(invalidateAll) @seealso(invalidateItem)
procedure internPaint(calledFromPaintingEvent: boolean=false);//shows the changes
//**This is the normal Delphi/Lazarus painting routine called when a paint message is received. You should call it seldom.
//**@seealso(sheduleInternRepaint) @seealso(internRepaint) @seealso(invalidateAll) @seealso(invalidateItem)
procedure Paint;override;
//Destroy
destructor Destroy;override;
property TopPos:integer read GetTopPos; //**< V-Scrollposition calculated in pixels (=position of Items[0])
property TopItem: TTreeListItem read GetTopItem write SetTopItem; //**< Visible item with the least real index (can be nil)
property TopItemIsEvenItem: boolean read GetTopItemEven; //**< Is the top item even (used for striping)
property TopItemVisualIndex: integer read GetTopItemVisualIndex; //**< Index of the top item, if all visible items were in a single list
property DrawingEvenItem: boolean read F_DrawingEvenItem; //**< Is the currently drawn item even (only valid during custom draw events, having this as property prevents parameter cluttering)
property DrawingYPos: longint read F_DrawingYPos; //**< Y-Position of the currently drawn item (only valid during custom draw events, having this as property prevents parameter cluttering)
property DrawingRecordItemRect: TRect read F_DrawingRecordItemRect; //**< boundaries of the currently drawn record item (only valid during custom draw events, having this as property prevents parameter cluttering)
published
{ Published-Deklarationen }
{-------------------------------START Ereignisse---------------------------}
//**General appearance/behaviour options @seealso TTreeListViewOption
property Options: TTreeListViewOptions read F_Options write SetOptions;
//Header-Eigenschaften
property Columns:THeaderSections read GetColumns write SetColumns; //**< All columns
property RowHeight:integer read F_RowHeight write SetRowHeight; //**< Height of a row
property Images:TImageList read F_ImageList write setImageList; //**< ImageList used to get the images for items using the TTreeListView.ImageIndex property
property HorizontalLineMode:TLineMode read F_HorizontalLines write SetHorizontalLines; //**< Determines how/if lines are drawn between the items
property HorizontalLineColor:TColor read F_HorizontalLineColor write SetHorizontalLineColor;
property VerticalLineMode:TLineMode read F_VerticalLines write SetVerticalLines; //**< Determines how/if lines are drawn between the columns
property VerticalLineColor:TColor read F_VerticalLineColor write SetVerticalLineColor;
property RootLineMode:TLineMode read F_RootLines write SetRootLines; //**< Determines how/if lines are drawn to connect the tree items
property RootLineColor:TColor read F_RootLineColor write SetRootLineColor;
property ColorSearchMark: tcolor read F_ColorSearchMark write SetColorSearchMark;
property ColorSearchMarkField: tcolor read F_ColorSearchMarkField write SetColorSearchMarkField;
property ExpandMode:TExpandMode read F_ExpandMode write SetExpandMode; //**< Determines how/if the user is allowed to collapse/expand items
property HotTrackFont:TFont read F_HotTrackFont write SetHotTrackFont;
property Font;
property SelectedFont:TFont read F_SelectedFont write SetSelectedFont;
property SelectedHotTrackFont:TFont read F_SelectedHotTrackFont write SetSelectedHotTrackFont;
property StripedOddColor:TColor read F_StripedOddColor write SetStripedOddColor;
property StripedEvenColor:TColor read F_StripedEvenColor write SetStripedEvenColor;
property SelectBackColor:TColor read F_SelectBackColor write SetSelectBackColor;
property ButtonColor:TColor read F_ButtonColor write SetButtonColor; //**< Color of the expand/collaps button
property BackGroundColor:TColor read F_BgColor write SetBgColor;
property Items:TTreeListItems read F_Items write SetItems; //**< All the items, use items.add to @noAutoLink create new ones
property Scrollbars: TScrollStyle read F_ScrollStyle write SetScrollStyle;
property HeaderVisible: boolean read F_HeaderVisible write SetHeaderVisible;
//Sortierungsereignisse
property OnCompareItems: TCompareTreeListItemsEvent read F_OnCompareItems write F_OnCompareItems; //**< Event which is called when two items are compared during sorting @br The default sorting is case-insensitive lexicographical on text and numerical on number string parts, every level is @noAutoLink sorted on its own, parents are not changed
property OnUserSortItemsEvent: TUserSortItemsEvent read F_OnUserSortItems write F_OnUserSortItems; //**< Called when the user clicks on the header to resort the items
property OnItemsSortedEvent: TNotifyEvent read F_OnItemsSorted write F_OnItemsSorted; //**< Called after the items have been @noAutoLink sorted
//Scrollbarereignisse
property OnVScrollBarChange:TNotifyEvent read F_VScrollBarChange write F_VScrollBarChange;
property OnHScrollBarChange:TNotifyEvent read F_HScrollBarChange write F_HScrollBarChange;
//CustomDrawEvents
property OnCustomBgDraw:TCustomBackgroundDrawEvent read F_CustomBgDraw write F_CustomBgDraw; //**< This is called before/after the items are drawn
property OnCustomItemDraw:TCustomItemDrawEvent read F_CustomItemDraw write F_CustomItemDraw; //**< This is called before/after an item is drawn @seealso TTreeListItem.PaintTo, TTreeListView.DrawingEvenItem, TTreeListView.DrawingYPos, TTreeListView.DrawingRecordItemRect
property OnCustomRecordItemDraw:TCustomRecordItemDrawEvent read F_CustomRecordItemDraw write F_CustomRecordItemDraw; //**< This is called before/after any record items is drawn
property OnCustomRecordItemPositioning: TCustomRecordItemPositioningEvent read F_CustomRecordItemPositioningEvent write F_CustomRecordItemPositioningEvent; //**< This is called when the position of a record item is calculated
//Inputevents
property OnClickAtRecordItem:TRecordItemEvent read F_ClickAtRecordItem write F_ClickAtRecordItem; //**< Called when the user clicks on a record item
property OnClickAtItem:TItemEvent read F_ClickAtItem write F_ClickAtItem; //**< Called when the user clicks on an item (if you need the column use OnClickAtRecordItem)
property OnSelect:TItemEvent read F_OnSelect write F_OnSelect; //**< Called when an item is selected or deselected
property OnItemCollapsed:TItemEvent read F_OnItemCollapsed write F_OnItemCollapsed; //**< Called when an item is collapsed
property OnItemExpanded:TItemEvent read F_OnItemExpanded write F_OnItemExpanded; //**< Called when an item is expanded
//Header-Ereignisse
{$ifdef FPC}
property OnHeaderSectionResize:TCustomSectionNotifyEvent read F_HeaderSectionResize write F_HeaderSectionResize;
property OnHeaderSectionTrack:TCustomSectionTrackEvent read F_HeaderSectionTrack write F_HeaderSectionTrack;
{$else}
property OnHeaderSectionResize:TSectionNotifyEvent read F_HeaderSectionResize write F_HeaderSectionResize;
property OnHeaderSectionTrack:TSectionTrackEvent read F_HeaderSectionTrack write F_HeaderSectionTrack;
{$endif}
//Freigeben (parent properties)
{$ifndef fpc}property BorderWidth; //if you want a border in Lazarus put it in a panel
property BevelWidth;
property BevelEdges;
property BevelInner default bvLowered;
property BevelOuter default bvLowered;
property BevelKind default bkTile; {$endif}
property TabStop default true;
property TabOrder;
//Freigeben von TControl
property Align;
property Anchors;
property Constraints;
property DragCursor;
property DragKind ;
property DragMode ;
property Hint ; //**< You can't use this if tooltips is true
property PopupMenu;
property ShowHint ;
//Freigeben von TWinControlereignissen
property OnDockDrop;
property OnDockOver;
property OnEnter;
property OnExit;
property OnGetSiteInfo;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnUnDock;
//Freigeben von TControl-Ereignissen
{$ifndef fpc}property OnCanResize;{$endif}
property OnClick;
property OnConstrainedResize;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnStartDock;
property OnStartDrag;
end;
procedure Register;
implementation
{$ifdef lcl}
uses LResources; //for icon
{$endif}
const HeaderItemDistance=2; //Distance between Header and first drawn item
LEFT_TEXT_PADDING=3;
LINE_DISTANCE=15;
{$IFNDEF lcl}
LM_USER=WM_USER;
{$ENDIF}
LM_USER_SHEDULED_EVENT = LM_USER+1125;
EVENT_REPAINT = 1;
EVENT_MOUSE_SCROLL = 2;
EVENT_HSCROLL = 3;
procedure ignore({%H-}o: TObject); inline;
begin
end;
{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{
################################################################################
================================================================================
////////////////////////////////////////////////////////////////////////////////
--------------------------------------------------------------------------------
................................TObjectList.....................................
--------------------------------------------------------------------------------
////////////////////////////////////////////////////////////////////////////////
================================================================================
################################################################################
}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
constructor TObjectList.Create(listEvent: TListEvent);
begin
inherited Create;
self.onListEvent:=listEvent;
end;
procedure TObjectList.BeginEdit;
begin
if assigned(onListEvent) then onListEvent(self,levBeginEdit);
end;
procedure TObjectList.EndEdit;
begin
if assigned(onListEvent) then onListEvent(self,levEndEdit);
end;
//Neu mit Objekten
function TObjectList.AddObject(Item: TObject): Integer;
begin
result:=add(item);
end;
procedure TObjectList.InsertObject(Index: Integer; Item: TObject);
begin
Insert(index,item);
end;
function TObjectList.RemoveObject(Item: TObject): Integer;
begin
result:=remove(item);
end;
//Eventauslöser
function TObjectList.Add(Item: TObject): Integer;
begin
result:=inherited add(item);
if assigned(onListEvent) then onListEvent(self,levAdd);
end;
procedure TObjectList.Clear;
begin
BeginEdit;
FreeObjects;
count:=0;
if assigned(onListEvent) then onListEvent(self,levClear);
EndEdit;
end;
procedure TObjectList.Delete(Index: Integer);
begin
inherited;
if assigned(onListEvent) then onListEvent(self,levDelete);
end;
procedure TObjectList.Exchange(Index1, Index2: Integer);
begin
inherited;
if assigned(onListEvent) then onListEvent(self,levExchange);
end;
procedure TObjectList.Insert(Index: Integer; Item: TObject);
begin
inherited insert(index,item);
if assigned(onListEvent) then onListEvent(self,levInsert);
end;
procedure TObjectList.Move(CurIndex, NewIndex: Integer);
begin
inherited;
if assigned(onListEvent) then onListEvent(self,levMove);
end;
function TObjectList.Remove(Item: TObject): Integer;
begin
result:=inherited remove(item);
item.free;
if assigned(onListEvent) then onListEvent(self,levDelete);
end;
procedure TObjectList.Sort(Compare: TListSortCompare);
begin
inherited;
if assigned(onListEvent) then onListEvent(self,levSort);
end;
procedure TObjectList.Assign(list:TList);
var i:integer;
begin
Count:=list.Count;
for i:=0 to Count-1 do
Items[i]:=list.Items[i];
if assigned(onListEvent) then onListEvent(self,levAssign);
end;
procedure TObjectList.FreeObjects;
var i:integer;
begin
for i:=0 to Count-1 do begin
TObject(Items[i]).free;
Items[i]:=nil;
end;
count:=0;
end;
destructor TObjectList.Destroy;
begin
FreeObjects;
inherited;
end;
{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{
################################################################################
================================================================================
////////////////////////////////////////////////////////////////////////////////
--------------------------------------------------------------------------------
...............................tTreeListItems...................................
--------------------------------------------------------------------------------
////////////////////////////////////////////////////////////////////////////////
================================================================================
################################################################################
}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
procedure TTreeListItems.Put(Index: Integer; const AValue: TTreeListItem);
begin
inherited put(Index, AValue);
end;
function TTreeListItems.Get(Index: Integer): TTreeListItem;
begin
result:=TTreeListItem(inherited get(index));
end;
//***find?
procedure TTreeListItems.Sort(CompareFunc: TTreeListItemCompare);
var temp: array of TTreeListItem;
procedure mergeSort(f,t:longint);
var {$ifndef fpc}i,{$endif}a,b,d,p: longint;
begin
if f>=t then exit;
d:=(f+t) div 2;
mergeSort(f,d);
mergeSort(d+1,t);
{$ifdef fpc}
system.move(List^[f],temp[f],(t-f+1)*sizeof(TTreeListItem));
{$else}
for i := f to t do
temp[i]:=TTreeListItem(List[i]);
{$endif}
p:=f;
a:=f;
b:=d+1;
while (a<=d) and (b<=t) do begin
if CompareFunc(temp[a],temp[b])<=0 then begin
List[p]:=temp[a];
inc(a);
end else begin
List[p]:=temp[b];
inc(b);
end;
inc(p);
end;
if a<=d then begin
f:=a;
t:=d;
end else if b<=t then f:=b
else exit;
{$ifdef fpc}
system.move(temp[f],List[p],(t-f+1)*sizeof(TTreeListItem));
{$else}