source: cprs/branches/tmg-cprs/TMG_Extra/tntUniCode/Source/TntComCtrls.pas

Last change on this file was 672, checked in by Kevin Toppenberg, 9 years ago

Adding source to tntControls for compilation

File size: 149.4 KB
Line 
1
2{*****************************************************************************}
3{                                                                             }
4{    Tnt Delphi Unicode Controls                                              }
5{      http://www.tntware.com/delphicontrols/unicode/                         }
6{        Version: 2.3.0                                                       }
7{                                                                             }
8{    Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com)       }
9{                                                                             }
10{*****************************************************************************}
11
12unit TntComCtrls;
13
14{$INCLUDE TntCompilers.inc}
15
16interface
17
18{ TODO: TTntCustomListView events - reintroduce ones that refer to ansi classes (ie. TListItem) }
19{ TODO: Handle RichEdit CRLF emulation at the WndProc level. }
20{ TODO: TTntCustomTreeView events - reintroduce ones that refer to ansi classes (ie. TTreeNode) }
21{ TODO: THotKey, Tanimate, TCoolBar (TCoolBand) }
22{ TODO: TToolBar: Unicode-enable TBN_GETBUTTONINFO/DoGetButton }
23{ TODO: TToolBar: Unicode-enable handling of CN_DIALOGCHAR, WM_SYSCOMMAND, FindButtonFromAccel }
24
25uses
26  Classes, Controls, ListActns, Menus, ComCtrls, Messages,
27  Windows, CommCtrl, Contnrs, TntControls, TntClasses, Graphics, TntSysUtils;
28
29type
30  TTntCustomListView = class;
31  TTntListItems = class;
32
33{TNT-WARN TListColumn}
34  TTntListColumn = class(TListColumn{TNT-ALLOW TListColumn})
35  private
36    FCaption: WideString;
37    procedure SetInheritedCaption(const Value: AnsiString);
38    function GetCaption: WideString;
39    procedure SetCaption(const Value: WideString);
40  protected
41    procedure DefineProperties(Filer: TFiler); override;
42  public
43    procedure Assign(Source: TPersistent); override;
44  published
45    property Caption: WideString read GetCaption write SetCaption;
46  end;
47
48{TNT-WARN TListColumns}
49  TTntListColumns = class(TListColumns{TNT-ALLOW TListColumns})
50  private
51    function GetItem(Index: Integer): TTntListColumn;
52    procedure SetItem(Index: Integer; Value: TTntListColumn);
53  public
54    constructor Create(AOwner: TTntCustomListView);
55    function Add: TTntListColumn;
56    function Owner: TTntCustomListView;
57    property Items[Index: Integer]: TTntListColumn read GetItem write SetItem; default;
58  end;
59
60{TNT-WARN TListItem}
61  TTntListItem = class(TListItem{TNT-ALLOW TListItem})
62  private
63    FCaption: WideString;
64    FSubItems: TTntStrings;
65    procedure SetInheritedCaption(const Value: AnsiString);
66    function GetCaption: WideString;
67    procedure SetCaption(const Value: WideString);
68    procedure SetSubItems(const Value: TTntStrings);
69    function GetListView: TTntCustomListView;
70    function GetTntOwner: TTntListItems;
71  public
72    constructor Create(AOwner: TListItems{TNT-ALLOW TListItems}); virtual;
73    destructor Destroy; override;
74    property Owner: TTntListItems read GetTntOwner;
75    property ListView: TTntCustomListView read GetListView;
76    procedure Assign(Source: TPersistent); override;
77    property Caption: WideString read GetCaption write SetCaption;
78    property SubItems: TTntStrings read FSubItems write SetSubItems;
79  end;
80
81  TTntListItemsEnumerator = class
82  private
83    FIndex: Integer;
84    FListItems: TTntListItems;
85  public
86    constructor Create(AListItems: TTntListItems);
87    function GetCurrent: TTntListItem;
88    function MoveNext: Boolean;
89    property Current: TTntListItem read GetCurrent;
90  end;
91
92{TNT-WARN TListItems}
93  TTntListItems = class(TListItems{TNT-ALLOW TListItems})
94  private
95    function GetItem(Index: Integer): TTntListItem;
96    procedure SetItem(Index: Integer; const Value: TTntListItem);
97  public
98    function Owner: TTntCustomListView;
99    property Item[Index: Integer]: TTntListItem read GetItem write SetItem; default;
100    function Add: TTntListItem;
101    function AddItem(Item: TTntListItem; Index: Integer = -1): TTntListItem;
102    function GetEnumerator: TTntListItemsEnumerator;
103    function Insert(Index: Integer): TTntListItem;
104  end;
105
106  TTntLVEditedEvent = procedure(Sender: TObject; Item: TTntListItem; var S: WideString) of object;
107  TTntLVOwnerDataFindEvent = procedure(Sender: TObject; Find: TItemFind;
108    const FindString: WideString; const FindPosition: TPoint; FindData: Pointer;
109    StartIndex: Integer; Direction: TSearchDirection; Wrap: Boolean;
110    var Index: Integer) of object;
111
112{TNT-WARN TCustomListView}
113  _TntInternalCustomListView = class(TCustomListView{TNT-ALLOW TCustomListView})
114  private
115    PWideFindString: PWideChar;
116    CurrentDispInfo: PLVDispInfoW;
117    OriginalDispInfoMask: Cardinal;
118    function OwnerDataFindW(Find: TItemFind; const FindString: WideString;
119      const FindPosition: TPoint; FindData: Pointer; StartIndex: Integer;
120        Direction: TSearchDirection; Wrap: Boolean): Integer; virtual; abstract;
121    function OwnerDataFetchW(Item: TListItem{TNT-ALLOW TListItem}; Request: TItemRequest): Boolean; virtual; abstract;
122  protected
123    function OwnerDataFind(Find: TItemFind; const FindString: AnsiString;
124      const FindPosition: TPoint; FindData: Pointer; StartIndex: Integer;
125        Direction: TSearchDirection; Wrap: Boolean): Integer; override;
126    function OwnerDataFetch(Item: TListItem{TNT-ALLOW TListItem}; Request: TItemRequest): Boolean; override;
127  end;
128
129  TTntCustomListView = class(_TntInternalCustomListView, IWideCustomListControl)
130  private
131    FEditHandle: THandle;
132    FEditInstance: Pointer;
133    FDefEditProc: Pointer;
134    FOnEdited: TTntLVEditedEvent;
135    FOnDataFind: TTntLVOwnerDataFindEvent;
136    procedure EditWndProcW(var Message: TMessage);
137    procedure BeginChangingWideItem;
138    procedure EndChangingWideItem;
139    function GetHint: WideString;
140    procedure SetHint(const Value: WideString);
141    function IsHintStored: Boolean;
142    function GetListColumns: TTntListColumns;
143    procedure SetListColumns(const Value: TTntListColumns);
144    function ColumnFromIndex(Index: Integer): TTntListColumn;
145    function GetColumnFromTag(Tag: Integer): TTntListColumn;
146    function OwnerDataFindW(Find: TItemFind; const FindString: WideString;
147      const FindPosition: TPoint; FindData: Pointer; StartIndex: Integer;
148        Direction: TSearchDirection; Wrap: Boolean): Integer; override;
149    function OwnerDataFetchW(Item: TListItem{TNT-ALLOW TListItem}; Request: TItemRequest): Boolean; override;
150    function GetDropTarget: TTntListItem;
151    procedure SetDropTarget(const Value: TTntListItem);
152    function GetItemFocused: TTntListItem;
153    procedure SetItemFocused(const Value: TTntListItem);
154    function GetSelected: TTntListItem;
155    procedure SetSelected(const Value: TTntListItem);
156    function GetTopItem: TTntListItem;
157  private
158    FSavedItems: TObjectList;
159    FTestingForSortProc: Boolean;
160    FChangingWideItemCount: Integer;
161    FTempItem: TTntListItem;
162    function AreItemsStored: Boolean;
163    function GetItems: TTntListItems;
164    procedure SetItems(Value: TTntListItems);
165    procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
166    function GetItemW(Value: TLVItemW): TTntListItem;
167    procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
168  protected
169    procedure CreateWindowHandle(const Params: TCreateParams); override;
170    procedure DefineProperties(Filer: TFiler); override;
171    function GetActionLinkClass: TControlActionLinkClass; override;
172    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
173    procedure CreateWnd; override;
174    procedure DestroyWnd; override;
175    procedure WndProc(var Message: TMessage); override;
176    function OwnerDataFetch(Item: TListItem{TNT-ALLOW TListItem}; Request: TItemRequest): Boolean; reintroduce; virtual;
177    function CreateListItem: TListItem{TNT-ALLOW TListItem}; override;
178    function CreateListItems: TListItems{TNT-ALLOW TListItems}; override;
179    property Items: TTntListItems read GetItems write SetItems stored AreItemsStored;
180    procedure Edit(const Item: TLVItem); override;
181    function OwnerDataFind(Find: TItemFind; const FindString: WideString;
182      const FindPosition: TPoint; FindData: Pointer; StartIndex: Integer;
183      Direction: TSearchDirection; Wrap: Boolean): Integer; reintroduce; virtual;
184    property Columns: TTntListColumns read GetListColumns write SetListColumns;
185    procedure DrawItem(Item: TListItem{TNT-ALLOW TListItem}; Rect: TRect; State: TOwnerDrawState); override;
186    property OnEdited: TTntLVEditedEvent read FOnEdited write FOnEdited;
187    property OnDataFind: TTntLVOwnerDataFindEvent read FOnDataFind write FOnDataFind;
188  public
189    constructor Create(AOwner: TComponent); override;
190    destructor Destroy; override;
191    property Column[Index: Integer]: TTntListColumn read ColumnFromIndex;
192    procedure CopySelection(Destination: TCustomListControl); override;
193    procedure AddItem(const Item: WideString; AObject: TObject); reintroduce; virtual;
194    function FindCaption(StartIndex: Integer; Value: WideString; Partial,
195      Inclusive, Wrap: Boolean): TTntListItem;
196    function GetSearchString: WideString;
197    function StringWidth(S: WideString): Integer;
198  public
199    property DropTarget: TTntListItem read GetDropTarget write SetDropTarget;
200    property ItemFocused: TTntListItem read GetItemFocused write SetItemFocused;
201    property Selected: TTntListItem read GetSelected write SetSelected;
202    property TopItem: TTntListItem read GetTopItem;
203  published
204    property Hint: WideString read GetHint write SetHint stored IsHintStored;
205  end;
206
207{TNT-WARN TListView}
208  TTntListView = class(TTntCustomListView)
209  published
210    property Action;
211    property Align;
212    property AllocBy;
213    property Anchors;
214    property BevelEdges;
215    property BevelInner;
216    property BevelOuter;
217    property BevelKind default bkNone;
218    property BevelWidth;
219    property BiDiMode;
220    property BorderStyle;
221    property BorderWidth;
222    property Checkboxes;
223    property Color;
224    property Columns;
225    property ColumnClick;
226    property Constraints;
227    property Ctl3D;
228    property DragCursor;
229    property DragKind;
230    property DragMode;
231    property Enabled;
232    property Font;
233    property FlatScrollBars;
234    property FullDrag;
235    property GridLines;
236    property HideSelection;
237    property HotTrack;
238    property HotTrackStyles;
239    property HoverTime;
240    property IconOptions;
241    property Items;
242    property LargeImages;
243    property MultiSelect;
244    property OwnerData;
245    property OwnerDraw;
246    property ReadOnly default False;
247    property RowSelect;
248    property ParentBiDiMode;
249    property ParentColor default False;
250    property ParentFont;
251    property ParentShowHint;
252    property PopupMenu;
253    property ShowColumnHeaders;
254    property ShowWorkAreas;
255    property ShowHint;
256    property SmallImages;
257    property SortType;
258    property StateImages;
259    property TabOrder;
260    property TabStop default True;
261    property ViewStyle;
262    property Visible;
263    property OnAdvancedCustomDraw;
264    property OnAdvancedCustomDrawItem;
265    property OnAdvancedCustomDrawSubItem;
266    property OnChange;
267    property OnChanging;
268    property OnClick;
269    property OnColumnClick;
270    property OnColumnDragged;
271    property OnColumnRightClick;
272    property OnCompare;
273    property OnContextPopup;
274    property OnCustomDraw;
275    property OnCustomDrawItem;
276    property OnCustomDrawSubItem;
277    property OnData;
278    property OnDataFind;
279    property OnDataHint;
280    property OnDataStateChange;
281    property OnDblClick;
282    property OnDeletion;
283    property OnDrawItem;
284    property OnEdited;
285    property OnEditing;
286    property OnEndDock;
287    property OnEndDrag;
288    property OnEnter;
289    property OnExit;
290    property OnGetImageIndex;
291    property OnGetSubItemImage;
292    property OnDragDrop;
293    property OnDragOver;
294    property OnInfoTip;
295    property OnInsert;
296    property OnKeyDown;
297    property OnKeyPress;
298    property OnKeyUp;
299    {$IFDEF COMPILER_9_UP}
300    property OnMouseActivate;
301    {$ENDIF}
302    property OnMouseDown;
303    {$IFDEF COMPILER_10_UP}
304    property OnMouseEnter;
305    property OnMouseLeave;
306    {$ENDIF}
307    property OnMouseMove;
308    property OnMouseUp;
309    property OnResize;
310    property OnSelectItem;
311    property OnStartDock;
312    property OnStartDrag;
313  end;
314
315type
316{TNT-WARN TToolButton}
317  TTntToolButton = class(TToolButton{TNT-ALLOW TToolButton})
318  private
319    procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
320    function GetCaption: TWideCaption;
321    procedure SetCaption(const Value: TWideCaption);
322    function IsCaptionStored: Boolean;
323    function GetHint: WideString;
324    procedure SetHint(const Value: WideString);
325    function IsHintStored: Boolean;
326    procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
327    function GetMenuItem: TMenuItem{TNT-ALLOW TMenuItem};
328    procedure SetMenuItem(const Value: TMenuItem{TNT-ALLOW TMenuItem});
329  protected
330    procedure DefineProperties(Filer: TFiler); override;
331    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
332    function GetActionLinkClass: TControlActionLinkClass; override;
333  published
334    property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
335    property Hint: WideString read GetHint write SetHint stored IsHintStored;
336    property MenuItem: TMenuItem{TNT-ALLOW TMenuItem} read GetMenuItem write SetMenuItem;
337  end;
338
339type
340{TNT-WARN TToolBar}
341  TTntToolBar = class(TToolBar{TNT-ALLOW TToolBar})
342  private
343    FCaption: WideString;
344    procedure TBInsertButtonA(var Message: TMessage); message TB_INSERTBUTTONA;
345    procedure WMGetText(var Message: TWMGetText); message WM_GETTEXT;
346    procedure WMGetTextLength(var Message: TWMGetTextLength); message WM_GETTEXTLENGTH;
347    procedure WMSetText(var Message: TWMSetText); message WM_SETTEXT;
348    function GetMenu: TMainMenu{TNT-ALLOW TMainMenu};
349    procedure SetMenu(const Value: TMainMenu{TNT-ALLOW TMainMenu});
350  private
351    function GetCaption: WideString;
352    function GetHint: WideString;
353    function IsCaptionStored: Boolean;
354    function IsHintStored: Boolean;
355    procedure SetCaption(const Value: WideString);
356    procedure SetHint(const Value: WideString);
357  protected
358    procedure CreateWindowHandle(const Params: TCreateParams); override;
359    procedure DefineProperties(Filer: TFiler); override;
360    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
361    function GetActionLinkClass: TControlActionLinkClass; override;
362  published
363    property Caption: WideString read GetCaption write SetCaption stored IsCaptionStored;
364    property Hint: WideString read GetHint write SetHint stored IsHintStored;
365    property Menu: TMainMenu{TNT-ALLOW TMainMenu} read GetMenu write SetMenu;
366  end;
367
368type
369{TNT-WARN TCustomRichEdit}
370  TTntCustomRichEdit = class(TCustomRichEdit{TNT-ALLOW TCustomRichEdit})
371  private
372    FRichEditStrings: TTntStrings;
373    FPrintingTextLength: Integer;
374    procedure WMGetTextLength(var Message: TWMGetTextLength); message WM_GETTEXTLENGTH;
375    procedure SetRichEditStrings(const Value: TTntStrings);
376    function GetWideSelText: WideString;
377    function GetText: WideString;
378    procedure SetWideSelText(const Value: WideString);
379    procedure SetText(const Value: WideString);
380    function GetHint: WideString;
381    function IsHintStored: Boolean;
382    procedure SetHint(const Value: WideString);
383    procedure SetRTFText(Flags: DWORD; const Value: AnsiString);
384  protected
385    procedure CreateParams(var Params: TCreateParams); override;
386    procedure CreateWindowHandle(const Params: TCreateParams); override;
387    procedure CreateWnd; override;
388    procedure DefineProperties(Filer: TFiler); override;
389    function GetActionLinkClass: TControlActionLinkClass; override;
390    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
391    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
392    function GetSelText: string{TNT-ALLOW string}; override;
393    function CharPosToGet(RawWin32CharPos: Integer): Integer; deprecated; // use EmulatedCharPos()
394    function CharPosToSet(EmulatedCharPos: Integer): Integer; deprecated; // use RawWin32CharPos()
395    function GetSelStart: Integer; reintroduce; virtual;
396    procedure SetSelStart(const Value: Integer); reintroduce; virtual;
397    function GetSelLength: Integer; reintroduce; virtual;
398    procedure SetSelLength(const Value: Integer); reintroduce; virtual;
399    function LineBreakStyle: TTntTextLineBreakStyle;
400    property Lines: TTntStrings read FRichEditStrings write SetRichEditStrings;
401  public
402    constructor Create(AOwner: TComponent); override;
403    destructor Destroy; override;
404    //
405    function EmulatedCharPos(RawWin32CharPos: Integer): Integer;
406    function RawWin32CharPos(EmulatedCharPos: Integer): Integer;
407    //
408    procedure Print(const Caption: string{TNT-ALLOW string}); override;
409    property SelText: WideString read GetWideSelText write SetWideSelText;
410    property SelStart: Integer read GetSelStart write SetSelStart;
411    property SelLength: Integer read GetSelLength write SetSelLength;
412    property Text: WideString read GetText write SetText;
413    function FindText(const SearchStr: WideString; StartPos,
414      Length: Integer; Options: TSearchTypes): Integer;
415  published
416    property Hint: WideString read GetHint write SetHint stored IsHintStored;
417  end;
418
419{TNT-WARN TRichEdit}
420  TTntRichEdit = class(TTntCustomRichEdit)
421  published
422    property Align;
423    property Alignment;
424    property Anchors;
425    property BevelEdges;
426    property BevelInner;
427    property BevelOuter;
428    property BevelKind default bkNone;
429    property BevelWidth;
430    property BiDiMode;
431    property BorderStyle;
432    property BorderWidth;
433    property Color;
434    property Ctl3D;
435    property DragCursor;
436    property DragKind;
437    property DragMode;
438    property Enabled;
439    property Font;
440    property HideSelection;
441    property HideScrollBars;
442    property ImeMode;
443    property ImeName;
444    property Constraints;
445    property Lines;
446    property MaxLength;
447    property ParentBiDiMode;
448    property ParentColor;
449    property ParentCtl3D;
450    property ParentFont;
451    property ParentShowHint;
452    property PlainText;
453    property PopupMenu;
454    property ReadOnly;
455    property ScrollBars;
456    property ShowHint;
457    property TabOrder;
458    property TabStop default True;
459    property Visible;
460    property WantTabs;
461    property WantReturns;
462    property WordWrap;
463    property OnChange;
464    property OnClick;
465    property OnContextPopup;
466    property OnDblClick;
467    property OnDragDrop;
468    property OnDragOver;
469    property OnEndDock;
470    property OnEndDrag;
471    property OnEnter;
472    property OnExit;
473    property OnKeyDown;
474    property OnKeyPress;
475    property OnKeyUp;
476    {$IFDEF COMPILER_9_UP}
477    property OnMouseActivate;
478    {$ENDIF}
479    property OnMouseDown;
480    {$IFDEF COMPILER_10_UP}
481    property OnMouseEnter;
482    property OnMouseLeave;
483    {$ENDIF}
484    property OnMouseMove;
485    property OnMouseUp;
486    property OnMouseWheel;
487    property OnMouseWheelDown;
488    property OnMouseWheelUp;
489    property OnProtectChange;
490    property OnResizeRequest;
491    property OnSaveClipboard;
492    property OnSelectionChange;
493    property OnStartDock;
494    property OnStartDrag;
495  end;
496
497type
498{TNT-WARN TCustomTabControl}
499  TTntCustomTabControl = class(TCustomTabControl{TNT-ALLOW TCustomTabControl})
500  private
501    FTabs: TTntStrings;
502    FSaveTabIndex: Integer;
503    FSaveTabs: TTntStrings;
504    function GetTabs: TTntStrings;
505    procedure SetTabs(const Value: TTntStrings);
506    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
507    function GetHint: WideString;
508    function IsHintStored: Boolean;
509    procedure SetHint(const Value: WideString);
510  protected
511    procedure CreateWindowHandle(const Params: TCreateParams); override;
512    procedure DefineProperties(Filer: TFiler); override;
513    function GetActionLinkClass: TControlActionLinkClass; override;
514    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
515    procedure CreateWnd; override;
516    procedure DestroyWnd; override;
517    property Tabs: TTntStrings read GetTabs write SetTabs;
518  public
519    constructor Create(AOwner: TComponent); override;
520    destructor Destroy; override;
521  published
522    property Hint: WideString read GetHint write SetHint stored IsHintStored;
523  end;
524
525{TNT-WARN TTabControl}
526  TTntTabControl = class(TTntCustomTabControl)
527  public
528    property DisplayRect;
529  published
530    property Align;
531    property Anchors;
532    property BiDiMode;
533    property Constraints;
534    property DockSite;
535    property DragCursor;
536    property DragKind;
537    property DragMode;
538    property Enabled;
539    property Font;
540    property HotTrack;
541    property Images;
542    property MultiLine;
543    property MultiSelect;
544    property OwnerDraw;
545    property ParentBiDiMode;
546    property ParentFont;
547    property ParentShowHint;
548    property PopupMenu;
549    property RaggedRight;
550    property ScrollOpposite;
551    property ShowHint;
552    property Style;
553    property TabHeight;
554    property TabOrder;
555    property TabPosition;
556    property Tabs;
557    property TabIndex;  // must be after Tabs
558    property TabStop;
559    property TabWidth;
560    property Visible;
561    property OnChange;
562    property OnChanging;
563    property OnContextPopup;
564    property OnDockDrop;
565    property OnDockOver;
566    property OnDragDrop;
567    property OnDragOver;
568    property OnDrawTab;
569    property OnEndDock;
570    property OnEndDrag;
571    property OnEnter;
572    property OnExit;
573    property OnGetImageIndex;
574    property OnGetSiteInfo;
575    {$IFDEF COMPILER_9_UP}
576    property OnMouseActivate;
577    {$ENDIF}
578    property OnMouseDown;
579    {$IFDEF COMPILER_10_UP}
580    property OnMouseEnter;
581    property OnMouseLeave;
582    {$ENDIF}
583    property OnMouseMove;
584    property OnMouseUp;
585    property OnResize;
586    property OnStartDock;
587    property OnStartDrag;
588    property OnUnDock;
589  end;
590
591type
592{TNT-WARN TTabSheet}
593  TTntTabSheet = class(TTabSheet{TNT-ALLOW TTabSheet})
594  private
595    Force_Inherited_WMSETTEXT: Boolean;
596    function IsCaptionStored: Boolean;
597    function GetCaption: TWideCaption;
598    procedure SetCaption(const Value: TWideCaption);
599    procedure WMSetText(var Message: TWMSetText); message WM_SETTEXT;
600    function GetHint: WideString;
601    function IsHintStored: Boolean;
602    procedure SetHint(const Value: WideString);
603  protected
604    procedure CreateWindowHandle(const Params: TCreateParams); override;
605    procedure DefineProperties(Filer: TFiler); override;
606    function GetActionLinkClass: TControlActionLinkClass; override;
607    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
608  published
609    property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
610    property Hint: WideString read GetHint write SetHint stored IsHintStored;
611  end;
612
613{TNT-WARN TPageControl}
614  TTntPageControl = class(TPageControl{TNT-ALLOW TPageControl})
615  private
616    FNewDockSheet: TTntTabSheet;
617    function IsHintStored: Boolean;
618    function GetHint: WideString;
619    procedure SetHint(const Value: WideString);
620    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
621    procedure CMDockNotification(var Message: TCMDockNotification); message CM_DOCKNOTIFICATION;
622    procedure CMDockClient(var Message: TCMDockClient); message CM_DOCKCLIENT;
623  protected
624    procedure CreateWindowHandle(const Params: TCreateParams); override;
625    procedure DefineProperties(Filer: TFiler); override;
626    function GetActionLinkClass: TControlActionLinkClass; override;
627    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
628    procedure WndProc(var Message: TMessage); override;
629    procedure DoAddDockClient(Client: TControl; const ARect: TRect); override;
630  published
631    property Hint: WideString read GetHint write SetHint stored IsHintStored;
632  end;
633
634{TNT-WARN TTrackBar}
635  TTntTrackBar = class(TTrackBar{TNT-ALLOW TTrackBar})
636  private
637    function IsHintStored: Boolean;
638    function GetHint: WideString;
639    procedure SetHint(const Value: WideString);
640  protected
641    procedure CreateWindowHandle(const Params: TCreateParams); override;
642    procedure DefineProperties(Filer: TFiler); override;
643    function GetActionLinkClass: TControlActionLinkClass; override;
644    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
645  published
646    property Hint: WideString read GetHint write SetHint stored IsHintStored;
647  end;
648
649{TNT-WARN TProgressBar}
650  TTntProgressBar = class(TProgressBar{TNT-ALLOW TProgressBar})
651  private
652    function IsHintStored: Boolean;
653    function GetHint: WideString;
654    procedure SetHint(const Value: WideString);
655  protected
656    procedure CreateWindowHandle(const Params: TCreateParams); override;
657    procedure DefineProperties(Filer: TFiler); override;
658    function GetActionLinkClass: TControlActionLinkClass; override;
659    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
660  published
661    property Hint: WideString read GetHint write SetHint stored IsHintStored;
662  end;
663
664{TNT-WARN TCustomUpDown}
665  TTntCustomUpDown = class(TCustomUpDown{TNT-ALLOW TCustomUpDown})
666  private
667    function IsHintStored: Boolean;
668    function GetHint: WideString;
669    procedure SetHint(const Value: WideString);
670  protected
671    procedure CreateWindowHandle(const Params: TCreateParams); override;
672    procedure DefineProperties(Filer: TFiler); override;
673    function GetActionLinkClass: TControlActionLinkClass; override;
674    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
675  published
676    property Hint: WideString read GetHint write SetHint stored IsHintStored;
677  end;
678
679{TNT-WARN TUpDown}
680  TTntUpDown = class(TTntCustomUpDown)
681  published
682    property AlignButton;
683    property Anchors;
684    property Associate;
685    property ArrowKeys;
686    property Enabled;
687    property Hint;
688    property Min;
689    property Max;
690    property Increment;
691    property Constraints;
692    property Orientation;
693    property ParentShowHint;
694    property PopupMenu;
695    property Position;
696    property ShowHint;
697    property TabOrder;
698    property TabStop;
699    property Thousands;
700    property Visible;
701    property Wrap;
702    property OnChanging;
703    property OnChangingEx;
704    property OnContextPopup;
705    property OnClick;
706    property OnEnter;
707    property OnExit;
708    {$IFDEF COMPILER_9_UP}
709    property OnMouseActivate;
710    {$ENDIF}
711    property OnMouseDown;
712    {$IFDEF COMPILER_10_UP}
713    property OnMouseEnter;
714    property OnMouseLeave;
715    {$ENDIF}
716    property OnMouseMove;
717    property OnMouseUp;
718  end;
719
720{TNT-WARN TDateTimePicker}
721  TTntDateTimePicker = class(TDateTimePicker{TNT-ALLOW TDateTimePicker})
722  private
723    FHadFirstMouseClick: Boolean;
724    function IsHintStored: Boolean;
725    function GetHint: WideString;
726    procedure SetHint(const Value: WideString);
727    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
728  protected
729    procedure CreateWindowHandle(const Params: TCreateParams); override;
730    procedure CreateWnd; override;
731    procedure DefineProperties(Filer: TFiler); override;
732    function GetActionLinkClass: TControlActionLinkClass; override;
733    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
734  published
735    property Hint: WideString read GetHint write SetHint stored IsHintStored;
736  end;
737
738{TNT-WARN TMonthCalendar}
739  TTntMonthCalendar = class(TMonthCalendar{TNT-ALLOW TMonthCalendar})
740  private
741    function IsHintStored: Boolean;
742    function GetHint: WideString;
743    procedure SetHint(const Value: WideString);
744    function GetDate: TDate;
745    procedure SetDate(const Value: TDate);
746  protected
747    procedure CreateWindowHandle(const Params: TCreateParams); override;
748    procedure DefineProperties(Filer: TFiler); override;
749    function GetActionLinkClass: TControlActionLinkClass; override;
750    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
751  public
752    procedure ForceGetMonthInfo;
753  published
754    property Date: TDate read GetDate write SetDate;
755    property Hint: WideString read GetHint write SetHint stored IsHintStored;
756  end;
757
758{TNT-WARN TPageScroller}
759  TTntPageScroller = class(TPageScroller{TNT-ALLOW TPageScroller})
760  private
761    function IsHintStored: Boolean;
762    function GetHint: WideString;
763    procedure SetHint(const Value: WideString);
764  protected
765    procedure CreateWindowHandle(const Params: TCreateParams); override;
766    procedure DefineProperties(Filer: TFiler); override;
767    function GetActionLinkClass: TControlActionLinkClass; override;
768    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
769  published
770    property Hint: WideString read GetHint write SetHint stored IsHintStored;
771  end;
772
773type
774{TNT-WARN TStatusPanel}
775  TTntStatusPanel = class(TStatusPanel{TNT-ALLOW TStatusPanel})
776  private
777    FText: WideString;
778    function GetText: Widestring;
779    procedure SetText(const Value: Widestring);
780    procedure SetInheritedText(const Value: AnsiString);
781  protected
782    procedure DefineProperties(Filer: TFiler); override;
783  public
784    procedure Assign(Source: TPersistent); override;
785  published
786    property Text: Widestring read GetText write SetText;
787  end;
788
789{TNT-WARN TStatusPanels}
790  TTntStatusPanels = class(TStatusPanels{TNT-ALLOW TStatusPanels})
791  private
792    function GetItem(Index: Integer): TTntStatusPanel;
793    procedure SetItem(Index: Integer; Value: TTntStatusPanel);
794  public
795    function Add: TTntStatusPanel;
796    function AddItem(Item: TTntStatusPanel; Index: Integer): TTntStatusPanel;
797    function Insert(Index: Integer): TTntStatusPanel;
798    property Items[Index: Integer]: TTntStatusPanel read GetItem write SetItem; default;
799  end;
800
801{TNT-WARN TCustomStatusBar}
802  TTntCustomStatusBar = class(TCustomStatusBar{TNT-ALLOW TCustomStatusBar})
803  private
804    FSimpleText: WideString;
805    function GetSimpleText: WideString;
806    procedure SetSimpleText(const Value: WideString);
807    procedure SetInheritedSimpleText(const Value: AnsiString);
808    function SyncLeadingTabs(const WideVal: WideString; const AnsiVal: AnsiString): WideString;
809    function GetHint: WideString;
810    function IsHintStored: Boolean;
811    procedure SetHint(const Value: WideString);
812    procedure WMGetTextLength(var Message: TWMGetTextLength); message WM_GETTEXTLENGTH;
813    function GetPanels: TTntStatusPanels;
814    procedure SetPanels(const Value: TTntStatusPanels);
815  protected
816    procedure DefineProperties(Filer: TFiler); override;
817    function CreatePanels: TStatusPanels{TNT-ALLOW TStatusPanels}; override;
818    function GetPanelClass: TStatusPanelClass; override;
819    procedure CreateWindowHandle(const Params: TCreateParams); override;
820    procedure WndProc(var Msg: TMessage); override;
821    function GetActionLinkClass: TControlActionLinkClass; override;
822    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
823  public
824    function ExecuteAction(Action: TBasicAction): Boolean; override;
825    property Panels: TTntStatusPanels read GetPanels write SetPanels;
826    property SimpleText: WideString read GetSimpleText write SetSimpleText;
827  published
828    property Hint: WideString read GetHint write SetHint stored IsHintStored;
829  end;
830
831{TNT-WARN TStatusBar}
832  TTntStatusBar = class(TTntCustomStatusBar)
833  private
834    function GetOnDrawPanel: TDrawPanelEvent;
835    procedure SetOnDrawPanel(const Value: TDrawPanelEvent);
836  published
837    property Action;
838    property AutoHint default False;
839    property Align default alBottom;
840    property Anchors;
841    property BiDiMode;
842    property BorderWidth;
843    property Color default clBtnFace;
844    property DragCursor;
845    property DragKind;
846    property DragMode;
847    property Enabled;
848    property Font stored IsFontStored;
849    property Constraints;
850    property Panels;
851    property ParentBiDiMode;
852    property ParentColor default False;
853    property ParentFont default False;
854    property ParentShowHint;
855    property PopupMenu;
856    property ShowHint;
857    property SimplePanel {$IFDEF COMPILER_7_UP} default False {$ENDIF};
858    property SimpleText;
859    property SizeGrip default True;
860    property UseSystemFont default True;
861    property Visible;
862    property OnClick;
863    property OnContextPopup;
864    property OnCreatePanelClass;   
865    property OnDblClick;
866    property OnDragDrop;
867    property OnDragOver;
868    property OnEndDock;
869    property OnEndDrag;
870    property OnHint;
871    {$IFDEF COMPILER_9_UP}
872    property OnMouseActivate;
873    {$ENDIF}
874    property OnMouseDown;
875    {$IFDEF COMPILER_10_UP}
876    property OnMouseEnter;
877    property OnMouseLeave;
878    {$ENDIF}
879    property OnMouseMove;
880    property OnMouseUp;
881    // Required for backwards compatibility with the old event signature
882    property OnDrawPanel: TDrawPanelEvent read GetOnDrawPanel write SetOnDrawPanel;
883    property OnResize;
884    property OnStartDock;
885    property OnStartDrag;
886  end;
887
888type
889  TTntTreeNodes = class;
890  TTntCustomTreeView = class;
891
892{TNT-WARN TTreeNode}
893  TTntTreeNode = class(TTreeNode{TNT-ALLOW TTreeNode})
894  private
895    FText: WideString;
896    procedure SetText(const Value: WideString);
897    procedure SetInheritedText(const Value: AnsiString);
898    function GetText: WideString;
899    function GetItem(Index: Integer): TTntTreeNode;
900    function GetNodeOwner: TTntTreeNodes;
901    function GetParent: TTntTreeNode;
902    function GetTreeView: TTntCustomTreeView;
903    procedure SetItem(Index: Integer; const Value: TTntTreeNode);
904    function IsEqual(Node: TTntTreeNode): Boolean;
905    procedure ReadData(Stream: TStream; Info: PNodeInfo);
906    procedure WriteData(Stream: TStream; Info: PNodeInfo);
907  public
908    procedure Assign(Source: TPersistent); override;
909    function getFirstChild: TTntTreeNode; {GetFirstChild conflicts with C++ macro}
910    function GetLastChild: TTntTreeNode;
911    function GetNext: TTntTreeNode;
912    function GetNextChild(Value: TTntTreeNode): TTntTreeNode;
913    function getNextSibling: TTntTreeNode; {GetNextSibling conflicts with C++ macro}
914    function GetNextVisible: TTntTreeNode;
915    function GetPrev: TTntTreeNode;
916    function GetPrevChild(Value: TTntTreeNode): TTntTreeNode;
917    function getPrevSibling: TTntTreeNode; {GetPrevSibling conflicts with a C++ macro}
918    function GetPrevVisible: TTntTreeNode;
919    property Item[Index: Integer]: TTntTreeNode read GetItem write SetItem; default;
920    property Owner: TTntTreeNodes read GetNodeOwner;
921    property Parent: TTntTreeNode read GetParent;
922    property Text: WideString read GetText write SetText;
923    property TreeView: TTntCustomTreeView read GetTreeView;
924  end;
925
926  TTntTreeNodeClass = class of TTntTreeNode;
927
928  TTntTreeNodesEnumerator = class
929  private
930    FIndex: Integer;
931    FTreeNodes: TTntTreeNodes;
932  public
933    constructor Create(ATreeNodes: TTntTreeNodes);
934    function GetCurrent: TTntTreeNode;
935    function MoveNext: Boolean;
936    property Current: TTntTreeNode read GetCurrent;
937  end;
938
939{TNT-WARN TTreeNodes}
940  TTntTreeNodes = class(TTreeNodes{TNT-ALLOW TTreeNodes})
941  private
942    function GetNodeFromIndex(Index: Integer): TTntTreeNode;
943    function GetNodesOwner: TTntCustomTreeView;
944    procedure ClearCache;
945    procedure ReadData(Stream: TStream);
946    procedure WriteData(Stream: TStream);
947  protected
948    procedure DefineProperties(Filer: TFiler); override;
949  public
950    procedure Assign(Source: TPersistent); override;
951    function Add(Sibling: TTntTreeNode; const S: WideString): TTntTreeNode;
952    function AddChild(Parent: TTntTreeNode; const S: WideString): TTntTreeNode;
953    function AddChildFirst(Parent: TTntTreeNode; const S: WideString): TTntTreeNode;
954    function AddChildObject(Parent: TTntTreeNode; const S: WideString;
955      Ptr: Pointer): TTntTreeNode;
956    function AddChildObjectFirst(Parent: TTntTreeNode; const S: WideString;
957      Ptr: Pointer): TTntTreeNode;
958    function AddFirst(Sibling: TTntTreeNode; const S: WideString): TTntTreeNode;
959    function AddObject(Sibling: TTntTreeNode; const S: WideString;
960      Ptr: Pointer): TTntTreeNode;
961    function AddObjectFirst(Sibling: TTntTreeNode; const S: WideString;
962      Ptr: Pointer): TTntTreeNode;
963    function Insert(Sibling: TTntTreeNode; const S: WideString): TTntTreeNode;
964    function InsertObject(Sibling: TTntTreeNode; const S: WideString;
965      Ptr: Pointer): TTntTreeNode;
966    function InsertNode(Node, Sibling: TTntTreeNode; const S: WideString;
967      Ptr: Pointer): TTntTreeNode;
968    function AddNode(Node, Relative: TTntTreeNode; const S: WideString;
969      Ptr: Pointer; Method: TNodeAttachMode): TTntTreeNode;
970  public
971    function GetFirstNode: TTntTreeNode;
972    function GetEnumerator: TTntTreeNodesEnumerator;
973    function GetNode(ItemId: HTreeItem): TTntTreeNode;
974    property Item[Index: Integer]: TTntTreeNode read GetNodeFromIndex; default;
975    property Owner: TTntCustomTreeView read GetNodesOwner;
976  end;
977
978  TTntTVEditedEvent = procedure(Sender: TObject; Node: TTntTreeNode; var S: WideString) of object;
979
980{TNT-WARN TCustomTreeView}
981  _TntInternalCustomTreeView = class(TCustomTreeView{TNT-ALLOW TCustomTreeView})
982  private
983    function Wide_FindNextToSelect: TTntTreeNode; virtual; abstract;
984    function Inherited_FindNextToSelect: TTreeNode{TNT-ALLOW TTreeNode};
985  public
986    function FindNextToSelect: TTreeNode{TNT-ALLOW TTreeNode}; override;
987  end;
988
989  TTntCustomTreeView = class(_TntInternalCustomTreeView)
990  private
991    FSavedNodeText: TTntStrings;
992    FSavedSortType: TSortType;
993    FOnEdited: TTntTVEditedEvent;
994    FTestingForSortProc: Boolean;
995    FEditHandle: THandle;
996    FEditInstance: Pointer;
997    FDefEditProc: Pointer;
998    function GetTreeNodes: TTntTreeNodes;
999    procedure SetTreeNodes(const Value: TTntTreeNodes);
1000    procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
1001    procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
1002    function GetNodeFromItem(const Item: TTVItem): TTntTreeNode;
1003    procedure EditWndProcW(var Message: TMessage);
1004    function Wide_FindNextToSelect: TTntTreeNode; override;
1005    function GetDropTarget: TTntTreeNode;
1006    function GetSelected: TTntTreeNode;
1007    function GetSelection(Index: Integer): TTntTreeNode;
1008    function GetTopItem: TTntTreeNode;
1009    procedure SetDropTarget(const Value: TTntTreeNode);
1010    procedure SetSelected(const Value: TTntTreeNode);
1011    procedure SetTopItem(const Value: TTntTreeNode);
1012    function GetHint: WideString;
1013    function IsHintStored: Boolean;
1014    procedure SetHint(const Value: WideString);
1015  protected
1016    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
1017    function GetActionLinkClass: TControlActionLinkClass; override;
1018    procedure CreateWindowHandle(const Params: TCreateParams); override;
1019    procedure CreateWnd; override;
1020    procedure DestroyWnd; override;
1021    procedure DefineProperties(Filer: TFiler); override;
1022    procedure WndProc(var Message: TMessage); override;
1023    procedure Edit(const Item: TTVItem); override;
1024    function CreateNode: TTreeNode{TNT-ALLOW TTreeNode}; override;
1025    function CreateNodes: TTreeNodes{TNT-ALLOW TTreeNodes}; override;
1026    property Items: TTntTreeNodes read GetTreeNodes write SetTreeNodes;
1027    property OnEdited: TTntTVEditedEvent read FOnEdited write FOnEdited;
1028  public
1029    constructor Create(AOwner: TComponent); override;
1030    destructor Destroy; override;
1031    procedure LoadFromFile(const FileName: WideString);
1032    procedure LoadFromStream(Stream: TStream);
1033    procedure SaveToFile(const FileName: WideString);
1034    procedure SaveToStream(Stream: TStream);
1035    function GetNodeAt(X, Y: Integer): TTntTreeNode;
1036    property DropTarget: TTntTreeNode read GetDropTarget write SetDropTarget;
1037    property Selected: TTntTreeNode read GetSelected write SetSelected;
1038    property TopItem: TTntTreeNode read GetTopItem write SetTopItem;
1039    property Selections[Index: Integer]: TTntTreeNode read GetSelection;
1040    function GetSelections(AList: TList): TTntTreeNode;
1041    function FindNextToSelect: TTntTreeNode; reintroduce; virtual;
1042  published
1043    property Hint: WideString read GetHint write SetHint stored IsHintStored;
1044  end;
1045
1046{TNT-WARN TTreeView}
1047  TTntTreeView = class(TTntCustomTreeView)
1048  published
1049    property Align;
1050    property Anchors;
1051    property AutoExpand;
1052    property BevelEdges;
1053    property BevelInner;
1054    property BevelOuter;
1055    property BevelKind default bkNone;
1056    property BevelWidth;
1057    property BiDiMode;
1058    property BorderStyle;
1059    property BorderWidth;
1060    property ChangeDelay;
1061    property Color;
1062    property Ctl3D;
1063    property Constraints;
1064    property DragKind;
1065    property DragCursor;
1066    property DragMode;
1067    property Enabled;
1068    property Font;
1069    property HideSelection;
1070    property HotTrack;
1071    property Images;
1072    property Indent;
1073    property MultiSelect;
1074    property MultiSelectStyle;
1075    property ParentBiDiMode;
1076    property ParentColor default False;
1077    property ParentCtl3D;
1078    property ParentFont;
1079    property ParentShowHint;
1080    property PopupMenu;
1081    property ReadOnly;
1082    property RightClickSelect;
1083    property RowSelect;
1084    property ShowButtons;
1085    property ShowHint;
1086    property ShowLines;
1087    property ShowRoot;
1088    property SortType;
1089    property StateImages;
1090    property TabOrder;
1091    property TabStop default True;
1092    property ToolTips;
1093    property Visible;
1094    property OnAddition;
1095    property OnAdvancedCustomDraw;
1096    property OnAdvancedCustomDrawItem;
1097    property OnChange;
1098    property OnChanging;
1099    property OnClick;
1100    property OnCollapsed;
1101    property OnCollapsing;
1102    property OnCompare;
1103    property OnContextPopup;
1104    property OnCreateNodeClass;
1105    property OnCustomDraw;
1106    property OnCustomDrawItem;
1107    property OnDblClick;
1108    property OnDeletion;
1109    property OnDragDrop;
1110    property OnDragOver;
1111    property OnEdited;
1112    property OnEditing;
1113    property OnEndDock;
1114    property OnEndDrag;
1115    property OnEnter;
1116    property OnExit;
1117    property OnExpanding;
1118    property OnExpanded;
1119    property OnGetImageIndex;
1120    property OnGetSelectedIndex;
1121    property OnKeyDown;
1122    property OnKeyPress;
1123    property OnKeyUp;
1124    {$IFDEF COMPILER_9_UP}
1125    property OnMouseActivate;
1126    {$ENDIF}
1127    property OnMouseDown;
1128    {$IFDEF COMPILER_10_UP}
1129    property OnMouseEnter;
1130    property OnMouseLeave;
1131    {$ENDIF}
1132    property OnMouseMove;
1133    property OnMouseUp;
1134    property OnStartDock;
1135    property OnStartDrag;
1136    { Items must be published after OnGetImageIndex and OnGetSelectedIndex }
1137    property Items;
1138  end;
1139
1140implementation
1141
1142uses
1143  Forms, SysUtils, TntGraphics, ImgList, TntSystem, TntStdCtrls, StdCtrls,
1144  RichEdit, ActiveIMM_TLB, TntForms, ComStrs, TntMenus,
1145  TntActnList, TntStdActns, TntWindows,
1146  {$IFNDEF COMPILER_10_UP}
1147  TntWideStrings,
1148  {$ELSE}
1149  WideStrings,
1150  {$ENDIF}
1151  {$IFDEF COMPILER_9_UP} WideStrUtils {$ELSE} TntWideStrUtils {$ENDIF};
1152
1153procedure CreateUnicodeHandle_ComCtl(Control: TWinControl; const Params: TCreateParams;
1154  const SubClass: WideString);
1155begin
1156  Assert(SubClass <> '', 'TNT Internal Error: Only call CreateUnicodeHandle_ComCtl for Common Controls.');
1157  CreateUnicodeHandle(Control, Params, SubClass);
1158  if Win32PlatformIsUnicode then
1159    SendMessageW(Control.Handle, CCM_SETUNICODEFORMAT, Integer(True), 0);
1160end;
1161
1162{ TTntListColumn }
1163
1164procedure TTntListColumn.Assign(Source: TPersistent);
1165begin
1166  inherited;
1167  if Source is TTntListColumn then
1168    Caption := TTntListColumn(Source).Caption
1169  else if Source is TListColumn{TNT-ALLOW TListColumn} then
1170    FCaption := TListColumn{TNT-ALLOW TListColumn}(Source).Caption;
1171end;
1172
1173procedure TTntListColumn.DefineProperties(Filer: TFiler);
1174begin
1175  inherited;
1176  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
1177end;
1178
1179procedure TTntListColumn.SetInheritedCaption(const Value: AnsiString);
1180begin
1181  inherited Caption := Value;
1182end;
1183
1184function TTntListColumn.GetCaption: WideString;
1185begin
1186  Result := GetSyncedWideString(FCaption, inherited Caption);
1187end;
1188
1189procedure TTntListColumn.SetCaption(const Value: WideString);
1190begin
1191  SetSyncedWideString(Value, FCaption, inherited Caption, SetInheritedCaption);
1192end;
1193
1194{ TTntListColumns }
1195
1196{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
1197type
1198  THackCollection = class(TPersistent)
1199  protected
1200    FItemClass: TCollectionItemClass;
1201  end;
1202{$ENDIF}
1203{$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
1204type
1205  THackCollection = class(TPersistent)
1206  protected
1207    FItemClass: TCollectionItemClass;
1208  end;
1209{$ENDIF}
1210{$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
1211type
1212  THackCollection = class(TPersistent)
1213  protected
1214    FItemClass: TCollectionItemClass;
1215  end;
1216{$ENDIF}
1217{$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
1218type
1219  THackCollection = class(TPersistent)
1220  protected
1221    FItemClass: TCollectionItemClass;
1222  end;
1223{$ENDIF}
1224
1225constructor TTntListColumns.Create(AOwner: TTntCustomListView);
1226begin
1227  inherited Create(AOwner);
1228  Assert(THackCollection(Self).FItemClass = Self.ItemClass, 'Internal Error in TTntListColumns.Create().');
1229  THackCollection(Self).FItemClass := TTntListColumn
1230end;
1231
1232function TTntListColumns.Owner: TTntCustomListView;
1233begin
1234  Result := inherited Owner as TTntCustomListView;
1235end;
1236
1237function TTntListColumns.Add: TTntListColumn;
1238begin
1239  Result := (inherited Add) as TTntListColumn;
1240end;
1241
1242function TTntListColumns.GetItem(Index: Integer): TTntListColumn;
1243begin
1244  Result := inherited Items[Index] as TTntListColumn;
1245end;
1246
1247procedure TTntListColumns.SetItem(Index: Integer; Value: TTntListColumn);
1248begin
1249  inherited SetItem(Index, Value);
1250end;
1251
1252{ TWideSubItems }
1253type
1254  TWideSubItems = class(TTntStringList)
1255  private
1256    FIgnoreInherited: Boolean;
1257    FInheritedOwner: TListItem{TNT-ALLOW TListItem};
1258    FOwner: TTntListItem;
1259  protected
1260    procedure Put(Index: Integer; const S: WideString); override;
1261    function GetObject(Index: Integer): TObject; override;
1262    procedure PutObject(Index: Integer; AObject: TObject); override;
1263    procedure SetUpdateState(Updating: Boolean); override;
1264  public
1265    procedure Insert(Index: Integer; const S: WideString); override;
1266    function AddObject(const S: WideString; AObject: TObject): Integer; override;
1267    procedure Clear; override;
1268    procedure Delete(Index: Integer); override;
1269  public
1270    constructor Create(AOwner: TTntListItem);
1271  end;
1272
1273constructor TWideSubItems.Create(AOwner: TTntListItem);
1274begin
1275  inherited Create;
1276  FInheritedOwner := AOwner;
1277  FOwner := AOwner;
1278end;
1279
1280function TWideSubItems.AddObject(const S: WideString; AObject: TObject): Integer;
1281begin
1282  FOwner.ListView.BeginChangingWideItem;
1283  try
1284    Result := inherited AddObject(S, AObject);
1285    if (not FIgnoreInherited) then
1286      FInheritedOwner.SubItems.AddObject(S, AObject);
1287  finally
1288    FOwner.ListView.EndChangingWideItem;
1289  end;
1290end;
1291
1292procedure TWideSubItems.Clear;
1293begin
1294  FOwner.ListView.BeginChangingWideItem;
1295  try
1296    inherited;
1297    if (not FIgnoreInherited) then
1298      FInheritedOwner.SubItems.Clear;
1299  finally
1300    FOwner.ListView.EndChangingWideItem;
1301  end;
1302end;
1303
1304procedure TWideSubItems.Delete(Index: Integer);
1305begin
1306  FOwner.ListView.BeginChangingWideItem;
1307  try
1308    inherited;
1309    if (not FIgnoreInherited) then
1310      FInheritedOwner.SubItems.Delete(Index);
1311  finally
1312    FOwner.ListView.EndChangingWideItem;
1313  end;
1314end;
1315
1316procedure TWideSubItems.Insert(Index: Integer; const S: WideString);
1317begin
1318  FOwner.ListView.BeginChangingWideItem;
1319  try
1320    inherited;
1321    if (not FIgnoreInherited) then
1322      FInheritedOwner.SubItems.Insert(Index, S);
1323  finally
1324    FOwner.ListView.EndChangingWideItem;
1325  end;
1326end;
1327
1328procedure TWideSubItems.Put(Index: Integer; const S: WideString);
1329begin
1330  FOwner.ListView.BeginChangingWideItem;
1331  try
1332    inherited;
1333    if (not FIgnoreInherited) then
1334      FInheritedOwner.SubItems[Index] := S;
1335  finally
1336    FOwner.ListView.EndChangingWideItem;
1337  end;
1338end;
1339
1340function TWideSubItems.GetObject(Index: Integer): TObject;
1341begin
1342  Result := FInheritedOwner.SubItems.Objects[Index];
1343end;
1344
1345procedure TWideSubItems.PutObject(Index: Integer; AObject: TObject);
1346begin
1347  FInheritedOwner.SubItems.Objects[Index] := AObject;
1348end;
1349
1350type TAccessStrings = class(TStrings{TNT-ALLOW TStrings});
1351
1352procedure TWideSubItems.SetUpdateState(Updating: Boolean);
1353begin
1354  inherited;
1355  TAccessStrings(FInheritedOwner.SubItems).SetUpdateState(Updating);
1356end;
1357
1358{ TTntListItem }
1359
1360constructor TTntListItem.Create(AOwner: TListItems{TNT-ALLOW TListItems});
1361begin
1362  inherited Create(AOwner);
1363  FSubItems := TWideSubItems.Create(Self);
1364end;
1365
1366destructor TTntListItem.Destroy;
1367begin
1368  inherited;
1369  FreeAndNil(FSubItems);
1370end;
1371
1372function TTntListItem.GetCaption: WideString;
1373begin
1374  Result := GetSyncedWideString(FCaption, inherited Caption);
1375end;
1376
1377procedure TTntListItem.SetInheritedCaption(const Value: AnsiString);
1378begin
1379  inherited Caption := Value;
1380end;
1381
1382procedure TTntListItem.SetCaption(const Value: WideString);
1383begin
1384  ListView.BeginChangingWideItem;
1385  try
1386    SetSyncedWideString(Value, FCaption, inherited Caption, SetInheritedCaption);
1387  finally
1388    ListView.EndChangingWideItem;
1389  end;
1390end;
1391
1392procedure TTntListItem.Assign(Source: TPersistent);
1393begin
1394  if Source is TTntListItem then
1395    with Source as TTntListItem do
1396    begin
1397      Self.Caption := Caption;
1398      Self.Data := Data;
1399      Self.ImageIndex := ImageIndex;
1400      Self.Indent := Indent;
1401      Self.OverlayIndex := OverlayIndex;
1402      Self.StateIndex := StateIndex;
1403      Self.SubItems := SubItems;
1404      Self.Checked := Checked;
1405    end
1406  else inherited Assign(Source);
1407end;
1408
1409procedure TTntListItem.SetSubItems(const Value: TTntStrings);
1410begin
1411  if Value <> nil then
1412    FSubItems.Assign(Value);
1413end;
1414
1415function TTntListItem.GetTntOwner: TTntListItems;
1416begin
1417  Result := ListView.Items;
1418end;
1419
1420function TTntListItem.GetListView: TTntCustomListView;
1421begin
1422  Result := ((inherited Owner).Owner as TTntCustomListView);
1423end;
1424
1425{ TTntListItemsEnumerator }
1426
1427constructor TTntListItemsEnumerator.Create(AListItems: TTntListItems);
1428begin
1429  inherited Create;
1430  FIndex := -1;
1431  FListItems := AListItems;
1432end;
1433
1434function TTntListItemsEnumerator.GetCurrent: TTntListItem;
1435begin
1436  Result := FListItems[FIndex];
1437end;
1438
1439function TTntListItemsEnumerator.MoveNext: Boolean;
1440begin
1441  Result := FIndex < FListItems.Count - 1;
1442  if Result then
1443    Inc(FIndex);
1444end;
1445
1446{ TTntListItems }
1447
1448function TTntListItems.Add: TTntListItem;
1449begin
1450  Result := (inherited Add) as TTntListItem;
1451end;
1452
1453function TTntListItems.AddItem(Item: TTntListItem; Index: Integer): TTntListItem;
1454begin
1455  Result := (inherited AddItem(Item, Index)) as TTntListItem;
1456end;
1457
1458function TTntListItems.Insert(Index: Integer): TTntListItem;
1459begin
1460  Result := (inherited Insert(Index)) as TTntListItem;
1461end;
1462
1463function TTntListItems.GetItem(Index: Integer): TTntListItem;
1464begin
1465  Result := (inherited Item[Index]) as TTntListItem;
1466end;
1467
1468function TTntListItems.Owner: TTntCustomListView;
1469begin
1470  Result := (inherited Owner) as TTntCustomListView;
1471end;
1472
1473procedure TTntListItems.SetItem(Index: Integer; const Value: TTntListItem);
1474begin
1475  inherited Item[Index] := Value;
1476end;
1477
1478function TTntListItems.GetEnumerator: TTntListItemsEnumerator;
1479begin
1480  Result := TTntListItemsEnumerator.Create(Self);
1481end;
1482
1483{ TSavedListItem }
1484type
1485  TSavedListItem = class
1486    FCaption: WideString;
1487    FSubItems: TTntStrings;
1488    constructor Create;
1489    destructor Destroy; override;
1490  end;
1491
1492constructor TSavedListItem.Create;
1493begin
1494  inherited;
1495  FSubItems := TTntStringList.Create;
1496end;
1497
1498destructor TSavedListItem.Destroy;
1499begin
1500  FSubItems.Free;
1501  inherited;
1502end;
1503
1504{ _TntInternalCustomListView }
1505
1506function _TntInternalCustomListView.OwnerDataFind(Find: TItemFind;
1507  const FindString: AnsiString; const FindPosition: TPoint;
1508  FindData: Pointer; StartIndex: Integer; Direction: TSearchDirection;
1509  Wrap: Boolean): Integer;
1510var
1511  WideFindString: WideString;
1512begin
1513  if Assigned(PWideFindString) then
1514    WideFindString := PWideFindString
1515  else
1516    WideFindString := FindString;
1517  Result := OwnerDataFindW(Find, WideFindString, FindPosition, FindData, StartIndex, Direction, Wrap);
1518end;
1519
1520function _TntInternalCustomListView.OwnerDataFetch(Item: TListItem{TNT-ALLOW TListItem};
1521  Request: TItemRequest): Boolean;
1522begin
1523  if  (CurrentDispInfo <> nil)
1524  and (OriginalDispInfoMask and LVIF_TEXT <> 0) then begin
1525    (Item as TTntListItem).FCaption := CurrentDispInfo.item.pszText
1526  end;
1527  (Item as TTntListItem).FSubItems.Clear;
1528  Result := OwnerDataFetchW(Item, Request);
1529end;
1530
1531{ TTntCustomListView }
1532
1533{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
1534type
1535  THackCustomListView = class(TCustomMultiSelectListControl)
1536  protected
1537    FxxxCanvas: TCanvas;
1538    FxxxBorderStyle: TBorderStyle;
1539    FxxxViewStyle: TViewStyle;
1540    FxxxReadOnly: Boolean;
1541    FxxxLargeImages: TCustomImageList;
1542    FxxxSmallImages: TCustomImageList;
1543    FxxxStateImages: TCustomImageList;
1544    FxxxDragImage: TDragImageList;
1545    FxxxMultiSelect: Boolean;
1546    FxxxSortType: TSortType;
1547    FxxxColumnClick: Boolean;
1548    FxxxShowColumnHeaders: Boolean;
1549    FxxxListItems: TListItems{TNT-ALLOW TListItems};
1550    FxxxClicked: Boolean;
1551    FxxxRClicked: Boolean;
1552    FxxxIconOptions: TIconOptions;
1553    FxxxHideSelection: Boolean;
1554    FListColumns: TListColumns{TNT-ALLOW TListColumns};
1555  end;
1556{$ENDIF}
1557{$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
1558type
1559  THackCustomListView = class(TCustomMultiSelectListControl)
1560  protected
1561    FxxxCanvas: TCanvas;
1562    FxxxBorderStyle: TBorderStyle;
1563    FxxxViewStyle: TViewStyle;
1564    FxxxReadOnly: Boolean;
1565    FxxxLargeImages: TCustomImageList;
1566    FxxxSmallImages: TCustomImageList;
1567    FxxxStateImages: TCustomImageList;
1568    FxxxDragImage: TDragImageList;
1569    FxxxMultiSelect: Boolean;
1570    FxxxSortType: TSortType;
1571    FxxxColumnClick: Boolean;
1572    FxxxShowColumnHeaders: Boolean;
1573    FxxxListItems: TListItems{TNT-ALLOW TListItems};
1574    FxxxClicked: Boolean;
1575    FxxxRClicked: Boolean;
1576    FxxxIconOptions: TIconOptions;
1577    FxxxHideSelection: Boolean;
1578    FListColumns: TListColumns{TNT-ALLOW TListColumns};
1579  end;
1580{$ENDIF}
1581{$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
1582type
1583  THackCustomListView = class(TCustomMultiSelectListControl)
1584  protected
1585    FxxxCanvas: TCanvas;
1586    FxxxBorderStyle: TBorderStyle;
1587    FxxxViewStyle: TViewStyle;
1588    FxxxReadOnly: Boolean;
1589    FxxxLargeImages: TCustomImageList;
1590    FxxxSmallImages: TCustomImageList;
1591    FxxxStateImages: TCustomImageList;
1592    FxxxDragImage: TDragImageList;
1593    FxxxMultiSelect: Boolean;
1594    FxxxSortType: TSortType;
1595    FxxxColumnClick: Boolean;
1596    FxxxShowColumnHeaders: Boolean;
1597    FxxxListItems: TListItems{TNT-ALLOW TListItems};
1598    FxxxClicked: Boolean;
1599    FxxxRClicked: Boolean;
1600    FxxxIconOptions: TIconOptions;
1601    FxxxHideSelection: Boolean;
1602    FListColumns: TListColumns{TNT-ALLOW TListColumns};
1603  end;
1604{$ENDIF}
1605{$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
1606type
1607  THackCustomListView = class(TCustomMultiSelectListControl)
1608  protected
1609    FxxxCanvas: TCanvas;
1610    FxxxBorderStyle: TBorderStyle;
1611    FxxxViewStyle: TViewStyle;
1612    FxxxReadOnly: Boolean;
1613    FxxxLargeImages: TCustomImageList;
1614    FxxxSaveSelectedIndex: Integer;
1615    FxxxSmallImages: TCustomImageList;
1616    FxxxStateImages: TCustomImageList;
1617    FxxxDragImage: TDragImageList;
1618    FxxxMultiSelect: Boolean;
1619    FxxxSortType: TSortType;
1620    FxxxColumnClick: Boolean;
1621    FxxxShowColumnHeaders: Boolean;
1622    FxxxListItems: TListItems{TNT-ALLOW TListItems};
1623    FxxxClicked: Boolean;
1624    FxxxRClicked: Boolean;
1625    FxxxIconOptions: TIconOptions;
1626    FxxxHideSelection: Boolean;
1627    FListColumns: TListColumns{TNT-ALLOW TListColumns};
1628  end;
1629{$ENDIF}
1630
1631var
1632  ComCtrls_DefaultListViewSort: TLVCompare = nil;
1633
1634constructor TTntCustomListView.Create(AOwner: TComponent);
1635begin
1636  inherited;
1637  FEditInstance := Classes.MakeObjectInstance(EditWndProcW);
1638  // create list columns
1639  Assert(THackCustomListView(Self).FListColumns = inherited Columns, 'Internal Error in TTntCustomListView.Create().');
1640  FreeAndNil(THackCustomListView(Self).FListColumns);
1641  THackCustomListView(Self).FListColumns := TTntListColumns.Create(Self);
1642end;
1643
1644destructor TTntCustomListView.Destroy;
1645begin
1646  inherited;
1647  Classes.FreeObjectInstance(FEditInstance);
1648  FreeAndNil(FSavedItems);
1649end;
1650
1651procedure TTntCustomListView.CreateWindowHandle(const Params: TCreateParams);
1652
1653  procedure Capture_ComCtrls_DefaultListViewSort;
1654  begin
1655    FTestingForSortProc := True;
1656    try
1657      AlphaSort;
1658    finally
1659      FTestingForSortProc := False;
1660    end;
1661  end;
1662
1663var
1664  Column: TLVColumn;
1665begin
1666  CreateUnicodeHandle_ComCtl(Self, Params, WC_LISTVIEW);
1667  if (Win32PlatformIsUnicode) then begin
1668    if not Assigned(ComCtrls_DefaultListViewSort) then
1669      Capture_ComCtrls_DefaultListViewSort;
1670    // the only way I could get editing to work is after a column had been inserted
1671    Column.mask := 0;
1672    ListView_InsertColumn(Handle, 0, Column);
1673    ListView_DeleteColumn(Handle, 0);
1674  end;
1675end;
1676
1677procedure TTntCustomListView.DefineProperties(Filer: TFiler);
1678begin
1679  inherited;
1680  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
1681end;
1682
1683procedure TTntCustomListView.CreateWnd;
1684begin
1685  inherited;
1686  FreeAndNil(FSavedItems);
1687end;
1688
1689procedure TTntCustomListView.DestroyWnd;
1690var
1691  i: integer;
1692  FSavedItem: TSavedListItem;
1693  Item: TTntListItem;
1694begin
1695  if (not (csDestroying in ComponentState)) and (not OwnerData) then begin
1696    FreeAndNil(FSavedItems); // fixes a bug on Windows 95.
1697    FSavedItems := TObjectList.Create(True);
1698    for i := 0 to Items.Count - 1 do begin
1699      FSavedItem := TSavedListItem.Create;
1700      Item := Items[i];
1701      FSavedItem.FCaption := Item.FCaption;
1702      FSavedItem.FSubItems.Assign(Item.FSubItems);
1703      FSavedItems.Add(FSavedItem)
1704    end;
1705  end;
1706  inherited;
1707end;
1708
1709function TTntCustomListView.GetDropTarget: TTntListItem;
1710begin
1711  Result := inherited DropTarget as TTntListItem;
1712end;
1713
1714procedure TTntCustomListView.SetDropTarget(const Value: TTntListItem);
1715begin
1716  inherited DropTarget := Value;
1717end;
1718
1719function TTntCustomListView.GetItemFocused: TTntListItem;
1720begin
1721  Result := inherited ItemFocused as TTntListItem;
1722end;
1723
1724procedure TTntCustomListView.SetItemFocused(const Value: TTntListItem);
1725begin
1726  inherited ItemFocused := Value;
1727end;
1728
1729function TTntCustomListView.GetSelected: TTntListItem;
1730begin
1731  Result := inherited Selected as TTntListItem;
1732end;
1733
1734procedure TTntCustomListView.SetSelected(const Value: TTntListItem);
1735begin
1736  inherited Selected := Value;
1737end;
1738
1739function TTntCustomListView.GetTopItem: TTntListItem;
1740begin
1741  Result := inherited TopItem as TTntListItem;
1742end;
1743
1744function TTntCustomListView.GetListColumns: TTntListColumns;
1745begin
1746  Result := inherited Columns as TTntListColumns;
1747end;
1748
1749procedure TTntCustomListView.SetListColumns(const Value: TTntListColumns);
1750begin
1751  inherited Columns := Value;
1752end;
1753
1754{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
1755type
1756  THackListColumn = class(TCollectionItem)
1757  protected
1758    FxxxAlignment: TAlignment;
1759    FxxxAutoSize: Boolean;
1760    FxxxCaption: AnsiString;
1761    FxxxMaxWidth: TWidth;
1762    FxxxMinWidth: TWidth;
1763    FxxxImageIndex: TImageIndex;
1764    FxxxPrivateWidth: TWidth;
1765    FxxxWidth: TWidth;
1766    FOrderTag: Integer;
1767  end;
1768{$ENDIF}
1769{$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
1770type
1771  THackListColumn = class(TCollectionItem)
1772  protected
1773    FxxxAlignment: TAlignment;
1774    FxxxAutoSize: Boolean;
1775    FxxxCaption: AnsiString;
1776    FxxxMaxWidth: TWidth;
1777    FxxxMinWidth: TWidth;
1778    FxxxImageIndex: TImageIndex;
1779    FxxxPrivateWidth: TWidth;
1780    FxxxWidth: TWidth;
1781    FOrderTag: Integer;
1782  end;
1783{$ENDIF}
1784{$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
1785type
1786  THackListColumn = class(TCollectionItem)
1787  protected
1788    FxxxxxxxxAlignment: TAlignment;
1789    FxxxxAutoSize: Boolean;
1790    FxxxxCaption: AnsiString;
1791    FxxxxMaxWidth: TWidth;
1792    FxxxxMinWidth: TWidth;
1793    FxxxxImageIndex: TImageIndex;
1794    FxxxxPrivateWidth: TWidth;
1795    FxxxxWidth: TWidth;
1796    FOrderTag: Integer;
1797  end;
1798{$ENDIF}
1799{$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
1800type
1801  THackListColumn = class(TCollectionItem)
1802  protected
1803    FxxxxxxxxAlignment: TAlignment;
1804    FxxxxAutoSize: Boolean;
1805    FxxxxCaption: AnsiString;
1806    FxxxxMaxWidth: TWidth;
1807    FxxxxMinWidth: TWidth;
1808    FxxxxImageIndex: TImageIndex;
1809    FxxxxPrivateWidth: TWidth;
1810    FxxxxWidth: TWidth;
1811    FOrderTag: Integer;
1812  end;
1813{$ENDIF}
1814
1815function TTntCustomListView.GetColumnFromTag(Tag: Integer): TTntListColumn;
1816var
1817  I: Integer;
1818begin
1819  for I := 0 to Columns.Count - 1 do
1820  begin
1821    Result := Columns[I];
1822    if THackListColumn(Result).FOrderTag = Tag then Exit;
1823  end;
1824  Result := nil;
1825end;
1826
1827function TTntCustomListView.ColumnFromIndex(Index: Integer): TTntListColumn;
1828begin
1829  Result := inherited Column[Index] as TTntListColumn;
1830end;
1831
1832function TTntCustomListView.AreItemsStored: Boolean;
1833begin
1834  if Assigned(Action) then
1835  begin
1836    if Action is TCustomListAction{TNT-ALLOW TCustomListAction} then
1837      Result := False
1838    else
1839      Result := True;
1840  end
1841  else
1842    Result := not OwnerData;
1843end;
1844
1845function TTntCustomListView.GetItems: TTntListItems;
1846begin
1847  Result := inherited Items as TTntListItems;
1848end;
1849
1850procedure TTntCustomListView.SetItems(Value: TTntListItems);
1851begin
1852  inherited Items := Value;
1853end;
1854
1855type TTntListItemClass = class of TTntListItem;
1856
1857function TTntCustomListView.CreateListItem: TListItem{TNT-ALLOW TListItem};
1858var
1859  LClass: TClass;
1860  TntLClass: TTntListItemClass;
1861begin
1862  LClass := TTntListItem;
1863  if Assigned(OnCreateItemClass) then
1864    OnCreateItemClass(Self, TListItemClass(LClass));
1865  if not LClass.InheritsFrom(TTntListItem) then
1866    raise ETntInternalError.Create('Internal Error: OnCreateItemClass.ItemClass must inherit from TTntListItem.');
1867  TntLClass := TTntListItemClass(LClass);
1868  Result := TntLClass.Create(inherited Items);
1869  if FTempItem = nil then
1870    FTempItem := Result as TTntListItem; { In Delphi 5/6/7/9/10, the first item created is the temp item }
1871  { TODO: Verify that D11 creates a temp item in its constructor. }
1872end;
1873
1874function TTntCustomListView.CreateListItems: TListItems{TNT-ALLOW TListItems};
1875begin
1876  Result := TTntListItems.Create(Self);
1877end;
1878
1879function TTntCustomListView.GetItemW(Value: TLVItemW): TTntListItem;
1880begin
1881  with Value do begin
1882    if (mask and LVIF_PARAM) <> 0 then
1883      Result := TListItem{TNT-ALLOW TListItem}(lParam) as TTntListItem
1884    else if iItem >= 0 then
1885      Result := Items[IItem]
1886    else if OwnerData then
1887      Result := FTempItem
1888    else
1889      Result := nil
1890  end;
1891end;
1892
1893function TTntCustomListView.OwnerDataFetchW(Item: TListItem{TNT-ALLOW TListItem}; Request: TItemRequest): Boolean;
1894begin
1895  Result := OwnerDataFetch(Item, Request);
1896end;
1897
1898function TTntCustomListView.OwnerDataFetch(Item: TListItem{TNT-ALLOW TListItem}; Request: TItemRequest): Boolean;
1899begin
1900  if Assigned(OnData) then
1901  begin
1902    OnData(Self, Item);
1903    Result := True;
1904  end
1905  else Result := False;
1906end;
1907
1908function TntDefaultListViewSort(Item1, Item2: TTntListItem; lParam: Integer): Integer; stdcall;
1909begin
1910  Assert(Win32PlatformIsUnicode);
1911  with Item1 do
1912    if Assigned(ListView.OnCompare) then
1913      ListView.OnCompare(ListView, Item1, Item2, lParam, Result)
1914    else Result := lstrcmpw(PWideChar(Item1.Caption), PWideChar(Item2.Caption));
1915end;
1916
1917procedure TTntCustomListView.WndProc(var Message: TMessage);
1918var
1919  Item: TTntListItem;
1920  InheritedItem: TListItem{TNT-ALLOW TListItem};
1921  SubItem: Integer;
1922  SavedItem: TSavedListItem;
1923  PCol: PLVColumn;
1924  Col: TTntListColumn;
1925begin
1926  with Message do begin
1927    // restore previous values (during CreateWnd)
1928    if (FSavedItems <> nil) and (FChangingWideItemCount = 0) and (Msg = LVM_SETITEMTEXTA) then begin
1929      Item := Items[wParam];
1930      SavedItem := TSavedListItem(FSavedItems[wParam]);
1931      if (Msg = LVM_SETITEMTEXTA) and (PLVItem(lParam).iSubItem = 0) then
1932        Item.FCaption := SavedItem.FCaption
1933      else begin
1934        SubItem := PLVItem(lParam).iSubItem - 1;
1935        TWideSubItems(Item.SubItems).FIgnoreInherited := True;
1936        try
1937          if SubItem < Item.SubItems.Count then begin
1938            Item.SubItems[SubItem] := SavedItem.FSubItems[SubItem];
1939            Item.SubItems.Objects[SubItem] := SavedItem.FSubItems.Objects[SubItem]
1940          end else if SubItem = Item.SubItems.Count then
1941            Item.SubItems.AddObject(SavedItem.FSubItems[SubItem], SavedItem.FSubItems.Objects[SubItem])
1942          else
1943            Item.SubItems.Assign(SavedItem.FSubItems)
1944        finally
1945          TWideSubItems(Item.SubItems).FIgnoreInherited := False;
1946        end;
1947      end;
1948    end;
1949
1950    // sync wide with ansi
1951    if (FSavedItems = nil) and (FChangingWideItemCount = 0) and (Msg = LVM_UPDATE) then begin
1952      Item := Items[wParam];
1953      InheritedItem := Item;
1954      TWideSubItems(Item.SubItems).FIgnoreInherited := True;
1955      try
1956        Item.SubItems.Assign(InheritedItem.SubItems)
1957      finally
1958        TWideSubItems(Item.SubItems).FIgnoreInherited := False;
1959      end;
1960    end;
1961
1962    if (FSavedItems = nil) and (FChangingWideItemCount = 0) and (Msg = LVM_SETITEMTEXTA) then begin
1963      if OwnerData then
1964        Item := FTempItem
1965      else
1966        Item := Items[wParam];
1967      InheritedItem := Item;
1968      if (Msg = LVM_SETITEMTEXTA) and (PLVItem(lParam).iSubItem = 0) then
1969        Item.FCaption := InheritedItem.Caption
1970      else begin
1971        SubItem := PLVItem(lParam).iSubItem - 1;
1972        TWideSubItems(Item.SubItems).FIgnoreInherited := True;
1973        try
1974          if SubItem < Item.SubItems.Count then begin
1975            Item.SubItems[SubItem] := InheritedItem.SubItems[SubItem];
1976            Item.SubItems.Objects[SubItem] := InheritedItem.SubItems.Objects[SubItem]
1977          end else if SubItem = Item.SubItems.Count then
1978            Item.SubItems.AddObject(InheritedItem.SubItems[SubItem], InheritedItem.SubItems.Objects[SubItem])
1979          else
1980            Item.SubItems.Assign(InheritedItem.SubItems)
1981        finally
1982          TWideSubItems(Item.SubItems).FIgnoreInherited := False;
1983        end;
1984      end;
1985    end;
1986
1987    // capture ANSI version of DefaultListViewSort from ComCtrls
1988    if (FTestingForSortProc)
1989    and (Msg = LVM_SORTITEMS) then begin
1990      ComCtrls_DefaultListViewSort := Pointer(lParam);
1991      exit;
1992    end;
1993
1994    if (Msg = LVM_SETCOLUMNA) then begin
1995      // make sure that wide column caption stays in sync with ANSI
1996      PCol := PLVColumn(lParam);
1997      if (PCol.mask and LVCF_TEXT) <> 0 then begin
1998        Col := GetColumnFromTag(wParam);
1999        if (Col <> nil) and (AnsiString(Col.Caption) <> PCol.pszText) then begin
2000          Col.FCaption := PCol.pszText;
2001        end;
2002      end;
2003    end;
2004
2005    if (Win32PlatformIsUnicode)
2006    and (Msg = LVM_SETITEMTEXTA) and (PLVItem(lParam).pszText = LPSTR_TEXTCALLBACK) then
2007      // Unicode:: call wide version of text call back instead
2008      Result := SendMessageW(Handle, LVM_SETITEMTEXTW, WParam, LParam)
2009    else if (Win32PlatformIsUnicode)
2010    and (Msg = LVM_SORTITEMS) and (Pointer(lParam) = @ComCtrls_DefaultListViewSort) then
2011      // Unicode:: call wide version of sort proc instead
2012      Result := SendMessageW(Handle, LVM_SORTITEMS, wParam, Integer(@TntDefaultListViewSort))
2013    else if (Win32PlatformIsUnicode)
2014    and (Msg = LVM_SETCOLUMNA) and ((PLVColumn(lParam).mask and LVCF_TEXT) <> 0)
2015    and (GetColumnFromTag(wParam) <> nil) then begin
2016      PLVColumn(lParam).pszText := PAnsiChar(PWideChar(GetColumnFromTag(wParam).FCaption));
2017      Result := SendMessageW(Handle, LVM_SETCOLUMNW, wParam, lParam);
2018    end else begin
2019      if (Msg = LVM_SETEXTENDEDLISTVIEWSTYLE) and CheckBoxes then begin
2020        { fix a bug in TCustomListView.ResetExStyles }
2021        lParam := lParam or LVS_EX_SUBITEMIMAGES or LVS_EX_INFOTIP;
2022      end;
2023      inherited;
2024    end;
2025  end;
2026end;
2027
2028procedure TTntCustomListView.WMNotify(var Message: TWMNotify);
2029begin
2030  inherited;
2031  // capture updated info after inherited
2032  with Message.NMHdr^ do
2033    case code of
2034      HDN_ENDTRACKW:
2035        begin
2036          Message.NMHdr^.code := HDN_ENDTRACKA;
2037          try
2038            inherited
2039          finally
2040            Message.NMHdr^.code := HDN_ENDTRACKW;
2041          end;
2042        end;
2043      HDN_DIVIDERDBLCLICKW:
2044        begin
2045          Message.NMHdr^.code := HDN_DIVIDERDBLCLICKA;
2046          try
2047            inherited
2048          finally
2049            Message.NMHdr^.code := HDN_DIVIDERDBLCLICKW;
2050          end;
2051        end;
2052    end;
2053end;
2054
2055procedure TTntCustomListView.CNNotify(var Message: TWMNotify);
2056var
2057  Item: TTntListItem;
2058begin
2059  if (not Win32PlatformIsUnicode) then
2060    inherited
2061  else begin
2062    with Message do
2063    begin
2064      case NMHdr^.code of
2065        HDN_TRACKW:
2066          begin
2067            NMHdr^.code := HDN_TRACKA;
2068            try
2069              inherited;
2070            finally
2071              NMHdr^.code := HDN_TRACKW;
2072            end;
2073          end;
2074        LVN_GETDISPINFOW:
2075          begin
2076            // call inherited without the LVIF_TEXT flag
2077            CurrentDispInfo := PLVDispInfoW(NMHdr);
2078            try
2079              OriginalDispInfoMask := PLVDispInfoW(NMHdr)^.item.mask;
2080
2081              PLVDispInfoW(NMHdr)^.item.mask := PLVDispInfoW(NMHdr)^.item.mask and (not LVIF_TEXT);
2082              try
2083                NMHdr^.code := LVN_GETDISPINFOA;
2084                try
2085                  inherited;
2086                finally
2087                  NMHdr^.code := LVN_GETDISPINFOW;
2088                end;
2089              finally
2090                if (OriginalDispInfoMask and LVIF_TEXT <> 0) then
2091                  PLVDispInfoW(NMHdr)^.item.mask := PLVDispInfoW(NMHdr)^.item.mask or LVIF_TEXT;
2092              end;
2093            finally
2094              CurrentDispInfo := nil;
2095            end;
2096
2097            // handle any text info
2098            with PLVDispInfoW(NMHdr)^.item do
2099            begin
2100              if (mask and LVIF_TEXT) <> 0 then
2101              begin
2102                Item := GetItemW(PLVDispInfoW(NMHdr)^.item);
2103                if iSubItem = 0 then
2104                  WStrLCopy(pszText, PWideChar(Item.Caption), cchTextMax - 1)
2105                else begin
2106                  with Item.SubItems do begin
2107                    if iSubItem <= Count then
2108                      WStrLCopy(pszText, PWideChar(Strings[iSubItem - 1]), cchTextMax - 1)
2109                    else pszText[0] := #0;
2110                  end;
2111                end;
2112              end;
2113            end;
2114          end;
2115        LVN_ODFINDITEMW:
2116          with PNMLVFindItem(NMHdr)^ do
2117          begin
2118            if ((lvfi.flags and LVFI_PARTIAL) <> 0) or ((lvfi.flags and LVFI_STRING) <> 0) then
2119              PWideFindString := TLVFindInfoW(lvfi).psz
2120            else
2121              PWideFindString := nil;
2122            lvfi.psz := nil;
2123            NMHdr^.code := LVN_ODFINDITEMA;
2124            try
2125              inherited; {will Result in call to OwnerDataFind}
2126            finally
2127              TLVFindInfoW(lvfi).psz := PWideFindString;
2128              NMHdr^.code := LVN_ODFINDITEMW;
2129              PWideFindString := nil;
2130            end;
2131          end;
2132        LVN_BEGINLABELEDITW:
2133          begin
2134            Item := GetItemW(PLVDispInfoW(NMHdr)^.item);
2135            if not CanEdit(Item) then Result := 1;
2136            if Result = 0 then
2137            begin
2138              FEditHandle := ListView_GetEditControl(Handle);
2139              FDefEditProc := Pointer(GetWindowLongW(FEditHandle, GWL_WNDPROC));
2140              SetWindowLongW(FEditHandle, GWL_WNDPROC, LongInt(FEditInstance));
2141            end;
2142          end;
2143        LVN_ENDLABELEDITW:
2144          with PLVDispInfoW(NMHdr)^ do
2145            if (item.pszText <> nil) and (item.IItem <> -1) then
2146              Edit(TLVItemA(item));
2147        LVN_GETINFOTIPW:
2148          begin
2149            NMHdr^.code := LVN_GETINFOTIPA;
2150            try
2151              inherited;
2152            finally
2153              NMHdr^.code := LVN_GETINFOTIPW;
2154            end;
2155          end;
2156        else
2157          inherited;
2158      end;
2159    end;
2160  end;
2161end;
2162
2163function TTntCustomListView.OwnerDataFindW(Find: TItemFind;
2164  const FindString: WideString; const FindPosition: TPoint;
2165  FindData: Pointer; StartIndex: Integer; Direction: TSearchDirection;
2166  Wrap: Boolean): Integer;
2167begin
2168  Result := OwnerDataFind(Find, FindString, FindPosition, FindData, StartIndex, Direction, Wrap);
2169end;
2170
2171function TTntCustomListView.OwnerDataFind(Find: TItemFind; const FindString: WideString;
2172  const FindPosition: TPoint; FindData: Pointer; StartIndex: Integer;
2173  Direction: TSearchDirection; Wrap: Boolean): Integer;
2174var
2175  AnsiEvent: TLVOwnerDataFindEvent;
2176begin
2177  Result := -1;
2178  if Assigned(OnDataFind) then
2179    OnDataFind(Self, Find, FindString, FindPosition, FindData, StartIndex, Direction, Wrap, Result)
2180  else if Assigned(inherited OnDataFind) then begin
2181    AnsiEvent := inherited OnDataFind;
2182    AnsiEvent(Self, Find, FindString, FindPosition, FindData, StartIndex, Direction,
2183      Wrap, Result);
2184  end;
2185end;
2186
2187procedure TTntCustomListView.Edit(const Item: TLVItem);
2188var
2189  S: WideString;
2190  AnsiS: AnsiString;
2191  EditItem: TTntListItem;
2192  AnsiEvent: TLVEditedEvent;
2193begin
2194  if (not Win32PlatformIsUnicode) then
2195    S := Item.pszText
2196  else
2197    S := TLVItemW(Item).pszText;
2198  EditItem := GetItemW(TLVItemW(Item));
2199  if Assigned(OnEdited) then
2200    OnEdited(Self, EditItem, S)
2201  else if Assigned(inherited OnEdited) then
2202  begin
2203    AnsiEvent := inherited OnEdited;
2204    AnsiS := S;
2205    AnsiEvent(Self, EditItem, AnsiS);
2206    S := AnsiS;
2207  end;
2208  if EditItem <> nil then
2209    EditItem.Caption := S;
2210end;
2211
2212procedure TTntCustomListView.EditWndProcW(var Message: TMessage);
2213begin
2214  Assert(Win32PlatformIsUnicode);
2215  try
2216    with Message do
2217    begin
2218      case Msg of
2219        WM_KEYDOWN,
2220        WM_SYSKEYDOWN: if DoKeyDown(TWMKey(Message)) then Exit;
2221        WM_CHAR:
2222          begin
2223            MakeWMCharMsgSafeForAnsi(Message);
2224            try
2225              if DoKeyPress(TWMKey(Message)) then Exit;
2226            finally
2227              RestoreWMCharMsg(Message);
2228            end;
2229          end;
2230        WM_KEYUP,
2231        WM_SYSKEYUP: if DoKeyUp(TWMKey(Message)) then Exit;
2232        CN_KEYDOWN,
2233        CN_CHAR, CN_SYSKEYDOWN,
2234        CN_SYSCHAR:
2235          begin
2236            WndProc(Message);
2237            Exit;
2238          end;
2239      end;
2240      Result := CallWindowProcW(FDefEditProc, FEditHandle, Msg, WParam, LParam);
2241    end;
2242  except
2243    Application.HandleException(Self);
2244  end;
2245end;
2246
2247procedure TTntCustomListView.BeginChangingWideItem;
2248begin
2249  Inc(FChangingWideItemCount);
2250end;
2251
2252procedure TTntCustomListView.EndChangingWideItem;
2253begin
2254  if FChangingWideItemCount > 0 then
2255    Dec(FChangingWideItemCount);
2256end;
2257
2258procedure TTntCustomListView.DrawItem(Item: TListItem{TNT-ALLOW TListItem}; Rect: TRect;
2259  State: TOwnerDrawState);
2260begin
2261  TControlCanvas(Canvas).UpdateTextFlags;
2262  if Assigned(OnDrawItem) then OnDrawItem(Self, Item, Rect, State)
2263  else
2264  begin
2265    Canvas.FillRect(Rect);
2266    WideCanvasTextOut(Canvas, Rect.Left + 2, Rect.Top, Item.Caption);
2267  end;
2268end;
2269
2270procedure TTntCustomListView.CopySelection(Destination: TCustomListControl);
2271var
2272  I: Integer;
2273begin
2274  for I := 0 to Items.Count - 1 do
2275    if Items[I].Selected then
2276      WideListControl_AddItem(Destination, Items[I].Caption, Items[I].Data);
2277end;
2278
2279procedure TTntCustomListView.AddItem(const Item: WideString; AObject: TObject);
2280begin
2281  with Items.Add do
2282  begin
2283    Caption := Item;
2284    Data := AObject;
2285  end;
2286end;
2287
2288//-------------
2289
2290function TTntCustomListView.FindCaption(StartIndex: Integer; Value: WideString;
2291  Partial, Inclusive, Wrap: Boolean): TTntListItem;
2292const
2293  FullString: array[Boolean] of Integer = (0, LVFI_PARTIAL);
2294  Wraps: array[Boolean] of Integer = (0, LVFI_WRAP);
2295var
2296  Info: TLVFindInfoW;
2297  Index: Integer;
2298begin
2299  if (not Win32PlatformIsUnicode) then
2300    Result := inherited FindCaption(StartIndex, Value, Partial, Inclusive, Wrap) as TTntListItem
2301  else begin
2302    with Info do
2303    begin
2304      flags := LVFI_STRING or FullString[Partial] or Wraps[Wrap];
2305      psz := PWideChar(Value);
2306    end;
2307    if Inclusive then Dec(StartIndex);
2308    Index := SendMessageW(Handle, LVM_FINDITEMW, StartIndex, Longint(@Info));
2309    if Index <> -1 then Result := Items[Index]
2310    else Result := nil;
2311  end;
2312end;
2313
2314function TTntCustomListView.StringWidth(S: WideString): Integer;
2315begin
2316  if (not Win32PlatformIsUnicode) then
2317    Result := inherited StringWidth(S)
2318  else
2319    Result := SendMessageW(Handle, LVM_GETSTRINGWIDTHW, 0, Longint(PWideChar(S)))
2320end;
2321
2322function TTntCustomListView.GetSearchString: WideString;
2323var
2324  Buffer: array[0..1023] of WideChar;
2325begin
2326  if (not Win32PlatformIsUnicode) then
2327    Result := inherited GetSearchString
2328  else begin
2329    Result := '';
2330    if HandleAllocated
2331    and Bool(SendMessageW(Handle, LVM_GETISEARCHSTRINGW, 0, Longint(PWideChar(@Buffer[0])))) then
2332      Result := Buffer;
2333  end;
2334end;
2335
2336function TTntCustomListView.IsHintStored: Boolean;
2337begin
2338  Result := TntControl_IsHintStored(Self);
2339end;
2340
2341function TTntCustomListView.GetHint: WideString;
2342begin
2343  Result := TntControl_GetHint(Self)
2344end;
2345
2346procedure TTntCustomListView.SetHint(const Value: WideString);
2347begin
2348  TntControl_SetHint(Self, Value);
2349end;
2350
2351procedure TTntCustomListView.ActionChange(Sender: TObject; CheckDefaults: Boolean);
2352begin
2353  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
2354  inherited;
2355end;
2356
2357function TTntCustomListView.GetActionLinkClass: TControlActionLinkClass;
2358begin
2359  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
2360end;
2361
2362{ TTntToolButton }
2363
2364procedure TTntToolButton.DefineProperties(Filer: TFiler);
2365begin
2366  inherited;
2367  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
2368end;
2369
2370procedure TTntToolButton.CMVisibleChanged(var Message: TMessage);
2371begin
2372  inherited;
2373  RefreshControl;
2374end;
2375
2376function TTntToolButton.GetCaption: TWideCaption;
2377begin
2378  Result := TntControl_GetText(Self);
2379end;
2380
2381procedure TTntToolButton.SetCaption(const Value: TWideCaption);
2382begin
2383  TntControl_SetText(Self, Value);
2384  RefreshControl; { causes button to be removed and reinserted with TB_INSERTBUTTON }
2385end;
2386
2387function TTntToolButton.IsCaptionStored: Boolean;
2388begin
2389  Result := TntControl_IsCaptionStored(Self)
2390end;
2391
2392function TTntToolButton.GetHint: WideString;
2393begin
2394  Result := TntControl_GetHint(Self)
2395end;
2396
2397procedure TTntToolButton.SetHint(const Value: WideString);
2398begin
2399  TntControl_SetHint(Self, Value);
2400end;
2401
2402function TTntToolButton.IsHintStored: Boolean;
2403begin
2404  Result := TntControl_IsHintStored(Self)
2405end;
2406
2407procedure TTntToolButton.CMHintShow(var Message: TMessage);
2408begin
2409  ProcessCMHintShowMsg(Message);
2410  inherited;
2411end;
2412
2413procedure TTntToolButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
2414begin
2415  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
2416  inherited;
2417end;
2418
2419function TTntToolButton.GetActionLinkClass: TControlActionLinkClass;
2420begin
2421  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
2422end;
2423
2424function TTntToolButton.GetMenuItem: TMenuItem{TNT-ALLOW TMenuItem};
2425begin
2426  Result := inherited MenuItem;
2427end;
2428
2429procedure TTntToolButton.SetMenuItem(const Value: TMenuItem{TNT-ALLOW TMenuItem});
2430begin
2431  inherited MenuItem := Value;
2432  if Value is TTntMenuItem then begin
2433    Caption := TTntMenuItem(Value).Caption;
2434    Hint := TTntMenuItem(Value).Hint;
2435  end;
2436end;
2437
2438{ TTntToolBar }
2439
2440procedure TTntToolBar.CreateWindowHandle(const Params: TCreateParams);
2441begin
2442  CreateUnicodeHandle_ComCtl(Self, Params, TOOLBARCLASSNAME);
2443end;
2444
2445procedure TTntToolBar.DefineProperties(Filer: TFiler);
2446begin
2447  inherited;
2448  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
2449end;
2450
2451procedure TTntToolBar.TBInsertButtonA(var Message: TMessage);
2452var
2453  Button: TTntToolButton;
2454  Buffer: WideString;
2455begin
2456  if Win32PlatformIsUnicode
2457  and (PTBButton(Message.LParam).iString <> -1)
2458  and (Buttons[Message.WParam] is TTntToolButton) then
2459  begin
2460    Button := TTntToolButton(Buttons[Message.WParam]);
2461    Buffer := Button.Caption + WideChar(#0);
2462    PTBButton(Message.LParam).iString :=
2463      SendMessage(Handle, TB_ADDSTRINGW, 0, Integer(PWideChar(Buffer)));
2464  end;
2465  inherited;
2466end;
2467
2468{ Need to read/write caption ourselves - default wndproc seems to discard it. }
2469
2470procedure TTntToolBar.WMGetText(var Message: TWMGetText);
2471begin
2472  if (not Win32PlatformIsUnicode) or (WindowHandle = 0) then
2473    inherited
2474  else
2475    with Message do
2476      Result := WStrLen(WStrLCopy(PWideChar(Text), PWideChar(FCaption), TextMax - 1));
2477end;
2478
2479procedure TTntToolBar.WMGetTextLength(var Message: TWMGetTextLength);
2480begin
2481  if (not Win32PlatformIsUnicode) or (WindowHandle = 0) then
2482    inherited
2483  else
2484    Message.Result := Length(FCaption);
2485end;
2486
2487procedure TTntToolBar.WMSetText(var Message: TWMSetText);
2488begin
2489  if (not Win32PlatformIsUnicode) or (WindowHandle = 0) then
2490    inherited
2491  else
2492    with Message do
2493      SetString(FCaption, PWideChar(Text), WStrLen(PWideChar(Text)));
2494end;
2495
2496function TTntToolBar.GetCaption: WideString;
2497begin
2498  Result := TntControl_GetText(Self);
2499end;
2500
2501procedure TTntToolBar.SetCaption(const Value: WideString);
2502begin
2503  TntControl_SetText(Self, Value);
2504end;
2505
2506function TTntToolBar.IsCaptionStored: Boolean;
2507begin
2508  Result := TntControl_IsCaptionStored(Self);
2509end;
2510
2511function TTntToolBar.GetHint: WideString;
2512begin
2513  Result := TntControl_GetHint(Self);
2514end;
2515
2516procedure TTntToolBar.SetHint(const Value: WideString);
2517begin
2518  TntControl_SetHint(Self, Value);
2519end;
2520
2521function TTntToolBar.IsHintStored: Boolean;
2522begin
2523  Result := TntControl_IsHintStored(Self);
2524end;
2525
2526procedure TTntToolBar.ActionChange(Sender: TObject; CheckDefaults: Boolean);
2527begin
2528  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
2529  inherited;
2530end;
2531
2532function TTntToolBar.GetActionLinkClass: TControlActionLinkClass;
2533begin
2534  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
2535end;
2536
2537function TTntToolBar.GetMenu: TMainMenu{TNT-ALLOW TMainMenu};
2538begin
2539  Result := inherited Menu;
2540end;
2541
2542procedure TTntToolBar.SetMenu(const Value: TMainMenu{TNT-ALLOW TMainMenu});
2543var
2544  I: Integer;
2545begin
2546  if (Menu <> Value) then begin
2547    inherited Menu := Value;
2548    if Assigned(Menu) then begin
2549      // get rid of TToolButton(s)
2550      for I := ButtonCount - 1 downto 0 do
2551        Buttons[I].Free;
2552      // add TTntToolButton(s)
2553      for I := Menu.Items.Count - 1 downto 0 do
2554      begin
2555        with TTntToolButton.Create(Self) do
2556        try
2557          AutoSize := True;
2558          Grouped := True;
2559          Parent := Self;
2560          MenuItem := Menu.Items[I];
2561        except
2562          Free;
2563          raise;
2564        end;
2565      end;
2566    end;
2567  end;
2568end;
2569
2570{ TTntRichEditStrings }
2571type
2572  TTntRichEditStrings = class(TTntMemoStrings)
2573  private
2574    RichEdit: TCustomRichEdit{TNT-ALLOW TCustomRichEdit};
2575    procedure EnableChange(const Value: Boolean);
2576  protected
2577    procedure SetTextStr(const Value: WideString); override;
2578  public
2579    constructor Create;
2580    procedure AddStrings(Strings: TWideStrings); overload; override;
2581    //--
2582    procedure LoadFromStream_BOM(Stream: TStream; WithBOM: Boolean); override;
2583    procedure SaveToStream_BOM(Stream: TStream; WithBOM: Boolean); override;
2584    procedure LoadFromFile(const FileName: WideString); override;
2585    procedure SaveToFile(const FileName: WideString); override;
2586  end;
2587
2588constructor TTntRichEditStrings.Create;
2589begin
2590  inherited Create;
2591  FRichEditMode := True;
2592end;
2593
2594procedure TTntRichEditStrings.AddStrings(Strings: TWideStrings);
2595var
2596  SelChange: TNotifyEvent;
2597begin
2598  SelChange := TTntCustomRichEdit(RichEdit).OnSelectionChange;
2599  TTntCustomRichEdit(RichEdit).OnSelectionChange := nil;
2600  try
2601    inherited;
2602  finally
2603    TTntCustomRichEdit(RichEdit).OnSelectionChange := SelChange;
2604  end;
2605end;
2606
2607procedure TTntRichEditStrings.EnableChange(const Value: Boolean);
2608var
2609  EventMask: Longint;
2610begin
2611  with RichEdit do
2612  begin
2613    if Value then
2614      EventMask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0) or ENM_CHANGE
2615    else
2616      EventMask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0) and not ENM_CHANGE;
2617    SendMessage(Handle, EM_SETEVENTMASK, 0, EventMask);
2618  end;
2619end;
2620
2621procedure TTntRichEditStrings.SetTextStr(const Value: WideString);
2622begin
2623  EnableChange(False);
2624  try
2625    inherited;
2626  finally
2627    EnableChange(True);
2628  end;
2629end;
2630
2631type TAccessCustomRichEdit = class(TCustomRichEdit{TNT-ALLOW TCustomRichEdit});
2632
2633procedure TTntRichEditStrings.LoadFromStream_BOM(Stream: TStream; WithBOM: Boolean);
2634begin
2635  if TAccessCustomRichEdit(RichEdit).PlainText then
2636    inherited LoadFromStream_BOM(Stream, WithBOM)
2637  else
2638    TAccessCustomRichEdit(RichEdit).Lines.LoadFromStream(Stream);
2639end;
2640
2641procedure TTntRichEditStrings.SaveToStream_BOM(Stream: TStream; WithBOM: Boolean);
2642begin
2643  if TAccessCustomRichEdit(RichEdit).PlainText then
2644    inherited SaveToStream_BOM(Stream, WithBOM)
2645  else
2646    TAccessCustomRichEdit(RichEdit).Lines.SaveToStream(Stream);
2647end;
2648
2649procedure TTntRichEditStrings.LoadFromFile(const FileName: WideString);
2650begin
2651  if TAccessCustomRichEdit(RichEdit).PlainText then
2652    inherited LoadFromFile(FileName)
2653  else
2654    TAccessCustomRichEdit(RichEdit).Lines.LoadFromFile(FileName);
2655end;
2656
2657procedure TTntRichEditStrings.SaveToFile(const FileName: WideString);
2658begin
2659  if TAccessCustomRichEdit(RichEdit).PlainText then
2660    inherited SaveToFile(FileName)
2661  else
2662    TAccessCustomRichEdit(RichEdit).Lines.SaveToFile(FileName);
2663end;
2664
2665{ TTntCustomRichEdit }
2666
2667constructor TTntCustomRichEdit.Create(AOwner: TComponent);
2668begin
2669  inherited;
2670  FRichEditStrings := TTntRichEditStrings.Create;
2671  TTntRichEditStrings(FRichEditStrings).FMemo := Self;
2672  TTntRichEditStrings(FRichEditStrings).FMemoLines := TAccessCustomRichEdit(Self).Lines;
2673  TTntRichEditStrings(FRichEditStrings).FLineBreakStyle := Self.LineBreakStyle;
2674  TTntRichEditStrings(FRichEditStrings).RichEdit := Self;
2675end;
2676
2677var
2678  FRichEdit20Module: THandle = 0;
2679
2680function IsRichEdit20Available: Boolean;
2681const
2682  RICHED20_DLL = 'RICHED20.DLL';
2683begin
2684  if FRichEdit20Module = 0 then
2685    FRichEdit20Module := Tnt_LoadLibraryW(RICHED20_DLL);
2686  Result := FRichEdit20Module <> 0;
2687end;
2688
2689{function IsRichEdit30Available: Boolean;
2690begin
2691  Result := False;
2692  exit;
2693  Result := IsRichEdit20Available and (Win32MajorVersion >= 5);
2694end;}
2695
2696procedure TTntCustomRichEdit.CreateParams(var Params: TCreateParams);
2697begin
2698  inherited CreateParams(Params);
2699  if WordWrap then
2700    Params.Style := Params.Style and not WS_HSCROLL; // more compatible with RichEdit 1.0
2701end;
2702
2703procedure TTntCustomRichEdit.CreateWindowHandle(const Params: TCreateParams);
2704begin
2705  if Win32PlatformIsUnicode and IsRichEdit20Available then
2706    CreateUnicodeHandle(Self, Params, RICHEDIT_CLASSW)
2707  else
2708    inherited
2709end;
2710
2711var
2712  AIMM: IActiveIMMApp = nil;
2713
2714function EnableActiveIMM: Boolean;
2715begin
2716  if AIMM <> nil then
2717    Result := True
2718  else begin
2719    Result := False;
2720    try
2721      if ClassIsRegistered(CLASS_CActiveIMM) then begin
2722        AIMM := CoCActiveIMM.Create;
2723        AIMM.Activate(1);
2724        Result := True;
2725      end;
2726    except
2727      AIMM := nil;
2728    end;
2729  end;
2730end;
2731
2732procedure TTntCustomRichEdit.CreateWnd;
2733const
2734  EM_SETEDITSTYLE = WM_USER + 204;
2735  SES_USEAIMM = 64;
2736begin
2737  inherited;
2738  // Only supported in RichEdit 3.0, but this flag is harmless to RichEdit1.0 or RichEdit 2.0
2739  if EnableActiveIMM then
2740    SendMessage(Handle, EM_SETEDITSTYLE, SES_USEAIMM, SES_USEAIMM);
2741end;
2742
2743procedure TTntCustomRichEdit.DefineProperties(Filer: TFiler);
2744begin
2745  inherited;
2746  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
2747end;
2748
2749destructor TTntCustomRichEdit.Destroy;
2750begin
2751  FreeAndNil(FRichEditStrings);
2752  inherited;
2753end;
2754
2755procedure TTntCustomRichEdit.KeyDown(var Key: Word; Shift: TShiftState);
2756begin
2757  inherited;
2758  if (not WantReturns) and (Key = VK_RETURN) and (Shift <> [ssCtrl])  then
2759    Key := 0;
2760end;
2761
2762function TTntCustomRichEdit.LineBreakStyle: TTntTextLineBreakStyle;
2763begin
2764  if Win32PlatformIsUnicode and IsRichEdit20Available then
2765    Result := tlbsCR
2766  else
2767    Result := tlbsCRLF;
2768end;
2769
2770procedure TTntCustomRichEdit.SetRichEditStrings(const Value: TTntStrings);
2771begin
2772  FRichEditStrings.Assign(Value);
2773end;
2774
2775function TTntCustomRichEdit.GetSelText: string{TNT-ALLOW string};
2776begin
2777  Result := GetWideSelText;
2778end;
2779
2780function TTntCustomRichEdit.GetWideSelText: WideString;
2781var
2782  CharRange: TCharRange;
2783  Length: Integer;
2784begin
2785  if (not IsWindowUnicode(Handle)) then
2786    Result := inherited GetSelText
2787  else begin
2788    SendMessageW(Handle, EM_EXGETSEL, 0, Longint(@CharRange));
2789    SetLength(Result, CharRange.cpMax - CharRange.cpMin + 1);
2790    Length := SendMessageW(Handle, EM_GETSELTEXT, 0, Longint(PWideChar(Result)));
2791    SetLength(Result, Length);
2792  end;
2793  if LineBreakStyle <> tlbsCRLF then
2794    Result := TntAdjustLineBreaks(Result, tlbsCRLF)
2795end;
2796
2797type
2798  TSetTextEx = record
2799    flags:dword;
2800    codepage:uint;
2801  end;
2802
2803procedure TTntCustomRichEdit.SetRTFText(Flags: DWORD; const Value: AnsiString);
2804const
2805  EM_SETTEXTEX = (WM_USER + 97);
2806var
2807  Info: TSetTextEx;
2808begin
2809  Info.flags := Flags;
2810  Info.codepage := CP_ACP{TNT-ALLOW CP_ACP};
2811  SendMessage(Handle, EM_SETTEXTEX, Integer(@Info), Integer(PAnsiChar(Value)));
2812end;
2813
2814procedure TTntCustomRichEdit.SetWideSelText(const Value: WideString);
2815const
2816  ST_SELECTION = 2;
2817begin
2818  if Win32PlatformIsUnicode and IsRichEdit20Available and IsRTF(Value) then begin
2819    // emulate RichEdit 1.0 so that RTF code is inserted as RTF (not plain text)
2820    SetRTFText(ST_SELECTION, Value)
2821  end else
2822    TntCustomEdit_SetSelText(Self, TntAdjustLineBreaks(Value, LineBreakStyle));
2823end;
2824
2825function TTntCustomRichEdit.GetText: WideString;
2826begin
2827  Result := TntControl_GetText(Self);
2828  if (LineBreakStyle <> tlbsCRLF) then
2829    Result := TntAdjustLineBreaks(Result, tlbsCRLF);
2830end;
2831
2832procedure TTntCustomRichEdit.SetText(const Value: WideString);
2833const
2834  ST_DEFAULT = 0;
2835begin
2836  if Win32PlatformIsUnicode and IsRichEdit20Available and IsRTF(Value) then begin
2837    // emulate RichEdit 1.0 so that RTF code is inserted as RTF (not plain text)
2838    SetRTFText(ST_DEFAULT, Value)
2839  end else if Value <> Text then
2840    TntControl_SetText(Self, TntAdjustLineBreaks(Value, LineBreakStyle));
2841end;
2842
2843function TTntCustomRichEdit.IsHintStored: Boolean;
2844begin
2845  Result := TntControl_IsHintStored(Self);
2846end;
2847
2848function TTntCustomRichEdit.GetHint: WideString;
2849begin
2850  Result := TntControl_GetHint(Self);
2851end;
2852
2853procedure TTntCustomRichEdit.SetHint(const Value: WideString);
2854begin
2855  TntControl_SetHint(Self, Value);
2856end;
2857
2858procedure TTntCustomRichEdit.WMGetTextLength(var Message: TWMGetTextLength);
2859begin
2860  if FPrintingTextLength <> 0 then
2861    Message.Result := FPrintingTextLength
2862  else
2863    inherited;
2864end;
2865
2866procedure TTntCustomRichEdit.Print(const Caption: string{TNT-ALLOW string});
2867begin
2868  if (LineBreakStyle <> tlbsCRLF) then
2869    FPrintingTextLength := TntAdjustLineBreaksLength(Text, LineBreakStyle)
2870  else
2871    FPrintingTextLength := 0;
2872  try
2873    inherited
2874  finally
2875    FPrintingTextLength := 0;
2876  end;
2877end;
2878
2879{$WARN SYMBOL_DEPRECATED OFF}
2880
2881function TTntCustomRichEdit.CharPosToGet(RawWin32CharPos: Integer): Integer;
2882begin
2883  Result := EmulatedCharPos(RawWin32CharPos);
2884end;
2885
2886function TTntCustomRichEdit.CharPosToSet(EmulatedCharPos: Integer): Integer;
2887begin
2888  Result := RawWin32CharPos(EmulatedCharPos);
2889end;
2890{$WARN SYMBOL_DEPRECATED ON}
2891
2892function TTntCustomRichEdit.EmulatedCharPos(RawWin32CharPos: Integer): Integer;
2893var
2894  i: Integer;
2895  ThisLine: Integer;
2896  CharCount: Integer;
2897  Line_Start: Integer;
2898  NumLineBreaks: Integer;
2899begin
2900  if (LineBreakStyle = tlbsCRLF) or (RawWin32CharPos <= 0) then
2901    Result := RawWin32CharPos
2902  else begin
2903    Assert(Win32PlatformIsUnicode);
2904    ThisLine := SendMessageW(Handle, EM_EXLINEFROMCHAR, 0, RawWin32CharPos);
2905    if (not WordWrap) then
2906      NumLineBreaks := ThisLine
2907    else begin
2908      CharCount := 0;
2909      for i := 0 to ThisLine - 1 do
2910        Inc(CharCount, TntMemo_LineLength(Handle, i));
2911      Line_Start := TntMemo_LineStart(Handle, ThisLine);
2912      NumLineBreaks := Line_Start - CharCount;
2913    end;
2914    Result := RawWin32CharPos + NumLineBreaks; {inflate CR -> CR/LF}
2915  end;
2916end;
2917
2918function TTntCustomRichEdit.RawWin32CharPos(EmulatedCharPos: Integer): Integer;
2919var
2920  Line: Integer;
2921  NumLineBreaks: Integer;
2922  CharCount: Integer;
2923  Line_Start: Integer;
2924  LineLength: Integer;
2925begin
2926  if (LineBreakStyle = tlbsCRLF) or (EmulatedCharPos <= 0) then
2927    Result := EmulatedCharPos
2928  else begin
2929    Assert(Win32PlatformIsUnicode);
2930    NumLineBreaks := 0;
2931    CharCount := 0;
2932    for Line := 0 to Lines.Count do begin
2933      Line_Start := TntMemo_LineStart(Handle, Line);
2934      if EmulatedCharPos < (Line_Start + NumLineBreaks) then
2935        break; {found it (it must have been the line separator)}
2936      if Line_Start > CharCount then begin
2937        Inc(NumLineBreaks);
2938        Inc(CharCount);
2939      end;
2940      LineLength := TntMemo_LineLength(Handle, Line, Line_Start);
2941      Inc(CharCount, LineLength);
2942      if (EmulatedCharPos >= (Line_Start + NumLineBreaks))
2943      and (EmulatedCharPos < (Line_Start + LineLength + NumLineBreaks)) then
2944        break; {found it}
2945    end;
2946    Result := EmulatedCharPos - NumLineBreaks; {deflate CR/LF -> CR}
2947  end;
2948end;
2949
2950function TTntCustomRichEdit.FindText(const SearchStr: WideString;
2951  StartPos, Length: Integer; Options: TSearchTypes): Integer;
2952const
2953  EM_FINDTEXTEXW = WM_USER + 124;
2954const
2955  FR_DOWN        = $00000001;
2956  FR_WHOLEWORD   = $00000002;
2957  FR_MATCHCASE   = $00000004;
2958var
2959  Find: TFindTextW;
2960  Flags: Integer;
2961begin
2962  if (not Win32PlatformIsUnicode) then
2963    Result := inherited FindText(SearchStr, StartPos, Length, Options)
2964  else begin
2965    with Find.chrg do
2966    begin
2967      cpMin := RawWin32CharPos(StartPos);
2968      cpMax := RawWin32CharPos(StartPos + Length);
2969    end;
2970    Flags := FR_DOWN; { RichEdit 2.0 and later needs this }
2971    if stWholeWord in Options then Flags := Flags or FR_WHOLEWORD;
2972    if stMatchCase in Options then Flags := Flags or FR_MATCHCASE;
2973    Find.lpstrText := PWideChar(SearchStr);
2974    Result := SendMessageW(Handle, EM_FINDTEXT, Flags, LongInt(@Find));
2975    Result := EmulatedCharPos(Result);
2976  end;
2977end;
2978
2979function TTntCustomRichEdit.GetSelStart: Integer;
2980begin
2981  Result := TntCustomEdit_GetSelStart(Self);
2982  Result := EmulatedCharPos(Result);
2983end;
2984
2985procedure TTntCustomRichEdit.SetSelStart(const Value: Integer);
2986begin
2987  TntCustomEdit_SetSelStart(Self, RawWin32CharPos(Value));
2988end;
2989
2990function TTntCustomRichEdit.GetSelLength: Integer;
2991var
2992  CharRange: TCharRange;
2993begin
2994  if (LineBreakStyle = tlbsCRLF) then
2995    Result := TntCustomEdit_GetSelLength(Self)
2996  else begin
2997    Assert(Win32PlatformIsUnicode);
2998    SendMessageW(Handle, EM_EXGETSEL, 0, Longint(@CharRange));
2999    Result := EmulatedCharPos(CharRange.cpMax) - EmulatedCharPos(CharRange.cpMin);
3000  end;
3001end;
3002
3003procedure TTntCustomRichEdit.SetSelLength(const Value: Integer);
3004var
3005  StartPos: Integer;
3006  SelEnd: Integer;
3007begin
3008  if (LineBreakStyle = tlbsCRLF) then
3009    TntCustomEdit_SetSelLength(Self, Value)
3010  else begin
3011    StartPos := Self.SelStart;
3012    SelEnd := StartPos + Value;
3013    inherited SetSelLength(RawWin32CharPos(SelEnd) - RawWin32CharPos(StartPos));
3014  end;
3015end;
3016
3017procedure TTntCustomRichEdit.ActionChange(Sender: TObject; CheckDefaults: Boolean);
3018begin
3019  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
3020  inherited;
3021end;
3022
3023function TTntCustomRichEdit.GetActionLinkClass: TControlActionLinkClass;
3024begin
3025  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
3026end;
3027
3028{ TTntTabStrings }
3029
3030type TAccessCustomTabControl = class(TCustomTabControl{TNT-ALLOW TCustomTabControl});
3031
3032type
3033  TTntTabStrings = class(TTntStrings)
3034  private
3035    FTabControl: TCustomTabControl{TNT-ALLOW TCustomTabControl};
3036    FAnsiTabs: TStrings{TNT-ALLOW TStrings};
3037  protected
3038    function Get(Index: Integer): WideString; override;
3039    function GetCount: Integer; override;
3040    function GetObject(Index: Integer): TObject; override;
3041    procedure Put(Index: Integer; const S: WideString); override;
3042    procedure PutObject(Index: Integer; AObject: TObject); override;
3043    procedure SetUpdateState(Updating: Boolean); override;
3044  public
3045    procedure Clear; override;
3046    procedure Delete(Index: Integer); override;
3047    procedure Insert(Index: Integer; const S: WideString); override;
3048  end;
3049
3050procedure TabControlError(const S: WideString);
3051begin
3052  raise EListError.Create(S);
3053end;
3054
3055procedure TTntTabStrings.Clear;
3056begin
3057  FAnsiTabs.Clear;
3058end;
3059
3060procedure TTntTabStrings.Delete(Index: Integer);
3061begin
3062  FAnsiTabs.Delete(Index);
3063end;
3064
3065function TTntTabStrings.GetCount: Integer;
3066begin
3067  Result := FAnsiTabs.Count;
3068end;
3069
3070function TTntTabStrings.GetObject(Index: Integer): TObject;
3071begin
3072  Result := FAnsiTabs.Objects[Index];
3073end;
3074
3075procedure TTntTabStrings.PutObject(Index: Integer; AObject: TObject);
3076begin
3077  FAnsiTabs.Objects[Index] := AObject;
3078end;
3079
3080procedure TTntTabStrings.SetUpdateState(Updating: Boolean);
3081begin
3082  inherited;
3083  TAccessStrings(FAnsiTabs).SetUpdateState(Updating);
3084end;
3085
3086function TTntTabStrings.Get(Index: Integer): WideString;
3087const
3088  RTL: array[Boolean] of LongInt = (0, TCIF_RTLREADING);
3089var
3090  TCItem: TTCItemW;
3091  Buffer: array[0..4095] of WideChar;
3092begin
3093  if (not Win32PlatformIsUnicode) then
3094    Result := FAnsiTabs[Index]
3095  else begin
3096    TCItem.mask := TCIF_TEXT or RTL[FTabControl.UseRightToLeftReading];
3097    TCItem.pszText := Buffer;
3098    TCItem.cchTextMax := SizeOf(Buffer);
3099    if SendMessageW(FTabControl.Handle, TCM_GETITEMW, Index, Longint(@TCItem)) = 0 then
3100      TabControlError(WideFormat(sTabFailRetrieve, [Index]));
3101    Result := Buffer;
3102  end;
3103end;
3104
3105function GetTabControlImageIndex(Self: TCustomTabControl{TNT-ALLOW TCustomTabControl}; TabIndex: Integer): Integer;
3106begin
3107  Result := TabIndex;
3108  with TAccessCustomTabControl(Self) do
3109    if Assigned(OnGetImageIndex) then OnGetImageIndex(Self, TabIndex, Result);
3110end;
3111
3112procedure TTntTabStrings.Put(Index: Integer; const S: WideString);
3113const
3114  RTL: array[Boolean] of LongInt = (0, TCIF_RTLREADING);
3115var
3116  TCItem: TTCItemW;
3117begin
3118  if (not Win32PlatformIsUnicode) then
3119    FAnsiTabs[Index] := S
3120  else begin
3121    TCItem.mask := TCIF_TEXT or RTL[FTabControl.UseRightToLeftReading] or TCIF_IMAGE;
3122    TCItem.pszText := PWideChar(S);
3123    TCItem.iImage := GetTabControlImageIndex(FTabControl, Index);
3124    if SendMessageW(FTabControl.Handle, TCM_SETITEMW, Index, Longint(@TCItem)) = 0 then
3125      TabControlError(WideFormat(sTabFailSet, [S, Index]));
3126    TAccessCustomTabControl(FTabControl).UpdateTabImages;
3127  end;
3128end;
3129
3130procedure TTntTabStrings.Insert(Index: Integer; const S: WideString);
3131const
3132  RTL: array[Boolean] of LongInt = (0, TCIF_RTLREADING);
3133var
3134  TCItem: TTCItemW;
3135begin
3136  if (not Win32PlatformIsUnicode) then
3137    FAnsiTabs.Insert(Index, S)
3138  else begin
3139    TCItem.mask := TCIF_TEXT or RTL[FTabControl.UseRightToLeftReading] or TCIF_IMAGE;
3140    TCItem.pszText := PWideChar(S);
3141    TCItem.iImage := GetTabControlImageIndex(FTabControl, Index);
3142    if SendMessageW(FTabControl.Handle, TCM_INSERTITEMW, Index, Longint(@TCItem)) < 0 then
3143      TabControlError(WideFormat(sTabFailSet, [S, Index]));
3144    TAccessCustomTabControl(FTabControl).UpdateTabImages;
3145  end;
3146end;
3147
3148{ TTntCustomTabControl }
3149
3150constructor TTntCustomTabControl.Create(AOwner: TComponent);
3151begin
3152  inherited;
3153  FTabs := TTntTabStrings.Create;
3154  TTntTabStrings(FTabs).FTabControl := Self;
3155  TTntTabStrings(FTabs).FAnsiTabs := inherited Tabs;
3156end;
3157
3158destructor TTntCustomTabControl.Destroy;
3159begin
3160  TTntTabStrings(FTabs).FTabControl := nil;
3161  TTntTabStrings(FTabs).FAnsiTabs := nil;
3162  FreeAndNil(FTabs);
3163  FreeAndNil(FSaveTabs);
3164  inherited;
3165end;
3166
3167procedure TTntCustomTabControl.CreateWindowHandle(const Params: TCreateParams);
3168begin
3169  CreateUnicodeHandle_ComCtl(Self, Params, WC_TABCONTROL);
3170end;
3171
3172procedure TTntCustomTabControl.DefineProperties(Filer: TFiler);
3173begin
3174  inherited;
3175  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
3176end;
3177
3178procedure TTntCustomTabControl.CreateWnd;
3179begin
3180  inherited;
3181  if FSaveTabs <> nil then
3182  begin
3183    FTabs.Assign(FSaveTabs);
3184    FreeAndNil(FSaveTabs);
3185    TabIndex := FSaveTabIndex;
3186  end;
3187end;
3188
3189procedure TTntCustomTabControl.DestroyWnd;
3190begin
3191  if (FTabs <> nil) and (FTabs.Count > 0) then
3192  begin
3193    FSaveTabs := TTntStringList.Create;
3194    FSaveTabs.Assign(FTabs);
3195    FSaveTabIndex := TabIndex;
3196  end;
3197  inherited;
3198end;
3199
3200function TTntCustomTabControl.GetTabs: TTntStrings;
3201begin
3202  if FSaveTabs <> nil then
3203    Result := FSaveTabs  // Use FSaveTabs while the window is deallocated
3204  else
3205    Result := FTabs;
3206end;
3207
3208procedure TTntCustomTabControl.SetTabs(const Value: TTntStrings);
3209begin
3210  FTabs.Assign(Value);
3211end;
3212
3213function TTntCustomTabControl.IsHintStored: Boolean;
3214begin
3215  Result := TntControl_IsHintStored(Self);
3216end;
3217
3218function TTntCustomTabControl.GetHint: WideString;
3219begin
3220  Result := TntControl_GetHint(Self);
3221end;
3222
3223procedure TTntCustomTabControl.SetHint(const Value: WideString);
3224begin
3225  TntControl_SetHint(Self, Value);
3226end;
3227
3228procedure TTntCustomTabControl.CMDialogChar(var Message: TCMDialogChar);
3229var
3230  I: Integer;
3231begin
3232  for I := 0 to Tabs.Count - 1 do
3233    if IsWideCharAccel(Message.CharCode, Tabs[I]) and CanShowTab(I) and CanFocus then
3234    begin
3235      Message.Result := 1;
3236      if CanChange then
3237      begin
3238        TabIndex := I;
3239        Change;
3240      end;
3241      Exit;
3242    end;
3243  Broadcast(Message);
3244end;
3245
3246procedure TTntCustomTabControl.ActionChange(Sender: TObject; CheckDefaults: Boolean);
3247begin
3248  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
3249  inherited;
3250end;
3251
3252function TTntCustomTabControl.GetActionLinkClass: TControlActionLinkClass;
3253begin
3254  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
3255end;
3256
3257{ TTntTabSheet }
3258
3259procedure TTntTabSheet.CreateWindowHandle(const Params: TCreateParams);
3260begin
3261  CreateUnicodeHandle(Self, Params, '');
3262end;
3263
3264function TTntTabSheet.IsCaptionStored: Boolean;
3265begin
3266  Result := TntControl_IsCaptionStored(Self);
3267end;
3268
3269function TTntTabSheet.GetCaption: TWideCaption;
3270begin
3271  Result := TntControl_GetText(Self);
3272end;
3273
3274procedure TTntTabSheet.SetCaption(const Value: TWideCaption);
3275begin
3276  TntControl_SetText(Self, Value);
3277end;
3278
3279procedure TTntTabSheet.DefineProperties(Filer: TFiler);
3280begin
3281  inherited;
3282  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
3283end;
3284
3285function TTntTabSheet.IsHintStored: Boolean;
3286begin
3287  Result := TntControl_IsHintStored(Self);
3288end;
3289
3290function TTntTabSheet.GetHint: WideString;
3291begin
3292  Result := TntControl_GetHint(Self);
3293end;
3294
3295procedure TTntTabSheet.SetHint(const Value: WideString);
3296begin
3297  TntControl_SetHint(Self, Value);
3298end;
3299
3300procedure TTntTabSheet.WMSetText(var Message: TWMSetText);
3301begin
3302  if (not Win32PlatformIsUnicode)
3303  or (HandleAllocated)
3304  or (Message.Text = AnsiString(TntControl_GetText(Self)))
3305  or (Force_Inherited_WMSETTEXT) then
3306    inherited
3307  else begin
3308    // NT, handle not allocated and text is different
3309    Force_Inherited_WMSETTEXT := True;
3310    try
3311      TntControl_SetText(Self, Message.Text) { sync WideCaption with ANSI Caption }
3312    finally
3313      Force_Inherited_WMSETTEXT := FALSE;
3314    end;
3315  end;
3316end;
3317
3318procedure TTntTabSheet.ActionChange(Sender: TObject; CheckDefaults: Boolean);
3319begin
3320  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
3321  inherited;
3322end;
3323
3324function TTntTabSheet.GetActionLinkClass: TControlActionLinkClass;
3325begin
3326  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
3327end;
3328
3329{ TTntPageControl }
3330
3331procedure TTntPageControl.CreateWindowHandle(const Params: TCreateParams);
3332begin
3333  CreateUnicodeHandle_ComCtl(Self, Params, WC_TABCONTROL);
3334end;
3335
3336procedure TTntPageControl.DefineProperties(Filer: TFiler);
3337begin
3338  inherited;
3339  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
3340end;
3341
3342function TTntPageControl.IsHintStored: Boolean;
3343begin
3344  Result := TntControl_IsHintStored(Self);
3345end;
3346
3347function TTntPageControl.GetHint: WideString;
3348begin
3349  Result := TntControl_GetHint(Self);
3350end;
3351
3352procedure TTntPageControl.SetHint(const Value: WideString);
3353begin
3354  TntControl_SetHint(Self, Value);
3355end;
3356
3357procedure TTntPageControl.WndProc(var Message: TMessage);
3358const
3359  RTL: array[Boolean] of Cardinal = (0, TCIF_RTLREADING);
3360var
3361  TCItemA: PTCItemA;
3362  TabSheet: TTabSheet{TNT-ALLOW TTabSheet};
3363  Text: WideString;
3364begin
3365  if (not Win32PlatformIsUnicode) then
3366    inherited
3367  else begin
3368    case Message.Msg of
3369      TCM_SETITEMA:
3370        begin
3371          TCItemA := PTCItemA(Message.lParam);
3372          if ((TCItemA.mask and TCIF_PARAM) = TCIF_PARAM) then
3373            TabSheet := TObject(TCItemA.lParam) as TTabSheet{TNT-ALLOW TTabSheet}
3374          else if ((TCItemA.mask and TCIF_TEXT) = TCIF_TEXT)
3375          and (Message.wParam >= 0) and (Message.wParam <= Tabs.Count - 1) then
3376            TabSheet := Tabs.Objects[Message.wParam] as TTabSheet{TNT-ALLOW TTabSheet}
3377          else
3378            TabSheet := nil;
3379
3380          if TabSheet = nil then begin
3381            // will always be followed by TCM_SETITEMA(TCIF_PARAM) if TCIF_TEXT is present
3382            TCItemA.mask := TCItemA.mask and (not TCIF_TEXT);
3383          end else begin
3384            // convert message to unicode, add text
3385            Message.Msg := TCM_SETITEMW;
3386            TCItemA.mask := TCItemA.mask or TCIF_TEXT or RTL[UseRightToLeftReading];
3387            if TabSheet is TTntTabSheet then
3388              Text := TTntTabSheet(TabSheet).Caption
3389            else
3390              Text := TabSheet.Caption;
3391            TCItemA.pszText := PAnsiChar(PWideChar(Text));
3392          end;
3393        end;
3394      TCM_INSERTITEMA:
3395        begin
3396          TCItemA := PTCItemA(Message.lParam);
3397          // will always be followed by TCM_SETITEMA(TCIF_PARAM) if TCIF_TEXT is present
3398          TCItemA.mask := TCItemA.mask and (not TCIF_TEXT);
3399        end;
3400    end;
3401    inherited;
3402  end;
3403end;
3404
3405procedure TTntPageControl.CMDialogChar(var Message: TCMDialogChar);
3406var
3407  I: Integer;
3408  TabText: WideString;
3409begin
3410  for I := 0 to PageCount - 1 do begin
3411    if Pages[i] is TTntTabSheet then
3412      TabText := TTntTabSheet(Pages[i]).Caption
3413    else
3414      TabText := Pages[i].Caption;
3415    if IsWideCharAccel(Message.CharCode, TabText) and CanShowTab(Pages[i].TabIndex) and CanFocus then
3416    begin
3417      Message.Result := 1;
3418      if CanChange then
3419      begin
3420        TabIndex := Pages[i].TabIndex;
3421        Change;
3422      end;
3423      Exit;
3424    end;
3425  end;
3426  Broadcast(Message);
3427end;
3428
3429procedure TTntPageControl.CMDockClient(var Message: TCMDockClient);
3430var
3431  IsVisible: Boolean;
3432  DockCtl: TControl;
3433begin
3434  Message.Result := 0;
3435  FNewDockSheet := TTntTabSheet.Create(Self);
3436  try
3437    try
3438      DockCtl := Message.DockSource.Control;
3439      if DockCtl is TCustomForm then
3440        FNewDockSheet.Caption := TntControl_GetText(DockCtl);
3441      FNewDockSheet.PageControl := Self;
3442      DockCtl.Dock(Self, Message.DockSource.DockRect);
3443    except
3444      FNewDockSheet.Free;
3445      raise;
3446    end;
3447    IsVisible := DockCtl.Visible;
3448    FNewDockSheet.TabVisible := IsVisible;
3449    if IsVisible then ActivePage := FNewDockSheet;
3450    DockCtl.Align := alClient;
3451  finally
3452    FNewDockSheet := nil;
3453  end;
3454end;
3455
3456procedure TTntPageControl.DoAddDockClient(Client: TControl; const ARect: TRect);
3457begin
3458  if FNewDockSheet <> nil then
3459    Client.Parent := FNewDockSheet;
3460end;
3461
3462procedure TTntPageControl.CMDockNotification(var Message: TCMDockNotification);
3463var
3464  I: Integer;
3465  S: WideString;
3466  Page: TTabSheet{TNT-ALLOW TTabSheet};
3467begin
3468  Page := GetPageFromDockClient(Message.Client);
3469  if (Message.NotifyRec.ClientMsg <> WM_SETTEXT)
3470  or (Page = nil) or (not (Page is TTntTabSheet)) then
3471    inherited
3472  else begin
3473    if (Message.Client is TWinControl)
3474    and (TWinControl(Message.Client).HandleAllocated)
3475    and IsWindowUnicode(TWinControl(Message.Client).Handle) then
3476      S := PWideChar(Message.NotifyRec.MsgLParam)
3477    else
3478      S := PAnsiChar(Message.NotifyRec.MsgLParam);
3479    { Search for first CR/LF and end string there }
3480    for I := 1 to Length(S) do
3481      if S[I] in [CR, LF] then
3482      begin
3483        SetLength(S, I - 1);
3484        Break;
3485      end;
3486    TTntTabSheet(Page).Caption := S;
3487  end;
3488end;
3489
3490procedure TTntPageControl.ActionChange(Sender: TObject; CheckDefaults: Boolean);
3491begin
3492  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
3493  inherited;
3494end;
3495
3496function TTntPageControl.GetActionLinkClass: TControlActionLinkClass;
3497begin
3498  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
3499end;
3500
3501{ TTntTrackBar }
3502
3503procedure TTntTrackBar.CreateWindowHandle(const Params: TCreateParams);
3504begin
3505  CreateUnicodeHandle_ComCtl(Self, Params, TRACKBAR_CLASS);
3506end;
3507
3508procedure TTntTrackBar.DefineProperties(Filer: TFiler);
3509begin
3510  inherited;
3511  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
3512end;
3513
3514function TTntTrackBar.IsHintStored: Boolean;
3515begin
3516  Result := TntControl_IsHintStored(Self);
3517end;
3518
3519function TTntTrackBar.GetHint: WideString;
3520begin
3521  Result := TntControl_GetHint(Self);
3522end;
3523
3524procedure TTntTrackBar.SetHint(const Value: WideString);
3525begin
3526  TntControl_SetHint(Self, Value);
3527end;
3528
3529procedure TTntTrackBar.ActionChange(Sender: TObject; CheckDefaults: Boolean);
3530begin
3531  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
3532  inherited;
3533end;
3534
3535function TTntTrackBar.GetActionLinkClass: TControlActionLinkClass;
3536begin
3537  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
3538end;
3539
3540{ TTntProgressBar }
3541
3542procedure TTntProgressBar.CreateWindowHandle(const Params: TCreateParams);
3543begin
3544  CreateUnicodeHandle_ComCtl(Self, Params, PROGRESS_CLASS);
3545end;
3546
3547procedure TTntProgressBar.DefineProperties(Filer: TFiler);
3548begin
3549  inherited;
3550  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
3551end;
3552
3553function TTntProgressBar.IsHintStored: Boolean;
3554begin
3555  Result := TntControl_IsHintStored(Self);
3556end;
3557
3558function TTntProgressBar.GetHint: WideString;
3559begin
3560  Result := TntControl_GetHint(Self);
3561end;
3562
3563procedure TTntProgressBar.SetHint(const Value: WideString);
3564begin
3565  TntControl_SetHint(Self, Value);
3566end;
3567
3568procedure TTntProgressBar.ActionChange(Sender: TObject; CheckDefaults: Boolean);
3569begin
3570  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
3571  inherited;
3572end;
3573
3574function TTntProgressBar.GetActionLinkClass: TControlActionLinkClass;
3575begin
3576  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
3577end;
3578
3579{ TTntCustomUpDown }
3580
3581procedure TTntCustomUpDown.CreateWindowHandle(const Params: TCreateParams);
3582begin
3583  CreateUnicodeHandle_ComCtl(Self, Params, UPDOWN_CLASS);
3584end;
3585
3586procedure TTntCustomUpDown.DefineProperties(Filer: TFiler);
3587begin
3588  inherited;
3589  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
3590end;
3591
3592function TTntCustomUpDown.IsHintStored: Boolean;
3593begin
3594  Result := TntControl_IsHintStored(Self);
3595end;
3596
3597function TTntCustomUpDown.GetHint: WideString;
3598begin
3599  Result := TntControl_GetHint(Self);
3600end;
3601
3602procedure TTntCustomUpDown.SetHint(const Value: WideString);
3603begin
3604  TntControl_SetHint(Self, Value);
3605end;
3606
3607procedure TTntCustomUpDown.ActionChange(Sender: TObject; CheckDefaults: Boolean);
3608begin
3609  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
3610  inherited;
3611end;
3612
3613function TTntCustomUpDown.GetActionLinkClass: TControlActionLinkClass;
3614begin
3615  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
3616end;
3617
3618{ TTntDateTimePicker }
3619
3620procedure TTntDateTimePicker.CreateWindowHandle(const Params: TCreateParams);
3621begin
3622  CreateUnicodeHandle_ComCtl(Self, Params, DATETIMEPICK_CLASS);
3623end;
3624
3625procedure TTntDateTimePicker.DefineProperties(Filer: TFiler);
3626begin
3627  inherited;
3628  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
3629end;
3630
3631function TTntDateTimePicker.IsHintStored: Boolean;
3632begin
3633  Result := TntControl_IsHintStored(Self);
3634end;
3635
3636function TTntDateTimePicker.GetHint: WideString;
3637begin
3638  Result := TntControl_GetHint(Self);
3639end;
3640
3641procedure TTntDateTimePicker.SetHint(const Value: WideString);
3642begin
3643  TntControl_SetHint(Self, Value);
3644end;
3645
3646procedure TTntDateTimePicker.ActionChange(Sender: TObject; CheckDefaults: Boolean);
3647begin
3648  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
3649  inherited;
3650end;
3651
3652function TTntDateTimePicker.GetActionLinkClass: TControlActionLinkClass;
3653begin
3654  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
3655end;
3656
3657procedure TTntDateTimePicker.CreateWnd;
3658var
3659  SaveChecked: Boolean;
3660begin
3661  FHadFirstMouseClick := False;
3662  SaveChecked := Checked;
3663  inherited;
3664  // This fixes an issue where TDateTimePicker.CNNotify causes "FChecked := True" to occur
3665  //   during window creation.  This issue results in .Checked to read True even though
3666  //     it is not visually checked.
3667  Checked := SaveChecked;
3668end;
3669
3670procedure TTntDateTimePicker.WMLButtonDown(var Message: TWMLButtonDown);
3671
3672    procedure UpdateValues;
3673    var
3674      Hdr: TNMDateTimeChange;
3675    begin
3676      Hdr.nmhdr.hwndFrom := Handle;
3677      Hdr.nmhdr.idFrom := 0;
3678      Hdr.nmhdr.code := DTN_DATETIMECHANGE;
3679      Hdr.dwFlags := DateTime_GetSystemTime(Handle, Hdr.st);
3680      if (Hdr.dwFlags <> Cardinal(GDT_ERROR)) then begin
3681        if Hdr.dwFlags = GDT_NONE then
3682          ZeroMemory(@Hdr.st, SizeOf(Hdr.st));
3683        Perform(CN_NOTIFY, Integer(Handle), Integer(@Hdr));
3684      end;
3685    end;
3686
3687begin
3688  inherited;
3689  if ShowCheckBox and (not FHadFirstMouseClick) then begin
3690    FHadFirstMouseClick := True;
3691    UpdateValues; // Sometimes the first mouse click doesn't result in WM_NOTIFY.
3692  end;
3693end;
3694
3695{ TTntMonthCalendar }
3696
3697procedure TTntMonthCalendar.CreateWindowHandle(const Params: TCreateParams);
3698begin
3699  CreateUnicodeHandle_ComCtl(Self, Params, MONTHCAL_CLASS);
3700  if Win32PlatformIsUnicode then begin
3701    { For some reason WM_NOTIFY:MCN_GETDAYSTATE never gets called. }
3702    ForceGetMonthInfo;
3703  end;
3704end;
3705
3706procedure TTntMonthCalendar.ForceGetMonthInfo;
3707var
3708  Hdr: TNMDayState;
3709  Days: array of TMonthDayState;
3710  Range: array[1..2] of TSystemTime;
3711begin
3712  // populate Days array
3713  Hdr.nmhdr.hwndFrom := Handle;
3714  Hdr.nmhdr.idFrom := 0;
3715  Hdr.nmhdr.code := MCN_GETDAYSTATE;
3716  Hdr.cDayState := MonthCal_GetMonthRange(Handle, GMR_DAYSTATE, @Range[1]);
3717  Hdr.stStart := Range[1];
3718  SetLength(Days, Hdr.cDayState);
3719  Hdr.prgDayState := @Days[0];
3720  SendMessage(Handle, CN_NOTIFY, Integer(Handle), Integer(@Hdr));
3721  // update day state
3722  SendMessage(Handle, MCM_SETDAYSTATE, Hdr.cDayState, Longint(Hdr.prgDayState))
3723end;
3724
3725procedure TTntMonthCalendar.DefineProperties(Filer: TFiler);
3726begin
3727  inherited;
3728  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
3729end;
3730
3731function TTntMonthCalendar.IsHintStored: Boolean;
3732begin
3733  Result := TntControl_IsHintStored(Self);
3734end;
3735
3736function TTntMonthCalendar.GetHint: WideString;
3737begin
3738  Result := TntControl_GetHint(Self);
3739end;
3740
3741procedure TTntMonthCalendar.SetHint(const Value: WideString);
3742begin
3743  TntControl_SetHint(Self, Value);
3744end;
3745
3746function TTntMonthCalendar.GetDate: TDate;
3747begin
3748  Result := Trunc(inherited Date); { Fixes issue where Date always reflects time of saving dfm. }
3749end;
3750
3751procedure TTntMonthCalendar.SetDate(const Value: TDate);
3752begin
3753  inherited Date := Trunc(Value);
3754end;
3755
3756procedure TTntMonthCalendar.ActionChange(Sender: TObject; CheckDefaults: Boolean);
3757begin
3758  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
3759  inherited;
3760end;
3761
3762function TTntMonthCalendar.GetActionLinkClass: TControlActionLinkClass;
3763begin
3764  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
3765end;
3766
3767{ TTntPageScroller }
3768
3769procedure TTntPageScroller.CreateWindowHandle(const Params: TCreateParams);
3770begin
3771  CreateUnicodeHandle_ComCtl(Self, Params, WC_PAGESCROLLER);
3772end;
3773
3774procedure TTntPageScroller.DefineProperties(Filer: TFiler);
3775begin
3776  inherited;
3777  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
3778end;
3779
3780function TTntPageScroller.IsHintStored: Boolean;
3781begin
3782  Result := TntControl_IsHintStored(Self);
3783end;
3784
3785function TTntPageScroller.GetHint: WideString;
3786begin
3787  Result := TntControl_GetHint(Self);
3788end;
3789
3790procedure TTntPageScroller.SetHint(const Value: WideString);
3791begin
3792  TntControl_SetHint(Self, Value);
3793end;
3794
3795procedure TTntPageScroller.ActionChange(Sender: TObject; CheckDefaults: Boolean);
3796begin
3797  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
3798  inherited;
3799end;
3800
3801function TTntPageScroller.GetActionLinkClass: TControlActionLinkClass;
3802begin
3803  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
3804end;
3805
3806{ TTntStatusPanel }
3807
3808procedure TTntStatusPanel.Assign(Source: TPersistent);
3809begin
3810  inherited;
3811  if Source is TTntStatusPanel then
3812    Text := TTntStatusPanel(Source).Text;
3813end;
3814
3815procedure TTntStatusPanel.DefineProperties(Filer: TFiler);
3816begin
3817  inherited;
3818  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
3819end;
3820
3821function TTntStatusPanel.GetText: Widestring;
3822begin
3823  Result := GetSyncedWideString(FText, inherited Text);
3824end;
3825
3826procedure TTntStatusPanel.SetInheritedText(const Value: AnsiString);
3827begin
3828  inherited Text := Value;
3829end;
3830
3831procedure TTntStatusPanel.SetText(const Value: Widestring);
3832begin
3833  SetSyncedWideString(Value, FText, inherited Text, SetInheritedText);
3834end;
3835
3836{ TTntStatusPanels }
3837
3838function TTntStatusPanels.GetItem(Index: Integer): TTntStatusPanel;
3839begin
3840  Result := (inherited GetItem(Index)) as TTntStatusPanel;
3841end;
3842
3843procedure TTntStatusPanels.SetItem(Index: Integer; Value: TTntStatusPanel);
3844begin
3845  inherited SetItem(Index, Value);
3846end;
3847
3848function TTntStatusPanels.Add: TTntStatusPanel;
3849begin
3850  Result := (inherited Add) as TTntStatusPanel;
3851end;
3852
3853function TTntStatusPanels.AddItem(Item: TTntStatusPanel; Index: Integer): TTntStatusPanel;
3854begin
3855  Result := (inherited AddItem(Item, Index)) as TTntStatusPanel;
3856end;
3857
3858function TTntStatusPanels.Insert(Index: Integer): TTntStatusPanel;
3859begin
3860  Result := (inherited Insert(Index)) as TTntStatusPanel;
3861end;
3862
3863{ TTntCustomStatusBar }
3864
3865function TTntCustomStatusBar.GetHint: WideString;
3866begin
3867  Result := TntControl_GetHint(Self);
3868end;
3869
3870procedure TTntCustomStatusBar.SetHint(const Value: WideString);
3871begin
3872  TntControl_SetHint(Self, Value);
3873end;
3874
3875function TTntCustomStatusBar.IsHintStored: Boolean;
3876begin
3877  Result := TntControl_IsHintStored(Self);
3878end;
3879
3880function TTntCustomStatusBar.CreatePanels: TStatusPanels{TNT-ALLOW TStatusPanels};
3881begin
3882  Result := TTntStatusPanels.Create(Self);
3883end;
3884
3885function TTntCustomStatusBar.GetPanelClass: TStatusPanelClass;
3886begin
3887  Result := TTntStatusPanel;
3888end;
3889
3890function TTntCustomStatusBar.SyncLeadingTabs(const WideVal: WideString; const AnsiVal: AnsiString): WideString;
3891
3892  function CountLeadingTabs(const Val: WideString): Integer;
3893  var
3894    i: integer;
3895  begin
3896    Result := 0;
3897    for i := 1 to Length(Val) do begin
3898      if Val[i] <> #9 then break;
3899      Inc(Result);
3900    end;
3901  end;
3902
3903var
3904  AnsiTabCount: Integer;
3905  WideTabCount: Integer;
3906begin
3907  AnsiTabCount := CountLeadingTabs(AnsiVal);
3908  WideTabCount := CountLeadingTabs(WideVal);
3909  Result := WideVal;
3910  while WideTabCount < AnsiTabCount do begin
3911    Insert(#9, Result, 1);
3912    Inc(WideTabCount);
3913  end;
3914  while WideTabCount > AnsiTabCount do begin
3915    Delete(Result, 1, 1);
3916    Dec(WideTabCount);
3917  end;
3918end;
3919
3920function TTntCustomStatusBar.GetSimpleText: WideString;
3921begin
3922  FSimpleText := SyncLeadingTabs(FSimpleText, inherited SimpleText);
3923  Result := GetSyncedWideString(FSimpleText, inherited SimpleText);
3924end;
3925
3926procedure TTntCustomStatusBar.SetInheritedSimpleText(const Value: AnsiString);
3927begin
3928  inherited SimpleText := Value;
3929end;
3930
3931procedure TTntCustomStatusBar.SetSimpleText(const Value: WideString);
3932begin
3933  SetSyncedWideString(Value, FSimpleText, inherited SimpleText, SetInheritedSimpleText);
3934end;
3935
3936procedure TTntCustomStatusBar.DefineProperties(Filer: TFiler);
3937begin
3938  inherited;
3939  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
3940end;
3941
3942procedure TTntCustomStatusBar.CreateWindowHandle(const Params: TCreateParams);
3943begin
3944  CreateUnicodeHandle_ComCtl(Self, Params, STATUSCLASSNAME);
3945end;
3946
3947procedure TTntCustomStatusBar.WndProc(var Msg: TMessage);
3948const
3949  SB_SIMPLEID = Integer($FF);
3950var
3951  iPart: Integer;
3952  szText: PAnsiChar;
3953  WideText: WideString;
3954begin
3955  if Win32PlatformIsUnicode and (Msg.Msg = SB_SETTEXTA) and ((Msg.WParam and SBT_OWNERDRAW) = 0)
3956  then begin
3957    // convert SB_SETTEXTA message to Unicode
3958    iPart := (Msg.WParam and SB_SIMPLEID);
3959    szText := PAnsiChar(Msg.LParam);
3960    if iPart = SB_SIMPLEID then
3961      WideText := SimpleText
3962    else if Panels.Count > 0 then
3963      WideText := Panels[iPart].Text
3964    else begin
3965      WideText := szText;
3966    end;
3967    WideText := SyncLeadingTabs(WideText, szText);
3968    Msg.Result := SendMessageW(Handle, SB_SETTEXTW, Msg.wParam, Integer(PWideChar(WideText)));
3969  end else
3970    inherited;
3971end;
3972
3973procedure TTntCustomStatusBar.WMGetTextLength(var Message: TWMGetTextLength);
3974begin
3975  Message.Result := Length(SimpleText);
3976end;
3977
3978procedure TTntCustomStatusBar.ActionChange(Sender: TObject; CheckDefaults: Boolean);
3979begin
3980  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
3981  inherited;
3982end;
3983
3984function TTntCustomStatusBar.GetActionLinkClass: TControlActionLinkClass;
3985begin
3986  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
3987end;
3988
3989function TTntCustomStatusBar.GetPanels: TTntStatusPanels;
3990begin
3991  Result := inherited Panels as TTntStatusPanels;
3992end;
3993
3994procedure TTntCustomStatusBar.SetPanels(const Value: TTntStatusPanels);
3995begin
3996  inherited Panels := Value;
3997end;
3998
3999function TTntCustomStatusBar.ExecuteAction(Action: TBasicAction): Boolean;
4000begin
4001  if AutoHint and (Action is TTntHintAction) and not DoHint then
4002  begin
4003    if SimplePanel or (Panels.Count = 0) then
4004      SimpleText := TTntHintAction(Action).Hint else
4005      Panels[0].Text := TTntHintAction(Action).Hint;
4006    Result := True;
4007  end
4008  else Result := inherited ExecuteAction(Action);
4009end;
4010
4011{ TTntStatusBar }
4012
4013function TTntStatusBar.GetOnDrawPanel: TDrawPanelEvent;
4014begin
4015  Result := TDrawPanelEvent(inherited OnDrawPanel);
4016end;
4017
4018procedure TTntStatusBar.SetOnDrawPanel(const Value: TDrawPanelEvent);
4019begin
4020  inherited OnDrawPanel := TCustomDrawPanelEvent(Value);
4021end;
4022
4023{ TTntTreeNode }
4024
4025function TTntTreeNode.IsEqual(Node: TTntTreeNode): Boolean;
4026begin
4027  Result := (Text = Node.Text) and (Data = Node.Data);
4028end;
4029
4030procedure TTntTreeNode.ReadData(Stream: TStream; Info: PNodeInfo);
4031var
4032  I, Size, ItemCount: Integer;
4033  LNode: TTntTreeNode;
4034  Utf8Text: AnsiString;
4035begin
4036  Owner.ClearCache;
4037  Stream.ReadBuffer(Size, SizeOf(Size));
4038  Stream.ReadBuffer(Info^, Size);
4039
4040  if Pos(UTF8_BOM, Info^.Text) = 1 then begin
4041    Utf8Text := Copy(Info^.Text, Length(UTF8_BOM) + 1, MaxInt);
4042    try
4043      Text := UTF8ToWideString(Utf8Text);
4044    except
4045      Text := Utf8Text;
4046    end;
4047  end else
4048    Text := Info^.Text;
4049
4050  ImageIndex := Info^.ImageIndex;
4051  SelectedIndex := Info^.SelectedIndex;
4052  StateIndex := Info^.StateIndex;
4053  OverlayIndex := Info^.OverlayIndex;
4054  Data := Info^.Data;
4055  ItemCount := Info^.Count;
4056  for I := 0 to ItemCount - 1 do
4057  begin
4058    LNode := Owner.AddChild(Self, '');
4059    LNode.ReadData(Stream, Info);
4060    Owner.Owner.Added(LNode);
4061  end;
4062end;
4063
4064procedure TTntTreeNode.WriteData(Stream: TStream; Info: PNodeInfo);
4065var
4066  I, Size, L, ItemCount: Integer;
4067  WideLen: Integer; Utf8Text: AnsiString;
4068begin
4069  WideLen := 255;
4070  repeat
4071    Utf8Text := UTF8_BOM + WideStringToUTF8(Copy(Text, 1, WideLen));
4072    L := Length(Utf8Text);
4073    Dec(WideLen);
4074  until
4075    L <= 255;
4076
4077  Size := SizeOf(TNodeInfo) + L - 255;
4078  Info^.Text := Utf8Text;
4079  Info^.ImageIndex := ImageIndex;
4080  Info^.SelectedIndex := SelectedIndex;
4081  Info^.OverlayIndex := OverlayIndex;
4082  Info^.StateIndex := StateIndex;
4083  Info^.Data := Data;
4084  ItemCount := Count;
4085  Info^.Count := ItemCount;
4086  Stream.WriteBuffer(Size, SizeOf(Size));
4087  Stream.WriteBuffer(Info^, Size);
4088  for I := 0 to ItemCount - 1 do
4089    Item[I].WriteData(Stream, Info);
4090end;
4091
4092procedure TTntTreeNode.Assign(Source: TPersistent);
4093var
4094  Node: TTntTreeNode;
4095begin
4096  inherited;
4097  if (not Deleting) and (Source is TTntTreeNode) then
4098  begin
4099    Node := TTntTreeNode(Source);
4100    Text := Node.Text;
4101  end;
4102end;
4103
4104function TTntTreeNode.GetText: WideString;
4105begin
4106  Result := GetSyncedWideString(FText, inherited Text);
4107end;
4108
4109procedure TTntTreeNode.SetInheritedText(const Value: AnsiString);
4110begin
4111  inherited Text := Value;
4112end;
4113
4114procedure TTntTreeNode.SetText(const Value: WideString);
4115begin
4116  SetSyncedWideString(Value, FText, inherited Text, SetInheritedText);
4117end;
4118
4119function TTntTreeNode.getFirstChild: TTntTreeNode;
4120begin
4121  Result := inherited getFirstChild as TTntTreeNode;
4122end;
4123
4124function TTntTreeNode.GetItem(Index: Integer): TTntTreeNode;
4125begin
4126  Result := inherited Item[Index] as TTntTreeNode;
4127end;
4128
4129procedure TTntTreeNode.SetItem(Index: Integer; const Value: TTntTreeNode);
4130begin
4131  inherited Item[Index] := Value;
4132end;
4133
4134function TTntTreeNode.GetLastChild: TTntTreeNode;
4135begin
4136  Result := inherited GetLastChild as TTntTreeNode;
4137end;
4138
4139function TTntTreeNode.GetNext: TTntTreeNode;
4140begin
4141  Result := inherited GetNext as TTntTreeNode;
4142end;
4143
4144function TTntTreeNode.GetNextChild(Value: TTntTreeNode): TTntTreeNode;
4145begin
4146  Result := inherited GetNextChild(Value) as TTntTreeNode;
4147end;
4148
4149function TTntTreeNode.getNextSibling: TTntTreeNode;
4150begin
4151  Result := inherited getNextSibling  as TTntTreeNode;
4152end;
4153
4154function TTntTreeNode.GetNextVisible: TTntTreeNode;
4155begin
4156  Result := inherited GetNextVisible as TTntTreeNode;
4157end;
4158
4159function TTntTreeNode.GetNodeOwner: TTntTreeNodes;
4160begin
4161  Result := inherited Owner as TTntTreeNodes;
4162end;
4163
4164function TTntTreeNode.GetParent: TTntTreeNode;
4165begin
4166  Result := inherited Parent as TTntTreeNode;
4167end;
4168
4169function TTntTreeNode.GetPrev: TTntTreeNode;
4170begin
4171  Result := inherited GetPrev as TTntTreeNode;
4172end;
4173
4174function TTntTreeNode.GetPrevChild(Value: TTntTreeNode): TTntTreeNode;
4175begin
4176  Result := inherited GetPrevChild(Value) as TTntTreeNode;
4177end;
4178
4179function TTntTreeNode.getPrevSibling: TTntTreeNode;
4180begin
4181  Result := inherited getPrevSibling as TTntTreeNode;
4182end;
4183
4184function TTntTreeNode.GetPrevVisible: TTntTreeNode;
4185begin
4186  Result := inherited GetPrevVisible as TTntTreeNode;
4187end;
4188
4189function TTntTreeNode.GetTreeView: TTntCustomTreeView;
4190begin
4191  Result := inherited TreeView as TTntCustomTreeView;
4192end;
4193
4194{ TTntTreeNodesEnumerator }
4195
4196constructor TTntTreeNodesEnumerator.Create(ATreeNodes: TTntTreeNodes);
4197begin
4198  inherited Create;
4199  FIndex := -1;
4200  FTreeNodes := ATreeNodes;
4201end;
4202
4203function TTntTreeNodesEnumerator.GetCurrent: TTntTreeNode;
4204begin
4205  Result := FTreeNodes[FIndex];
4206end;
4207
4208function TTntTreeNodesEnumerator.MoveNext: Boolean;
4209begin
4210  Result := FIndex < FTreeNodes.Count - 1;
4211  if Result then
4212    Inc(FIndex);
4213end;
4214
4215{ TTntTreeNodes }
4216
4217{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
4218type
4219  THackTreeNodes = class(TPersistent)
4220  protected
4221    FxxxOwner: TCustomTreeView{TNT-ALLOW TCustomTreeView};
4222    FxxxUpdateCount: Integer;
4223    FNodeCache: TNodeCache;
4224    FReading: Boolean;
4225  end;
4226{$ENDIF}
4227{$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
4228type
4229  THackTreeNodes = class(TPersistent)
4230  protected
4231    FxxxOwner: TCustomTreeView{TNT-ALLOW TCustomTreeView};
4232    FxxxUpdateCount: Integer;
4233    FNodeCache: TNodeCache;
4234    FReading: Boolean;
4235  end;
4236{$ENDIF}
4237{$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
4238type
4239  THackTreeNodes = class(TPersistent)
4240  protected
4241    FxxxOwner: TCustomTreeView{TNT-ALLOW TCustomTreeView};
4242    FxxxUpdateCount: Integer;
4243    FNodeCache: TNodeCache;
4244    FReading: Boolean;
4245  end;
4246{$ENDIF}
4247{$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
4248type
4249  THackTreeNodes = class(TPersistent)
4250  protected
4251    FxxxOwner: TCustomTreeView{TNT-ALLOW TCustomTreeView};
4252    FxxxUpdateCount: Integer;
4253    FNodeCache: TNodeCache;
4254    FReading: Boolean;
4255  end;
4256{$ENDIF}
4257
4258procedure SaveNodeTextToStrings(Nodes: TTntTreeNodes; sList: TTntStrings);
4259var
4260  ANode: TTntTreeNode;
4261begin
4262  sList.Clear;
4263  if Nodes.Count > 0 then
4264  begin
4265    ANode := Nodes[0];
4266    while ANode <> nil do
4267    begin
4268      sList.Add(ANode.Text);
4269      ANode := ANode.GetNext;
4270    end;
4271  end;
4272end;
4273
4274procedure TTntTreeNodes.Assign(Source: TPersistent);
4275var
4276  TreeNodes: TTntTreeNodes;
4277  MemStream: TTntMemoryStream;
4278begin
4279  ClearCache;
4280  if Source is TTntTreeNodes then
4281  begin
4282    TreeNodes := TTntTreeNodes(Source);
4283    Clear;
4284    MemStream := TTntMemoryStream.Create;
4285    try
4286      TreeNodes.WriteData(MemStream);
4287      MemStream.Position := 0;
4288      ReadData(MemStream);
4289    finally
4290      MemStream.Free;
4291    end;
4292  end else
4293    inherited Assign(Source);
4294end;
4295
4296function TTntTreeNodes.GetNodeFromIndex(Index: Integer): TTntTreeNode;
4297begin
4298  Result := inherited Item[Index] as TTntTreeNode;
4299end;
4300
4301function TTntTreeNodes.AddChildFirst(Parent: TTntTreeNode; const S: WideString): TTntTreeNode;
4302begin
4303  Result := AddNode(nil, Parent, S, nil, naAddChildFirst);
4304end;
4305
4306function TTntTreeNodes.AddChildObjectFirst(Parent: TTntTreeNode; const S: WideString;
4307  Ptr: Pointer): TTntTreeNode;
4308begin
4309  Result := AddNode(nil, Parent, S, Ptr, naAddChildFirst);
4310end;
4311
4312function TTntTreeNodes.AddChild(Parent: TTntTreeNode; const S: WideString): TTntTreeNode;
4313begin
4314  Result := AddNode(nil, Parent, S, nil, naAddChild);
4315end;
4316
4317function TTntTreeNodes.AddChildObject(Parent: TTntTreeNode; const S: WideString;
4318  Ptr: Pointer): TTntTreeNode;
4319begin
4320  Result := AddNode(nil, Parent, S, Ptr, naAddChild);
4321end;
4322
4323function TTntTreeNodes.AddFirst(Sibling: TTntTreeNode; const S: WideString): TTntTreeNode;
4324begin
4325  Result := AddNode(nil, Sibling, S, nil, naAddFirst);
4326end;
4327
4328function TTntTreeNodes.AddObjectFirst(Sibling: TTntTreeNode; const S: WideString;
4329  Ptr: Pointer): TTntTreeNode;
4330begin
4331  Result := AddNode(nil, Sibling, S, Ptr, naAddFirst);
4332end;
4333
4334function TTntTreeNodes.Add(Sibling: TTntTreeNode; const S: WideString): TTntTreeNode;
4335begin
4336  Result := AddNode(nil, Sibling, S, nil, naAdd);
4337end;
4338
4339function TTntTreeNodes.AddObject(Sibling: TTntTreeNode; const S: WideString;
4340  Ptr: Pointer): TTntTreeNode;
4341begin
4342  Result := AddNode(nil, Sibling, S, Ptr, naAdd);
4343end;
4344
4345function TTntTreeNodes.Insert(Sibling: TTntTreeNode; const S: WideString): TTntTreeNode;
4346begin
4347  Result := AddNode(nil, Sibling, S, nil, naInsert);
4348end;
4349
4350function TTntTreeNodes.InsertObject(Sibling: TTntTreeNode; const S: WideString;
4351  Ptr: Pointer): TTntTreeNode;
4352begin
4353  Result := AddNode(nil, Sibling, S, Ptr, naInsert);
4354end;
4355
4356function TTntTreeNodes.InsertNode(Node, Sibling: TTntTreeNode; const S: WideString;
4357  Ptr: Pointer): TTntTreeNode;
4358begin
4359  Result := AddNode(Node, Sibling, S, Ptr, naInsert);
4360end;
4361
4362function TTntTreeNodes.AddNode(Node, Relative: TTntTreeNode; const S: WideString;
4363  Ptr: Pointer; Method: TNodeAttachMode): TTntTreeNode;
4364begin
4365  Result := inherited AddNode(Node, Relative, '', Ptr, Method) as TTntTreeNode;
4366  Result.Text := S;
4367end;
4368
4369function TTntTreeNodes.GetNode(ItemId: HTreeItem): TTntTreeNode;
4370begin
4371  Result := inherited GetNode(ItemID) as TTntTreeNode;
4372end;
4373
4374function TTntTreeNodes.GetFirstNode: TTntTreeNode;
4375begin
4376  Result := inherited GetFirstNode as TTntTreeNode;
4377end;
4378
4379function TTntTreeNodes.GetEnumerator: TTntTreeNodesEnumerator;
4380begin
4381  Result := TTntTreeNodesEnumerator.Create(Self);
4382end;
4383
4384function TTntTreeNodes.GetNodesOwner: TTntCustomTreeView;
4385begin
4386  Result := inherited Owner as TTntCustomTreeView;
4387end;
4388
4389procedure TTntTreeNodes.ClearCache;
4390begin
4391  THackTreeNodes(Self).FNodeCache.CacheNode := nil;
4392end;
4393
4394procedure TTntTreeNodes.DefineProperties(Filer: TFiler);
4395
4396  function WriteNodes: Boolean;
4397  var
4398    I: Integer;
4399    Nodes: TTntTreeNodes;
4400  begin
4401    Nodes := TTntTreeNodes(Filer.Ancestor);
4402    if Nodes = nil then
4403      Result := Count > 0
4404    else if Nodes.Count <> Count then
4405      Result := True
4406    else
4407    begin
4408      Result := False;
4409      for I := 0 to Count - 1 do
4410      begin
4411        Result := not Item[I].IsEqual(Nodes[I]);
4412        if Result then
4413          Break;
4414      end
4415    end;
4416  end;
4417
4418begin
4419  inherited DefineProperties(Filer);
4420  Filer.DefineBinaryProperty('Utf8Data', ReadData, WriteData, WriteNodes);
4421end;
4422
4423procedure TTntTreeNodes.ReadData(Stream: TStream);
4424var
4425  I, Count: Integer;
4426  NodeInfo: TNodeInfo;
4427  LNode: TTntTreeNode;
4428  LHandleAllocated: Boolean;
4429begin
4430  LHandleAllocated := Owner.HandleAllocated;
4431  if LHandleAllocated then
4432    BeginUpdate;
4433  THackTreeNodes(Self).FReading := True;
4434  try
4435    Clear;
4436    Stream.ReadBuffer(Count, SizeOf(Count));
4437    for I := 0 to Count - 1 do
4438    begin
4439      LNode := Add(nil, '');
4440      LNode.ReadData(Stream, @NodeInfo);
4441      Owner.Added(LNode);
4442    end;
4443  finally
4444    THackTreeNodes(Self).FReading := False;
4445    if LHandleAllocated then
4446      EndUpdate;
4447  end;
4448end;
4449
4450procedure TTntTreeNodes.WriteData(Stream: TStream);
4451var
4452  I: Integer;
4453  Node: TTntTreeNode;
4454  NodeInfo: TNodeInfo;
4455begin
4456  I := 0;
4457  Node := GetFirstNode;
4458  while Node <> nil do
4459  begin
4460    Inc(I);
4461    Node := Node.GetNextSibling;
4462  end;
4463  Stream.WriteBuffer(I, SizeOf(I));
4464  Node := GetFirstNode;
4465  while Node <> nil do
4466  begin
4467    Node.WriteData(Stream, @NodeInfo);
4468    Node := Node.GetNextSibling;
4469  end;
4470end;
4471
4472{ TTntTreeStrings }
4473
4474type
4475  TTntTreeStrings = class(TTntStringList)
4476  protected
4477    function GetBufStart(Buffer: PWideChar; var Level: Integer): PWideChar;
4478  public
4479    procedure SaveToTree(Tree: TTntCustomTreeView);
4480    procedure LoadFromTree(Tree: TTntCustomTreeView);
4481  end;
4482
4483function TTntTreeStrings.GetBufStart(Buffer: PWideChar; var Level: Integer): PWideChar;
4484begin
4485  Level := 0;
4486  while Buffer^ in [WideChar(' '), WideChar(#9)] do
4487  begin
4488    Inc(Buffer);
4489    Inc(Level);
4490  end;
4491  Result := Buffer;
4492end;
4493
4494procedure TTntTreeStrings.SaveToTree(Tree: TTntCustomTreeView);
4495var
4496  ANode, NextNode: TTntTreeNode;
4497  ALevel, i: Integer;
4498  CurrStr: WideString;
4499  Owner: TTntTreeNodes;
4500begin
4501  Owner := Tree.Items;
4502  Owner.BeginUpdate;
4503  try
4504    try
4505      Owner.Clear;
4506      ANode := nil;
4507      for i := 0 to Count - 1 do
4508      begin
4509        CurrStr := GetBufStart(PWideChar(Strings[i]), ALevel);
4510        if ANode = nil then
4511          ANode := Owner.AddChild(nil, CurrStr)
4512        else if ANode.Level = ALevel then
4513          ANode := Owner.AddChild(ANode.Parent, CurrStr)
4514        else if ANode.Level = (ALevel - 1) then
4515          ANode := Owner.AddChild(ANode, CurrStr)
4516        else if ANode.Level > ALevel then
4517        begin
4518          NextNode := ANode.Parent;
4519          while NextNode.Level > ALevel do
4520            NextNode := NextNode.Parent;
4521          ANode := Owner.AddChild(NextNode.Parent, CurrStr);
4522        end
4523        else
4524          raise ETreeViewError.CreateFmt(sInvalidLevelEx, [ALevel, CurrStr]);
4525      end;
4526    finally
4527      Owner.EndUpdate;
4528    end;
4529  except
4530    Owner.Owner.Invalidate;  // force repaint on exception
4531    raise;
4532  end;
4533end;
4534
4535procedure TTntTreeStrings.LoadFromTree(Tree: TTntCustomTreeView);
4536const
4537  TabChar = #9;
4538var
4539  i: Integer;
4540  ANode: TTntTreeNode;
4541  NodeStr: WideString;
4542  Owner: TTntTreeNodes;
4543begin
4544  Clear;
4545  Owner := Tree.Items;
4546  if Owner.Count > 0 then
4547  begin
4548    ANode := Owner[0];
4549    while ANode <> nil do
4550    begin
4551      NodeStr := '';
4552      for i := 0 to ANode.Level - 1 do NodeStr := NodeStr + TabChar;
4553      NodeStr := NodeStr + ANode.Text;
4554      Add(NodeStr);
4555      ANode := ANode.GetNext;
4556    end;
4557  end;
4558end;
4559
4560{ _TntInternalCustomTreeView }
4561
4562function _TntInternalCustomTreeView.FindNextToSelect: TTreeNode{TNT-ALLOW TTreeNode};
4563begin
4564  Result := Wide_FindNextToSelect;
4565end;
4566
4567function _TntInternalCustomTreeView.Inherited_FindNextToSelect: TTreeNode{TNT-ALLOW TTreeNode};
4568begin
4569  Result := inherited FindNextToSelect;
4570end;
4571
4572{ TTntCustomTreeView }
4573
4574function TntDefaultTreeViewSort(Node1, Node2: TTntTreeNode; lParam: Integer): Integer; stdcall;
4575begin
4576  with Node1 do
4577    if Assigned(TreeView.OnCompare) then
4578      TreeView.OnCompare(TreeView, Node1, Node2, lParam, Result)
4579    else Result := lstrcmpw(PWideChar(Node1.Text), PWideChar(Node2.Text));
4580end;
4581
4582constructor TTntCustomTreeView.Create(AOwner: TComponent);
4583begin
4584  inherited;
4585  FEditInstance := Classes.MakeObjectInstance(EditWndProcW);
4586end;
4587
4588destructor TTntCustomTreeView.Destroy;
4589begin
4590  Destroying;
4591  Classes.FreeObjectInstance(FEditInstance);
4592  FreeAndNil(FSavedNodeText);
4593  inherited;
4594end;
4595
4596var
4597  ComCtrls_DefaultTreeViewSort: TTVCompare = nil;
4598
4599procedure TTntCustomTreeView.CreateWindowHandle(const Params: TCreateParams);
4600
4601  procedure Capture_ComCtrls_DefaultTreeViewSort;
4602  begin
4603    FTestingForSortProc := True;
4604    try
4605      AlphaSort;
4606    finally
4607      FTestingForSortProc := False;
4608    end;
4609  end;
4610
4611begin
4612  CreateUnicodeHandle_ComCtl(Self, Params, WC_TREEVIEW);
4613  if (Win32PlatformIsUnicode) then begin
4614    if not Assigned(ComCtrls_DefaultTreeViewSort) then
4615      Capture_ComCtrls_DefaultTreeViewSort;
4616  end;
4617end;
4618
4619procedure TTntCustomTreeView.CreateWnd;
4620begin
4621  inherited;
4622  if FSavedNodeText <> nil then begin
4623    FreeAndNil(FSavedNodeText);
4624    SortType := FSavedSortType;
4625  end;
4626end;
4627
4628procedure TTntCustomTreeView.DestroyWnd;
4629begin
4630  if (not (csDestroying in ComponentState)) then begin
4631    FSavedNodeText := TTntStringList.Create;
4632    FSavedSortType := SortType;
4633    SortType := stNone; // when recreating window, we are expecting items to come back in same order
4634    SaveNodeTextToStrings(Items, FSavedNodeText);
4635  end;
4636  inherited;
4637end;
4638
4639procedure TTntCustomTreeView.DefineProperties(Filer: TFiler);
4640begin
4641  inherited;
4642  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
4643end;
4644
4645function TTntCustomTreeView.IsHintStored: Boolean;
4646begin
4647  Result := TntControl_IsHintStored(Self);
4648end;
4649
4650function TTntCustomTreeView.GetHint: WideString;
4651begin
4652  Result := TntControl_GetHint(Self)
4653end;
4654
4655procedure TTntCustomTreeView.SetHint(const Value: WideString);
4656begin
4657  TntControl_SetHint(Self, Value);
4658end;
4659
4660procedure TTntCustomTreeView.ActionChange(Sender: TObject; CheckDefaults: Boolean);
4661begin
4662  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
4663  inherited;
4664end;
4665
4666function TTntCustomTreeView.GetActionLinkClass: TControlActionLinkClass;
4667begin
4668  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
4669end;
4670
4671function TTntCustomTreeView.CreateNode: TTreeNode{TNT-ALLOW TTreeNode};
4672var
4673  LClass: TClass;
4674  TntLClass: TTntTreeNodeClass;
4675begin
4676  LClass := TTntTreeNode;
4677  if Assigned(OnCreateNodeClass) then
4678    OnCreateNodeClass(Self, TTreeNodeClass(LClass));
4679  if not LClass.InheritsFrom(TTntTreeNode) then
4680    raise ETntInternalError.Create('Internal Error: OnCreateNodeClass.ItemClass must inherit from TTntTreeNode.');
4681  TntLClass := TTntTreeNodeClass(LClass);
4682  Result := TntLClass.Create(inherited Items);
4683end;
4684
4685function TTntCustomTreeView.CreateNodes: TTreeNodes{TNT-ALLOW TTreeNodes};
4686begin
4687  Result := TTntTreeNodes.Create(Self);
4688end;
4689
4690function TTntCustomTreeView.GetTreeNodes: TTntTreeNodes;
4691begin
4692  Result := inherited Items as TTntTreeNodes;
4693end;
4694
4695procedure TTntCustomTreeView.SetTreeNodes(const Value: TTntTreeNodes);
4696begin
4697  Items.Assign(Value);
4698end;
4699
4700function TTntCustomTreeView.GetNodeFromItem(const Item: TTVItem): TTntTreeNode;
4701begin
4702  Result := nil;
4703  if Items <> nil then
4704    with Item do
4705      if (state and TVIF_PARAM) <> 0 then
4706        Result := Pointer(lParam)
4707      else
4708        Result := Items.GetNode(hItem);
4709end;
4710
4711function TTntCustomTreeView.Wide_FindNextToSelect: TTntTreeNode;
4712begin
4713  Result := FindNextToSelect;
4714end;
4715
4716function TTntCustomTreeView.FindNextToSelect: TTntTreeNode;
4717begin
4718  Result := Inherited_FindNextToSelect as TTntTreeNode;
4719end;
4720
4721function TTntCustomTreeView.GetDropTarget: TTntTreeNode;
4722begin
4723  Result := inherited DropTarget as TTntTreeNode;
4724end;
4725
4726function TTntCustomTreeView.GetNodeAt(X, Y: Integer): TTntTreeNode;
4727begin
4728  Result := inherited GetNodeAt(X, Y) as TTntTreeNode;
4729end;
4730
4731function TTntCustomTreeView.GetSelected: TTntTreeNode;
4732begin
4733  Result := inherited Selected as TTntTreeNode;
4734end;
4735
4736function TTntCustomTreeView.GetSelection(Index: Integer): TTntTreeNode;
4737begin
4738  Result := inherited Selections[Index] as TTntTreeNode;
4739end;
4740
4741function TTntCustomTreeView.GetSelections(AList: TList): TTntTreeNode;
4742begin
4743  Result := inherited GetSelections(AList) as TTntTreeNode;
4744end;
4745
4746function TTntCustomTreeView.GetTopItem: TTntTreeNode;
4747begin
4748  Result := inherited TopItem as TTntTreeNode;
4749end;
4750
4751procedure TTntCustomTreeView.SetDropTarget(const Value: TTntTreeNode);
4752begin
4753  inherited DropTarget := Value;
4754end;
4755
4756procedure TTntCustomTreeView.SetSelected(const Value: TTntTreeNode);
4757begin
4758  inherited Selected := Value;
4759end;
4760
4761procedure TTntCustomTreeView.SetTopItem(const Value: TTntTreeNode);
4762begin
4763  inherited TopItem := Value;
4764end;
4765
4766procedure TTntCustomTreeView.WndProc(var Message: TMessage);
4767type
4768  PTVSortCB = ^TTVSortCB;
4769begin
4770  with Message do begin
4771    // capture ANSI version of DefaultTreeViewSort from ComCtrls
4772    if (FTestingForSortProc)
4773    and (Msg = TVM_SORTCHILDRENCB) then begin
4774      ComCtrls_DefaultTreeViewSort := PTVSortCB(lParam).lpfnCompare;
4775      exit;
4776    end;
4777
4778    if (Win32PlatformIsUnicode)
4779    and (Msg = TVM_SORTCHILDRENCB)
4780    and (@PTVSortCB(lParam).lpfnCompare = @ComCtrls_DefaultTreeViewSort) then
4781    begin
4782      // Unicode:: call wide version of sort proc instead
4783      PTVSortCB(lParam)^.lpfnCompare := TTVCompare(@TntDefaultTreeViewSort);
4784      Result := SendMessageW(Handle, TVM_SORTCHILDRENCB, wParam, lParam);
4785    end else
4786      inherited;
4787  end;
4788end;
4789
4790procedure TTntCustomTreeView.CNNotify(var Message: TWMNotify);
4791var
4792  Node: TTntTreeNode;
4793begin
4794  if (not Win32PlatformIsUnicode) then
4795    inherited
4796  else begin
4797    with Message do begin
4798      case NMHdr^.code of
4799        TVN_BEGINDRAGW:
4800          begin
4801            NMHdr^.code := TVN_BEGINDRAGA;
4802            try
4803              inherited;
4804            finally
4805              NMHdr^.code := TVN_BEGINDRAGW;
4806            end;
4807          end;
4808        TVN_BEGINLABELEDITW:
4809          begin
4810            with PTVDispInfo(NMHdr)^ do
4811              if Dragging or not CanEdit(GetNodeFromItem(item)) then
4812                Result := 1;
4813            if Result = 0 then
4814            begin
4815              FEditHandle := TreeView_GetEditControl(Handle);
4816              FDefEditProc := Pointer(GetWindowLongW(FEditHandle, GWL_WNDPROC));
4817              SetWindowLongW(FEditHandle, GWL_WNDPROC, LongInt(FEditInstance));
4818            end;
4819          end;
4820        TVN_ENDLABELEDITW:
4821          Edit(PTVDispInfo(NMHdr)^.item);
4822        TVN_ITEMEXPANDINGW:
4823          begin
4824            NMHdr^.code := TVN_ITEMEXPANDINGA;
4825            try
4826              inherited;
4827            finally
4828              NMHdr^.code := TVN_ITEMEXPANDINGW;
4829            end;
4830          end;
4831        TVN_ITEMEXPANDEDW:
4832          begin
4833            NMHdr^.code := TVN_ITEMEXPANDEDA;
4834            try
4835              inherited;
4836            finally
4837              NMHdr^.code := TVN_ITEMEXPANDEDW;
4838            end;
4839          end;
4840        TVN_DELETEITEMW:
4841          begin
4842            NMHdr^.code := TVN_DELETEITEMA;
4843            try
4844              inherited;
4845            finally
4846              NMHdr^.code := TVN_DELETEITEMW;
4847            end;
4848          end;
4849        TVN_SETDISPINFOW:
4850          with PTVDispInfo(NMHdr)^ do
4851          begin
4852            Node := GetNodeFromItem(item);
4853            if (Node <> nil) and ((item.mask and TVIF_TEXT) <> 0) then
4854              Node.Text := TTVItemW(item).pszText;
4855          end;
4856        TVN_GETDISPINFOW:
4857          with PTVDispInfo(NMHdr)^ do
4858          begin
4859            Node := GetNodeFromItem(item);
4860            if Node <> nil then
4861            begin
4862              if (item.mask and TVIF_TEXT) <> 0 then begin
4863                if (FSavedNodeText <> nil)
4864                and (FSavedNodeText.Count > 0)
4865                and (AnsiString(FSavedNodeText[0]) = AnsiString(Node.Text)) then
4866                begin
4867                  Node.FText := FSavedNodeText[0]; // recover saved text
4868                  FSavedNodeText.Delete(0);
4869                end;
4870                WStrLCopy(TTVItemW(item).pszText, PWideChar(Node.Text), item.cchTextMax - 1);
4871              end;
4872
4873              if (item.mask and TVIF_IMAGE) <> 0 then
4874              begin
4875                GetImageIndex(Node);
4876                item.iImage := Node.ImageIndex;
4877              end;
4878              if (item.mask and TVIF_SELECTEDIMAGE) <> 0 then
4879              begin
4880                GetSelectedIndex(Node);
4881                item.iSelectedImage := Node.SelectedIndex;
4882              end;
4883            end;
4884          end;
4885        else
4886          inherited;
4887      end;
4888    end;
4889  end;
4890end;
4891
4892procedure TTntCustomTreeView.WMNotify(var Message: TWMNotify);
4893var
4894  Node: TTntTreeNode;
4895  FWideText: WideString;
4896  MaxTextLen: Integer;
4897  Pt: TPoint;
4898begin
4899  with Message do
4900    if NMHdr^.code = TTN_NEEDTEXTW then
4901    begin
4902      // Work around NT COMCTL32 problem with tool tips >= 80 characters
4903      GetCursorPos(Pt);
4904      Pt := ScreenToClient(Pt);
4905      Node := GetNodeAt(Pt.X, Pt.Y);
4906      if (Node = nil) or (Node.Text = '') or
4907        (PToolTipTextW(NMHdr)^.uFlags and TTF_IDISHWND = 0) then Exit;
4908      if (GetComCtlVersion >= ComCtlVersionIE4)
4909      or {Borland's VCL wrongly uses "and"} (Length(Node.Text) < 80) then
4910      begin
4911        DefaultHandler(Message);
4912        Exit;
4913      end;
4914      FWideText := Node.Text;
4915      MaxTextLen := SizeOf(PToolTipTextW(NMHdr)^.szText) div SizeOf(WideChar);
4916      if Length(FWideText) >= MaxTextLen then
4917        SetLength(FWideText, MaxTextLen - 1);
4918      PToolTipTextW(NMHdr)^.lpszText := PWideChar(FWideText);
4919      FillChar(PToolTipTextW(NMHdr)^.szText, MaxTextLen, 0);
4920      Move(Pointer(FWideText)^, PToolTipTextW(NMHdr)^.szText, Length(FWideText) * SizeOf(WideChar));
4921      PToolTipTextW(NMHdr)^.hInst := 0;
4922      SetWindowPos(NMHdr^.hwndFrom, HWND_TOP, 0, 0, 0, 0, SWP_NOACTIVATE or
4923        SWP_NOSIZE or SWP_NOMOVE or SWP_NOOWNERZORDER);
4924      Result := 1;
4925    end
4926    else inherited;
4927end;
4928
4929procedure TTntCustomTreeView.Edit(const Item: TTVItem);
4930var
4931  S: WideString;
4932  AnsiS: AnsiString;
4933  Node: TTntTreeNode;
4934  AnsiEvent: TTVEditedEvent;
4935begin
4936  with Item do
4937  begin
4938    Node := GetNodeFromItem(Item);
4939    if pszText <> nil then
4940    begin
4941      if Win32PlatformIsUnicode then
4942        S := TTVItemW(Item).pszText
4943      else
4944        S := pszText;
4945
4946      if Assigned(FOnEdited) then
4947        FOnEdited(Self, Node, S)
4948      else if Assigned(inherited OnEdited) then
4949      begin
4950        AnsiEvent := inherited OnEdited;
4951        AnsiS := S;
4952        AnsiEvent(Self, Node, AnsiS);
4953        S := AnsiS;
4954      end;
4955
4956      if Node <> nil then Node.Text := S;
4957    end
4958    else if Assigned(OnCancelEdit) then
4959      OnCancelEdit(Self, Node);
4960  end;
4961end;
4962
4963procedure TTntCustomTreeView.EditWndProcW(var Message: TMessage);
4964begin
4965  Assert(Win32PlatformIsUnicode);
4966  try
4967    with Message do
4968    begin
4969      case Msg of
4970        WM_KEYDOWN,
4971        WM_SYSKEYDOWN: if DoKeyDown(TWMKey(Message)) then Exit;
4972        WM_CHAR:
4973          begin
4974            MakeWMCharMsgSafeForAnsi(Message);
4975            try
4976              if DoKeyPress(TWMKey(Message)) then Exit;
4977            finally
4978              RestoreWMCharMsg(Message);
4979            end;
4980          end;
4981        WM_KEYUP,
4982        WM_SYSKEYUP: if DoKeyUp(TWMKey(Message)) then Exit;
4983        CN_KEYDOWN,
4984        CN_CHAR, CN_SYSKEYDOWN,
4985        CN_SYSCHAR:
4986          begin
4987            WndProc(Message);
4988            Exit;
4989          end;
4990      end;
4991      Result := CallWindowProcW(FDefEditProc, FEditHandle, Msg, WParam, LParam);
4992    end;
4993  except
4994    Application.HandleException(Self);
4995  end;
4996end;
4997
4998procedure TTntCustomTreeView.LoadFromFile(const FileName: WideString);
4999var
5000  TreeStrings: TTntTreeStrings;
5001begin
5002  TreeStrings := TTntTreeStrings.Create;
5003  try
5004    TreeStrings.LoadFromFile(FileName);
5005    TreeStrings.SaveToTree(Self);
5006  finally
5007    TreeStrings.Free;
5008  end;
5009end;
5010
5011procedure TTntCustomTreeView.LoadFromStream(Stream: TStream);
5012var
5013  TreeStrings: TTntTreeStrings;
5014begin
5015  TreeStrings := TTntTreeStrings.Create;
5016  try
5017    TreeStrings.LoadFromStream(Stream);
5018    TreeStrings.SaveToTree(Self);
5019  finally
5020    TreeStrings.Free;
5021  end;
5022end;
5023
5024procedure TTntCustomTreeView.SaveToFile(const FileName: WideString);
5025var
5026  TreeStrings: TTntTreeStrings;
5027begin
5028  TreeStrings := TTntTreeStrings.Create;
5029  try
5030    TreeStrings.LoadFromTree(Self);
5031    TreeStrings.SaveToFile(FileName);
5032  finally
5033    TreeStrings.Free;
5034  end;
5035end;
5036
5037procedure TTntCustomTreeView.SaveToStream(Stream: TStream);
5038var
5039  TreeStrings: TTntTreeStrings;
5040begin
5041  TreeStrings := TTntTreeStrings.Create;
5042  try
5043    TreeStrings.LoadFromTree(Self);
5044    TreeStrings.SaveToStream(Stream);
5045  finally
5046    TreeStrings.Free;
5047  end;
5048end;
5049
5050initialization
5051
5052finalization
5053  if Assigned(AIMM) then
5054    AIMM.Deactivate;
5055  if FRichEdit20Module <> 0 then
5056    FreeLibrary(FRichEdit20Module);
5057
5058end.
Note: See TracBrowser for help on using the repository browser.