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

Last change on this file since 713 was 672, checked in by Kevin Toppenberg, 15 years ago

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