Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

TntComCtrls.pas@ 672

Last change on this file since 672 was 672, checked in by Kevin Toppenberg, 14 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
12	unit TntComCtrls;
13
14	{$INCLUDE TntCompilers.inc}
15
16	interface
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
25	uses
26	Classes, Controls, ListActns, Menus, ComCtrls, Messages,
27	Windows, CommCtrl, Contnrs, TntControls, TntClasses, Graphics, TntSysUtils;
28
29	type
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
315	type
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
339	type
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
368	type
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
497	type
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
591	type
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
773	type
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
888	type
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
1140	implementation
1141
1142	uses
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
1153	procedure CreateUnicodeHandle_ComCtl(Control: TWinControl; const Params: TCreateParams;
1154	const SubClass: WideString);
1155	begin
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);
1160	end;
1161
1162	{ TTntListColumn }
1163
1164	procedure TTntListColumn.Assign(Source: TPersistent);
1165	begin
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;
1171	end;
1172
1173	procedure TTntListColumn.DefineProperties(Filer: TFiler);
1174	begin
1175	inherited;
1176	TntPersistent_AfterInherited_DefineProperties(Filer, Self);
1177	end;
1178
1179	procedure TTntListColumn.SetInheritedCaption(const Value: AnsiString);
1180	begin
1181	inherited Caption := Value;
1182	end;
1183
1184	function TTntListColumn.GetCaption: WideString;
1185	begin
1186	Result := GetSyncedWideString(FCaption, inherited Caption);
1187	end;
1188
1189	procedure TTntListColumn.SetCaption(const Value: WideString);
1190	begin
1191	SetSyncedWideString(Value, FCaption, inherited Caption, SetInheritedCaption);
1192	end;
1193
1194	{ TTntListColumns }
1195
1196	{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
1197	type
1198	THackCollection = class(TPersistent)
1199	protected
1200	FItemClass: TCollectionItemClass;
1201	end;
1202	{$ENDIF}
1203	{$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
1204	type
1205	THackCollection = class(TPersistent)
1206	protected
1207	FItemClass: TCollectionItemClass;
1208	end;
1209	{$ENDIF}
1210	{$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
1211	type
1212	THackCollection = class(TPersistent)
1213	protected
1214	FItemClass: TCollectionItemClass;
1215	end;
1216	{$ENDIF}
1217	{$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
1218	type
1219	THackCollection = class(TPersistent)
1220	protected
1221	FItemClass: TCollectionItemClass;
1222	end;
1223	{$ENDIF}
1224
1225	constructor TTntListColumns.Create(AOwner: TTntCustomListView);
1226	begin
1227	inherited Create(AOwner);
1228	Assert(THackCollection(Self).FItemClass = Self.ItemClass, 'Internal Error in TTntListColumns.Create().');
1229	THackCollection(Self).FItemClass := TTntListColumn
1230	end;
1231
1232	function TTntListColumns.Owner: TTntCustomListView;
1233	begin
1234	Result := inherited Owner as TTntCustomListView;
1235	end;
1236
1237	function TTntListColumns.Add: TTntListColumn;
1238	begin
1239	Result := (inherited Add) as TTntListColumn;
1240	end;
1241
1242	function TTntListColumns.GetItem(Index: Integer): TTntListColumn;
1243	begin
1244	Result := inherited Items[Index] as TTntListColumn;
1245	end;
1246
1247	procedure TTntListColumns.SetItem(Index: Integer; Value: TTntListColumn);
1248	begin
1249	inherited SetItem(Index, Value);
1250	end;
1251
1252	{ TWideSubItems }
1253	type
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
1273	constructor TWideSubItems.Create(AOwner: TTntListItem);
1274	begin
1275	inherited Create;
1276	FInheritedOwner := AOwner;
1277	FOwner := AOwner;
1278	end;
1279
1280	function TWideSubItems.AddObject(const S: WideString; AObject: TObject): Integer;
1281	begin
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;
1290	end;
1291
1292	procedure TWideSubItems.Clear;
1293	begin
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;
1302	end;
1303
1304	procedure TWideSubItems.Delete(Index: Integer);
1305	begin
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;
1314	end;
1315
1316	procedure TWideSubItems.Insert(Index: Integer; const S: WideString);
1317	begin
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;
1326	end;
1327
1328	procedure TWideSubItems.Put(Index: Integer; const S: WideString);
1329	begin
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;
1338	end;
1339
1340	function TWideSubItems.GetObject(Index: Integer): TObject;
1341	begin
1342	Result := FInheritedOwner.SubItems.Objects[Index];
1343	end;
1344
1345	procedure TWideSubItems.PutObject(Index: Integer; AObject: TObject);
1346	begin
1347	FInheritedOwner.SubItems.Objects[Index] := AObject;
1348	end;
1349
1350	type TAccessStrings = class(TStrings{TNT-ALLOW TStrings});
1351
1352	procedure TWideSubItems.SetUpdateState(Updating: Boolean);
1353	begin
1354	inherited;
1355	TAccessStrings(FInheritedOwner.SubItems).SetUpdateState(Updating);
1356	end;
1357
1358	{ TTntListItem }
1359
1360	constructor TTntListItem.Create(AOwner: TListItems{TNT-ALLOW TListItems});
1361	begin
1362	inherited Create(AOwner);
1363	FSubItems := TWideSubItems.Create(Self);
1364	end;
1365
1366	destructor TTntListItem.Destroy;
1367	begin
1368	inherited;
1369	FreeAndNil(FSubItems);
1370	end;
1371
1372	function TTntListItem.GetCaption: WideString;
1373	begin
1374	Result := GetSyncedWideString(FCaption, inherited Caption);
1375	end;
1376
1377	procedure TTntListItem.SetInheritedCaption(const Value: AnsiString);
1378	begin
1379	inherited Caption := Value;
1380	end;
1381
1382	procedure TTntListItem.SetCaption(const Value: WideString);
1383	begin
1384	ListView.BeginChangingWideItem;
1385	try
1386	SetSyncedWideString(Value, FCaption, inherited Caption, SetInheritedCaption);
1387	finally
1388	ListView.EndChangingWideItem;
1389	end;
1390	end;
1391
1392	procedure TTntListItem.Assign(Source: TPersistent);
1393	begin
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);
1407	end;
1408
1409	procedure TTntListItem.SetSubItems(const Value: TTntStrings);
1410	begin
1411	if Value <> nil then
1412	FSubItems.Assign(Value);
1413	end;
1414
1415	function TTntListItem.GetTntOwner: TTntListItems;
1416	begin
1417	Result := ListView.Items;
1418	end;
1419
1420	function TTntListItem.GetListView: TTntCustomListView;
1421	begin
1422	Result := ((inherited Owner).Owner as TTntCustomListView);
1423	end;
1424
1425	{ TTntListItemsEnumerator }
1426
1427	constructor TTntListItemsEnumerator.Create(AListItems: TTntListItems);
1428	begin
1429	inherited Create;
1430	FIndex := -1;
1431	FListItems := AListItems;
1432	end;
1433
1434	function TTntListItemsEnumerator.GetCurrent: TTntListItem;
1435	begin
1436	Result := FListItems[FIndex];
1437	end;
1438
1439	function TTntListItemsEnumerator.MoveNext: Boolean;
1440	begin
1441	Result := FIndex < FListItems.Count - 1;
1442	if Result then
1443	Inc(FIndex);
1444	end;
1445
1446	{ TTntListItems }
1447
1448	function TTntListItems.Add: TTntListItem;
1449	begin
1450	Result := (inherited Add) as TTntListItem;
1451	end;
1452
1453	function TTntListItems.AddItem(Item: TTntListItem; Index: Integer): TTntListItem;
1454	begin
1455	Result := (inherited AddItem(Item, Index)) as TTntListItem;
1456	end;
1457
1458	function TTntListItems.Insert(Index: Integer): TTntListItem;
1459	begin
1460	Result := (inherited Insert(Index)) as TTntListItem;
1461	end;
1462
1463	function TTntListItems.GetItem(Index: Integer): TTntListItem;
1464	begin
1465	Result := (inherited Item[Index]) as TTntListItem;
1466	end;
1467
1468	function TTntListItems.Owner: TTntCustomListView;
1469	begin
1470	Result := (inherited Owner) as TTntCustomListView;
1471	end;
1472
1473	procedure TTntListItems.SetItem(Index: Integer; const Value: TTntListItem);
1474	begin
1475	inherited Item[Index] := Value;
1476	end;
1477
1478	function TTntListItems.GetEnumerator: TTntListItemsEnumerator;
1479	begin
1480	Result := TTntListItemsEnumerator.Create(Self);
1481	end;
1482
1483	{ TSavedListItem }
1484	type
1485	TSavedListItem = class
1486	FCaption: WideString;
1487	FSubItems: TTntStrings;
1488	constructor Create;
1489	destructor Destroy; override;
1490	end;
1491
1492	constructor TSavedListItem.Create;
1493	begin
1494	inherited;
1495	FSubItems := TTntStringList.Create;
1496	end;
1497
1498	destructor TSavedListItem.Destroy;
1499	begin
1500	FSubItems.Free;
1501	inherited;
1502	end;
1503
1504	{ _TntInternalCustomListView }
1505
1506	function _TntInternalCustomListView.OwnerDataFind(Find: TItemFind;
1507	const FindString: AnsiString; const FindPosition: TPoint;
1508	FindData: Pointer; StartIndex: Integer; Direction: TSearchDirection;
1509	Wrap: Boolean): Integer;
1510	var
1511	WideFindString: WideString;
1512	begin
1513	if Assigned(PWideFindString) then
1514	WideFindString := PWideFindString
1515	else
1516	WideFindString := FindString;
1517	Result := OwnerDataFindW(Find, WideFindString, FindPosition, FindData, StartIndex, Direction, Wrap);
1518	end;
1519
1520	function _TntInternalCustomListView.OwnerDataFetch(Item: TListItem{TNT-ALLOW TListItem};
1521	Request: TItemRequest): Boolean;
1522	begin
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);
1529	end;
1530
1531	{ TTntCustomListView }
1532
1533	{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
1534	type
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
1558	type
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
1582	type
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
1606	type
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
1631	var
1632	ComCtrls_DefaultListViewSort: TLVCompare = nil;
1633
1634	constructor TTntCustomListView.Create(AOwner: TComponent);
1635	begin
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);
1642	end;
1643
1644	destructor TTntCustomListView.Destroy;
1645	begin
1646	inherited;
1647	Classes.FreeObjectInstance(FEditInstance);
1648	FreeAndNil(FSavedItems);
1649	end;
1650
1651	procedure 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
1663	var
1664	Column: TLVColumn;
1665	begin
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;
1675	end;
1676
1677	procedure TTntCustomListView.DefineProperties(Filer: TFiler);
1678	begin
1679	inherited;
1680	TntPersistent_AfterInherited_DefineProperties(Filer, Self);
1681	end;
1682
1683	procedure TTntCustomListView.CreateWnd;
1684	begin
1685	inherited;
1686	FreeAndNil(FSavedItems);
1687	end;
1688
1689	procedure TTntCustomListView.DestroyWnd;
1690	var
1691	i: integer;
1692	FSavedItem: TSavedListItem;
1693	Item: TTntListItem;
1694	begin
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;
1707	end;
1708
1709	function TTntCustomListView.GetDropTarget: TTntListItem;
1710	begin
1711	Result := inherited DropTarget as TTntListItem;
1712	end;
1713
1714	procedure TTntCustomListView.SetDropTarget(const Value: TTntListItem);
1715	begin
1716	inherited DropTarget := Value;
1717	end;
1718
1719	function TTntCustomListView.GetItemFocused: TTntListItem;
1720	begin
1721	Result := inherited ItemFocused as TTntListItem;
1722	end;
1723
1724	procedure TTntCustomListView.SetItemFocused(const Value: TTntListItem);
1725	begin
1726	inherited ItemFocused := Value;
1727	end;
1728
1729	function TTntCustomListView.GetSelected: TTntListItem;
1730	begin
1731	Result := inherited Selected as TTntListItem;
1732	end;
1733
1734	procedure TTntCustomListView.SetSelected(const Value: TTntListItem);
1735	begin
1736	inherited Selected := Value;
1737	end;
1738
1739	function TTntCustomListView.GetTopItem: TTntListItem;
1740	begin
1741	Result := inherited TopItem as TTntListItem;
1742	end;
1743
1744	function TTntCustomListView.GetListColumns: TTntListColumns;
1745	begin
1746	Result := inherited Columns as TTntListColumns;
1747	end;
1748
1749	procedure TTntCustomListView.SetListColumns(const Value: TTntListColumns);
1750	begin
1751	inherited Columns := Value;
1752	end;
1753
1754	{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
1755	type
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
1770	type
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
1785	type
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
1800	type
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
1815	function TTntCustomListView.GetColumnFromTag(Tag: Integer): TTntListColumn;
1816	var
1817	I: Integer;
1818	begin
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;
1825	end;
1826
1827	function TTntCustomListView.ColumnFromIndex(Index: Integer): TTntListColumn;
1828	begin
1829	Result := inherited Column[Index] as TTntListColumn;
1830	end;
1831
1832	function TTntCustomListView.AreItemsStored: Boolean;
1833	begin
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;
1843	end;
1844
1845	function TTntCustomListView.GetItems: TTntListItems;
1846	begin
1847	Result := inherited Items as TTntListItems;
1848	end;
1849
1850	procedure TTntCustomListView.SetItems(Value: TTntListItems);
1851	begin
1852	inherited Items := Value;
1853	end;
1854
1855	type TTntListItemClass = class of TTntListItem;
1856
1857	function TTntCustomListView.CreateListItem: TListItem{TNT-ALLOW TListItem};
1858	var
1859	LClass: TClass;
1860	TntLClass: TTntListItemClass;
1861	begin
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. }
1872	end;
1873
1874	function TTntCustomListView.CreateListItems: TListItems{TNT-ALLOW TListItems};
1875	begin
1876	Result := TTntListItems.Create(Self);
1877	end;
1878
1879	function TTntCustomListView.GetItemW(Value: TLVItemW): TTntListItem;
1880	begin
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;
1891	end;
1892
1893	function TTntCustomListView.OwnerDataFetchW(Item: TListItem{TNT-ALLOW TListItem}; Request: TItemRequest): Boolean;
1894	begin
1895	Result := OwnerDataFetch(Item, Request);
1896	end;
1897
1898	function TTntCustomListView.OwnerDataFetch(Item: TListItem{TNT-ALLOW TListItem}; Request: TItemRequest): Boolean;
1899	begin
1900	if Assigned(OnData) then
1901	begin
1902	OnData(Self, Item);
1903	Result := True;
1904	end
1905	else Result := False;
1906	end;
1907
1908	function TntDefaultListViewSort(Item1, Item2: TTntListItem; lParam: Integer): Integer; stdcall;
1909	begin
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));
1915	end;
1916
1917	procedure TTntCustomListView.WndProc(var Message: TMessage);
1918	var
1919	Item: TTntListItem;
1920	InheritedItem: TListItem{TNT-ALLOW TListItem};
1921	SubItem: Integer;
1922	SavedItem: TSavedListItem;
1923	PCol: PLVColumn;
1924	Col: TTntListColumn;
1925	begin
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;
2026	end;
2027
2028	procedure TTntCustomListView.WMNotify(var Message: TWMNotify);
2029	begin
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;
2053	end;
2054
2055	procedure TTntCustomListView.CNNotify(var Message: TWMNotify);
2056	var
2057	Item: TTntListItem;
2058	begin
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;
2161	end;
2162
2163	function TTntCustomListView.OwnerDataFindW(Find: TItemFind;
2164	const FindString: WideString; const FindPosition: TPoint;
2165	FindData: Pointer; StartIndex: Integer; Direction: TSearchDirection;
2166	Wrap: Boolean): Integer;
2167	begin
2168	Result := OwnerDataFind(Find, FindString, FindPosition, FindData, StartIndex, Direction, Wrap);
2169	end;
2170
2171	function TTntCustomListView.OwnerDataFind(Find: TItemFind; const FindString: WideString;
2172	const FindPosition: TPoint; FindData: Pointer; StartIndex: Integer;
2173	Direction: TSearchDirection; Wrap: Boolean): Integer;
2174	var
2175	AnsiEvent: TLVOwnerDataFindEvent;
2176	begin
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;
2185	end;
2186
2187	procedure TTntCustomListView.Edit(const Item: TLVItem);
2188	var
2189	S: WideString;
2190	AnsiS: AnsiString;
2191	EditItem: TTntListItem;
2192	AnsiEvent: TLVEditedEvent;
2193	begin
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;
2210	end;
2211
2212	procedure TTntCustomListView.EditWndProcW(var Message: TMessage);
2213	begin
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;
2245	end;
2246
2247	procedure TTntCustomListView.BeginChangingWideItem;
2248	begin
2249	Inc(FChangingWideItemCount);
2250	end;
2251
2252	procedure TTntCustomListView.EndChangingWideItem;
2253	begin
2254	if FChangingWideItemCount > 0 then
2255	Dec(FChangingWideItemCount);
2256	end;
2257
2258	procedure TTntCustomListView.DrawItem(Item: TListItem{TNT-ALLOW TListItem}; Rect: TRect;
2259	State: TOwnerDrawState);
2260	begin
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;
2268	end;
2269
2270	procedure TTntCustomListView.CopySelection(Destination: TCustomListControl);
2271	var
2272	I: Integer;
2273	begin
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);
2277	end;
2278
2279	procedure TTntCustomListView.AddItem(const Item: WideString; AObject: TObject);
2280	begin
2281	with Items.Add do
2282	begin
2283	Caption := Item;
2284	Data := AObject;
2285	end;
2286	end;
2287
2288	//-------------
2289
2290	function TTntCustomListView.FindCaption(StartIndex: Integer; Value: WideString;
2291	Partial, Inclusive, Wrap: Boolean): TTntListItem;
2292	const
2293	FullString: array[Boolean] of Integer = (0, LVFI_PARTIAL);
2294	Wraps: array[Boolean] of Integer = (0, LVFI_WRAP);
2295	var
2296	Info: TLVFindInfoW;
2297	Index: Integer;
2298	begin
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;
2312	end;
2313
2314	function TTntCustomListView.StringWidth(S: WideString): Integer;
2315	begin
2316	if (not Win32PlatformIsUnicode) then
2317	Result := inherited StringWidth(S)
2318	else
2319	Result := SendMessageW(Handle, LVM_GETSTRINGWIDTHW, 0, Longint(PWideChar(S)))
2320	end;
2321
2322	function TTntCustomListView.GetSearchString: WideString;
2323	var
2324	Buffer: array[0..1023] of WideChar;
2325	begin
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;
2334	end;
2335
2336	function TTntCustomListView.IsHintStored: Boolean;
2337	begin
2338	Result := TntControl_IsHintStored(Self);
2339	end;
2340
2341	function TTntCustomListView.GetHint: WideString;
2342	begin
2343	Result := TntControl_GetHint(Self)
2344	end;
2345
2346	procedure TTntCustomListView.SetHint(const Value: WideString);
2347	begin
2348	TntControl_SetHint(Self, Value);
2349	end;
2350
2351	procedure TTntCustomListView.ActionChange(Sender: TObject; CheckDefaults: Boolean);
2352	begin
2353	TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
2354	inherited;
2355	end;
2356
2357	function TTntCustomListView.GetActionLinkClass: TControlActionLinkClass;
2358	begin
2359	Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
2360	end;
2361
2362	{ TTntToolButton }
2363
2364	procedure TTntToolButton.DefineProperties(Filer: TFiler);
2365	begin
2366	inherited;
2367	TntPersistent_AfterInherited_DefineProperties(Filer, Self);
2368	end;
2369
2370	procedure TTntToolButton.CMVisibleChanged(var Message: TMessage);
2371	begin
2372	inherited;
2373	RefreshControl;
2374	end;
2375
2376	function TTntToolButton.GetCaption: TWideCaption;
2377	begin
2378	Result := TntControl_GetText(Self);
2379	end;
2380
2381	procedure TTntToolButton.SetCaption(const Value: TWideCaption);
2382	begin
2383	TntControl_SetText(Self, Value);
2384	RefreshControl; { causes button to be removed and reinserted with TB_INSERTBUTTON }
2385	end;
2386
2387	function TTntToolButton.IsCaptionStored: Boolean;
2388	begin
2389	Result := TntControl_IsCaptionStored(Self)
2390	end;
2391
2392	function TTntToolButton.GetHint: WideString;
2393	begin
2394	Result := TntControl_GetHint(Self)
2395	end;
2396
2397	procedure TTntToolButton.SetHint(const Value: WideString);
2398	begin
2399	TntControl_SetHint(Self, Value);
2400	end;
2401
2402	function TTntToolButton.IsHintStored: Boolean;
2403	begin
2404	Result := TntControl_IsHintStored(Self)
2405	end;
2406
2407	procedure TTntToolButton.CMHintShow(var Message: TMessage);
2408	begin
2409	ProcessCMHintShowMsg(Message);
2410	inherited;
2411	end;
2412
2413	procedure TTntToolButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
2414	begin
2415	TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
2416	inherited;
2417	end;
2418
2419	function TTntToolButton.GetActionLinkClass: TControlActionLinkClass;
2420	begin
2421	Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
2422	end;
2423
2424	function TTntToolButton.GetMenuItem: TMenuItem{TNT-ALLOW TMenuItem};
2425	begin
2426	Result := inherited MenuItem;
2427	end;
2428
2429	procedure TTntToolButton.SetMenuItem(const Value: TMenuItem{TNT-ALLOW TMenuItem});
2430	begin
2431	inherited MenuItem := Value;
2432	if Value is TTntMenuItem then begin
2433	Caption := TTntMenuItem(Value).Caption;
2434	Hint := TTntMenuItem(Value).Hint;
2435	end;
2436	end;
2437
2438	{ TTntToolBar }
2439
2440	procedure TTntToolBar.CreateWindowHandle(const Params: TCreateParams);
2441	begin
2442	CreateUnicodeHandle_ComCtl(Self, Params, TOOLBARCLASSNAME);
2443	end;
2444
2445	procedure TTntToolBar.DefineProperties(Filer: TFiler);
2446	begin
2447	inherited;
2448	TntPersistent_AfterInherited_DefineProperties(Filer, Self);
2449	end;
2450
2451	procedure TTntToolBar.TBInsertButtonA(var Message: TMessage);
2452	var
2453	Button: TTntToolButton;
2454	Buffer: WideString;
2455	begin
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;
2466	end;
2467
2468	{ Need to read/write caption ourselves - default wndproc seems to discard it. }
2469
2470	procedure TTntToolBar.WMGetText(var Message: TWMGetText);
2471	begin
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));
2477	end;
2478
2479	procedure TTntToolBar.WMGetTextLength(var Message: TWMGetTextLength);
2480	begin
2481	if (not Win32PlatformIsUnicode) or (WindowHandle = 0) then
2482	inherited
2483	else
2484	Message.Result := Length(FCaption);
2485	end;
2486
2487	procedure TTntToolBar.WMSetText(var Message: TWMSetText);
2488	begin
2489	if (not Win32PlatformIsUnicode) or (WindowHandle = 0) then
2490	inherited
2491	else
2492	with Message do
2493	SetString(FCaption, PWideChar(Text), WStrLen(PWideChar(Text)));
2494	end;
2495
2496	function TTntToolBar.GetCaption: WideString;
2497	begin
2498	Result := TntControl_GetText(Self);
2499	end;
2500
2501	procedure TTntToolBar.SetCaption(const Value: WideString);
2502	begin
2503	TntControl_SetText(Self, Value);
2504	end;
2505
2506	function TTntToolBar.IsCaptionStored: Boolean;
2507	begin
2508	Result := TntControl_IsCaptionStored(Self);
2509	end;
2510
2511	function TTntToolBar.GetHint: WideString;
2512	begin
2513	Result := TntControl_GetHint(Self);
2514	end;
2515
2516	procedure TTntToolBar.SetHint(const Value: WideString);
2517	begin
2518	TntControl_SetHint(Self, Value);
2519	end;
2520
2521	function TTntToolBar.IsHintStored: Boolean;
2522	begin
2523	Result := TntControl_IsHintStored(Self);
2524	end;
2525
2526	procedure TTntToolBar.ActionChange(Sender: TObject; CheckDefaults: Boolean);
2527	begin
2528	TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
2529	inherited;
2530	end;
2531
2532	function TTntToolBar.GetActionLinkClass: TControlActionLinkClass;
2533	begin
2534	Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
2535	end;
2536
2537	function TTntToolBar.GetMenu: TMainMenu{TNT-ALLOW TMainMenu};
2538	begin
2539	Result := inherited Menu;
2540	end;
2541
2542	procedure TTntToolBar.SetMenu(const Value: TMainMenu{TNT-ALLOW TMainMenu});
2543	var
2544	I: Integer;
2545	begin
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;
2568	end;
2569
2570	{ TTntRichEditStrings }
2571	type
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
2588	constructor TTntRichEditStrings.Create;
2589	begin
2590	inherited Create;
2591	FRichEditMode := True;
2592	end;
2593
2594	procedure TTntRichEditStrings.AddStrings(Strings: TWideStrings);
2595	var
2596	SelChange: TNotifyEvent;
2597	begin
2598	SelChange := TTntCustomRichEdit(RichEdit).OnSelectionChange;
2599	TTntCustomRichEdit(RichEdit).OnSelectionChange := nil;
2600	try
2601	inherited;
2602	finally
2603	TTntCustomRichEdit(RichEdit).OnSelectionChange := SelChange;
2604	end;
2605	end;
2606
2607	procedure TTntRichEditStrings.EnableChange(const Value: Boolean);
2608	var
2609	EventMask: Longint;
2610	begin
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;
2619	end;
2620
2621	procedure TTntRichEditStrings.SetTextStr(const Value: WideString);
2622	begin
2623	EnableChange(False);
2624	try
2625	inherited;
2626	finally
2627	EnableChange(True);
2628	end;
2629	end;
2630
2631	type TAccessCustomRichEdit = class(TCustomRichEdit{TNT-ALLOW TCustomRichEdit});
2632
2633	procedure TTntRichEditStrings.LoadFromStream_BOM(Stream: TStream; WithBOM: Boolean);
2634	begin
2635	if TAccessCustomRichEdit(RichEdit).PlainText then
2636	inherited LoadFromStream_BOM(Stream, WithBOM)
2637	else
2638	TAccessCustomRichEdit(RichEdit).Lines.LoadFromStream(Stream);
2639	end;
2640
2641	procedure TTntRichEditStrings.SaveToStream_BOM(Stream: TStream; WithBOM: Boolean);
2642	begin
2643	if TAccessCustomRichEdit(RichEdit).PlainText then
2644	inherited SaveToStream_BOM(Stream, WithBOM)
2645	else
2646	TAccessCustomRichEdit(RichEdit).Lines.SaveToStream(Stream);
2647	end;
2648
2649	procedure TTntRichEditStrings.LoadFromFile(const FileName: WideString);
2650	begin
2651	if TAccessCustomRichEdit(RichEdit).PlainText then
2652	inherited LoadFromFile(FileName)
2653	else
2654	TAccessCustomRichEdit(RichEdit).Lines.LoadFromFile(FileName);
2655	end;
2656
2657	procedure TTntRichEditStrings.SaveToFile(const FileName: WideString);
2658	begin
2659	if TAccessCustomRichEdit(RichEdit).PlainText then
2660	inherited SaveToFile(FileName)
2661	else
2662	TAccessCustomRichEdit(RichEdit).Lines.SaveToFile(FileName);
2663	end;
2664
2665	{ TTntCustomRichEdit }
2666
2667	constructor TTntCustomRichEdit.Create(AOwner: TComponent);
2668	begin
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;
2675	end;
2676
2677	var
2678	FRichEdit20Module: THandle = 0;
2679
2680	function IsRichEdit20Available: Boolean;
2681	const
2682	RICHED20_DLL = 'RICHED20.DLL';
2683	begin
2684	if FRichEdit20Module = 0 then
2685	FRichEdit20Module := Tnt_LoadLibraryW(RICHED20_DLL);
2686	Result := FRichEdit20Module <> 0;
2687	end;
2688
2689	{function IsRichEdit30Available: Boolean;
2690	begin
2691	Result := False;
2692	exit;
2693	Result := IsRichEdit20Available and (Win32MajorVersion >= 5);
2694	end;}
2695
2696	procedure TTntCustomRichEdit.CreateParams(var Params: TCreateParams);
2697	begin
2698	inherited CreateParams(Params);
2699	if WordWrap then
2700	Params.Style := Params.Style and not WS_HSCROLL; // more compatible with RichEdit 1.0
2701	end;
2702
2703	procedure TTntCustomRichEdit.CreateWindowHandle(const Params: TCreateParams);
2704	begin
2705	if Win32PlatformIsUnicode and IsRichEdit20Available then
2706	CreateUnicodeHandle(Self, Params, RICHEDIT_CLASSW)
2707	else
2708	inherited
2709	end;
2710
2711	var
2712	AIMM: IActiveIMMApp = nil;
2713
2714	function EnableActiveIMM: Boolean;
2715	begin
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;
2730	end;
2731
2732	procedure TTntCustomRichEdit.CreateWnd;
2733	const
2734	EM_SETEDITSTYLE = WM_USER + 204;
2735	SES_USEAIMM = 64;
2736	begin
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);
2741	end;
2742
2743	procedure TTntCustomRichEdit.DefineProperties(Filer: TFiler);
2744	begin
2745	inherited;
2746	TntPersistent_AfterInherited_DefineProperties(Filer, Self);
2747	end;
2748
2749	destructor TTntCustomRichEdit.Destroy;
2750	begin
2751	FreeAndNil(FRichEditStrings);
2752	inherited;
2753	end;
2754
2755	procedure TTntCustomRichEdit.KeyDown(var Key: Word; Shift: TShiftState);
2756	begin
2757	inherited;
2758	if (not WantReturns) and (Key = VK_RETURN) and (Shift <> [ssCtrl]) then
2759	Key := 0;
2760	end;
2761
2762	function TTntCustomRichEdit.LineBreakStyle: TTntTextLineBreakStyle;
2763	begin
2764	if Win32PlatformIsUnicode and IsRichEdit20Available then
2765	Result := tlbsCR
2766	else
2767	Result := tlbsCRLF;
2768	end;
2769
2770	procedure TTntCustomRichEdit.SetRichEditStrings(const Value: TTntStrings);
2771	begin
2772	FRichEditStrings.Assign(Value);
2773	end;
2774
2775	function TTntCustomRichEdit.GetSelText: string{TNT-ALLOW string};
2776	begin
2777	Result := GetWideSelText;
2778	end;
2779
2780	function TTntCustomRichEdit.GetWideSelText: WideString;
2781	var
2782	CharRange: TCharRange;
2783	Length: Integer;
2784	begin
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)
2795	end;
2796
2797	type
2798	TSetTextEx = record
2799	flags:dword;
2800	codepage:uint;
2801	end;
2802
2803	procedure TTntCustomRichEdit.SetRTFText(Flags: DWORD; const Value: AnsiString);
2804	const
2805	EM_SETTEXTEX = (WM_USER + 97);
2806	var
2807	Info: TSetTextEx;
2808	begin
2809	Info.flags := Flags;
2810	Info.codepage := CP_ACP{TNT-ALLOW CP_ACP};
2811	SendMessage(Handle, EM_SETTEXTEX, Integer(@Info), Integer(PAnsiChar(Value)));
2812	end;
2813
2814	procedure TTntCustomRichEdit.SetWideSelText(const Value: WideString);
2815	const
2816	ST_SELECTION = 2;
2817	begin
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));
2823	end;
2824
2825	function TTntCustomRichEdit.GetText: WideString;
2826	begin
2827	Result := TntControl_GetText(Self);
2828	if (LineBreakStyle <> tlbsCRLF) then
2829	Result := TntAdjustLineBreaks(Result, tlbsCRLF);
2830	end;
2831
2832	procedure TTntCustomRichEdit.SetText(const Value: WideString);
2833	const
2834	ST_DEFAULT = 0;
2835	begin
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));
2841	end;
2842
2843	function TTntCustomRichEdit.IsHintStored: Boolean;
2844	begin
2845	Result := TntControl_IsHintStored(Self);
2846	end;
2847
2848	function TTntCustomRichEdit.GetHint: WideString;
2849	begin
2850	Result := TntControl_GetHint(Self);
2851	end;
2852
2853	procedure TTntCustomRichEdit.SetHint(const Value: WideString);
2854	begin
2855	TntControl_SetHint(Self, Value);
2856	end;
2857
2858	procedure TTntCustomRichEdit.WMGetTextLength(var Message: TWMGetTextLength);
2859	begin
2860	if FPrintingTextLength <> 0 then
2861	Message.Result := FPrintingTextLength
2862	else
2863	inherited;
2864	end;
2865
2866	procedure TTntCustomRichEdit.Print(const Caption: string{TNT-ALLOW string});
2867	begin
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;
2877	end;
2878
2879	{$WARN SYMBOL_DEPRECATED OFF}
2880
2881	function TTntCustomRichEdit.CharPosToGet(RawWin32CharPos: Integer): Integer;
2882	begin
2883	Result := EmulatedCharPos(RawWin32CharPos);
2884	end;
2885
2886	function TTntCustomRichEdit.CharPosToSet(EmulatedCharPos: Integer): Integer;
2887	begin
2888	Result := RawWin32CharPos(EmulatedCharPos);
2889	end;
2890	{$WARN SYMBOL_DEPRECATED ON}
2891
2892	function TTntCustomRichEdit.EmulatedCharPos(RawWin32CharPos: Integer): Integer;
2893	var
2894	i: Integer;
2895	ThisLine: Integer;
2896	CharCount: Integer;
2897	Line_Start: Integer;
2898	NumLineBreaks: Integer;
2899	begin
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;
2916	end;
2917
2918	function TTntCustomRichEdit.RawWin32CharPos(EmulatedCharPos: Integer): Integer;
2919	var
2920	Line: Integer;
2921	NumLineBreaks: Integer;
2922	CharCount: Integer;
2923	Line_Start: Integer;
2924	LineLength: Integer;
2925	begin
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;
2948	end;
2949
2950	function TTntCustomRichEdit.FindText(const SearchStr: WideString;
2951	StartPos, Length: Integer; Options: TSearchTypes): Integer;
2952	const
2953	EM_FINDTEXTEXW = WM_USER + 124;
2954	const
2955	FR_DOWN = $00000001;
2956	FR_WHOLEWORD = $00000002;
2957	FR_MATCHCASE = $00000004;
2958	var
2959	Find: TFindTextW;
2960	Flags: Integer;
2961	begin
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;
2977	end;
2978
2979	function TTntCustomRichEdit.GetSelStart: Integer;
2980	begin
2981	Result := TntCustomEdit_GetSelStart(Self);
2982	Result := EmulatedCharPos(Result);
2983	end;
2984
2985	procedure TTntCustomRichEdit.SetSelStart(const Value: Integer);
2986	begin
2987	TntCustomEdit_SetSelStart(Self, RawWin32CharPos(Value));
2988	end;
2989
2990	function TTntCustomRichEdit.GetSelLength: Integer;
2991	var
2992	CharRange: TCharRange;
2993	begin
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;
3001	end;
3002
3003	procedure TTntCustomRichEdit.SetSelLength(const Value: Integer);
3004	var
3005	StartPos: Integer;
3006	SelEnd: Integer;
3007	begin
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;
3015	end;
3016
3017	procedure TTntCustomRichEdit.ActionChange(Sender: TObject; CheckDefaults: Boolean);
3018	begin
3019	TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
3020	inherited;
3021	end;
3022
3023	function TTntCustomRichEdit.GetActionLinkClass: TControlActionLinkClass;
3024	begin
3025	Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
3026	end;
3027
3028	{ TTntTabStrings }
3029
3030	type TAccessCustomTabControl = class(TCustomTabControl{TNT-ALLOW TCustomTabControl});
3031
3032	type
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
3050	procedure TabControlError(const S: WideString);
3051	begin
3052	raise EListError.Create(S);
3053	end;
3054
3055	procedure TTntTabStrings.Clear;
3056	begin
3057	FAnsiTabs.Clear;
3058	end;
3059
3060	procedure TTntTabStrings.Delete(Index: Integer);
3061	begin
3062	FAnsiTabs.Delete(Index);
3063	end;
3064
3065	function TTntTabStrings.GetCount: Integer;
3066	begin
3067	Result := FAnsiTabs.Count;
3068	end;
3069
3070	function TTntTabStrings.GetObject(Index: Integer): TObject;
3071	begin
3072	Result := FAnsiTabs.Objects[Index];
3073	end;
3074
3075	procedure TTntTabStrings.PutObject(Index: Integer; AObject: TObject);
3076	begin
3077	FAnsiTabs.Objects[Index] := AObject;
3078	end;
3079
3080	procedure TTntTabStrings.SetUpdateState(Updating: Boolean);
3081	begin
3082	inherited;
3083	TAccessStrings(FAnsiTabs).SetUpdateState(Updating);
3084	end;
3085
3086	function TTntTabStrings.Get(Index: Integer): WideString;
3087	const
3088	RTL: array[Boolean] of LongInt = (0, TCIF_RTLREADING);
3089	var
3090	TCItem: TTCItemW;
3091	Buffer: array[0..4095] of WideChar;
3092	begin
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;
3103	end;
3104
3105	function GetTabControlImageIndex(Self: TCustomTabControl{TNT-ALLOW TCustomTabControl}; TabIndex: Integer): Integer;
3106	begin
3107	Result := TabIndex;
3108	with TAccessCustomTabControl(Self) do
3109	if Assigned(OnGetImageIndex) then OnGetImageIndex(Self, TabIndex, Result);
3110	end;
3111
3112	procedure TTntTabStrings.Put(Index: Integer; const S: WideString);
3113	const
3114	RTL: array[Boolean] of LongInt = (0, TCIF_RTLREADING);
3115	var
3116	TCItem: TTCItemW;
3117	begin
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;
3128	end;
3129
3130	procedure TTntTabStrings.Insert(Index: Integer; const S: WideString);
3131	const
3132	RTL: array[Boolean] of LongInt = (0, TCIF_RTLREADING);
3133	var
3134	TCItem: TTCItemW;
3135	begin
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;
3146	end;
3147
3148	{ TTntCustomTabControl }
3149
3150	constructor TTntCustomTabControl.Create(AOwner: TComponent);
3151	begin
3152	inherited;
3153	FTabs := TTntTabStrings.Create;
3154	TTntTabStrings(FTabs).FTabControl := Self;
3155	TTntTabStrings(FTabs).FAnsiTabs := inherited Tabs;
3156	end;
3157
3158	destructor TTntCustomTabControl.Destroy;
3159	begin
3160	TTntTabStrings(FTabs).FTabControl := nil;
3161	TTntTabStrings(FTabs).FAnsiTabs := nil;
3162	FreeAndNil(FTabs);
3163	FreeAndNil(FSaveTabs);
3164	inherited;
3165	end;
3166
3167	procedure TTntCustomTabControl.CreateWindowHandle(const Params: TCreateParams);
3168	begin
3169	CreateUnicodeHandle_ComCtl(Self, Params, WC_TABCONTROL);
3170	end;
3171
3172	procedure TTntCustomTabControl.DefineProperties(Filer: TFiler);
3173	begin
3174	inherited;
3175	TntPersistent_AfterInherited_DefineProperties(Filer, Self);
3176	end;
3177
3178	procedure TTntCustomTabControl.CreateWnd;
3179	begin
3180	inherited;
3181	if FSaveTabs <> nil then
3182	begin
3183	FTabs.Assign(FSaveTabs);
3184	FreeAndNil(FSaveTabs);
3185	TabIndex := FSaveTabIndex;
3186	end;
3187	end;
3188
3189	procedure TTntCustomTabControl.DestroyWnd;
3190	begin
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;
3198	end;
3199
3200	function TTntCustomTabControl.GetTabs: TTntStrings;
3201	begin
3202	if FSaveTabs <> nil then
3203	Result := FSaveTabs // Use FSaveTabs while the window is deallocated
3204	else
3205	Result := FTabs;
3206	end;
3207
3208	procedure TTntCustomTabControl.SetTabs(const Value: TTntStrings);
3209	begin
3210	FTabs.Assign(Value);
3211	end;
3212
3213	function TTntCustomTabControl.IsHintStored: Boolean;
3214	begin
3215	Result := TntControl_IsHintStored(Self);
3216	end;
3217
3218	function TTntCustomTabControl.GetHint: WideString;
3219	begin
3220	Result := TntControl_GetHint(Self);
3221	end;
3222
3223	procedure TTntCustomTabControl.SetHint(const Value: WideString);
3224	begin
3225	TntControl_SetHint(Self, Value);
3226	end;
3227
3228	procedure TTntCustomTabControl.CMDialogChar(var Message: TCMDialogChar);
3229	var
3230	I: Integer;
3231	begin
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);
3244	end;
3245
3246	procedure TTntCustomTabControl.ActionChange(Sender: TObject; CheckDefaults: Boolean);
3247	begin
3248	TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
3249	inherited;
3250	end;
3251
3252	function TTntCustomTabControl.GetActionLinkClass: TControlActionLinkClass;
3253	begin
3254	Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
3255	end;
3256
3257	{ TTntTabSheet }
3258
3259	procedure TTntTabSheet.CreateWindowHandle(const Params: TCreateParams);
3260	begin
3261	CreateUnicodeHandle(Self, Params, '');
3262	end;
3263
3264	function TTntTabSheet.IsCaptionStored: Boolean;
3265	begin
3266	Result := TntControl_IsCaptionStored(Self);
3267	end;
3268
3269	function TTntTabSheet.GetCaption: TWideCaption;
3270	begin
3271	Result := TntControl_GetText(Self);
3272	end;
3273
3274	procedure TTntTabSheet.SetCaption(const Value: TWideCaption);
3275	begin
3276	TntControl_SetText(Self, Value);
3277	end;
3278
3279	procedure TTntTabSheet.DefineProperties(Filer: TFiler);
3280	begin
3281	inherited;
3282	TntPersistent_AfterInherited_DefineProperties(Filer, Self);
3283	end;
3284
3285	function TTntTabSheet.IsHintStored: Boolean;
3286	begin
3287	Result := TntControl_IsHintStored(Self);
3288	end;
3289
3290	function TTntTabSheet.GetHint: WideString;
3291	begin
3292	Result := TntControl_GetHint(Self);
3293	end;
3294
3295	procedure TTntTabSheet.SetHint(const Value: WideString);
3296	begin
3297	TntControl_SetHint(Self, Value);
3298	end;
3299
3300	procedure TTntTabSheet.WMSetText(var Message: TWMSetText);
3301	begin
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;
3316	end;
3317
3318	procedure TTntTabSheet.ActionChange(Sender: TObject; CheckDefaults: Boolean);
3319	begin
3320	TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
3321	inherited;
3322	end;
3323
3324	function TTntTabSheet.GetActionLinkClass: TControlActionLinkClass;
3325	begin
3326	Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
3327	end;
3328
3329	{ TTntPageControl }
3330
3331	procedure TTntPageControl.CreateWindowHandle(const Params: TCreateParams);
3332	begin
3333	CreateUnicodeHandle_ComCtl(Self, Params, WC_TABCONTROL);
3334	end;
3335
3336	procedure TTntPageControl.DefineProperties(Filer: TFiler);
3337	begin
3338	inherited;
3339	TntPersistent_AfterInherited_DefineProperties(Filer, Self);
3340	end;
3341
3342	function TTntPageControl.IsHintStored: Boolean;
3343	begin
3344	Result := TntControl_IsHintStored(Self);
3345	end;
3346
3347	function TTntPageControl.GetHint: WideString;
3348	begin
3349	Result := TntControl_GetHint(Self);
3350	end;
3351
3352	procedure TTntPageControl.SetHint(const Value: WideString);
3353	begin
3354	TntControl_SetHint(Self, Value);
3355	end;
3356
3357	procedure TTntPageControl.WndProc(var Message: TMessage);
3358	const
3359	RTL: array[Boolean] of Cardinal = (0, TCIF_RTLREADING);
3360	var
3361	TCItemA: PTCItemA;
3362	TabSheet: TTabSheet{TNT-ALLOW TTabSheet};
3363	Text: WideString;
3364	begin
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;
3403	end;
3404
3405	procedure TTntPageControl.CMDialogChar(var Message: TCMDialogChar);
3406	var
3407	I: Integer;
3408	TabText: WideString;
3409	begin
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);
3427	end;
3428
3429	procedure TTntPageControl.CMDockClient(var Message: TCMDockClient);
3430	var
3431	IsVisible: Boolean;
3432	DockCtl: TControl;
3433	begin
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;
3454	end;
3455
3456	procedure TTntPageControl.DoAddDockClient(Client: TControl; const ARect: TRect);
3457	begin
3458	if FNewDockSheet <> nil then
3459	Client.Parent := FNewDockSheet;
3460	end;
3461
3462	procedure TTntPageControl.CMDockNotification(var Message: TCMDockNotification);
3463	var
3464	I: Integer;
3465	S: WideString;
3466	Page: TTabSheet{TNT-ALLOW TTabSheet};
3467	begin
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;
3488	end;
3489
3490	procedure TTntPageControl.ActionChange(Sender: TObject; CheckDefaults: Boolean);
3491	begin
3492	TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
3493	inherited;
3494	end;
3495
3496	function TTntPageControl.GetActionLinkClass: TControlActionLinkClass;
3497	begin
3498	Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
3499	end;
3500
3501	{ TTntTrackBar }
3502
3503	procedure TTntTrackBar.CreateWindowHandle(const Params: TCreateParams);
3504	begin
3505	CreateUnicodeHandle_ComCtl(Self, Params, TRACKBAR_CLASS);
3506	end;
3507
3508	procedure TTntTrackBar.DefineProperties(Filer: TFiler);
3509	begin
3510	inherited;
3511	TntPersistent_AfterInherited_DefineProperties(Filer, Self);
3512	end;
3513
3514	function TTntTrackBar.IsHintStored: Boolean;
3515	begin
3516	Result := TntControl_IsHintStored(Self);
3517	end;
3518
3519	function TTntTrackBar.GetHint: WideString;
3520	begin
3521	Result := TntControl_GetHint(Self);
3522	end;
3523
3524	procedure TTntTrackBar.SetHint(const Value: WideString);
3525	begin
3526	TntControl_SetHint(Self, Value);
3527	end;
3528
3529	procedure TTntTrackBar.ActionChange(Sender: TObject; CheckDefaults: Boolean);
3530	begin
3531	TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
3532	inherited;
3533	end;
3534
3535	function TTntTrackBar.GetActionLinkClass: TControlActionLinkClass;
3536	begin
3537	Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
3538	end;
3539
3540	{ TTntProgressBar }
3541
3542	procedure TTntProgressBar.CreateWindowHandle(const Params: TCreateParams);
3543	begin
3544	CreateUnicodeHandle_ComCtl(Self, Params, PROGRESS_CLASS);
3545	end;
3546
3547	procedure TTntProgressBar.DefineProperties(Filer: TFiler);
3548	begin
3549	inherited;
3550	TntPersistent_AfterInherited_DefineProperties(Filer, Self);
3551	end;
3552
3553	function TTntProgressBar.IsHintStored: Boolean;
3554	begin
3555	Result := TntControl_IsHintStored(Self);
3556	end;
3557
3558	function TTntProgressBar.GetHint: WideString;
3559	begin
3560	Result := TntControl_GetHint(Self);
3561	end;
3562
3563	procedure TTntProgressBar.SetHint(const Value: WideString);
3564	begin
3565	TntControl_SetHint(Self, Value);
3566	end;
3567
3568	procedure TTntProgressBar.ActionChange(Sender: TObject; CheckDefaults: Boolean);
3569	begin
3570	TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
3571	inherited;
3572	end;
3573
3574	function TTntProgressBar.GetActionLinkClass: TControlActionLinkClass;
3575	begin
3576	Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
3577	end;
3578
3579	{ TTntCustomUpDown }
3580
3581	procedure TTntCustomUpDown.CreateWindowHandle(const Params: TCreateParams);
3582	begin
3583	CreateUnicodeHandle_ComCtl(Self, Params, UPDOWN_CLASS);
3584	end;
3585
3586	procedure TTntCustomUpDown.DefineProperties(Filer: TFiler);
3587	begin
3588	inherited;
3589	TntPersistent_AfterInherited_DefineProperties(Filer, Self);
3590	end;
3591
3592	function TTntCustomUpDown.IsHintStored: Boolean;
3593	begin
3594	Result := TntControl_IsHintStored(Self);
3595	end;
3596
3597	function TTntCustomUpDown.GetHint: WideString;
3598	begin
3599	Result := TntControl_GetHint(Self);
3600	end;
3601
3602	procedure TTntCustomUpDown.SetHint(const Value: WideString);
3603	begin
3604	TntControl_SetHint(Self, Value);
3605	end;
3606
3607	procedure TTntCustomUpDown.ActionChange(Sender: TObject; CheckDefaults: Boolean);
3608	begin
3609	TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
3610	inherited;
3611	end;
3612
3613	function TTntCustomUpDown.GetActionLinkClass: TControlActionLinkClass;
3614	begin
3615	Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
3616	end;
3617
3618	{ TTntDateTimePicker }
3619
3620	procedure TTntDateTimePicker.CreateWindowHandle(const Params: TCreateParams);
3621	begin
3622	CreateUnicodeHandle_ComCtl(Self, Params, DATETIMEPICK_CLASS);
3623	end;
3624
3625	procedure TTntDateTimePicker.DefineProperties(Filer: TFiler);
3626	begin
3627	inherited;
3628	TntPersistent_AfterInherited_DefineProperties(Filer, Self);
3629	end;
3630
3631	function TTntDateTimePicker.IsHintStored: Boolean;
3632	begin
3633	Result := TntControl_IsHintStored(Self);
3634	end;
3635
3636	function TTntDateTimePicker.GetHint: WideString;
3637	begin
3638	Result := TntControl_GetHint(Self);
3639	end;
3640
3641	procedure TTntDateTimePicker.SetHint(const Value: WideString);
3642	begin
3643	TntControl_SetHint(Self, Value);
3644	end;
3645
3646	procedure TTntDateTimePicker.ActionChange(Sender: TObject; CheckDefaults: Boolean);
3647	begin
3648	TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
3649	inherited;
3650	end;
3651
3652	function TTntDateTimePicker.GetActionLinkClass: TControlActionLinkClass;
3653	begin
3654	Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
3655	end;
3656
3657	procedure TTntDateTimePicker.CreateWnd;
3658	var
3659	SaveChecked: Boolean;
3660	begin
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;
3668	end;
3669
3670	procedure 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
3687	begin
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;
3693	end;
3694
3695	{ TTntMonthCalendar }
3696
3697	procedure TTntMonthCalendar.CreateWindowHandle(const Params: TCreateParams);
3698	begin
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;
3704	end;
3705
3706	procedure TTntMonthCalendar.ForceGetMonthInfo;
3707	var
3708	Hdr: TNMDayState;
3709	Days: array of TMonthDayState;
3710	Range: array[1..2] of TSystemTime;
3711	begin
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))
3723	end;
3724
3725	procedure TTntMonthCalendar.DefineProperties(Filer: TFiler);
3726	begin
3727	inherited;
3728	TntPersistent_AfterInherited_DefineProperties(Filer, Self);
3729	end;
3730
3731	function TTntMonthCalendar.IsHintStored: Boolean;
3732	begin
3733	Result := TntControl_IsHintStored(Self);
3734	end;
3735
3736	function TTntMonthCalendar.GetHint: WideString;
3737	begin
3738	Result := TntControl_GetHint(Self);
3739	end;
3740
3741	procedure TTntMonthCalendar.SetHint(const Value: WideString);
3742	begin
3743	TntControl_SetHint(Self, Value);
3744	end;
3745
3746	function TTntMonthCalendar.GetDate: TDate;
3747	begin
3748	Result := Trunc(inherited Date); { Fixes issue where Date always reflects time of saving dfm. }
3749	end;
3750
3751	procedure TTntMonthCalendar.SetDate(const Value: TDate);
3752	begin
3753	inherited Date := Trunc(Value);
3754	end;
3755
3756	procedure TTntMonthCalendar.ActionChange(Sender: TObject; CheckDefaults: Boolean);
3757	begin
3758	TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
3759	inherited;
3760	end;
3761
3762	function TTntMonthCalendar.GetActionLinkClass: TControlActionLinkClass;
3763	begin
3764	Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
3765	end;
3766
3767	{ TTntPageScroller }
3768
3769	procedure TTntPageScroller.CreateWindowHandle(const Params: TCreateParams);
3770	begin
3771	CreateUnicodeHandle_ComCtl(Self, Params, WC_PAGESCROLLER);
3772	end;
3773
3774	procedure TTntPageScroller.DefineProperties(Filer: TFiler);
3775	begin
3776	inherited;
3777	TntPersistent_AfterInherited_DefineProperties(Filer, Self);
3778	end;
3779
3780	function TTntPageScroller.IsHintStored: Boolean;
3781	begin
3782	Result := TntControl_IsHintStored(Self);
3783	end;
3784
3785	function TTntPageScroller.GetHint: WideString;
3786	begin
3787	Result := TntControl_GetHint(Self);
3788	end;
3789
3790	procedure TTntPageScroller.SetHint(const Value: WideString);
3791	begin
3792	TntControl_SetHint(Self, Value);
3793	end;
3794
3795	procedure TTntPageScroller.ActionChange(Sender: TObject; CheckDefaults: Boolean);
3796	begin
3797	TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
3798	inherited;
3799	end;
3800
3801	function TTntPageScroller.GetActionLinkClass: TControlActionLinkClass;
3802	begin
3803	Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
3804	end;
3805
3806	{ TTntStatusPanel }
3807
3808	procedure TTntStatusPanel.Assign(Source: TPersistent);
3809	begin
3810	inherited;
3811	if Source is TTntStatusPanel then
3812	Text := TTntStatusPanel(Source).Text;
3813	end;
3814
3815	procedure TTntStatusPanel.DefineProperties(Filer: TFiler);
3816	begin
3817	inherited;
3818	TntPersistent_AfterInherited_DefineProperties(Filer, Self);
3819	end;
3820
3821	function TTntStatusPanel.GetText: Widestring;
3822	begin
3823	Result := GetSyncedWideString(FText, inherited Text);
3824	end;
3825
3826	procedure TTntStatusPanel.SetInheritedText(const Value: AnsiString);
3827	begin
3828	inherited Text := Value;
3829	end;
3830
3831	procedure TTntStatusPanel.SetText(const Value: Widestring);
3832	begin
3833	SetSyncedWideString(Value, FText, inherited Text, SetInheritedText);
3834	end;
3835
3836	{ TTntStatusPanels }
3837
3838	function TTntStatusPanels.GetItem(Index: Integer): TTntStatusPanel;
3839	begin
3840	Result := (inherited GetItem(Index)) as TTntStatusPanel;
3841	end;
3842
3843	procedure TTntStatusPanels.SetItem(Index: Integer; Value: TTntStatusPanel);
3844	begin
3845	inherited SetItem(Index, Value);
3846	end;
3847
3848	function TTntStatusPanels.Add: TTntStatusPanel;
3849	begin
3850	Result := (inherited Add) as TTntStatusPanel;
3851	end;
3852
3853	function TTntStatusPanels.AddItem(Item: TTntStatusPanel; Index: Integer): TTntStatusPanel;
3854	begin
3855	Result := (inherited AddItem(Item, Index)) as TTntStatusPanel;
3856	end;
3857
3858	function TTntStatusPanels.Insert(Index: Integer): TTntStatusPanel;
3859	begin
3860	Result := (inherited Insert(Index)) as TTntStatusPanel;
3861	end;
3862
3863	{ TTntCustomStatusBar }
3864
3865	function TTntCustomStatusBar.GetHint: WideString;
3866	begin
3867	Result := TntControl_GetHint(Self);
3868	end;
3869
3870	procedure TTntCustomStatusBar.SetHint(const Value: WideString);
3871	begin
3872	TntControl_SetHint(Self, Value);
3873	end;
3874
3875	function TTntCustomStatusBar.IsHintStored: Boolean;
3876	begin
3877	Result := TntControl_IsHintStored(Self);
3878	end;
3879
3880	function TTntCustomStatusBar.CreatePanels: TStatusPanels{TNT-ALLOW TStatusPanels};
3881	begin
3882	Result := TTntStatusPanels.Create(Self);
3883	end;
3884
3885	function TTntCustomStatusBar.GetPanelClass: TStatusPanelClass;
3886	begin
3887	Result := TTntStatusPanel;
3888	end;
3889
3890	function 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
3903	var
3904	AnsiTabCount: Integer;
3905	WideTabCount: Integer;
3906	begin
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;
3918	end;
3919
3920	function TTntCustomStatusBar.GetSimpleText: WideString;
3921	begin
3922	FSimpleText := SyncLeadingTabs(FSimpleText, inherited SimpleText);
3923	Result := GetSyncedWideString(FSimpleText, inherited SimpleText);
3924	end;
3925
3926	procedure TTntCustomStatusBar.SetInheritedSimpleText(const Value: AnsiString);
3927	begin
3928	inherited SimpleText := Value;
3929	end;
3930
3931	procedure TTntCustomStatusBar.SetSimpleText(const Value: WideString);
3932	begin
3933	SetSyncedWideString(Value, FSimpleText, inherited SimpleText, SetInheritedSimpleText);
3934	end;
3935
3936	procedure TTntCustomStatusBar.DefineProperties(Filer: TFiler);
3937	begin
3938	inherited;
3939	TntPersistent_AfterInherited_DefineProperties(Filer, Self);
3940	end;
3941
3942	procedure TTntCustomStatusBar.CreateWindowHandle(const Params: TCreateParams);
3943	begin
3944	CreateUnicodeHandle_ComCtl(Self, Params, STATUSCLASSNAME);
3945	end;
3946
3947	procedure TTntCustomStatusBar.WndProc(var Msg: TMessage);
3948	const
3949	SB_SIMPLEID = Integer($FF);
3950	var
3951	iPart: Integer;
3952	szText: PAnsiChar;
3953	WideText: WideString;
3954	begin
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;
3971	end;
3972
3973	procedure TTntCustomStatusBar.WMGetTextLength(var Message: TWMGetTextLength);
3974	begin
3975	Message.Result := Length(SimpleText);
3976	end;
3977
3978	procedure TTntCustomStatusBar.ActionChange(Sender: TObject; CheckDefaults: Boolean);
3979	begin
3980	TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
3981	inherited;
3982	end;
3983
3984	function TTntCustomStatusBar.GetActionLinkClass: TControlActionLinkClass;
3985	begin
3986	Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
3987	end;
3988
3989	function TTntCustomStatusBar.GetPanels: TTntStatusPanels;
3990	begin
3991	Result := inherited Panels as TTntStatusPanels;
3992	end;
3993
3994	procedure TTntCustomStatusBar.SetPanels(const Value: TTntStatusPanels);
3995	begin
3996	inherited Panels := Value;
3997	end;
3998
3999	function TTntCustomStatusBar.ExecuteAction(Action: TBasicAction): Boolean;
4000	begin
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);
4009	end;
4010
4011	{ TTntStatusBar }
4012
4013	function TTntStatusBar.GetOnDrawPanel: TDrawPanelEvent;
4014	begin
4015	Result := TDrawPanelEvent(inherited OnDrawPanel);
4016	end;
4017
4018	procedure TTntStatusBar.SetOnDrawPanel(const Value: TDrawPanelEvent);
4019	begin
4020	inherited OnDrawPanel := TCustomDrawPanelEvent(Value);
4021	end;
4022
4023	{ TTntTreeNode }
4024
4025	function TTntTreeNode.IsEqual(Node: TTntTreeNode): Boolean;
4026	begin
4027	Result := (Text = Node.Text) and (Data = Node.Data);
4028	end;
4029
4030	procedure TTntTreeNode.ReadData(Stream: TStream; Info: PNodeInfo);
4031	var
4032	I, Size, ItemCount: Integer;
4033	LNode: TTntTreeNode;
4034	Utf8Text: AnsiString;
4035	begin
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;
4062	end;
4063
4064	procedure TTntTreeNode.WriteData(Stream: TStream; Info: PNodeInfo);
4065	var
4066	I, Size, L, ItemCount: Integer;
4067	WideLen: Integer; Utf8Text: AnsiString;
4068	begin
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);
4090	end;
4091
4092	procedure TTntTreeNode.Assign(Source: TPersistent);
4093	var
4094	Node: TTntTreeNode;
4095	begin
4096	inherited;
4097	if (not Deleting) and (Source is TTntTreeNode) then
4098	begin
4099	Node := TTntTreeNode(Source);
4100	Text := Node.Text;
4101	end;
4102	end;
4103
4104	function TTntTreeNode.GetText: WideString;
4105	begin
4106	Result := GetSyncedWideString(FText, inherited Text);
4107	end;
4108
4109	procedure TTntTreeNode.SetInheritedText(const Value: AnsiString);
4110	begin
4111	inherited Text := Value;
4112	end;
4113
4114	procedure TTntTreeNode.SetText(const Value: WideString);
4115	begin
4116	SetSyncedWideString(Value, FText, inherited Text, SetInheritedText);
4117	end;
4118
4119	function TTntTreeNode.getFirstChild: TTntTreeNode;
4120	begin
4121	Result := inherited getFirstChild as TTntTreeNode;
4122	end;
4123
4124	function TTntTreeNode.GetItem(Index: Integer): TTntTreeNode;
4125	begin
4126	Result := inherited Item[Index] as TTntTreeNode;
4127	end;
4128
4129	procedure TTntTreeNode.SetItem(Index: Integer; const Value: TTntTreeNode);
4130	begin
4131	inherited Item[Index] := Value;
4132	end;
4133
4134	function TTntTreeNode.GetLastChild: TTntTreeNode;
4135	begin
4136	Result := inherited GetLastChild as TTntTreeNode;
4137	end;
4138
4139	function TTntTreeNode.GetNext: TTntTreeNode;
4140	begin
4141	Result := inherited GetNext as TTntTreeNode;
4142	end;
4143
4144	function TTntTreeNode.GetNextChild(Value: TTntTreeNode): TTntTreeNode;
4145	begin
4146	Result := inherited GetNextChild(Value) as TTntTreeNode;
4147	end;
4148
4149	function TTntTreeNode.getNextSibling: TTntTreeNode;
4150	begin
4151	Result := inherited getNextSibling as TTntTreeNode;
4152	end;
4153
4154	function TTntTreeNode.GetNextVisible: TTntTreeNode;
4155	begin
4156	Result := inherited GetNextVisible as TTntTreeNode;
4157	end;
4158
4159	function TTntTreeNode.GetNodeOwner: TTntTreeNodes;
4160	begin
4161	Result := inherited Owner as TTntTreeNodes;
4162	end;
4163
4164	function TTntTreeNode.GetParent: TTntTreeNode;
4165	begin
4166	Result := inherited Parent as TTntTreeNode;
4167	end;
4168
4169	function TTntTreeNode.GetPrev: TTntTreeNode;
4170	begin
4171	Result := inherited GetPrev as TTntTreeNode;
4172	end;
4173
4174	function TTntTreeNode.GetPrevChild(Value: TTntTreeNode): TTntTreeNode;
4175	begin
4176	Result := inherited GetPrevChild(Value) as TTntTreeNode;
4177	end;
4178
4179	function TTntTreeNode.getPrevSibling: TTntTreeNode;
4180	begin
4181	Result := inherited getPrevSibling as TTntTreeNode;
4182	end;
4183
4184	function TTntTreeNode.GetPrevVisible: TTntTreeNode;
4185	begin
4186	Result := inherited GetPrevVisible as TTntTreeNode;
4187	end;
4188
4189	function TTntTreeNode.GetTreeView: TTntCustomTreeView;
4190	begin
4191	Result := inherited TreeView as TTntCustomTreeView;
4192	end;
4193
4194	{ TTntTreeNodesEnumerator }
4195
4196	constructor TTntTreeNodesEnumerator.Create(ATreeNodes: TTntTreeNodes);
4197	begin
4198	inherited Create;
4199	FIndex := -1;
4200	FTreeNodes := ATreeNodes;
4201	end;
4202
4203	function TTntTreeNodesEnumerator.GetCurrent: TTntTreeNode;
4204	begin
4205	Result := FTreeNodes[FIndex];
4206	end;
4207
4208	function TTntTreeNodesEnumerator.MoveNext: Boolean;
4209	begin
4210	Result := FIndex < FTreeNodes.Count - 1;
4211	if Result then
4212	Inc(FIndex);
4213	end;
4214
4215	{ TTntTreeNodes }
4216
4217	{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
4218	type
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
4228	type
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
4238	type
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
4248	type
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
4258	procedure SaveNodeTextToStrings(Nodes: TTntTreeNodes; sList: TTntStrings);
4259	var
4260	ANode: TTntTreeNode;
4261	begin
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;
4272	end;
4273
4274	procedure TTntTreeNodes.Assign(Source: TPersistent);
4275	var
4276	TreeNodes: TTntTreeNodes;
4277	MemStream: TTntMemoryStream;
4278	begin
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);
4294	end;
4295
4296	function TTntTreeNodes.GetNodeFromIndex(Index: Integer): TTntTreeNode;
4297	begin
4298	Result := inherited Item[Index] as TTntTreeNode;
4299	end;
4300
4301	function TTntTreeNodes.AddChildFirst(Parent: TTntTreeNode; const S: WideString): TTntTreeNode;
4302	begin
4303	Result := AddNode(nil, Parent, S, nil, naAddChildFirst);
4304	end;
4305
4306	function TTntTreeNodes.AddChildObjectFirst(Parent: TTntTreeNode; const S: WideString;
4307	Ptr: Pointer): TTntTreeNode;
4308	begin
4309	Result := AddNode(nil, Parent, S, Ptr, naAddChildFirst);
4310	end;
4311
4312	function TTntTreeNodes.AddChild(Parent: TTntTreeNode; const S: WideString): TTntTreeNode;
4313	begin
4314	Result := AddNode(nil, Parent, S, nil, naAddChild);
4315	end;
4316
4317	function TTntTreeNodes.AddChildObject(Parent: TTntTreeNode; const S: WideString;
4318	Ptr: Pointer): TTntTreeNode;
4319	begin
4320	Result := AddNode(nil, Parent, S, Ptr, naAddChild);
4321	end;
4322
4323	function TTntTreeNodes.AddFirst(Sibling: TTntTreeNode; const S: WideString): TTntTreeNode;
4324	begin
4325	Result := AddNode(nil, Sibling, S, nil, naAddFirst);
4326	end;
4327
4328	function TTntTreeNodes.AddObjectFirst(Sibling: TTntTreeNode; const S: WideString;
4329	Ptr: Pointer): TTntTreeNode;
4330	begin
4331	Result := AddNode(nil, Sibling, S, Ptr, naAddFirst);
4332	end;
4333
4334	function TTntTreeNodes.Add(Sibling: TTntTreeNode; const S: WideString): TTntTreeNode;
4335	begin
4336	Result := AddNode(nil, Sibling, S, nil, naAdd);
4337	end;
4338
4339	function TTntTreeNodes.AddObject(Sibling: TTntTreeNode; const S: WideString;
4340	Ptr: Pointer): TTntTreeNode;
4341	begin
4342	Result := AddNode(nil, Sibling, S, Ptr, naAdd);
4343	end;
4344
4345	function TTntTreeNodes.Insert(Sibling: TTntTreeNode; const S: WideString): TTntTreeNode;
4346	begin
4347	Result := AddNode(nil, Sibling, S, nil, naInsert);
4348	end;
4349
4350	function TTntTreeNodes.InsertObject(Sibling: TTntTreeNode; const S: WideString;
4351	Ptr: Pointer): TTntTreeNode;
4352	begin
4353	Result := AddNode(nil, Sibling, S, Ptr, naInsert);
4354	end;
4355
4356	function TTntTreeNodes.InsertNode(Node, Sibling: TTntTreeNode; const S: WideString;
4357	Ptr: Pointer): TTntTreeNode;
4358	begin
4359	Result := AddNode(Node, Sibling, S, Ptr, naInsert);
4360	end;
4361
4362	function TTntTreeNodes.AddNode(Node, Relative: TTntTreeNode; const S: WideString;
4363	Ptr: Pointer; Method: TNodeAttachMode): TTntTreeNode;
4364	begin
4365	Result := inherited AddNode(Node, Relative, '', Ptr, Method) as TTntTreeNode;
4366	Result.Text := S;
4367	end;
4368
4369	function TTntTreeNodes.GetNode(ItemId: HTreeItem): TTntTreeNode;
4370	begin
4371	Result := inherited GetNode(ItemID) as TTntTreeNode;
4372	end;
4373
4374	function TTntTreeNodes.GetFirstNode: TTntTreeNode;
4375	begin
4376	Result := inherited GetFirstNode as TTntTreeNode;
4377	end;
4378
4379	function TTntTreeNodes.GetEnumerator: TTntTreeNodesEnumerator;
4380	begin
4381	Result := TTntTreeNodesEnumerator.Create(Self);
4382	end;
4383
4384	function TTntTreeNodes.GetNodesOwner: TTntCustomTreeView;
4385	begin
4386	Result := inherited Owner as TTntCustomTreeView;
4387	end;
4388
4389	procedure TTntTreeNodes.ClearCache;
4390	begin
4391	THackTreeNodes(Self).FNodeCache.CacheNode := nil;
4392	end;
4393
4394	procedure 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
4418	begin
4419	inherited DefineProperties(Filer);
4420	Filer.DefineBinaryProperty('Utf8Data', ReadData, WriteData, WriteNodes);
4421	end;
4422
4423	procedure TTntTreeNodes.ReadData(Stream: TStream);
4424	var
4425	I, Count: Integer;
4426	NodeInfo: TNodeInfo;
4427	LNode: TTntTreeNode;
4428	LHandleAllocated: Boolean;
4429	begin
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;
4448	end;
4449
4450	procedure TTntTreeNodes.WriteData(Stream: TStream);
4451	var
4452	I: Integer;
4453	Node: TTntTreeNode;
4454	NodeInfo: TNodeInfo;
4455	begin
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;
4470	end;
4471
4472	{ TTntTreeStrings }
4473
4474	type
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
4483	function TTntTreeStrings.GetBufStart(Buffer: PWideChar; var Level: Integer): PWideChar;
4484	begin
4485	Level := 0;
4486	while Buffer^ in [WideChar(' '), WideChar(#9)] do
4487	begin
4488	Inc(Buffer);
4489	Inc(Level);
4490	end;
4491	Result := Buffer;
4492	end;
4493
4494	procedure TTntTreeStrings.SaveToTree(Tree: TTntCustomTreeView);
4495	var
4496	ANode, NextNode: TTntTreeNode;
4497	ALevel, i: Integer;
4498	CurrStr: WideString;
4499	Owner: TTntTreeNodes;
4500	begin
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;
4533	end;
4534
4535	procedure TTntTreeStrings.LoadFromTree(Tree: TTntCustomTreeView);
4536	const
4537	TabChar = #9;
4538	var
4539	i: Integer;
4540	ANode: TTntTreeNode;
4541	NodeStr: WideString;
4542	Owner: TTntTreeNodes;
4543	begin
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;
4558	end;
4559
4560	{ _TntInternalCustomTreeView }
4561
4562	function _TntInternalCustomTreeView.FindNextToSelect: TTreeNode{TNT-ALLOW TTreeNode};
4563	begin
4564	Result := Wide_FindNextToSelect;
4565	end;
4566
4567	function _TntInternalCustomTreeView.Inherited_FindNextToSelect: TTreeNode{TNT-ALLOW TTreeNode};
4568	begin
4569	Result := inherited FindNextToSelect;
4570	end;
4571
4572	{ TTntCustomTreeView }
4573
4574	function TntDefaultTreeViewSort(Node1, Node2: TTntTreeNode; lParam: Integer): Integer; stdcall;
4575	begin
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));
4580	end;
4581
4582	constructor TTntCustomTreeView.Create(AOwner: TComponent);
4583	begin
4584	inherited;
4585	FEditInstance := Classes.MakeObjectInstance(EditWndProcW);
4586	end;
4587
4588	destructor TTntCustomTreeView.Destroy;
4589	begin
4590	Destroying;
4591	Classes.FreeObjectInstance(FEditInstance);
4592	FreeAndNil(FSavedNodeText);
4593	inherited;
4594	end;
4595
4596	var
4597	ComCtrls_DefaultTreeViewSort: TTVCompare = nil;
4598
4599	procedure 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
4611	begin
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;
4617	end;
4618
4619	procedure TTntCustomTreeView.CreateWnd;
4620	begin
4621	inherited;
4622	if FSavedNodeText <> nil then begin
4623	FreeAndNil(FSavedNodeText);
4624	SortType := FSavedSortType;
4625	end;
4626	end;
4627
4628	procedure TTntCustomTreeView.DestroyWnd;
4629	begin
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;
4637	end;
4638
4639	procedure TTntCustomTreeView.DefineProperties(Filer: TFiler);
4640	begin
4641	inherited;
4642	TntPersistent_AfterInherited_DefineProperties(Filer, Self);
4643	end;
4644
4645	function TTntCustomTreeView.IsHintStored: Boolean;
4646	begin
4647	Result := TntControl_IsHintStored(Self);
4648	end;
4649
4650	function TTntCustomTreeView.GetHint: WideString;
4651	begin
4652	Result := TntControl_GetHint(Self)
4653	end;
4654
4655	procedure TTntCustomTreeView.SetHint(const Value: WideString);
4656	begin
4657	TntControl_SetHint(Self, Value);
4658	end;
4659
4660	procedure TTntCustomTreeView.ActionChange(Sender: TObject; CheckDefaults: Boolean);
4661	begin
4662	TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
4663	inherited;
4664	end;
4665
4666	function TTntCustomTreeView.GetActionLinkClass: TControlActionLinkClass;
4667	begin
4668	Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
4669	end;
4670
4671	function TTntCustomTreeView.CreateNode: TTreeNode{TNT-ALLOW TTreeNode};
4672	var
4673	LClass: TClass;
4674	TntLClass: TTntTreeNodeClass;
4675	begin
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);
4683	end;
4684
4685	function TTntCustomTreeView.CreateNodes: TTreeNodes{TNT-ALLOW TTreeNodes};
4686	begin
4687	Result := TTntTreeNodes.Create(Self);
4688	end;
4689
4690	function TTntCustomTreeView.GetTreeNodes: TTntTreeNodes;
4691	begin
4692	Result := inherited Items as TTntTreeNodes;
4693	end;
4694
4695	procedure TTntCustomTreeView.SetTreeNodes(const Value: TTntTreeNodes);
4696	begin
4697	Items.Assign(Value);
4698	end;
4699
4700	function TTntCustomTreeView.GetNodeFromItem(const Item: TTVItem): TTntTreeNode;
4701	begin
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);
4709	end;
4710
4711	function TTntCustomTreeView.Wide_FindNextToSelect: TTntTreeNode;
4712	begin
4713	Result := FindNextToSelect;
4714	end;
4715
4716	function TTntCustomTreeView.FindNextToSelect: TTntTreeNode;
4717	begin
4718	Result := Inherited_FindNextToSelect as TTntTreeNode;
4719	end;
4720
4721	function TTntCustomTreeView.GetDropTarget: TTntTreeNode;
4722	begin
4723	Result := inherited DropTarget as TTntTreeNode;
4724	end;
4725
4726	function TTntCustomTreeView.GetNodeAt(X, Y: Integer): TTntTreeNode;
4727	begin
4728	Result := inherited GetNodeAt(X, Y) as TTntTreeNode;
4729	end;
4730
4731	function TTntCustomTreeView.GetSelected: TTntTreeNode;
4732	begin
4733	Result := inherited Selected as TTntTreeNode;
4734	end;
4735
4736	function TTntCustomTreeView.GetSelection(Index: Integer): TTntTreeNode;
4737	begin
4738	Result := inherited Selections[Index] as TTntTreeNode;
4739	end;
4740
4741	function TTntCustomTreeView.GetSelections(AList: TList): TTntTreeNode;
4742	begin
4743	Result := inherited GetSelections(AList) as TTntTreeNode;
4744	end;
4745
4746	function TTntCustomTreeView.GetTopItem: TTntTreeNode;
4747	begin
4748	Result := inherited TopItem as TTntTreeNode;
4749	end;
4750
4751	procedure TTntCustomTreeView.SetDropTarget(const Value: TTntTreeNode);
4752	begin
4753	inherited DropTarget := Value;
4754	end;
4755
4756	procedure TTntCustomTreeView.SetSelected(const Value: TTntTreeNode);
4757	begin
4758	inherited Selected := Value;
4759	end;
4760
4761	procedure TTntCustomTreeView.SetTopItem(const Value: TTntTreeNode);
4762	begin
4763	inherited TopItem := Value;
4764	end;
4765
4766	procedure TTntCustomTreeView.WndProc(var Message: TMessage);
4767	type
4768	PTVSortCB = ^TTVSortCB;
4769	begin
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;
4788	end;
4789
4790	procedure TTntCustomTreeView.CNNotify(var Message: TWMNotify);
4791	var
4792	Node: TTntTreeNode;
4793	begin
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;
4890	end;
4891
4892	procedure TTntCustomTreeView.WMNotify(var Message: TWMNotify);
4893	var
4894	Node: TTntTreeNode;
4895	FWideText: WideString;
4896	MaxTextLen: Integer;
4897	Pt: TPoint;
4898	begin
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;
4927	end;
4928
4929	procedure TTntCustomTreeView.Edit(const Item: TTVItem);
4930	var
4931	S: WideString;
4932	AnsiS: AnsiString;
4933	Node: TTntTreeNode;
4934	AnsiEvent: TTVEditedEvent;
4935	begin
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;
4961	end;
4962
4963	procedure TTntCustomTreeView.EditWndProcW(var Message: TMessage);
4964	begin
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;
4996	end;
4997
4998	procedure TTntCustomTreeView.LoadFromFile(const FileName: WideString);
4999	var
5000	TreeStrings: TTntTreeStrings;
5001	begin
5002	TreeStrings := TTntTreeStrings.Create;
5003	try
5004	TreeStrings.LoadFromFile(FileName);
5005	TreeStrings.SaveToTree(Self);
5006	finally
5007	TreeStrings.Free;
5008	end;
5009	end;
5010
5011	procedure TTntCustomTreeView.LoadFromStream(Stream: TStream);
5012	var
5013	TreeStrings: TTntTreeStrings;
5014	begin
5015	TreeStrings := TTntTreeStrings.Create;
5016	try
5017	TreeStrings.LoadFromStream(Stream);
5018	TreeStrings.SaveToTree(Self);
5019	finally
5020	TreeStrings.Free;
5021	end;
5022	end;
5023
5024	procedure TTntCustomTreeView.SaveToFile(const FileName: WideString);
5025	var
5026	TreeStrings: TTntTreeStrings;
5027	begin
5028	TreeStrings := TTntTreeStrings.Create;
5029	try
5030	TreeStrings.LoadFromTree(Self);
5031	TreeStrings.SaveToFile(FileName);
5032	finally
5033	TreeStrings.Free;
5034	end;
5035	end;
5036
5037	procedure TTntCustomTreeView.SaveToStream(Stream: TStream);
5038	var
5039	TreeStrings: TTntTreeStrings;
5040	begin
5041	TreeStrings := TTntTreeStrings.Create;
5042	try
5043	TreeStrings.LoadFromTree(Self);
5044	TreeStrings.SaveToStream(Stream);
5045	finally
5046	TreeStrings.Free;
5047	end;
5048	end;
5049
5050	initialization
5051
5052	finalization
5053	if Assigned(AIMM) then
5054	AIMM.Deactivate;
5055	if FRichEdit20Module <> 0 then
5056	FreeLibrary(FRichEdit20Module);
5057
5058	end.

Note: See TracBrowser for help on using the repository browser.

Context Navigation

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

Download in other formats: