diff options
Diffstat (limited to 'plugins/!NotAdopted/Chess4Net/lib/TntUnicodeControls/Source/TntComCtrls.pas')
| -rw-r--r-- | plugins/!NotAdopted/Chess4Net/lib/TntUnicodeControls/Source/TntComCtrls.pas | 5058 |
1 files changed, 5058 insertions, 0 deletions
diff --git a/plugins/!NotAdopted/Chess4Net/lib/TntUnicodeControls/Source/TntComCtrls.pas b/plugins/!NotAdopted/Chess4Net/lib/TntUnicodeControls/Source/TntComCtrls.pas new file mode 100644 index 0000000000..42bec4cd46 --- /dev/null +++ b/plugins/!NotAdopted/Chess4Net/lib/TntUnicodeControls/Source/TntComCtrls.pas @@ -0,0 +1,5058 @@ +
+{*****************************************************************************}
+{ }
+{ Tnt Delphi Unicode Controls }
+{ http://www.tntware.com/delphicontrols/unicode/ }
+{ Version: 2.3.0 }
+{ }
+{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
+{ }
+{*****************************************************************************}
+
+unit TntComCtrls;
+
+{$INCLUDE TntCompilers.inc}
+
+interface
+
+{ TODO: TTntCustomListView events - reintroduce ones that refer to ansi classes (ie. TListItem) }
+{ TODO: Handle RichEdit CRLF emulation at the WndProc level. }
+{ TODO: TTntCustomTreeView events - reintroduce ones that refer to ansi classes (ie. TTreeNode) }
+{ TODO: THotKey, Tanimate, TCoolBar (TCoolBand) }
+{ TODO: TToolBar: Unicode-enable TBN_GETBUTTONINFO/DoGetButton }
+{ TODO: TToolBar: Unicode-enable handling of CN_DIALOGCHAR, WM_SYSCOMMAND, FindButtonFromAccel }
+
+uses
+ Classes, Controls, ListActns, Menus, ComCtrls, Messages,
+ Windows, CommCtrl, Contnrs, TntControls, TntClasses, Graphics, TntSysUtils;
+
+type
+ TTntCustomListView = class;
+ TTntListItems = class;
+
+{TNT-WARN TListColumn}
+ TTntListColumn = class(TListColumn{TNT-ALLOW TListColumn})
+ private
+ FCaption: WideString;
+ procedure SetInheritedCaption(const Value: AnsiString);
+ function GetCaption: WideString;
+ procedure SetCaption(const Value: WideString);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ public
+ procedure Assign(Source: TPersistent); override;
+ published
+ property Caption: WideString read GetCaption write SetCaption;
+ end;
+
+{TNT-WARN TListColumns}
+ TTntListColumns = class(TListColumns{TNT-ALLOW TListColumns})
+ private
+ function GetItem(Index: Integer): TTntListColumn;
+ procedure SetItem(Index: Integer; Value: TTntListColumn);
+ public
+ constructor Create(AOwner: TTntCustomListView);
+ function Add: TTntListColumn;
+ function Owner: TTntCustomListView;
+ property Items[Index: Integer]: TTntListColumn read GetItem write SetItem; default;
+ end;
+
+{TNT-WARN TListItem}
+ TTntListItem = class(TListItem{TNT-ALLOW TListItem})
+ private
+ FCaption: WideString;
+ FSubItems: TTntStrings;
+ procedure SetInheritedCaption(const Value: AnsiString);
+ function GetCaption: WideString;
+ procedure SetCaption(const Value: WideString);
+ procedure SetSubItems(const Value: TTntStrings);
+ function GetListView: TTntCustomListView;
+ function GetTntOwner: TTntListItems;
+ public
+ constructor Create(AOwner: TListItems{TNT-ALLOW TListItems}); virtual;
+ destructor Destroy; override;
+ property Owner: TTntListItems read GetTntOwner;
+ property ListView: TTntCustomListView read GetListView;
+ procedure Assign(Source: TPersistent); override;
+ property Caption: WideString read GetCaption write SetCaption;
+ property SubItems: TTntStrings read FSubItems write SetSubItems;
+ end;
+
+ TTntListItemsEnumerator = class
+ private
+ FIndex: Integer;
+ FListItems: TTntListItems;
+ public
+ constructor Create(AListItems: TTntListItems);
+ function GetCurrent: TTntListItem;
+ function MoveNext: Boolean;
+ property Current: TTntListItem read GetCurrent;
+ end;
+
+{TNT-WARN TListItems}
+ TTntListItems = class(TListItems{TNT-ALLOW TListItems})
+ private
+ function GetItem(Index: Integer): TTntListItem;
+ procedure SetItem(Index: Integer; const Value: TTntListItem);
+ public
+ function Owner: TTntCustomListView;
+ property Item[Index: Integer]: TTntListItem read GetItem write SetItem; default;
+ function Add: TTntListItem;
+ function AddItem(Item: TTntListItem; Index: Integer = -1): TTntListItem;
+ function GetEnumerator: TTntListItemsEnumerator;
+ function Insert(Index: Integer): TTntListItem;
+ end;
+
+ TTntLVEditedEvent = procedure(Sender: TObject; Item: TTntListItem; var S: WideString) of object;
+ TTntLVOwnerDataFindEvent = procedure(Sender: TObject; Find: TItemFind;
+ const FindString: WideString; const FindPosition: TPoint; FindData: Pointer;
+ StartIndex: Integer; Direction: TSearchDirection; Wrap: Boolean;
+ var Index: Integer) of object;
+
+{TNT-WARN TCustomListView}
+ _TntInternalCustomListView = class(TCustomListView{TNT-ALLOW TCustomListView})
+ private
+ PWideFindString: PWideChar;
+ CurrentDispInfo: PLVDispInfoW;
+ OriginalDispInfoMask: Cardinal;
+ function OwnerDataFindW(Find: TItemFind; const FindString: WideString;
+ const FindPosition: TPoint; FindData: Pointer; StartIndex: Integer;
+ Direction: TSearchDirection; Wrap: Boolean): Integer; virtual; abstract;
+ function OwnerDataFetchW(Item: TListItem{TNT-ALLOW TListItem}; Request: TItemRequest): Boolean; virtual; abstract;
+ protected
+ function OwnerDataFind(Find: TItemFind; const FindString: AnsiString;
+ const FindPosition: TPoint; FindData: Pointer; StartIndex: Integer;
+ Direction: TSearchDirection; Wrap: Boolean): Integer; override;
+ function OwnerDataFetch(Item: TListItem{TNT-ALLOW TListItem}; Request: TItemRequest): Boolean; override;
+ end;
+
+ TTntCustomListView = class(_TntInternalCustomListView, IWideCustomListControl)
+ private
+ FEditHandle: THandle;
+ FEditInstance: Pointer;
+ FDefEditProc: Pointer;
+ FOnEdited: TTntLVEditedEvent;
+ FOnDataFind: TTntLVOwnerDataFindEvent;
+ procedure EditWndProcW(var Message: TMessage);
+ procedure BeginChangingWideItem;
+ procedure EndChangingWideItem;
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ function IsHintStored: Boolean;
+ function GetListColumns: TTntListColumns;
+ procedure SetListColumns(const Value: TTntListColumns);
+ function ColumnFromIndex(Index: Integer): TTntListColumn;
+ function GetColumnFromTag(Tag: Integer): TTntListColumn;
+ function OwnerDataFindW(Find: TItemFind; const FindString: WideString;
+ const FindPosition: TPoint; FindData: Pointer; StartIndex: Integer;
+ Direction: TSearchDirection; Wrap: Boolean): Integer; override;
+ function OwnerDataFetchW(Item: TListItem{TNT-ALLOW TListItem}; Request: TItemRequest): Boolean; override;
+ function GetDropTarget: TTntListItem;
+ procedure SetDropTarget(const Value: TTntListItem);
+ function GetItemFocused: TTntListItem;
+ procedure SetItemFocused(const Value: TTntListItem);
+ function GetSelected: TTntListItem;
+ procedure SetSelected(const Value: TTntListItem);
+ function GetTopItem: TTntListItem;
+ private
+ FSavedItems: TObjectList;
+ FTestingForSortProc: Boolean;
+ FChangingWideItemCount: Integer;
+ FTempItem: TTntListItem;
+ function AreItemsStored: Boolean;
+ function GetItems: TTntListItems;
+ procedure SetItems(Value: TTntListItems);
+ procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
+ function GetItemW(Value: TLVItemW): TTntListItem;
+ procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
+ protected
+ procedure CreateWindowHandle(const Params: TCreateParams); override;
+ procedure DefineProperties(Filer: TFiler); override;
+ function GetActionLinkClass: TControlActionLinkClass; override;
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ procedure CreateWnd; override;
+ procedure DestroyWnd; override;
+ procedure WndProc(var Message: TMessage); override;
+ function OwnerDataFetch(Item: TListItem{TNT-ALLOW TListItem}; Request: TItemRequest): Boolean; reintroduce; virtual;
+ function CreateListItem: TListItem{TNT-ALLOW TListItem}; override;
+ function CreateListItems: TListItems{TNT-ALLOW TListItems}; override;
+ property Items: TTntListItems read GetItems write SetItems stored AreItemsStored;
+ procedure Edit(const Item: TLVItem); override;
+ function OwnerDataFind(Find: TItemFind; const FindString: WideString;
+ const FindPosition: TPoint; FindData: Pointer; StartIndex: Integer;
+ Direction: TSearchDirection; Wrap: Boolean): Integer; reintroduce; virtual;
+ property Columns: TTntListColumns read GetListColumns write SetListColumns;
+ procedure DrawItem(Item: TListItem{TNT-ALLOW TListItem}; Rect: TRect; State: TOwnerDrawState); override;
+ property OnEdited: TTntLVEditedEvent read FOnEdited write FOnEdited;
+ property OnDataFind: TTntLVOwnerDataFindEvent read FOnDataFind write FOnDataFind;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ property Column[Index: Integer]: TTntListColumn read ColumnFromIndex;
+ procedure CopySelection(Destination: TCustomListControl); override;
+ procedure AddItem(const Item: WideString; AObject: TObject); reintroduce; virtual;
+ function FindCaption(StartIndex: Integer; Value: WideString; Partial,
+ Inclusive, Wrap: Boolean): TTntListItem;
+ function GetSearchString: WideString;
+ function StringWidth(S: WideString): Integer;
+ public
+ property DropTarget: TTntListItem read GetDropTarget write SetDropTarget;
+ property ItemFocused: TTntListItem read GetItemFocused write SetItemFocused;
+ property Selected: TTntListItem read GetSelected write SetSelected;
+ property TopItem: TTntListItem read GetTopItem;
+ published
+ property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ end;
+
+{TNT-WARN TListView}
+ TTntListView = class(TTntCustomListView)
+ published
+ property Action;
+ property Align;
+ property AllocBy;
+ property Anchors;
+ property BevelEdges;
+ property BevelInner;
+ property BevelOuter;
+ property BevelKind default bkNone;
+ property BevelWidth;
+ property BiDiMode;
+ property BorderStyle;
+ property BorderWidth;
+ property Checkboxes;
+ property Color;
+ property Columns;
+ property ColumnClick;
+ property Constraints;
+ property Ctl3D;
+ property DragCursor;
+ property DragKind;
+ property DragMode;
+ property Enabled;
+ property Font;
+ property FlatScrollBars;
+ property FullDrag;
+ property GridLines;
+ property HideSelection;
+ property HotTrack;
+ property HotTrackStyles;
+ property HoverTime;
+ property IconOptions;
+ property Items;
+ property LargeImages;
+ property MultiSelect;
+ property OwnerData;
+ property OwnerDraw;
+ property ReadOnly default False;
+ property RowSelect;
+ property ParentBiDiMode;
+ property ParentColor default False;
+ property ParentFont;
+ property ParentShowHint;
+ property PopupMenu;
+ property ShowColumnHeaders;
+ property ShowWorkAreas;
+ property ShowHint;
+ property SmallImages;
+ property SortType;
+ property StateImages;
+ property TabOrder;
+ property TabStop default True;
+ property ViewStyle;
+ property Visible;
+ property OnAdvancedCustomDraw;
+ property OnAdvancedCustomDrawItem;
+ property OnAdvancedCustomDrawSubItem;
+ property OnChange;
+ property OnChanging;
+ property OnClick;
+ property OnColumnClick;
+ property OnColumnDragged;
+ property OnColumnRightClick;
+ property OnCompare;
+ property OnContextPopup;
+ property OnCustomDraw;
+ property OnCustomDrawItem;
+ property OnCustomDrawSubItem;
+ property OnData;
+ property OnDataFind;
+ property OnDataHint;
+ property OnDataStateChange;
+ property OnDblClick;
+ property OnDeletion;
+ property OnDrawItem;
+ property OnEdited;
+ property OnEditing;
+ property OnEndDock;
+ property OnEndDrag;
+ property OnEnter;
+ property OnExit;
+ property OnGetImageIndex;
+ property OnGetSubItemImage;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnInfoTip;
+ property OnInsert;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ {$IFDEF COMPILER_9_UP}
+ property OnMouseActivate;
+ {$ENDIF}
+ property OnMouseDown;
+ {$IFDEF COMPILER_10_UP}
+ property OnMouseEnter;
+ property OnMouseLeave;
+ {$ENDIF}
+ property OnMouseMove;
+ property OnMouseUp;
+ property OnResize;
+ property OnSelectItem;
+ property OnStartDock;
+ property OnStartDrag;
+ end;
+
+type
+{TNT-WARN TToolButton}
+ TTntToolButton = class(TToolButton{TNT-ALLOW TToolButton})
+ private
+ procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
+ function GetCaption: TWideCaption;
+ procedure SetCaption(const Value: TWideCaption);
+ function IsCaptionStored: Boolean;
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ function IsHintStored: Boolean;
+ procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
+ function GetMenuItem: TMenuItem{TNT-ALLOW TMenuItem};
+ procedure SetMenuItem(const Value: TMenuItem{TNT-ALLOW TMenuItem});
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ function GetActionLinkClass: TControlActionLinkClass; override;
+ published
+ property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
+ property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ property MenuItem: TMenuItem{TNT-ALLOW TMenuItem} read GetMenuItem write SetMenuItem;
+ end;
+
+type
+{TNT-WARN TToolBar}
+ TTntToolBar = class(TToolBar{TNT-ALLOW TToolBar})
+ private
+ FCaption: WideString;
+ procedure TBInsertButtonA(var Message: TMessage); message TB_INSERTBUTTONA;
+ procedure WMGetText(var Message: TWMGetText); message WM_GETTEXT;
+ procedure WMGetTextLength(var Message: TWMGetTextLength); message WM_GETTEXTLENGTH;
+ procedure WMSetText(var Message: TWMSetText); message WM_SETTEXT;
+ function GetMenu: TMainMenu{TNT-ALLOW TMainMenu};
+ procedure SetMenu(const Value: TMainMenu{TNT-ALLOW TMainMenu});
+ private
+ function GetCaption: WideString;
+ function GetHint: WideString;
+ function IsCaptionStored: Boolean;
+ function IsHintStored: Boolean;
+ procedure SetCaption(const Value: WideString);
+ procedure SetHint(const Value: WideString);
+ protected
+ procedure CreateWindowHandle(const Params: TCreateParams); override;
+ procedure DefineProperties(Filer: TFiler); override;
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ function GetActionLinkClass: TControlActionLinkClass; override;
+ published
+ property Caption: WideString read GetCaption write SetCaption stored IsCaptionStored;
+ property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ property Menu: TMainMenu{TNT-ALLOW TMainMenu} read GetMenu write SetMenu;
+ end;
+
+type
+{TNT-WARN TCustomRichEdit}
+ TTntCustomRichEdit = class(TCustomRichEdit{TNT-ALLOW TCustomRichEdit})
+ private
+ FRichEditStrings: TTntStrings;
+ FPrintingTextLength: Integer;
+ procedure WMGetTextLength(var Message: TWMGetTextLength); message WM_GETTEXTLENGTH;
+ procedure SetRichEditStrings(const Value: TTntStrings);
+ function GetWideSelText: WideString;
+ function GetText: WideString;
+ procedure SetWideSelText(const Value: WideString);
+ procedure SetText(const Value: WideString);
+ function GetHint: WideString;
+ function IsHintStored: Boolean;
+ procedure SetHint(const Value: WideString);
+ procedure SetRTFText(Flags: DWORD; const Value: AnsiString);
+ protected
+ procedure CreateParams(var Params: TCreateParams); override;
+ procedure CreateWindowHandle(const Params: TCreateParams); override;
+ procedure CreateWnd; override;
+ procedure DefineProperties(Filer: TFiler); override;
+ function GetActionLinkClass: TControlActionLinkClass; override;
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ procedure KeyDown(var Key: Word; Shift: TShiftState); override;
+ function GetSelText: string{TNT-ALLOW string}; override;
+ function CharPosToGet(RawWin32CharPos: Integer): Integer; deprecated; // use EmulatedCharPos()
+ function CharPosToSet(EmulatedCharPos: Integer): Integer; deprecated; // use RawWin32CharPos()
+ function GetSelStart: Integer; reintroduce; virtual;
+ procedure SetSelStart(const Value: Integer); reintroduce; virtual;
+ function GetSelLength: Integer; reintroduce; virtual;
+ procedure SetSelLength(const Value: Integer); reintroduce; virtual;
+ function LineBreakStyle: TTntTextLineBreakStyle;
+ property Lines: TTntStrings read FRichEditStrings write SetRichEditStrings;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ //
+ function EmulatedCharPos(RawWin32CharPos: Integer): Integer;
+ function RawWin32CharPos(EmulatedCharPos: Integer): Integer;
+ //
+ procedure Print(const Caption: string{TNT-ALLOW string}); override;
+ property SelText: WideString read GetWideSelText write SetWideSelText;
+ property SelStart: Integer read GetSelStart write SetSelStart;
+ property SelLength: Integer read GetSelLength write SetSelLength;
+ property Text: WideString read GetText write SetText;
+ function FindText(const SearchStr: WideString; StartPos,
+ Length: Integer; Options: TSearchTypes): Integer;
+ published
+ property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ end;
+
+{TNT-WARN TRichEdit}
+ TTntRichEdit = class(TTntCustomRichEdit)
+ published
+ property Align;
+ property Alignment;
+ property Anchors;
+ property BevelEdges;
+ property BevelInner;
+ property BevelOuter;
+ property BevelKind default bkNone;
+ property BevelWidth;
+ property BiDiMode;
+ property BorderStyle;
+ property BorderWidth;
+ property Color;
+ property Ctl3D;
+ property DragCursor;
+ property DragKind;
+ property DragMode;
+ property Enabled;
+ property Font;
+ property HideSelection;
+ property HideScrollBars;
+ property ImeMode;
+ property ImeName;
+ property Constraints;
+ property Lines;
+ property MaxLength;
+ property ParentBiDiMode;
+ property ParentColor;
+ property ParentCtl3D;
+ property ParentFont;
+ property ParentShowHint;
+ property PlainText;
+ property PopupMenu;
+ property ReadOnly;
+ property ScrollBars;
+ property ShowHint;
+ property TabOrder;
+ property TabStop default True;
+ property Visible;
+ property WantTabs;
+ property WantReturns;
+ property WordWrap;
+ property OnChange;
+ property OnClick;
+ property OnContextPopup;
+ property OnDblClick;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEndDock;
+ property OnEndDrag;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ {$IFDEF COMPILER_9_UP}
+ property OnMouseActivate;
+ {$ENDIF}
+ property OnMouseDown;
+ {$IFDEF COMPILER_10_UP}
+ property OnMouseEnter;
+ property OnMouseLeave;
+ {$ENDIF}
+ property OnMouseMove;
+ property OnMouseUp;
+ property OnMouseWheel;
+ property OnMouseWheelDown;
+ property OnMouseWheelUp;
+ property OnProtectChange;
+ property OnResizeRequest;
+ property OnSaveClipboard;
+ property OnSelectionChange;
+ property OnStartDock;
+ property OnStartDrag;
+ end;
+
+type
+{TNT-WARN TCustomTabControl}
+ TTntCustomTabControl = class(TCustomTabControl{TNT-ALLOW TCustomTabControl})
+ private
+ FTabs: TTntStrings;
+ FSaveTabIndex: Integer;
+ FSaveTabs: TTntStrings;
+ function GetTabs: TTntStrings;
+ procedure SetTabs(const Value: TTntStrings);
+ procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
+ function GetHint: WideString;
+ function IsHintStored: Boolean;
+ procedure SetHint(const Value: WideString);
+ protected
+ procedure CreateWindowHandle(const Params: TCreateParams); override;
+ procedure DefineProperties(Filer: TFiler); override;
+ function GetActionLinkClass: TControlActionLinkClass; override;
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ procedure CreateWnd; override;
+ procedure DestroyWnd; override;
+ property Tabs: TTntStrings read GetTabs write SetTabs;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ published
+ property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ end;
+
+{TNT-WARN TTabControl}
+ TTntTabControl = class(TTntCustomTabControl)
+ public
+ property DisplayRect;
+ published
+ property Align;
+ property Anchors;
+ property BiDiMode;
+ property Constraints;
+ property DockSite;
+ property DragCursor;
+ property DragKind;
+ property DragMode;
+ property Enabled;
+ property Font;
+ property HotTrack;
+ property Images;
+ property MultiLine;
+ property MultiSelect;
+ property OwnerDraw;
+ property ParentBiDiMode;
+ property ParentFont;
+ property ParentShowHint;
+ property PopupMenu;
+ property RaggedRight;
+ property ScrollOpposite;
+ property ShowHint;
+ property Style;
+ property TabHeight;
+ property TabOrder;
+ property TabPosition;
+ property Tabs;
+ property TabIndex; // must be after Tabs
+ property TabStop;
+ property TabWidth;
+ property Visible;
+ property OnChange;
+ property OnChanging;
+ property OnContextPopup;
+ property OnDockDrop;
+ property OnDockOver;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnDrawTab;
+ property OnEndDock;
+ property OnEndDrag;
+ property OnEnter;
+ property OnExit;
+ property OnGetImageIndex;
+ property OnGetSiteInfo;
+ {$IFDEF COMPILER_9_UP}
+ property OnMouseActivate;
+ {$ENDIF}
+ property OnMouseDown;
+ {$IFDEF COMPILER_10_UP}
+ property OnMouseEnter;
+ property OnMouseLeave;
+ {$ENDIF}
+ property OnMouseMove;
+ property OnMouseUp;
+ property OnResize;
+ property OnStartDock;
+ property OnStartDrag;
+ property OnUnDock;
+ end;
+
+type
+{TNT-WARN TTabSheet}
+ TTntTabSheet = class(TTabSheet{TNT-ALLOW TTabSheet})
+ private
+ Force_Inherited_WMSETTEXT: Boolean;
+ function IsCaptionStored: Boolean;
+ function GetCaption: TWideCaption;
+ procedure SetCaption(const Value: TWideCaption);
+ procedure WMSetText(var Message: TWMSetText); message WM_SETTEXT;
+ function GetHint: WideString;
+ function IsHintStored: Boolean;
+ procedure SetHint(const Value: WideString);
+ protected
+ procedure CreateWindowHandle(const Params: TCreateParams); override;
+ procedure DefineProperties(Filer: TFiler); override;
+ function GetActionLinkClass: TControlActionLinkClass; override;
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ published
+ property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
+ property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ end;
+
+{TNT-WARN TPageControl}
+ TTntPageControl = class(TPageControl{TNT-ALLOW TPageControl})
+ private
+ FNewDockSheet: TTntTabSheet;
+ function IsHintStored: Boolean;
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
+ procedure CMDockNotification(var Message: TCMDockNotification); message CM_DOCKNOTIFICATION;
+ procedure CMDockClient(var Message: TCMDockClient); message CM_DOCKCLIENT;
+ protected
+ procedure CreateWindowHandle(const Params: TCreateParams); override;
+ procedure DefineProperties(Filer: TFiler); override;
+ function GetActionLinkClass: TControlActionLinkClass; override;
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ procedure WndProc(var Message: TMessage); override;
+ procedure DoAddDockClient(Client: TControl; const ARect: TRect); override;
+ published
+ property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ end;
+
+{TNT-WARN TTrackBar}
+ TTntTrackBar = class(TTrackBar{TNT-ALLOW TTrackBar})
+ private
+ function IsHintStored: Boolean;
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ protected
+ procedure CreateWindowHandle(const Params: TCreateParams); override;
+ procedure DefineProperties(Filer: TFiler); override;
+ function GetActionLinkClass: TControlActionLinkClass; override;
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ published
+ property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ end;
+
+{TNT-WARN TProgressBar}
+ TTntProgressBar = class(TProgressBar{TNT-ALLOW TProgressBar})
+ private
+ function IsHintStored: Boolean;
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ protected
+ procedure CreateWindowHandle(const Params: TCreateParams); override;
+ procedure DefineProperties(Filer: TFiler); override;
+ function GetActionLinkClass: TControlActionLinkClass; override;
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ published
+ property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ end;
+
+{TNT-WARN TCustomUpDown}
+ TTntCustomUpDown = class(TCustomUpDown{TNT-ALLOW TCustomUpDown})
+ private
+ function IsHintStored: Boolean;
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ protected
+ procedure CreateWindowHandle(const Params: TCreateParams); override;
+ procedure DefineProperties(Filer: TFiler); override;
+ function GetActionLinkClass: TControlActionLinkClass; override;
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ published
+ property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ end;
+
+{TNT-WARN TUpDown}
+ TTntUpDown = class(TTntCustomUpDown)
+ published
+ property AlignButton;
+ property Anchors;
+ property Associate;
+ property ArrowKeys;
+ property Enabled;
+ property Hint;
+ property Min;
+ property Max;
+ property Increment;
+ property Constraints;
+ property Orientation;
+ property ParentShowHint;
+ property PopupMenu;
+ property Position;
+ property ShowHint;
+ property TabOrder;
+ property TabStop;
+ property Thousands;
+ property Visible;
+ property Wrap;
+ property OnChanging;
+ property OnChangingEx;
+ property OnContextPopup;
+ property OnClick;
+ property OnEnter;
+ property OnExit;
+ {$IFDEF COMPILER_9_UP}
+ property OnMouseActivate;
+ {$ENDIF}
+ property OnMouseDown;
+ {$IFDEF COMPILER_10_UP}
+ property OnMouseEnter;
+ property OnMouseLeave;
+ {$ENDIF}
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+
+{TNT-WARN TDateTimePicker}
+ TTntDateTimePicker = class(TDateTimePicker{TNT-ALLOW TDateTimePicker})
+ private
+ FHadFirstMouseClick: Boolean;
+ function IsHintStored: Boolean;
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
+ protected
+ procedure CreateWindowHandle(const Params: TCreateParams); override;
+ procedure CreateWnd; override;
+ procedure DefineProperties(Filer: TFiler); override;
+ function GetActionLinkClass: TControlActionLinkClass; override;
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ published
+ property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ end;
+
+{TNT-WARN TMonthCalendar}
+ TTntMonthCalendar = class(TMonthCalendar{TNT-ALLOW TMonthCalendar})
+ private
+ function IsHintStored: Boolean;
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ function GetDate: TDate;
+ procedure SetDate(const Value: TDate);
+ protected
+ procedure CreateWindowHandle(const Params: TCreateParams); override;
+ procedure DefineProperties(Filer: TFiler); override;
+ function GetActionLinkClass: TControlActionLinkClass; override;
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ public
+ procedure ForceGetMonthInfo;
+ published
+ property Date: TDate read GetDate write SetDate;
+ property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ end;
+
+{TNT-WARN TPageScroller}
+ TTntPageScroller = class(TPageScroller{TNT-ALLOW TPageScroller})
+ private
+ function IsHintStored: Boolean;
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ protected
+ procedure CreateWindowHandle(const Params: TCreateParams); override;
+ procedure DefineProperties(Filer: TFiler); override;
+ function GetActionLinkClass: TControlActionLinkClass; override;
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ published
+ property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ end;
+
+type
+{TNT-WARN TStatusPanel}
+ TTntStatusPanel = class(TStatusPanel{TNT-ALLOW TStatusPanel})
+ private
+ FText: WideString;
+ function GetText: Widestring;
+ procedure SetText(const Value: Widestring);
+ procedure SetInheritedText(const Value: AnsiString);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ public
+ procedure Assign(Source: TPersistent); override;
+ published
+ property Text: Widestring read GetText write SetText;
+ end;
+
+{TNT-WARN TStatusPanels}
+ TTntStatusPanels = class(TStatusPanels{TNT-ALLOW TStatusPanels})
+ private
+ function GetItem(Index: Integer): TTntStatusPanel;
+ procedure SetItem(Index: Integer; Value: TTntStatusPanel);
+ public
+ function Add: TTntStatusPanel;
+ function AddItem(Item: TTntStatusPanel; Index: Integer): TTntStatusPanel;
+ function Insert(Index: Integer): TTntStatusPanel;
+ property Items[Index: Integer]: TTntStatusPanel read GetItem write SetItem; default;
+ end;
+
+{TNT-WARN TCustomStatusBar}
+ TTntCustomStatusBar = class(TCustomStatusBar{TNT-ALLOW TCustomStatusBar})
+ private
+ FSimpleText: WideString;
+ function GetSimpleText: WideString;
+ procedure SetSimpleText(const Value: WideString);
+ procedure SetInheritedSimpleText(const Value: AnsiString);
+ function SyncLeadingTabs(const WideVal: WideString; const AnsiVal: AnsiString): WideString;
+ function GetHint: WideString;
+ function IsHintStored: Boolean;
+ procedure SetHint(const Value: WideString);
+ procedure WMGetTextLength(var Message: TWMGetTextLength); message WM_GETTEXTLENGTH;
+ function GetPanels: TTntStatusPanels;
+ procedure SetPanels(const Value: TTntStatusPanels);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ function CreatePanels: TStatusPanels{TNT-ALLOW TStatusPanels}; override;
+ function GetPanelClass: TStatusPanelClass; override;
+ procedure CreateWindowHandle(const Params: TCreateParams); override;
+ procedure WndProc(var Msg: TMessage); override;
+ function GetActionLinkClass: TControlActionLinkClass; override;
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ public
+ function ExecuteAction(Action: TBasicAction): Boolean; override;
+ property Panels: TTntStatusPanels read GetPanels write SetPanels;
+ property SimpleText: WideString read GetSimpleText write SetSimpleText;
+ published
+ property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ end;
+
+{TNT-WARN TStatusBar}
+ TTntStatusBar = class(TTntCustomStatusBar)
+ private
+ function GetOnDrawPanel: TDrawPanelEvent;
+ procedure SetOnDrawPanel(const Value: TDrawPanelEvent);
+ published
+ property Action;
+ property AutoHint default False;
+ property Align default alBottom;
+ property Anchors;
+ property BiDiMode;
+ property BorderWidth;
+ property Color default clBtnFace;
+ property DragCursor;
+ property DragKind;
+ property DragMode;
+ property Enabled;
+ property Font stored IsFontStored;
+ property Constraints;
+ property Panels;
+ property ParentBiDiMode;
+ property ParentColor default False;
+ property ParentFont default False;
+ property ParentShowHint;
+ property PopupMenu;
+ property ShowHint;
+ property SimplePanel {$IFDEF COMPILER_7_UP} default False {$ENDIF};
+ property SimpleText;
+ property SizeGrip default True;
+ property UseSystemFont default True;
+ property Visible;
+ property OnClick;
+ property OnContextPopup;
+ property OnCreatePanelClass;
+ property OnDblClick;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEndDock;
+ property OnEndDrag;
+ property OnHint;
+ {$IFDEF COMPILER_9_UP}
+ property OnMouseActivate;
+ {$ENDIF}
+ property OnMouseDown;
+ {$IFDEF COMPILER_10_UP}
+ property OnMouseEnter;
+ property OnMouseLeave;
+ {$ENDIF}
+ property OnMouseMove;
+ property OnMouseUp;
+ // Required for backwards compatibility with the old event signature
+ property OnDrawPanel: TDrawPanelEvent read GetOnDrawPanel write SetOnDrawPanel;
+ property OnResize;
+ property OnStartDock;
+ property OnStartDrag;
+ end;
+
+type
+ TTntTreeNodes = class;
+ TTntCustomTreeView = class;
+
+{TNT-WARN TTreeNode}
+ TTntTreeNode = class(TTreeNode{TNT-ALLOW TTreeNode})
+ private
+ FText: WideString;
+ procedure SetText(const Value: WideString);
+ procedure SetInheritedText(const Value: AnsiString);
+ function GetText: WideString;
+ function GetItem(Index: Integer): TTntTreeNode;
+ function GetNodeOwner: TTntTreeNodes;
+ function GetParent: TTntTreeNode;
+ function GetTreeView: TTntCustomTreeView;
+ procedure SetItem(Index: Integer; const Value: TTntTreeNode);
+ function IsEqual(Node: TTntTreeNode): Boolean;
+ procedure ReadData(Stream: TStream; Info: PNodeInfo);
+ procedure WriteData(Stream: TStream; Info: PNodeInfo);
+ public
+ procedure Assign(Source: TPersistent); override;
+ function getFirstChild: TTntTreeNode; {GetFirstChild conflicts with C++ macro}
+ function GetLastChild: TTntTreeNode;
+ function GetNext: TTntTreeNode;
+ function GetNextChild(Value: TTntTreeNode): TTntTreeNode;
+ function getNextSibling: TTntTreeNode; {GetNextSibling conflicts with C++ macro}
+ function GetNextVisible: TTntTreeNode;
+ function GetPrev: TTntTreeNode;
+ function GetPrevChild(Value: TTntTreeNode): TTntTreeNode;
+ function getPrevSibling: TTntTreeNode; {GetPrevSibling conflicts with a C++ macro}
+ function GetPrevVisible: TTntTreeNode;
+ property Item[Index: Integer]: TTntTreeNode read GetItem write SetItem; default;
+ property Owner: TTntTreeNodes read GetNodeOwner;
+ property Parent: TTntTreeNode read GetParent;
+ property Text: WideString read GetText write SetText;
+ property TreeView: TTntCustomTreeView read GetTreeView;
+ end;
+
+ TTntTreeNodeClass = class of TTntTreeNode;
+
+ TTntTreeNodesEnumerator = class
+ private
+ FIndex: Integer;
+ FTreeNodes: TTntTreeNodes;
+ public
+ constructor Create(ATreeNodes: TTntTreeNodes);
+ function GetCurrent: TTntTreeNode;
+ function MoveNext: Boolean;
+ property Current: TTntTreeNode read GetCurrent;
+ end;
+
+{TNT-WARN TTreeNodes}
+ TTntTreeNodes = class(TTreeNodes{TNT-ALLOW TTreeNodes})
+ private
+ function GetNodeFromIndex(Index: Integer): TTntTreeNode;
+ function GetNodesOwner: TTntCustomTreeView;
+ procedure ClearCache;
+ procedure ReadData(Stream: TStream);
+ procedure WriteData(Stream: TStream);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ public
+ procedure Assign(Source: TPersistent); override;
+ function Add(Sibling: TTntTreeNode; const S: WideString): TTntTreeNode;
+ function AddChild(Parent: TTntTreeNode; const S: WideString): TTntTreeNode;
+ function AddChildFirst(Parent: TTntTreeNode; const S: WideString): TTntTreeNode;
+ function AddChildObject(Parent: TTntTreeNode; const S: WideString;
+ Ptr: Pointer): TTntTreeNode;
+ function AddChildObjectFirst(Parent: TTntTreeNode; const S: WideString;
+ Ptr: Pointer): TTntTreeNode;
+ function AddFirst(Sibling: TTntTreeNode; const S: WideString): TTntTreeNode;
+ function AddObject(Sibling: TTntTreeNode; const S: WideString;
+ Ptr: Pointer): TTntTreeNode;
+ function AddObjectFirst(Sibling: TTntTreeNode; const S: WideString;
+ Ptr: Pointer): TTntTreeNode;
+ function Insert(Sibling: TTntTreeNode; const S: WideString): TTntTreeNode;
+ function InsertObject(Sibling: TTntTreeNode; const S: WideString;
+ Ptr: Pointer): TTntTreeNode;
+ function InsertNode(Node, Sibling: TTntTreeNode; const S: WideString;
+ Ptr: Pointer): TTntTreeNode;
+ function AddNode(Node, Relative: TTntTreeNode; const S: WideString;
+ Ptr: Pointer; Method: TNodeAttachMode): TTntTreeNode;
+ public
+ function GetFirstNode: TTntTreeNode;
+ function GetEnumerator: TTntTreeNodesEnumerator;
+ function GetNode(ItemId: HTreeItem): TTntTreeNode;
+ property Item[Index: Integer]: TTntTreeNode read GetNodeFromIndex; default;
+ property Owner: TTntCustomTreeView read GetNodesOwner;
+ end;
+
+ TTntTVEditedEvent = procedure(Sender: TObject; Node: TTntTreeNode; var S: WideString) of object;
+
+{TNT-WARN TCustomTreeView}
+ _TntInternalCustomTreeView = class(TCustomTreeView{TNT-ALLOW TCustomTreeView})
+ private
+ function Wide_FindNextToSelect: TTntTreeNode; virtual; abstract;
+ function Inherited_FindNextToSelect: TTreeNode{TNT-ALLOW TTreeNode};
+ public
+ function FindNextToSelect: TTreeNode{TNT-ALLOW TTreeNode}; override;
+ end;
+
+ TTntCustomTreeView = class(_TntInternalCustomTreeView)
+ private
+ FSavedNodeText: TTntStrings;
+ FSavedSortType: TSortType;
+ FOnEdited: TTntTVEditedEvent;
+ FTestingForSortProc: Boolean;
+ FEditHandle: THandle;
+ FEditInstance: Pointer;
+ FDefEditProc: Pointer;
+ function GetTreeNodes: TTntTreeNodes;
+ procedure SetTreeNodes(const Value: TTntTreeNodes);
+ procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
+ procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
+ function GetNodeFromItem(const Item: TTVItem): TTntTreeNode;
+ procedure EditWndProcW(var Message: TMessage);
+ function Wide_FindNextToSelect: TTntTreeNode; override;
+ function GetDropTarget: TTntTreeNode;
+ function GetSelected: TTntTreeNode;
+ function GetSelection(Index: Integer): TTntTreeNode;
+ function GetTopItem: TTntTreeNode;
+ procedure SetDropTarget(const Value: TTntTreeNode);
+ procedure SetSelected(const Value: TTntTreeNode);
+ procedure SetTopItem(const Value: TTntTreeNode);
+ function GetHint: WideString;
+ function IsHintStored: Boolean;
+ procedure SetHint(const Value: WideString);
+ protected
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ function GetActionLinkClass: TControlActionLinkClass; override;
+ procedure CreateWindowHandle(const Params: TCreateParams); override;
+ procedure CreateWnd; override;
+ procedure DestroyWnd; override;
+ procedure DefineProperties(Filer: TFiler); override;
+ procedure WndProc(var Message: TMessage); override;
+ procedure Edit(const Item: TTVItem); override;
+ function CreateNode: TTreeNode{TNT-ALLOW TTreeNode}; override;
+ function CreateNodes: TTreeNodes{TNT-ALLOW TTreeNodes}; override;
+ property Items: TTntTreeNodes read GetTreeNodes write SetTreeNodes;
+ property OnEdited: TTntTVEditedEvent read FOnEdited write FOnEdited;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure LoadFromFile(const FileName: WideString);
+ procedure LoadFromStream(Stream: TStream);
+ procedure SaveToFile(const FileName: WideString);
+ procedure SaveToStream(Stream: TStream);
+ function GetNodeAt(X, Y: Integer): TTntTreeNode;
+ property DropTarget: TTntTreeNode read GetDropTarget write SetDropTarget;
+ property Selected: TTntTreeNode read GetSelected write SetSelected;
+ property TopItem: TTntTreeNode read GetTopItem write SetTopItem;
+ property Selections[Index: Integer]: TTntTreeNode read GetSelection;
+ function GetSelections(AList: TList): TTntTreeNode;
+ function FindNextToSelect: TTntTreeNode; reintroduce; virtual;
+ published
+ property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ end;
+
+{TNT-WARN TTreeView}
+ TTntTreeView = class(TTntCustomTreeView)
+ published
+ property Align;
+ property Anchors;
+ property AutoExpand;
+ property BevelEdges;
+ property BevelInner;
+ property BevelOuter;
+ property BevelKind default bkNone;
+ property BevelWidth;
+ property BiDiMode;
+ property BorderStyle;
+ property BorderWidth;
+ property ChangeDelay;
+ property Color;
+ property Ctl3D;
+ property Constraints;
+ property DragKind;
+ property DragCursor;
+ property DragMode;
+ property Enabled;
+ property Font;
+ property HideSelection;
+ property HotTrack;
+ property Images;
+ property Indent;
+ property MultiSelect;
+ property MultiSelectStyle;
+ property ParentBiDiMode;
+ property ParentColor default False;
+ property ParentCtl3D;
+ property ParentFont;
+ property ParentShowHint;
+ property PopupMenu;
+ property ReadOnly;
+ property RightClickSelect;
+ property RowSelect;
+ property ShowButtons;
+ property ShowHint;
+ property ShowLines;
+ property ShowRoot;
+ property SortType;
+ property StateImages;
+ property TabOrder;
+ property TabStop default True;
+ property ToolTips;
+ property Visible;
+ property OnAddition;
+ property OnAdvancedCustomDraw;
+ property OnAdvancedCustomDrawItem;
+ property OnChange;
+ property OnChanging;
+ property OnClick;
+ property OnCollapsed;
+ property OnCollapsing;
+ property OnCompare;
+ property OnContextPopup;
+ property OnCreateNodeClass;
+ property OnCustomDraw;
+ property OnCustomDrawItem;
+ property OnDblClick;
+ property OnDeletion;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEdited;
+ property OnEditing;
+ property OnEndDock;
+ property OnEndDrag;
+ property OnEnter;
+ property OnExit;
+ property OnExpanding;
+ property OnExpanded;
+ property OnGetImageIndex;
+ property OnGetSelectedIndex;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ {$IFDEF COMPILER_9_UP}
+ property OnMouseActivate;
+ {$ENDIF}
+ property OnMouseDown;
+ {$IFDEF COMPILER_10_UP}
+ property OnMouseEnter;
+ property OnMouseLeave;
+ {$ENDIF}
+ property OnMouseMove;
+ property OnMouseUp;
+ property OnStartDock;
+ property OnStartDrag;
+ { Items must be published after OnGetImageIndex and OnGetSelectedIndex }
+ property Items;
+ end;
+
+implementation
+
+uses
+ Forms, SysUtils, TntGraphics, ImgList, TntSystem, TntStdCtrls, StdCtrls,
+ RichEdit, ActiveIMM_TLB, TntForms, ComStrs, TntMenus,
+ TntActnList, TntStdActns, TntWindows,
+ {$IFNDEF COMPILER_10_UP}
+ TntWideStrings,
+ {$ELSE}
+ WideStrings,
+ {$ENDIF}
+ {$IFDEF COMPILER_9_UP} WideStrUtils {$ELSE} TntWideStrUtils {$ENDIF};
+
+procedure CreateUnicodeHandle_ComCtl(Control: TWinControl; const Params: TCreateParams;
+ const SubClass: WideString);
+begin
+ Assert(SubClass <> '', 'TNT Internal Error: Only call CreateUnicodeHandle_ComCtl for Common Controls.');
+ CreateUnicodeHandle(Control, Params, SubClass);
+ if Win32PlatformIsUnicode then
+ SendMessageW(Control.Handle, CCM_SETUNICODEFORMAT, Integer(True), 0);
+end;
+
+{ TTntListColumn }
+
+procedure TTntListColumn.Assign(Source: TPersistent);
+begin
+ inherited;
+ if Source is TTntListColumn then
+ Caption := TTntListColumn(Source).Caption
+ else if Source is TListColumn{TNT-ALLOW TListColumn} then
+ FCaption := TListColumn{TNT-ALLOW TListColumn}(Source).Caption;
+end;
+
+procedure TTntListColumn.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+procedure TTntListColumn.SetInheritedCaption(const Value: AnsiString);
+begin
+ inherited Caption := Value;
+end;
+
+function TTntListColumn.GetCaption: WideString;
+begin
+ Result := GetSyncedWideString(FCaption, inherited Caption);
+end;
+
+procedure TTntListColumn.SetCaption(const Value: WideString);
+begin
+ SetSyncedWideString(Value, FCaption, inherited Caption, SetInheritedCaption);
+end;
+
+{ TTntListColumns }
+
+{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
+type
+ THackCollection = class(TPersistent)
+ protected
+ FItemClass: TCollectionItemClass;
+ end;
+{$ENDIF}
+{$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
+type
+ THackCollection = class(TPersistent)
+ protected
+ FItemClass: TCollectionItemClass;
+ end;
+{$ENDIF}
+{$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
+type
+ THackCollection = class(TPersistent)
+ protected
+ FItemClass: TCollectionItemClass;
+ end;
+{$ENDIF}
+{$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
+type
+ THackCollection = class(TPersistent)
+ protected
+ FItemClass: TCollectionItemClass;
+ end;
+{$ENDIF}
+
+constructor TTntListColumns.Create(AOwner: TTntCustomListView);
+begin
+ inherited Create(AOwner);
+ Assert(THackCollection(Self).FItemClass = Self.ItemClass, 'Internal Error in TTntListColumns.Create().');
+ THackCollection(Self).FItemClass := TTntListColumn
+end;
+
+function TTntListColumns.Owner: TTntCustomListView;
+begin
+ Result := inherited Owner as TTntCustomListView;
+end;
+
+function TTntListColumns.Add: TTntListColumn;
+begin
+ Result := (inherited Add) as TTntListColumn;
+end;
+
+function TTntListColumns.GetItem(Index: Integer): TTntListColumn;
+begin
+ Result := inherited Items[Index] as TTntListColumn;
+end;
+
+procedure TTntListColumns.SetItem(Index: Integer; Value: TTntListColumn);
+begin
+ inherited SetItem(Index, Value);
+end;
+
+{ TWideSubItems }
+type
+ TWideSubItems = class(TTntStringList)
+ private
+ FIgnoreInherited: Boolean;
+ FInheritedOwner: TListItem{TNT-ALLOW TListItem};
+ FOwner: TTntListItem;
+ protected
+ procedure Put(Index: Integer; const S: WideString); override;
+ function GetObject(Index: Integer): TObject; override;
+ procedure PutObject(Index: Integer; AObject: TObject); override;
+ procedure SetUpdateState(Updating: Boolean); override;
+ public
+ procedure Insert(Index: Integer; const S: WideString); override;
+ function AddObject(const S: WideString; AObject: TObject): Integer; override;
+ procedure Clear; override;
+ procedure Delete(Index: Integer); override;
+ public
+ constructor Create(AOwner: TTntListItem);
+ end;
+
+constructor TWideSubItems.Create(AOwner: TTntListItem);
+begin
+ inherited Create;
+ FInheritedOwner := AOwner;
+ FOwner := AOwner;
+end;
+
+function TWideSubItems.AddObject(const S: WideString; AObject: TObject): Integer;
+begin
+ FOwner.ListView.BeginChangingWideItem;
+ try
+ Result := inherited AddObject(S, AObject);
+ if (not FIgnoreInherited) then
+ FInheritedOwner.SubItems.AddObject(S, AObject);
+ finally
+ FOwner.ListView.EndChangingWideItem;
+ end;
+end;
+
+procedure TWideSubItems.Clear;
+begin
+ FOwner.ListView.BeginChangingWideItem;
+ try
+ inherited;
+ if (not FIgnoreInherited) then
+ FInheritedOwner.SubItems.Clear;
+ finally
+ FOwner.ListView.EndChangingWideItem;
+ end;
+end;
+
+procedure TWideSubItems.Delete(Index: Integer);
+begin
+ FOwner.ListView.BeginChangingWideItem;
+ try
+ inherited;
+ if (not FIgnoreInherited) then
+ FInheritedOwner.SubItems.Delete(Index);
+ finally
+ FOwner.ListView.EndChangingWideItem;
+ end;
+end;
+
+procedure TWideSubItems.Insert(Index: Integer; const S: WideString);
+begin
+ FOwner.ListView.BeginChangingWideItem;
+ try
+ inherited;
+ if (not FIgnoreInherited) then
+ FInheritedOwner.SubItems.Insert(Index, S);
+ finally
+ FOwner.ListView.EndChangingWideItem;
+ end;
+end;
+
+procedure TWideSubItems.Put(Index: Integer; const S: WideString);
+begin
+ FOwner.ListView.BeginChangingWideItem;
+ try
+ inherited;
+ if (not FIgnoreInherited) then
+ FInheritedOwner.SubItems[Index] := S;
+ finally
+ FOwner.ListView.EndChangingWideItem;
+ end;
+end;
+
+function TWideSubItems.GetObject(Index: Integer): TObject;
+begin
+ Result := FInheritedOwner.SubItems.Objects[Index];
+end;
+
+procedure TWideSubItems.PutObject(Index: Integer; AObject: TObject);
+begin
+ FInheritedOwner.SubItems.Objects[Index] := AObject;
+end;
+
+type TAccessStrings = class(TStrings{TNT-ALLOW TStrings});
+
+procedure TWideSubItems.SetUpdateState(Updating: Boolean);
+begin
+ inherited;
+ TAccessStrings(FInheritedOwner.SubItems).SetUpdateState(Updating);
+end;
+
+{ TTntListItem }
+
+constructor TTntListItem.Create(AOwner: TListItems{TNT-ALLOW TListItems});
+begin
+ inherited Create(AOwner);
+ FSubItems := TWideSubItems.Create(Self);
+end;
+
+destructor TTntListItem.Destroy;
+begin
+ inherited;
+ FreeAndNil(FSubItems);
+end;
+
+function TTntListItem.GetCaption: WideString;
+begin
+ Result := GetSyncedWideString(FCaption, inherited Caption);
+end;
+
+procedure TTntListItem.SetInheritedCaption(const Value: AnsiString);
+begin
+ inherited Caption := Value;
+end;
+
+procedure TTntListItem.SetCaption(const Value: WideString);
+begin
+ ListView.BeginChangingWideItem;
+ try
+ SetSyncedWideString(Value, FCaption, inherited Caption, SetInheritedCaption);
+ finally
+ ListView.EndChangingWideItem;
+ end;
+end;
+
+procedure TTntListItem.Assign(Source: TPersistent);
+begin
+ if Source is TTntListItem then
+ with Source as TTntListItem do
+ begin
+ Self.Caption := Caption;
+ Self.Data := Data;
+ Self.ImageIndex := ImageIndex;
+ Self.Indent := Indent;
+ Self.OverlayIndex := OverlayIndex;
+ Self.StateIndex := StateIndex;
+ Self.SubItems := SubItems;
+ Self.Checked := Checked;
+ end
+ else inherited Assign(Source);
+end;
+
+procedure TTntListItem.SetSubItems(const Value: TTntStrings);
+begin
+ if Value <> nil then
+ FSubItems.Assign(Value);
+end;
+
+function TTntListItem.GetTntOwner: TTntListItems;
+begin
+ Result := ListView.Items;
+end;
+
+function TTntListItem.GetListView: TTntCustomListView;
+begin
+ Result := ((inherited Owner).Owner as TTntCustomListView);
+end;
+
+{ TTntListItemsEnumerator }
+
+constructor TTntListItemsEnumerator.Create(AListItems: TTntListItems);
+begin
+ inherited Create;
+ FIndex := -1;
+ FListItems := AListItems;
+end;
+
+function TTntListItemsEnumerator.GetCurrent: TTntListItem;
+begin
+ Result := FListItems[FIndex];
+end;
+
+function TTntListItemsEnumerator.MoveNext: Boolean;
+begin
+ Result := FIndex < FListItems.Count - 1;
+ if Result then
+ Inc(FIndex);
+end;
+
+{ TTntListItems }
+
+function TTntListItems.Add: TTntListItem;
+begin
+ Result := (inherited Add) as TTntListItem;
+end;
+
+function TTntListItems.AddItem(Item: TTntListItem; Index: Integer): TTntListItem;
+begin
+ Result := (inherited AddItem(Item, Index)) as TTntListItem;
+end;
+
+function TTntListItems.Insert(Index: Integer): TTntListItem;
+begin
+ Result := (inherited Insert(Index)) as TTntListItem;
+end;
+
+function TTntListItems.GetItem(Index: Integer): TTntListItem;
+begin
+ Result := (inherited Item[Index]) as TTntListItem;
+end;
+
+function TTntListItems.Owner: TTntCustomListView;
+begin
+ Result := (inherited Owner) as TTntCustomListView;
+end;
+
+procedure TTntListItems.SetItem(Index: Integer; const Value: TTntListItem);
+begin
+ inherited Item[Index] := Value;
+end;
+
+function TTntListItems.GetEnumerator: TTntListItemsEnumerator;
+begin
+ Result := TTntListItemsEnumerator.Create(Self);
+end;
+
+{ TSavedListItem }
+type
+ TSavedListItem = class
+ FCaption: WideString;
+ FSubItems: TTntStrings;
+ constructor Create;
+ destructor Destroy; override;
+ end;
+
+constructor TSavedListItem.Create;
+begin
+ inherited;
+ FSubItems := TTntStringList.Create;
+end;
+
+destructor TSavedListItem.Destroy;
+begin
+ FSubItems.Free;
+ inherited;
+end;
+
+{ _TntInternalCustomListView }
+
+function _TntInternalCustomListView.OwnerDataFind(Find: TItemFind;
+ const FindString: AnsiString; const FindPosition: TPoint;
+ FindData: Pointer; StartIndex: Integer; Direction: TSearchDirection;
+ Wrap: Boolean): Integer;
+var
+ WideFindString: WideString;
+begin
+ if Assigned(PWideFindString) then
+ WideFindString := PWideFindString
+ else
+ WideFindString := FindString;
+ Result := OwnerDataFindW(Find, WideFindString, FindPosition, FindData, StartIndex, Direction, Wrap);
+end;
+
+function _TntInternalCustomListView.OwnerDataFetch(Item: TListItem{TNT-ALLOW TListItem};
+ Request: TItemRequest): Boolean;
+begin
+ if (CurrentDispInfo <> nil)
+ and (OriginalDispInfoMask and LVIF_TEXT <> 0) then begin
+ (Item as TTntListItem).FCaption := CurrentDispInfo.item.pszText
+ end;
+ (Item as TTntListItem).FSubItems.Clear;
+ Result := OwnerDataFetchW(Item, Request);
+end;
+
+{ TTntCustomListView }
+
+{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
+type
+ THackCustomListView = class(TCustomMultiSelectListControl)
+ protected
+ FxxxCanvas: TCanvas;
+ FxxxBorderStyle: TBorderStyle;
+ FxxxViewStyle: TViewStyle;
+ FxxxReadOnly: Boolean;
+ FxxxLargeImages: TCustomImageList;
+ FxxxSmallImages: TCustomImageList;
+ FxxxStateImages: TCustomImageList;
+ FxxxDragImage: TDragImageList;
+ FxxxMultiSelect: Boolean;
+ FxxxSortType: TSortType;
+ FxxxColumnClick: Boolean;
+ FxxxShowColumnHeaders: Boolean;
+ FxxxListItems: TListItems{TNT-ALLOW TListItems};
+ FxxxClicked: Boolean;
+ FxxxRClicked: Boolean;
+ FxxxIconOptions: TIconOptions;
+ FxxxHideSelection: Boolean;
+ FListColumns: TListColumns{TNT-ALLOW TListColumns};
+ end;
+{$ENDIF}
+{$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
+type
+ THackCustomListView = class(TCustomMultiSelectListControl)
+ protected
+ FxxxCanvas: TCanvas;
+ FxxxBorderStyle: TBorderStyle;
+ FxxxViewStyle: TViewStyle;
+ FxxxReadOnly: Boolean;
+ FxxxLargeImages: TCustomImageList;
+ FxxxSmallImages: TCustomImageList;
+ FxxxStateImages: TCustomImageList;
+ FxxxDragImage: TDragImageList;
+ FxxxMultiSelect: Boolean;
+ FxxxSortType: TSortType;
+ FxxxColumnClick: Boolean;
+ FxxxShowColumnHeaders: Boolean;
+ FxxxListItems: TListItems{TNT-ALLOW TListItems};
+ FxxxClicked: Boolean;
+ FxxxRClicked: Boolean;
+ FxxxIconOptions: TIconOptions;
+ FxxxHideSelection: Boolean;
+ FListColumns: TListColumns{TNT-ALLOW TListColumns};
+ end;
+{$ENDIF}
+{$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
+type
+ THackCustomListView = class(TCustomMultiSelectListControl)
+ protected
+ FxxxCanvas: TCanvas;
+ FxxxBorderStyle: TBorderStyle;
+ FxxxViewStyle: TViewStyle;
+ FxxxReadOnly: Boolean;
+ FxxxLargeImages: TCustomImageList;
+ FxxxSmallImages: TCustomImageList;
+ FxxxStateImages: TCustomImageList;
+ FxxxDragImage: TDragImageList;
+ FxxxMultiSelect: Boolean;
+ FxxxSortType: TSortType;
+ FxxxColumnClick: Boolean;
+ FxxxShowColumnHeaders: Boolean;
+ FxxxListItems: TListItems{TNT-ALLOW TListItems};
+ FxxxClicked: Boolean;
+ FxxxRClicked: Boolean;
+ FxxxIconOptions: TIconOptions;
+ FxxxHideSelection: Boolean;
+ FListColumns: TListColumns{TNT-ALLOW TListColumns};
+ end;
+{$ENDIF}
+{$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
+type
+ THackCustomListView = class(TCustomMultiSelectListControl)
+ protected
+ FxxxCanvas: TCanvas;
+ FxxxBorderStyle: TBorderStyle;
+ FxxxViewStyle: TViewStyle;
+ FxxxReadOnly: Boolean;
+ FxxxLargeImages: TCustomImageList;
+ FxxxSaveSelectedIndex: Integer;
+ FxxxSmallImages: TCustomImageList;
+ FxxxStateImages: TCustomImageList;
+ FxxxDragImage: TDragImageList;
+ FxxxMultiSelect: Boolean;
+ FxxxSortType: TSortType;
+ FxxxColumnClick: Boolean;
+ FxxxShowColumnHeaders: Boolean;
+ FxxxListItems: TListItems{TNT-ALLOW TListItems};
+ FxxxClicked: Boolean;
+ FxxxRClicked: Boolean;
+ FxxxIconOptions: TIconOptions;
+ FxxxHideSelection: Boolean;
+ FListColumns: TListColumns{TNT-ALLOW TListColumns};
+ end;
+{$ENDIF}
+
+var
+ ComCtrls_DefaultListViewSort: TLVCompare = nil;
+
+constructor TTntCustomListView.Create(AOwner: TComponent);
+begin
+ inherited;
+ FEditInstance := Classes.MakeObjectInstance(EditWndProcW);
+ // create list columns
+ Assert(THackCustomListView(Self).FListColumns = inherited Columns, 'Internal Error in TTntCustomListView.Create().');
+ FreeAndNil(THackCustomListView(Self).FListColumns);
+ THackCustomListView(Self).FListColumns := TTntListColumns.Create(Self);
+end;
+
+destructor TTntCustomListView.Destroy;
+begin
+ inherited;
+ Classes.FreeObjectInstance(FEditInstance);
+ FreeAndNil(FSavedItems);
+end;
+
+procedure TTntCustomListView.CreateWindowHandle(const Params: TCreateParams);
+
+ procedure Capture_ComCtrls_DefaultListViewSort;
+ begin
+ FTestingForSortProc := True;
+ try
+ AlphaSort;
+ finally
+ FTestingForSortProc := False;
+ end;
+ end;
+
+var
+ Column: TLVColumn;
+begin
+ CreateUnicodeHandle_ComCtl(Self, Params, WC_LISTVIEW);
+ if (Win32PlatformIsUnicode) then begin
+ if not Assigned(ComCtrls_DefaultListViewSort) then
+ Capture_ComCtrls_DefaultListViewSort;
+ // the only way I could get editing to work is after a column had been inserted
+ Column.mask := 0;
+ ListView_InsertColumn(Handle, 0, Column);
+ ListView_DeleteColumn(Handle, 0);
+ end;
+end;
+
+procedure TTntCustomListView.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+procedure TTntCustomListView.CreateWnd;
+begin
+ inherited;
+ FreeAndNil(FSavedItems);
+end;
+
+procedure TTntCustomListView.DestroyWnd;
+var
+ i: integer;
+ FSavedItem: TSavedListItem;
+ Item: TTntListItem;
+begin
+ if (not (csDestroying in ComponentState)) and (not OwnerData) then begin
+ FreeAndNil(FSavedItems); // fixes a bug on Windows 95.
+ FSavedItems := TObjectList.Create(True);
+ for i := 0 to Items.Count - 1 do begin
+ FSavedItem := TSavedListItem.Create;
+ Item := Items[i];
+ FSavedItem.FCaption := Item.FCaption;
+ FSavedItem.FSubItems.Assign(Item.FSubItems);
+ FSavedItems.Add(FSavedItem)
+ end;
+ end;
+ inherited;
+end;
+
+function TTntCustomListView.GetDropTarget: TTntListItem;
+begin
+ Result := inherited DropTarget as TTntListItem;
+end;
+
+procedure TTntCustomListView.SetDropTarget(const Value: TTntListItem);
+begin
+ inherited DropTarget := Value;
+end;
+
+function TTntCustomListView.GetItemFocused: TTntListItem;
+begin
+ Result := inherited ItemFocused as TTntListItem;
+end;
+
+procedure TTntCustomListView.SetItemFocused(const Value: TTntListItem);
+begin
+ inherited ItemFocused := Value;
+end;
+
+function TTntCustomListView.GetSelected: TTntListItem;
+begin
+ Result := inherited Selected as TTntListItem;
+end;
+
+procedure TTntCustomListView.SetSelected(const Value: TTntListItem);
+begin
+ inherited Selected := Value;
+end;
+
+function TTntCustomListView.GetTopItem: TTntListItem;
+begin
+ Result := inherited TopItem as TTntListItem;
+end;
+
+function TTntCustomListView.GetListColumns: TTntListColumns;
+begin
+ Result := inherited Columns as TTntListColumns;
+end;
+
+procedure TTntCustomListView.SetListColumns(const Value: TTntListColumns);
+begin
+ inherited Columns := Value;
+end;
+
+{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
+type
+ THackListColumn = class(TCollectionItem)
+ protected
+ FxxxAlignment: TAlignment;
+ FxxxAutoSize: Boolean;
+ FxxxCaption: AnsiString;
+ FxxxMaxWidth: TWidth;
+ FxxxMinWidth: TWidth;
+ FxxxImageIndex: TImageIndex;
+ FxxxPrivateWidth: TWidth;
+ FxxxWidth: TWidth;
+ FOrderTag: Integer;
+ end;
+{$ENDIF}
+{$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
+type
+ THackListColumn = class(TCollectionItem)
+ protected
+ FxxxAlignment: TAlignment;
+ FxxxAutoSize: Boolean;
+ FxxxCaption: AnsiString;
+ FxxxMaxWidth: TWidth;
+ FxxxMinWidth: TWidth;
+ FxxxImageIndex: TImageIndex;
+ FxxxPrivateWidth: TWidth;
+ FxxxWidth: TWidth;
+ FOrderTag: Integer;
+ end;
+{$ENDIF}
+{$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
+type
+ THackListColumn = class(TCollectionItem)
+ protected
+ FxxxxxxxxAlignment: TAlignment;
+ FxxxxAutoSize: Boolean;
+ FxxxxCaption: AnsiString;
+ FxxxxMaxWidth: TWidth;
+ FxxxxMinWidth: TWidth;
+ FxxxxImageIndex: TImageIndex;
+ FxxxxPrivateWidth: TWidth;
+ FxxxxWidth: TWidth;
+ FOrderTag: Integer;
+ end;
+{$ENDIF}
+{$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
+type
+ THackListColumn = class(TCollectionItem)
+ protected
+ FxxxxxxxxAlignment: TAlignment;
+ FxxxxAutoSize: Boolean;
+ FxxxxCaption: AnsiString;
+ FxxxxMaxWidth: TWidth;
+ FxxxxMinWidth: TWidth;
+ FxxxxImageIndex: TImageIndex;
+ FxxxxPrivateWidth: TWidth;
+ FxxxxWidth: TWidth;
+ FOrderTag: Integer;
+ end;
+{$ENDIF}
+
+function TTntCustomListView.GetColumnFromTag(Tag: Integer): TTntListColumn;
+var
+ I: Integer;
+begin
+ for I := 0 to Columns.Count - 1 do
+ begin
+ Result := Columns[I];
+ if THackListColumn(Result).FOrderTag = Tag then Exit;
+ end;
+ Result := nil;
+end;
+
+function TTntCustomListView.ColumnFromIndex(Index: Integer): TTntListColumn;
+begin
+ Result := inherited Column[Index] as TTntListColumn;
+end;
+
+function TTntCustomListView.AreItemsStored: Boolean;
+begin
+ if Assigned(Action) then
+ begin
+ if Action is TCustomListAction{TNT-ALLOW TCustomListAction} then
+ Result := False
+ else
+ Result := True;
+ end
+ else
+ Result := not OwnerData;
+end;
+
+function TTntCustomListView.GetItems: TTntListItems;
+begin
+ Result := inherited Items as TTntListItems;
+end;
+
+procedure TTntCustomListView.SetItems(Value: TTntListItems);
+begin
+ inherited Items := Value;
+end;
+
+type TTntListItemClass = class of TTntListItem;
+
+function TTntCustomListView.CreateListItem: TListItem{TNT-ALLOW TListItem};
+var
+ LClass: TClass;
+ TntLClass: TTntListItemClass;
+begin
+ LClass := TTntListItem;
+ if Assigned(OnCreateItemClass) then
+ OnCreateItemClass(Self, TListItemClass(LClass));
+ if not LClass.InheritsFrom(TTntListItem) then
+ raise ETntInternalError.Create('Internal Error: OnCreateItemClass.ItemClass must inherit from TTntListItem.');
+ TntLClass := TTntListItemClass(LClass);
+ Result := TntLClass.Create(inherited Items);
+ if FTempItem = nil then
+ FTempItem := Result as TTntListItem; { In Delphi 5/6/7/9/10, the first item created is the temp item }
+ { TODO: Verify that D11 creates a temp item in its constructor. }
+end;
+
+function TTntCustomListView.CreateListItems: TListItems{TNT-ALLOW TListItems};
+begin
+ Result := TTntListItems.Create(Self);
+end;
+
+function TTntCustomListView.GetItemW(Value: TLVItemW): TTntListItem;
+begin
+ with Value do begin
+ if (mask and LVIF_PARAM) <> 0 then
+ Result := TListItem{TNT-ALLOW TListItem}(lParam) as TTntListItem
+ else if iItem >= 0 then
+ Result := Items[IItem]
+ else if OwnerData then
+ Result := FTempItem
+ else
+ Result := nil
+ end;
+end;
+
+function TTntCustomListView.OwnerDataFetchW(Item: TListItem{TNT-ALLOW TListItem}; Request: TItemRequest): Boolean;
+begin
+ Result := OwnerDataFetch(Item, Request);
+end;
+
+function TTntCustomListView.OwnerDataFetch(Item: TListItem{TNT-ALLOW TListItem}; Request: TItemRequest): Boolean;
+begin
+ if Assigned(OnData) then
+ begin
+ OnData(Self, Item);
+ Result := True;
+ end
+ else Result := False;
+end;
+
+function TntDefaultListViewSort(Item1, Item2: TTntListItem; lParam: Integer): Integer; stdcall;
+begin
+ Assert(Win32PlatformIsUnicode);
+ with Item1 do
+ if Assigned(ListView.OnCompare) then
+ ListView.OnCompare(ListView, Item1, Item2, lParam, Result)
+ else Result := lstrcmpw(PWideChar(Item1.Caption), PWideChar(Item2.Caption));
+end;
+
+procedure TTntCustomListView.WndProc(var Message: TMessage);
+var
+ Item: TTntListItem;
+ InheritedItem: TListItem{TNT-ALLOW TListItem};
+ SubItem: Integer;
+ SavedItem: TSavedListItem;
+ PCol: PLVColumn;
+ Col: TTntListColumn;
+begin
+ with Message do begin
+ // restore previous values (during CreateWnd)
+ if (FSavedItems <> nil) and (FChangingWideItemCount = 0) and (Msg = LVM_SETITEMTEXTA) then begin
+ Item := Items[wParam];
+ SavedItem := TSavedListItem(FSavedItems[wParam]);
+ if (Msg = LVM_SETITEMTEXTA) and (PLVItem(lParam).iSubItem = 0) then
+ Item.FCaption := SavedItem.FCaption
+ else begin
+ SubItem := PLVItem(lParam).iSubItem - 1;
+ TWideSubItems(Item.SubItems).FIgnoreInherited := True;
+ try
+ if SubItem < Item.SubItems.Count then begin
+ Item.SubItems[SubItem] := SavedItem.FSubItems[SubItem];
+ Item.SubItems.Objects[SubItem] := SavedItem.FSubItems.Objects[SubItem]
+ end else if SubItem = Item.SubItems.Count then
+ Item.SubItems.AddObject(SavedItem.FSubItems[SubItem], SavedItem.FSubItems.Objects[SubItem])
+ else
+ Item.SubItems.Assign(SavedItem.FSubItems)
+ finally
+ TWideSubItems(Item.SubItems).FIgnoreInherited := False;
+ end;
+ end;
+ end;
+
+ // sync wide with ansi
+ if (FSavedItems = nil) and (FChangingWideItemCount = 0) and (Msg = LVM_UPDATE) then begin
+ Item := Items[wParam];
+ InheritedItem := Item;
+ TWideSubItems(Item.SubItems).FIgnoreInherited := True;
+ try
+ Item.SubItems.Assign(InheritedItem.SubItems)
+ finally
+ TWideSubItems(Item.SubItems).FIgnoreInherited := False;
+ end;
+ end;
+
+ if (FSavedItems = nil) and (FChangingWideItemCount = 0) and (Msg = LVM_SETITEMTEXTA) then begin
+ if OwnerData then
+ Item := FTempItem
+ else
+ Item := Items[wParam];
+ InheritedItem := Item;
+ if (Msg = LVM_SETITEMTEXTA) and (PLVItem(lParam).iSubItem = 0) then
+ Item.FCaption := InheritedItem.Caption
+ else begin
+ SubItem := PLVItem(lParam).iSubItem - 1;
+ TWideSubItems(Item.SubItems).FIgnoreInherited := True;
+ try
+ if SubItem < Item.SubItems.Count then begin
+ Item.SubItems[SubItem] := InheritedItem.SubItems[SubItem];
+ Item.SubItems.Objects[SubItem] := InheritedItem.SubItems.Objects[SubItem]
+ end else if SubItem = Item.SubItems.Count then
+ Item.SubItems.AddObject(InheritedItem.SubItems[SubItem], InheritedItem.SubItems.Objects[SubItem])
+ else
+ Item.SubItems.Assign(InheritedItem.SubItems)
+ finally
+ TWideSubItems(Item.SubItems).FIgnoreInherited := False;
+ end;
+ end;
+ end;
+
+ // capture ANSI version of DefaultListViewSort from ComCtrls
+ if (FTestingForSortProc)
+ and (Msg = LVM_SORTITEMS) then begin
+ ComCtrls_DefaultListViewSort := Pointer(lParam);
+ exit;
+ end;
+
+ if (Msg = LVM_SETCOLUMNA) then begin
+ // make sure that wide column caption stays in sync with ANSI
+ PCol := PLVColumn(lParam);
+ if (PCol.mask and LVCF_TEXT) <> 0 then begin
+ Col := GetColumnFromTag(wParam);
+ if (Col <> nil) and (AnsiString(Col.Caption) <> PCol.pszText) then begin
+ Col.FCaption := PCol.pszText;
+ end;
+ end;
+ end;
+
+ if (Win32PlatformIsUnicode)
+ and (Msg = LVM_SETITEMTEXTA) and (PLVItem(lParam).pszText = LPSTR_TEXTCALLBACK) then
+ // Unicode:: call wide version of text call back instead
+ Result := SendMessageW(Handle, LVM_SETITEMTEXTW, WParam, LParam)
+ else if (Win32PlatformIsUnicode)
+ and (Msg = LVM_SORTITEMS) and (Pointer(lParam) = @ComCtrls_DefaultListViewSort) then
+ // Unicode:: call wide version of sort proc instead
+ Result := SendMessageW(Handle, LVM_SORTITEMS, wParam, Integer(@TntDefaultListViewSort))
+ else if (Win32PlatformIsUnicode)
+ and (Msg = LVM_SETCOLUMNA) and ((PLVColumn(lParam).mask and LVCF_TEXT) <> 0)
+ and (GetColumnFromTag(wParam) <> nil) then begin
+ PLVColumn(lParam).pszText := PAnsiChar(PWideChar(GetColumnFromTag(wParam).FCaption));
+ Result := SendMessageW(Handle, LVM_SETCOLUMNW, wParam, lParam);
+ end else begin
+ if (Msg = LVM_SETEXTENDEDLISTVIEWSTYLE) and CheckBoxes then begin
+ { fix a bug in TCustomListView.ResetExStyles }
+ lParam := lParam or LVS_EX_SUBITEMIMAGES or LVS_EX_INFOTIP;
+ end;
+ inherited;
+ end;
+ end;
+end;
+
+procedure TTntCustomListView.WMNotify(var Message: TWMNotify);
+begin
+ inherited;
+ // capture updated info after inherited
+ with Message.NMHdr^ do
+ case code of
+ HDN_ENDTRACKW:
+ begin
+ Message.NMHdr^.code := HDN_ENDTRACKA;
+ try
+ inherited
+ finally
+ Message.NMHdr^.code := HDN_ENDTRACKW;
+ end;
+ end;
+ HDN_DIVIDERDBLCLICKW:
+ begin
+ Message.NMHdr^.code := HDN_DIVIDERDBLCLICKA;
+ try
+ inherited
+ finally
+ Message.NMHdr^.code := HDN_DIVIDERDBLCLICKW;
+ end;
+ end;
+ end;
+end;
+
+procedure TTntCustomListView.CNNotify(var Message: TWMNotify);
+var
+ Item: TTntListItem;
+begin
+ if (not Win32PlatformIsUnicode) then
+ inherited
+ else begin
+ with Message do
+ begin
+ case NMHdr^.code of
+ HDN_TRACKW:
+ begin
+ NMHdr^.code := HDN_TRACKA;
+ try
+ inherited;
+ finally
+ NMHdr^.code := HDN_TRACKW;
+ end;
+ end;
+ LVN_GETDISPINFOW:
+ begin
+ // call inherited without the LVIF_TEXT flag
+ CurrentDispInfo := PLVDispInfoW(NMHdr);
+ try
+ OriginalDispInfoMask := PLVDispInfoW(NMHdr)^.item.mask;
+
+ PLVDispInfoW(NMHdr)^.item.mask := PLVDispInfoW(NMHdr)^.item.mask and (not LVIF_TEXT);
+ try
+ NMHdr^.code := LVN_GETDISPINFOA;
+ try
+ inherited;
+ finally
+ NMHdr^.code := LVN_GETDISPINFOW;
+ end;
+ finally
+ if (OriginalDispInfoMask and LVIF_TEXT <> 0) then
+ PLVDispInfoW(NMHdr)^.item.mask := PLVDispInfoW(NMHdr)^.item.mask or LVIF_TEXT;
+ end;
+ finally
+ CurrentDispInfo := nil;
+ end;
+
+ // handle any text info
+ with PLVDispInfoW(NMHdr)^.item do
+ begin
+ if (mask and LVIF_TEXT) <> 0 then
+ begin
+ Item := GetItemW(PLVDispInfoW(NMHdr)^.item);
+ if iSubItem = 0 then
+ WStrLCopy(pszText, PWideChar(Item.Caption), cchTextMax - 1)
+ else begin
+ with Item.SubItems do begin
+ if iSubItem <= Count then
+ WStrLCopy(pszText, PWideChar(Strings[iSubItem - 1]), cchTextMax - 1)
+ else pszText[0] := #0;
+ end;
+ end;
+ end;
+ end;
+ end;
+ LVN_ODFINDITEMW:
+ with PNMLVFindItem(NMHdr)^ do
+ begin
+ if ((lvfi.flags and LVFI_PARTIAL) <> 0) or ((lvfi.flags and LVFI_STRING) <> 0) then
+ PWideFindString := TLVFindInfoW(lvfi).psz
+ else
+ PWideFindString := nil;
+ lvfi.psz := nil;
+ NMHdr^.code := LVN_ODFINDITEMA;
+ try
+ inherited; {will Result in call to OwnerDataFind}
+ finally
+ TLVFindInfoW(lvfi).psz := PWideFindString;
+ NMHdr^.code := LVN_ODFINDITEMW;
+ PWideFindString := nil;
+ end;
+ end;
+ LVN_BEGINLABELEDITW:
+ begin
+ Item := GetItemW(PLVDispInfoW(NMHdr)^.item);
+ if not CanEdit(Item) then Result := 1;
+ if Result = 0 then
+ begin
+ FEditHandle := ListView_GetEditControl(Handle);
+ FDefEditProc := Pointer(GetWindowLongW(FEditHandle, GWL_WNDPROC));
+ SetWindowLongW(FEditHandle, GWL_WNDPROC, LongInt(FEditInstance));
+ end;
+ end;
+ LVN_ENDLABELEDITW:
+ with PLVDispInfoW(NMHdr)^ do
+ if (item.pszText <> nil) and (item.IItem <> -1) then
+ Edit(TLVItemA(item));
+ LVN_GETINFOTIPW:
+ begin
+ NMHdr^.code := LVN_GETINFOTIPA;
+ try
+ inherited;
+ finally
+ NMHdr^.code := LVN_GETINFOTIPW;
+ end;
+ end;
+ else
+ inherited;
+ end;
+ end;
+ end;
+end;
+
+function TTntCustomListView.OwnerDataFindW(Find: TItemFind;
+ const FindString: WideString; const FindPosition: TPoint;
+ FindData: Pointer; StartIndex: Integer; Direction: TSearchDirection;
+ Wrap: Boolean): Integer;
+begin
+ Result := OwnerDataFind(Find, FindString, FindPosition, FindData, StartIndex, Direction, Wrap);
+end;
+
+function TTntCustomListView.OwnerDataFind(Find: TItemFind; const FindString: WideString;
+ const FindPosition: TPoint; FindData: Pointer; StartIndex: Integer;
+ Direction: TSearchDirection; Wrap: Boolean): Integer;
+var
+ AnsiEvent: TLVOwnerDataFindEvent;
+begin
+ Result := -1;
+ if Assigned(OnDataFind) then
+ OnDataFind(Self, Find, FindString, FindPosition, FindData, StartIndex, Direction, Wrap, Result)
+ else if Assigned(inherited OnDataFind) then begin
+ AnsiEvent := inherited OnDataFind;
+ AnsiEvent(Self, Find, FindString, FindPosition, FindData, StartIndex, Direction,
+ Wrap, Result);
+ end;
+end;
+
+procedure TTntCustomListView.Edit(const Item: TLVItem);
+var
+ S: WideString;
+ AnsiS: AnsiString;
+ EditItem: TTntListItem;
+ AnsiEvent: TLVEditedEvent;
+begin
+ if (not Win32PlatformIsUnicode) then
+ S := Item.pszText
+ else
+ S := TLVItemW(Item).pszText;
+ EditItem := GetItemW(TLVItemW(Item));
+ if Assigned(OnEdited) then
+ OnEdited(Self, EditItem, S)
+ else if Assigned(inherited OnEdited) then
+ begin
+ AnsiEvent := inherited OnEdited;
+ AnsiS := S;
+ AnsiEvent(Self, EditItem, AnsiS);
+ S := AnsiS;
+ end;
+ if EditItem <> nil then
+ EditItem.Caption := S;
+end;
+
+procedure TTntCustomListView.EditWndProcW(var Message: TMessage);
+begin
+ Assert(Win32PlatformIsUnicode);
+ try
+ with Message do
+ begin
+ case Msg of
+ WM_KEYDOWN,
+ WM_SYSKEYDOWN: if DoKeyDown(TWMKey(Message)) then Exit;
+ WM_CHAR:
+ begin
+ MakeWMCharMsgSafeForAnsi(Message);
+ try
+ if DoKeyPress(TWMKey(Message)) then Exit;
+ finally
+ RestoreWMCharMsg(Message);
+ end;
+ end;
+ WM_KEYUP,
+ WM_SYSKEYUP: if DoKeyUp(TWMKey(Message)) then Exit;
+ CN_KEYDOWN,
+ CN_CHAR, CN_SYSKEYDOWN,
+ CN_SYSCHAR:
+ begin
+ WndProc(Message);
+ Exit;
+ end;
+ end;
+ Result := CallWindowProcW(FDefEditProc, FEditHandle, Msg, WParam, LParam);
+ end;
+ except
+ Application.HandleException(Self);
+ end;
+end;
+
+procedure TTntCustomListView.BeginChangingWideItem;
+begin
+ Inc(FChangingWideItemCount);
+end;
+
+procedure TTntCustomListView.EndChangingWideItem;
+begin
+ if FChangingWideItemCount > 0 then
+ Dec(FChangingWideItemCount);
+end;
+
+procedure TTntCustomListView.DrawItem(Item: TListItem{TNT-ALLOW TListItem}; Rect: TRect;
+ State: TOwnerDrawState);
+begin
+ TControlCanvas(Canvas).UpdateTextFlags;
+ if Assigned(OnDrawItem) then OnDrawItem(Self, Item, Rect, State)
+ else
+ begin
+ Canvas.FillRect(Rect);
+ WideCanvasTextOut(Canvas, Rect.Left + 2, Rect.Top, Item.Caption);
+ end;
+end;
+
+procedure TTntCustomListView.CopySelection(Destination: TCustomListControl);
+var
+ I: Integer;
+begin
+ for I := 0 to Items.Count - 1 do
+ if Items[I].Selected then
+ WideListControl_AddItem(Destination, Items[I].Caption, Items[I].Data);
+end;
+
+procedure TTntCustomListView.AddItem(const Item: WideString; AObject: TObject);
+begin
+ with Items.Add do
+ begin
+ Caption := Item;
+ Data := AObject;
+ end;
+end;
+
+//-------------
+
+function TTntCustomListView.FindCaption(StartIndex: Integer; Value: WideString;
+ Partial, Inclusive, Wrap: Boolean): TTntListItem;
+const
+ FullString: array[Boolean] of Integer = (0, LVFI_PARTIAL);
+ Wraps: array[Boolean] of Integer = (0, LVFI_WRAP);
+var
+ Info: TLVFindInfoW;
+ Index: Integer;
+begin
+ if (not Win32PlatformIsUnicode) then
+ Result := inherited FindCaption(StartIndex, Value, Partial, Inclusive, Wrap) as TTntListItem
+ else begin
+ with Info do
+ begin
+ flags := LVFI_STRING or FullString[Partial] or Wraps[Wrap];
+ psz := PWideChar(Value);
+ end;
+ if Inclusive then Dec(StartIndex);
+ Index := SendMessageW(Handle, LVM_FINDITEMW, StartIndex, Longint(@Info));
+ if Index <> -1 then Result := Items[Index]
+ else Result := nil;
+ end;
+end;
+
+function TTntCustomListView.StringWidth(S: WideString): Integer;
+begin
+ if (not Win32PlatformIsUnicode) then
+ Result := inherited StringWidth(S)
+ else
+ Result := SendMessageW(Handle, LVM_GETSTRINGWIDTHW, 0, Longint(PWideChar(S)))
+end;
+
+function TTntCustomListView.GetSearchString: WideString;
+var
+ Buffer: array[0..1023] of WideChar;
+begin
+ if (not Win32PlatformIsUnicode) then
+ Result := inherited GetSearchString
+ else begin
+ Result := '';
+ if HandleAllocated
+ and Bool(SendMessageW(Handle, LVM_GETISEARCHSTRINGW, 0, Longint(PWideChar(@Buffer[0])))) then
+ Result := Buffer;
+ end;
+end;
+
+function TTntCustomListView.IsHintStored: Boolean;
+begin
+ Result := TntControl_IsHintStored(Self);
+end;
+
+function TTntCustomListView.GetHint: WideString;
+begin
+ Result := TntControl_GetHint(Self)
+end;
+
+procedure TTntCustomListView.SetHint(const Value: WideString);
+begin
+ TntControl_SetHint(Self, Value);
+end;
+
+procedure TTntCustomListView.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
+ inherited;
+end;
+
+function TTntCustomListView.GetActionLinkClass: TControlActionLinkClass;
+begin
+ Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
+end;
+
+{ TTntToolButton }
+
+procedure TTntToolButton.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+procedure TTntToolButton.CMVisibleChanged(var Message: TMessage);
+begin
+ inherited;
+ RefreshControl;
+end;
+
+function TTntToolButton.GetCaption: TWideCaption;
+begin
+ Result := TntControl_GetText(Self);
+end;
+
+procedure TTntToolButton.SetCaption(const Value: TWideCaption);
+begin
+ TntControl_SetText(Self, Value);
+ RefreshControl; { causes button to be removed and reinserted with TB_INSERTBUTTON }
+end;
+
+function TTntToolButton.IsCaptionStored: Boolean;
+begin
+ Result := TntControl_IsCaptionStored(Self)
+end;
+
+function TTntToolButton.GetHint: WideString;
+begin
+ Result := TntControl_GetHint(Self)
+end;
+
+procedure TTntToolButton.SetHint(const Value: WideString);
+begin
+ TntControl_SetHint(Self, Value);
+end;
+
+function TTntToolButton.IsHintStored: Boolean;
+begin
+ Result := TntControl_IsHintStored(Self)
+end;
+
+procedure TTntToolButton.CMHintShow(var Message: TMessage);
+begin
+ ProcessCMHintShowMsg(Message);
+ inherited;
+end;
+
+procedure TTntToolButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
+ inherited;
+end;
+
+function TTntToolButton.GetActionLinkClass: TControlActionLinkClass;
+begin
+ Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
+end;
+
+function TTntToolButton.GetMenuItem: TMenuItem{TNT-ALLOW TMenuItem};
+begin
+ Result := inherited MenuItem;
+end;
+
+procedure TTntToolButton.SetMenuItem(const Value: TMenuItem{TNT-ALLOW TMenuItem});
+begin
+ inherited MenuItem := Value;
+ if Value is TTntMenuItem then begin
+ Caption := TTntMenuItem(Value).Caption;
+ Hint := TTntMenuItem(Value).Hint;
+ end;
+end;
+
+{ TTntToolBar }
+
+procedure TTntToolBar.CreateWindowHandle(const Params: TCreateParams);
+begin
+ CreateUnicodeHandle_ComCtl(Self, Params, TOOLBARCLASSNAME);
+end;
+
+procedure TTntToolBar.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+procedure TTntToolBar.TBInsertButtonA(var Message: TMessage);
+var
+ Button: TTntToolButton;
+ Buffer: WideString;
+begin
+ if Win32PlatformIsUnicode
+ and (PTBButton(Message.LParam).iString <> -1)
+ and (Buttons[Message.WParam] is TTntToolButton) then
+ begin
+ Button := TTntToolButton(Buttons[Message.WParam]);
+ Buffer := Button.Caption + WideChar(#0);
+ PTBButton(Message.LParam).iString :=
+ SendMessage(Handle, TB_ADDSTRINGW, 0, Integer(PWideChar(Buffer)));
+ end;
+ inherited;
+end;
+
+{ Need to read/write caption ourselves - default wndproc seems to discard it. }
+
+procedure TTntToolBar.WMGetText(var Message: TWMGetText);
+begin
+ if (not Win32PlatformIsUnicode) or (WindowHandle = 0) then
+ inherited
+ else
+ with Message do
+ Result := WStrLen(WStrLCopy(PWideChar(Text), PWideChar(FCaption), TextMax - 1));
+end;
+
+procedure TTntToolBar.WMGetTextLength(var Message: TWMGetTextLength);
+begin
+ if (not Win32PlatformIsUnicode) or (WindowHandle = 0) then
+ inherited
+ else
+ Message.Result := Length(FCaption);
+end;
+
+procedure TTntToolBar.WMSetText(var Message: TWMSetText);
+begin
+ if (not Win32PlatformIsUnicode) or (WindowHandle = 0) then
+ inherited
+ else
+ with Message do
+ SetString(FCaption, PWideChar(Text), WStrLen(PWideChar(Text)));
+end;
+
+function TTntToolBar.GetCaption: WideString;
+begin
+ Result := TntControl_GetText(Self);
+end;
+
+procedure TTntToolBar.SetCaption(const Value: WideString);
+begin
+ TntControl_SetText(Self, Value);
+end;
+
+function TTntToolBar.IsCaptionStored: Boolean;
+begin
+ Result := TntControl_IsCaptionStored(Self);
+end;
+
+function TTntToolBar.GetHint: WideString;
+begin
+ Result := TntControl_GetHint(Self);
+end;
+
+procedure TTntToolBar.SetHint(const Value: WideString);
+begin
+ TntControl_SetHint(Self, Value);
+end;
+
+function TTntToolBar.IsHintStored: Boolean;
+begin
+ Result := TntControl_IsHintStored(Self);
+end;
+
+procedure TTntToolBar.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
+ inherited;
+end;
+
+function TTntToolBar.GetActionLinkClass: TControlActionLinkClass;
+begin
+ Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
+end;
+
+function TTntToolBar.GetMenu: TMainMenu{TNT-ALLOW TMainMenu};
+begin
+ Result := inherited Menu;
+end;
+
+procedure TTntToolBar.SetMenu(const Value: TMainMenu{TNT-ALLOW TMainMenu});
+var
+ I: Integer;
+begin
+ if (Menu <> Value) then begin
+ inherited Menu := Value;
+ if Assigned(Menu) then begin
+ // get rid of TToolButton(s)
+ for I := ButtonCount - 1 downto 0 do
+ Buttons[I].Free;
+ // add TTntToolButton(s)
+ for I := Menu.Items.Count - 1 downto 0 do
+ begin
+ with TTntToolButton.Create(Self) do
+ try
+ AutoSize := True;
+ Grouped := True;
+ Parent := Self;
+ MenuItem := Menu.Items[I];
+ except
+ Free;
+ raise;
+ end;
+ end;
+ end;
+ end;
+end;
+
+{ TTntRichEditStrings }
+type
+ TTntRichEditStrings = class(TTntMemoStrings)
+ private
+ RichEdit: TCustomRichEdit{TNT-ALLOW TCustomRichEdit};
+ procedure EnableChange(const Value: Boolean);
+ protected
+ procedure SetTextStr(const Value: WideString); override;
+ public
+ constructor Create;
+ procedure AddStrings(Strings: TWideStrings); overload; override;
+ //--
+ procedure LoadFromStream_BOM(Stream: TStream; WithBOM: Boolean); override;
+ procedure SaveToStream_BOM(Stream: TStream; WithBOM: Boolean); override;
+ procedure LoadFromFile(const FileName: WideString); override;
+ procedure SaveToFile(const FileName: WideString); override;
+ end;
+
+constructor TTntRichEditStrings.Create;
+begin
+ inherited Create;
+ FRichEditMode := True;
+end;
+
+procedure TTntRichEditStrings.AddStrings(Strings: TWideStrings);
+var
+ SelChange: TNotifyEvent;
+begin
+ SelChange := TTntCustomRichEdit(RichEdit).OnSelectionChange;
+ TTntCustomRichEdit(RichEdit).OnSelectionChange := nil;
+ try
+ inherited;
+ finally
+ TTntCustomRichEdit(RichEdit).OnSelectionChange := SelChange;
+ end;
+end;
+
+procedure TTntRichEditStrings.EnableChange(const Value: Boolean);
+var
+ EventMask: Longint;
+begin
+ with RichEdit do
+ begin
+ if Value then
+ EventMask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0) or ENM_CHANGE
+ else
+ EventMask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0) and not ENM_CHANGE;
+ SendMessage(Handle, EM_SETEVENTMASK, 0, EventMask);
+ end;
+end;
+
+procedure TTntRichEditStrings.SetTextStr(const Value: WideString);
+begin
+ EnableChange(False);
+ try
+ inherited;
+ finally
+ EnableChange(True);
+ end;
+end;
+
+type TAccessCustomRichEdit = class(TCustomRichEdit{TNT-ALLOW TCustomRichEdit});
+
+procedure TTntRichEditStrings.LoadFromStream_BOM(Stream: TStream; WithBOM: Boolean);
+begin
+ if TAccessCustomRichEdit(RichEdit).PlainText then
+ inherited LoadFromStream_BOM(Stream, WithBOM)
+ else
+ TAccessCustomRichEdit(RichEdit).Lines.LoadFromStream(Stream);
+end;
+
+procedure TTntRichEditStrings.SaveToStream_BOM(Stream: TStream; WithBOM: Boolean);
+begin
+ if TAccessCustomRichEdit(RichEdit).PlainText then
+ inherited SaveToStream_BOM(Stream, WithBOM)
+ else
+ TAccessCustomRichEdit(RichEdit).Lines.SaveToStream(Stream);
+end;
+
+procedure TTntRichEditStrings.LoadFromFile(const FileName: WideString);
+begin
+ if TAccessCustomRichEdit(RichEdit).PlainText then
+ inherited LoadFromFile(FileName)
+ else
+ TAccessCustomRichEdit(RichEdit).Lines.LoadFromFile(FileName);
+end;
+
+procedure TTntRichEditStrings.SaveToFile(const FileName: WideString);
+begin
+ if TAccessCustomRichEdit(RichEdit).PlainText then
+ inherited SaveToFile(FileName)
+ else
+ TAccessCustomRichEdit(RichEdit).Lines.SaveToFile(FileName);
+end;
+
+{ TTntCustomRichEdit }
+
+constructor TTntCustomRichEdit.Create(AOwner: TComponent);
+begin
+ inherited;
+ FRichEditStrings := TTntRichEditStrings.Create;
+ TTntRichEditStrings(FRichEditStrings).FMemo := Self;
+ TTntRichEditStrings(FRichEditStrings).FMemoLines := TAccessCustomRichEdit(Self).Lines;
+ TTntRichEditStrings(FRichEditStrings).FLineBreakStyle := Self.LineBreakStyle;
+ TTntRichEditStrings(FRichEditStrings).RichEdit := Self;
+end;
+
+var
+ FRichEdit20Module: THandle = 0;
+
+function IsRichEdit20Available: Boolean;
+const
+ RICHED20_DLL = 'RICHED20.DLL';
+begin
+ if FRichEdit20Module = 0 then
+ FRichEdit20Module := Tnt_LoadLibraryW(RICHED20_DLL);
+ Result := FRichEdit20Module <> 0;
+end;
+
+{function IsRichEdit30Available: Boolean;
+begin
+ Result := False;
+ exit;
+ Result := IsRichEdit20Available and (Win32MajorVersion >= 5);
+end;}
+
+procedure TTntCustomRichEdit.CreateParams(var Params: TCreateParams);
+begin
+ inherited CreateParams(Params);
+ if WordWrap then
+ Params.Style := Params.Style and not WS_HSCROLL; // more compatible with RichEdit 1.0
+end;
+
+procedure TTntCustomRichEdit.CreateWindowHandle(const Params: TCreateParams);
+begin
+ if Win32PlatformIsUnicode and IsRichEdit20Available then
+ CreateUnicodeHandle(Self, Params, RICHEDIT_CLASSW)
+ else
+ inherited
+end;
+
+var
+ AIMM: IActiveIMMApp = nil;
+
+function EnableActiveIMM: Boolean;
+begin
+ if AIMM <> nil then
+ Result := True
+ else begin
+ Result := False;
+ try
+ if ClassIsRegistered(CLASS_CActiveIMM) then begin
+ AIMM := CoCActiveIMM.Create;
+ AIMM.Activate(1);
+ Result := True;
+ end;
+ except
+ AIMM := nil;
+ end;
+ end;
+end;
+
+procedure TTntCustomRichEdit.CreateWnd;
+const
+ EM_SETEDITSTYLE = WM_USER + 204;
+ SES_USEAIMM = 64;
+begin
+ inherited;
+ // Only supported in RichEdit 3.0, but this flag is harmless to RichEdit1.0 or RichEdit 2.0
+ if EnableActiveIMM then
+ SendMessage(Handle, EM_SETEDITSTYLE, SES_USEAIMM, SES_USEAIMM);
+end;
+
+procedure TTntCustomRichEdit.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+destructor TTntCustomRichEdit.Destroy;
+begin
+ FreeAndNil(FRichEditStrings);
+ inherited;
+end;
+
+procedure TTntCustomRichEdit.KeyDown(var Key: Word; Shift: TShiftState);
+begin
+ inherited;
+ if (not WantReturns) and (Key = VK_RETURN) and (Shift <> [ssCtrl]) then
+ Key := 0;
+end;
+
+function TTntCustomRichEdit.LineBreakStyle: TTntTextLineBreakStyle;
+begin
+ if Win32PlatformIsUnicode and IsRichEdit20Available then
+ Result := tlbsCR
+ else
+ Result := tlbsCRLF;
+end;
+
+procedure TTntCustomRichEdit.SetRichEditStrings(const Value: TTntStrings);
+begin
+ FRichEditStrings.Assign(Value);
+end;
+
+function TTntCustomRichEdit.GetSelText: string{TNT-ALLOW string};
+begin
+ Result := GetWideSelText;
+end;
+
+function TTntCustomRichEdit.GetWideSelText: WideString;
+var
+ CharRange: TCharRange;
+ Length: Integer;
+begin
+ if (not IsWindowUnicode(Handle)) then
+ Result := inherited GetSelText
+ else begin
+ SendMessageW(Handle, EM_EXGETSEL, 0, Longint(@CharRange));
+ SetLength(Result, CharRange.cpMax - CharRange.cpMin + 1);
+ Length := SendMessageW(Handle, EM_GETSELTEXT, 0, Longint(PWideChar(Result)));
+ SetLength(Result, Length);
+ end;
+ if LineBreakStyle <> tlbsCRLF then
+ Result := TntAdjustLineBreaks(Result, tlbsCRLF)
+end;
+
+type
+ TSetTextEx = record
+ flags:dword;
+ codepage:uint;
+ end;
+
+procedure TTntCustomRichEdit.SetRTFText(Flags: DWORD; const Value: AnsiString);
+const
+ EM_SETTEXTEX = (WM_USER + 97);
+var
+ Info: TSetTextEx;
+begin
+ Info.flags := Flags;
+ Info.codepage := CP_ACP{TNT-ALLOW CP_ACP};
+ SendMessage(Handle, EM_SETTEXTEX, Integer(@Info), Integer(PAnsiChar(Value)));
+end;
+
+procedure TTntCustomRichEdit.SetWideSelText(const Value: WideString);
+const
+ ST_SELECTION = 2;
+begin
+ if Win32PlatformIsUnicode and IsRichEdit20Available and IsRTF(Value) then begin
+ // emulate RichEdit 1.0 so that RTF code is inserted as RTF (not plain text)
+ SetRTFText(ST_SELECTION, Value)
+ end else
+ TntCustomEdit_SetSelText(Self, TntAdjustLineBreaks(Value, LineBreakStyle));
+end;
+
+function TTntCustomRichEdit.GetText: WideString;
+begin
+ Result := TntControl_GetText(Self);
+ if (LineBreakStyle <> tlbsCRLF) then
+ Result := TntAdjustLineBreaks(Result, tlbsCRLF);
+end;
+
+procedure TTntCustomRichEdit.SetText(const Value: WideString);
+const
+ ST_DEFAULT = 0;
+begin
+ if Win32PlatformIsUnicode and IsRichEdit20Available and IsRTF(Value) then begin
+ // emulate RichEdit 1.0 so that RTF code is inserted as RTF (not plain text)
+ SetRTFText(ST_DEFAULT, Value)
+ end else if Value <> Text then
+ TntControl_SetText(Self, TntAdjustLineBreaks(Value, LineBreakStyle));
+end;
+
+function TTntCustomRichEdit.IsHintStored: Boolean;
+begin
+ Result := TntControl_IsHintStored(Self);
+end;
+
+function TTntCustomRichEdit.GetHint: WideString;
+begin
+ Result := TntControl_GetHint(Self);
+end;
+
+procedure TTntCustomRichEdit.SetHint(const Value: WideString);
+begin
+ TntControl_SetHint(Self, Value);
+end;
+
+procedure TTntCustomRichEdit.WMGetTextLength(var Message: TWMGetTextLength);
+begin
+ if FPrintingTextLength <> 0 then
+ Message.Result := FPrintingTextLength
+ else
+ inherited;
+end;
+
+procedure TTntCustomRichEdit.Print(const Caption: string{TNT-ALLOW string});
+begin
+ if (LineBreakStyle <> tlbsCRLF) then
+ FPrintingTextLength := TntAdjustLineBreaksLength(Text, LineBreakStyle)
+ else
+ FPrintingTextLength := 0;
+ try
+ inherited
+ finally
+ FPrintingTextLength := 0;
+ end;
+end;
+
+{$WARN SYMBOL_DEPRECATED OFF}
+
+function TTntCustomRichEdit.CharPosToGet(RawWin32CharPos: Integer): Integer;
+begin
+ Result := EmulatedCharPos(RawWin32CharPos);
+end;
+
+function TTntCustomRichEdit.CharPosToSet(EmulatedCharPos: Integer): Integer;
+begin
+ Result := RawWin32CharPos(EmulatedCharPos);
+end;
+{$WARN SYMBOL_DEPRECATED ON}
+
+function TTntCustomRichEdit.EmulatedCharPos(RawWin32CharPos: Integer): Integer;
+var
+ i: Integer;
+ ThisLine: Integer;
+ CharCount: Integer;
+ Line_Start: Integer;
+ NumLineBreaks: Integer;
+begin
+ if (LineBreakStyle = tlbsCRLF) or (RawWin32CharPos <= 0) then
+ Result := RawWin32CharPos
+ else begin
+ Assert(Win32PlatformIsUnicode);
+ ThisLine := SendMessageW(Handle, EM_EXLINEFROMCHAR, 0, RawWin32CharPos);
+ if (not WordWrap) then
+ NumLineBreaks := ThisLine
+ else begin
+ CharCount := 0;
+ for i := 0 to ThisLine - 1 do
+ Inc(CharCount, TntMemo_LineLength(Handle, i));
+ Line_Start := TntMemo_LineStart(Handle, ThisLine);
+ NumLineBreaks := Line_Start - CharCount;
+ end;
+ Result := RawWin32CharPos + NumLineBreaks; {inflate CR -> CR/LF}
+ end;
+end;
+
+function TTntCustomRichEdit.RawWin32CharPos(EmulatedCharPos: Integer): Integer;
+var
+ Line: Integer;
+ NumLineBreaks: Integer;
+ CharCount: Integer;
+ Line_Start: Integer;
+ LineLength: Integer;
+begin
+ if (LineBreakStyle = tlbsCRLF) or (EmulatedCharPos <= 0) then
+ Result := EmulatedCharPos
+ else begin
+ Assert(Win32PlatformIsUnicode);
+ NumLineBreaks := 0;
+ CharCount := 0;
+ for Line := 0 to Lines.Count do begin
+ Line_Start := TntMemo_LineStart(Handle, Line);
+ if EmulatedCharPos < (Line_Start + NumLineBreaks) then
+ break; {found it (it must have been the line separator)}
+ if Line_Start > CharCount then begin
+ Inc(NumLineBreaks);
+ Inc(CharCount);
+ end;
+ LineLength := TntMemo_LineLength(Handle, Line, Line_Start);
+ Inc(CharCount, LineLength);
+ if (EmulatedCharPos >= (Line_Start + NumLineBreaks))
+ and (EmulatedCharPos < (Line_Start + LineLength + NumLineBreaks)) then
+ break; {found it}
+ end;
+ Result := EmulatedCharPos - NumLineBreaks; {deflate CR/LF -> CR}
+ end;
+end;
+
+function TTntCustomRichEdit.FindText(const SearchStr: WideString;
+ StartPos, Length: Integer; Options: TSearchTypes): Integer;
+const
+ EM_FINDTEXTEXW = WM_USER + 124;
+const
+ FR_DOWN = $00000001;
+ FR_WHOLEWORD = $00000002;
+ FR_MATCHCASE = $00000004;
+var
+ Find: TFindTextW;
+ Flags: Integer;
+begin
+ if (not Win32PlatformIsUnicode) then
+ Result := inherited FindText(SearchStr, StartPos, Length, Options)
+ else begin
+ with Find.chrg do
+ begin
+ cpMin := RawWin32CharPos(StartPos);
+ cpMax := RawWin32CharPos(StartPos + Length);
+ end;
+ Flags := FR_DOWN; { RichEdit 2.0 and later needs this }
+ if stWholeWord in Options then Flags := Flags or FR_WHOLEWORD;
+ if stMatchCase in Options then Flags := Flags or FR_MATCHCASE;
+ Find.lpstrText := PWideChar(SearchStr);
+ Result := SendMessageW(Handle, EM_FINDTEXT, Flags, LongInt(@Find));
+ Result := EmulatedCharPos(Result);
+ end;
+end;
+
+function TTntCustomRichEdit.GetSelStart: Integer;
+begin
+ Result := TntCustomEdit_GetSelStart(Self);
+ Result := EmulatedCharPos(Result);
+end;
+
+procedure TTntCustomRichEdit.SetSelStart(const Value: Integer);
+begin
+ TntCustomEdit_SetSelStart(Self, RawWin32CharPos(Value));
+end;
+
+function TTntCustomRichEdit.GetSelLength: Integer;
+var
+ CharRange: TCharRange;
+begin
+ if (LineBreakStyle = tlbsCRLF) then
+ Result := TntCustomEdit_GetSelLength(Self)
+ else begin
+ Assert(Win32PlatformIsUnicode);
+ SendMessageW(Handle, EM_EXGETSEL, 0, Longint(@CharRange));
+ Result := EmulatedCharPos(CharRange.cpMax) - EmulatedCharPos(CharRange.cpMin);
+ end;
+end;
+
+procedure TTntCustomRichEdit.SetSelLength(const Value: Integer);
+var
+ StartPos: Integer;
+ SelEnd: Integer;
+begin
+ if (LineBreakStyle = tlbsCRLF) then
+ TntCustomEdit_SetSelLength(Self, Value)
+ else begin
+ StartPos := Self.SelStart;
+ SelEnd := StartPos + Value;
+ inherited SetSelLength(RawWin32CharPos(SelEnd) - RawWin32CharPos(StartPos));
+ end;
+end;
+
+procedure TTntCustomRichEdit.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
+ inherited;
+end;
+
+function TTntCustomRichEdit.GetActionLinkClass: TControlActionLinkClass;
+begin
+ Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
+end;
+
+{ TTntTabStrings }
+
+type TAccessCustomTabControl = class(TCustomTabControl{TNT-ALLOW TCustomTabControl});
+
+type
+ TTntTabStrings = class(TTntStrings)
+ private
+ FTabControl: TCustomTabControl{TNT-ALLOW TCustomTabControl};
+ FAnsiTabs: TStrings{TNT-ALLOW TStrings};
+ protected
+ function Get(Index: Integer): WideString; override;
+ function GetCount: Integer; override;
+ function GetObject(Index: Integer): TObject; override;
+ procedure Put(Index: Integer; const S: WideString); override;
+ procedure PutObject(Index: Integer; AObject: TObject); override;
+ procedure SetUpdateState(Updating: Boolean); override;
+ public
+ procedure Clear; override;
+ procedure Delete(Index: Integer); override;
+ procedure Insert(Index: Integer; const S: WideString); override;
+ end;
+
+procedure TabControlError(const S: WideString);
+begin
+ raise EListError.Create(S);
+end;
+
+procedure TTntTabStrings.Clear;
+begin
+ FAnsiTabs.Clear;
+end;
+
+procedure TTntTabStrings.Delete(Index: Integer);
+begin
+ FAnsiTabs.Delete(Index);
+end;
+
+function TTntTabStrings.GetCount: Integer;
+begin
+ Result := FAnsiTabs.Count;
+end;
+
+function TTntTabStrings.GetObject(Index: Integer): TObject;
+begin
+ Result := FAnsiTabs.Objects[Index];
+end;
+
+procedure TTntTabStrings.PutObject(Index: Integer; AObject: TObject);
+begin
+ FAnsiTabs.Objects[Index] := AObject;
+end;
+
+procedure TTntTabStrings.SetUpdateState(Updating: Boolean);
+begin
+ inherited;
+ TAccessStrings(FAnsiTabs).SetUpdateState(Updating);
+end;
+
+function TTntTabStrings.Get(Index: Integer): WideString;
+const
+ RTL: array[Boolean] of LongInt = (0, TCIF_RTLREADING);
+var
+ TCItem: TTCItemW;
+ Buffer: array[0..4095] of WideChar;
+begin
+ if (not Win32PlatformIsUnicode) then
+ Result := FAnsiTabs[Index]
+ else begin
+ TCItem.mask := TCIF_TEXT or RTL[FTabControl.UseRightToLeftReading];
+ TCItem.pszText := Buffer;
+ TCItem.cchTextMax := SizeOf(Buffer);
+ if SendMessageW(FTabControl.Handle, TCM_GETITEMW, Index, Longint(@TCItem)) = 0 then
+ TabControlError(WideFormat(sTabFailRetrieve, [Index]));
+ Result := Buffer;
+ end;
+end;
+
+function GetTabControlImageIndex(Self: TCustomTabControl{TNT-ALLOW TCustomTabControl}; TabIndex: Integer): Integer;
+begin
+ Result := TabIndex;
+ with TAccessCustomTabControl(Self) do
+ if Assigned(OnGetImageIndex) then OnGetImageIndex(Self, TabIndex, Result);
+end;
+
+procedure TTntTabStrings.Put(Index: Integer; const S: WideString);
+const
+ RTL: array[Boolean] of LongInt = (0, TCIF_RTLREADING);
+var
+ TCItem: TTCItemW;
+begin
+ if (not Win32PlatformIsUnicode) then
+ FAnsiTabs[Index] := S
+ else begin
+ TCItem.mask := TCIF_TEXT or RTL[FTabControl.UseRightToLeftReading] or TCIF_IMAGE;
+ TCItem.pszText := PWideChar(S);
+ TCItem.iImage := GetTabControlImageIndex(FTabControl, Index);
+ if SendMessageW(FTabControl.Handle, TCM_SETITEMW, Index, Longint(@TCItem)) = 0 then
+ TabControlError(WideFormat(sTabFailSet, [S, Index]));
+ TAccessCustomTabControl(FTabControl).UpdateTabImages;
+ end;
+end;
+
+procedure TTntTabStrings.Insert(Index: Integer; const S: WideString);
+const
+ RTL: array[Boolean] of LongInt = (0, TCIF_RTLREADING);
+var
+ TCItem: TTCItemW;
+begin
+ if (not Win32PlatformIsUnicode) then
+ FAnsiTabs.Insert(Index, S)
+ else begin
+ TCItem.mask := TCIF_TEXT or RTL[FTabControl.UseRightToLeftReading] or TCIF_IMAGE;
+ TCItem.pszText := PWideChar(S);
+ TCItem.iImage := GetTabControlImageIndex(FTabControl, Index);
+ if SendMessageW(FTabControl.Handle, TCM_INSERTITEMW, Index, Longint(@TCItem)) < 0 then
+ TabControlError(WideFormat(sTabFailSet, [S, Index]));
+ TAccessCustomTabControl(FTabControl).UpdateTabImages;
+ end;
+end;
+
+{ TTntCustomTabControl }
+
+constructor TTntCustomTabControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FTabs := TTntTabStrings.Create;
+ TTntTabStrings(FTabs).FTabControl := Self;
+ TTntTabStrings(FTabs).FAnsiTabs := inherited Tabs;
+end;
+
+destructor TTntCustomTabControl.Destroy;
+begin
+ TTntTabStrings(FTabs).FTabControl := nil;
+ TTntTabStrings(FTabs).FAnsiTabs := nil;
+ FreeAndNil(FTabs);
+ FreeAndNil(FSaveTabs);
+ inherited;
+end;
+
+procedure TTntCustomTabControl.CreateWindowHandle(const Params: TCreateParams);
+begin
+ CreateUnicodeHandle_ComCtl(Self, Params, WC_TABCONTROL);
+end;
+
+procedure TTntCustomTabControl.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+procedure TTntCustomTabControl.CreateWnd;
+begin
+ inherited;
+ if FSaveTabs <> nil then
+ begin
+ FTabs.Assign(FSaveTabs);
+ FreeAndNil(FSaveTabs);
+ TabIndex := FSaveTabIndex;
+ end;
+end;
+
+procedure TTntCustomTabControl.DestroyWnd;
+begin
+ if (FTabs <> nil) and (FTabs.Count > 0) then
+ begin
+ FSaveTabs := TTntStringList.Create;
+ FSaveTabs.Assign(FTabs);
+ FSaveTabIndex := TabIndex;
+ end;
+ inherited;
+end;
+
+function TTntCustomTabControl.GetTabs: TTntStrings;
+begin
+ if FSaveTabs <> nil then
+ Result := FSaveTabs // Use FSaveTabs while the window is deallocated
+ else
+ Result := FTabs;
+end;
+
+procedure TTntCustomTabControl.SetTabs(const Value: TTntStrings);
+begin
+ FTabs.Assign(Value);
+end;
+
+function TTntCustomTabControl.IsHintStored: Boolean;
+begin
+ Result := TntControl_IsHintStored(Self);
+end;
+
+function TTntCustomTabControl.GetHint: WideString;
+begin
+ Result := TntControl_GetHint(Self);
+end;
+
+procedure TTntCustomTabControl.SetHint(const Value: WideString);
+begin
+ TntControl_SetHint(Self, Value);
+end;
+
+procedure TTntCustomTabControl.CMDialogChar(var Message: TCMDialogChar);
+var
+ I: Integer;
+begin
+ for I := 0 to Tabs.Count - 1 do
+ if IsWideCharAccel(Message.CharCode, Tabs[I]) and CanShowTab(I) and CanFocus then
+ begin
+ Message.Result := 1;
+ if CanChange then
+ begin
+ TabIndex := I;
+ Change;
+ end;
+ Exit;
+ end;
+ Broadcast(Message);
+end;
+
+procedure TTntCustomTabControl.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
+ inherited;
+end;
+
+function TTntCustomTabControl.GetActionLinkClass: TControlActionLinkClass;
+begin
+ Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
+end;
+
+{ TTntTabSheet }
+
+procedure TTntTabSheet.CreateWindowHandle(const Params: TCreateParams);
+begin
+ CreateUnicodeHandle(Self, Params, '');
+end;
+
+function TTntTabSheet.IsCaptionStored: Boolean;
+begin
+ Result := TntControl_IsCaptionStored(Self);
+end;
+
+function TTntTabSheet.GetCaption: TWideCaption;
+begin
+ Result := TntControl_GetText(Self);
+end;
+
+procedure TTntTabSheet.SetCaption(const Value: TWideCaption);
+begin
+ TntControl_SetText(Self, Value);
+end;
+
+procedure TTntTabSheet.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntTabSheet.IsHintStored: Boolean;
+begin
+ Result := TntControl_IsHintStored(Self);
+end;
+
+function TTntTabSheet.GetHint: WideString;
+begin
+ Result := TntControl_GetHint(Self);
+end;
+
+procedure TTntTabSheet.SetHint(const Value: WideString);
+begin
+ TntControl_SetHint(Self, Value);
+end;
+
+procedure TTntTabSheet.WMSetText(var Message: TWMSetText);
+begin
+ if (not Win32PlatformIsUnicode)
+ or (HandleAllocated)
+ or (Message.Text = AnsiString(TntControl_GetText(Self)))
+ or (Force_Inherited_WMSETTEXT) then
+ inherited
+ else begin
+ // NT, handle not allocated and text is different
+ Force_Inherited_WMSETTEXT := True;
+ try
+ TntControl_SetText(Self, Message.Text) { sync WideCaption with ANSI Caption }
+ finally
+ Force_Inherited_WMSETTEXT := FALSE;
+ end;
+ end;
+end;
+
+procedure TTntTabSheet.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
+ inherited;
+end;
+
+function TTntTabSheet.GetActionLinkClass: TControlActionLinkClass;
+begin
+ Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
+end;
+
+{ TTntPageControl }
+
+procedure TTntPageControl.CreateWindowHandle(const Params: TCreateParams);
+begin
+ CreateUnicodeHandle_ComCtl(Self, Params, WC_TABCONTROL);
+end;
+
+procedure TTntPageControl.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntPageControl.IsHintStored: Boolean;
+begin
+ Result := TntControl_IsHintStored(Self);
+end;
+
+function TTntPageControl.GetHint: WideString;
+begin
+ Result := TntControl_GetHint(Self);
+end;
+
+procedure TTntPageControl.SetHint(const Value: WideString);
+begin
+ TntControl_SetHint(Self, Value);
+end;
+
+procedure TTntPageControl.WndProc(var Message: TMessage);
+const
+ RTL: array[Boolean] of Cardinal = (0, TCIF_RTLREADING);
+var
+ TCItemA: PTCItemA;
+ TabSheet: TTabSheet{TNT-ALLOW TTabSheet};
+ Text: WideString;
+begin
+ if (not Win32PlatformIsUnicode) then
+ inherited
+ else begin
+ case Message.Msg of
+ TCM_SETITEMA:
+ begin
+ TCItemA := PTCItemA(Message.lParam);
+ if ((TCItemA.mask and TCIF_PARAM) = TCIF_PARAM) then
+ TabSheet := TObject(TCItemA.lParam) as TTabSheet{TNT-ALLOW TTabSheet}
+ else if ((TCItemA.mask and TCIF_TEXT) = TCIF_TEXT)
+ and (Message.wParam >= 0) and (Message.wParam <= Tabs.Count - 1) then
+ TabSheet := Tabs.Objects[Message.wParam] as TTabSheet{TNT-ALLOW TTabSheet}
+ else
+ TabSheet := nil;
+
+ if TabSheet = nil then begin
+ // will always be followed by TCM_SETITEMA(TCIF_PARAM) if TCIF_TEXT is present
+ TCItemA.mask := TCItemA.mask and (not TCIF_TEXT);
+ end else begin
+ // convert message to unicode, add text
+ Message.Msg := TCM_SETITEMW;
+ TCItemA.mask := TCItemA.mask or TCIF_TEXT or RTL[UseRightToLeftReading];
+ if TabSheet is TTntTabSheet then
+ Text := TTntTabSheet(TabSheet).Caption
+ else
+ Text := TabSheet.Caption;
+ TCItemA.pszText := PAnsiChar(PWideChar(Text));
+ end;
+ end;
+ TCM_INSERTITEMA:
+ begin
+ TCItemA := PTCItemA(Message.lParam);
+ // will always be followed by TCM_SETITEMA(TCIF_PARAM) if TCIF_TEXT is present
+ TCItemA.mask := TCItemA.mask and (not TCIF_TEXT);
+ end;
+ end;
+ inherited;
+ end;
+end;
+
+procedure TTntPageControl.CMDialogChar(var Message: TCMDialogChar);
+var
+ I: Integer;
+ TabText: WideString;
+begin
+ for I := 0 to PageCount - 1 do begin
+ if Pages[i] is TTntTabSheet then
+ TabText := TTntTabSheet(Pages[i]).Caption
+ else
+ TabText := Pages[i].Caption;
+ if IsWideCharAccel(Message.CharCode, TabText) and CanShowTab(Pages[i].TabIndex) and CanFocus then
+ begin
+ Message.Result := 1;
+ if CanChange then
+ begin
+ TabIndex := Pages[i].TabIndex;
+ Change;
+ end;
+ Exit;
+ end;
+ end;
+ Broadcast(Message);
+end;
+
+procedure TTntPageControl.CMDockClient(var Message: TCMDockClient);
+var
+ IsVisible: Boolean;
+ DockCtl: TControl;
+begin
+ Message.Result := 0;
+ FNewDockSheet := TTntTabSheet.Create(Self);
+ try
+ try
+ DockCtl := Message.DockSource.Control;
+ if DockCtl is TCustomForm then
+ FNewDockSheet.Caption := TntControl_GetText(DockCtl);
+ FNewDockSheet.PageControl := Self;
+ DockCtl.Dock(Self, Message.DockSource.DockRect);
+ except
+ FNewDockSheet.Free;
+ raise;
+ end;
+ IsVisible := DockCtl.Visible;
+ FNewDockSheet.TabVisible := IsVisible;
+ if IsVisible then ActivePage := FNewDockSheet;
+ DockCtl.Align := alClient;
+ finally
+ FNewDockSheet := nil;
+ end;
+end;
+
+procedure TTntPageControl.DoAddDockClient(Client: TControl; const ARect: TRect);
+begin
+ if FNewDockSheet <> nil then
+ Client.Parent := FNewDockSheet;
+end;
+
+procedure TTntPageControl.CMDockNotification(var Message: TCMDockNotification);
+var
+ I: Integer;
+ S: WideString;
+ Page: TTabSheet{TNT-ALLOW TTabSheet};
+begin
+ Page := GetPageFromDockClient(Message.Client);
+ if (Message.NotifyRec.ClientMsg <> WM_SETTEXT)
+ or (Page = nil) or (not (Page is TTntTabSheet)) then
+ inherited
+ else begin
+ if (Message.Client is TWinControl)
+ and (TWinControl(Message.Client).HandleAllocated)
+ and IsWindowUnicode(TWinControl(Message.Client).Handle) then
+ S := PWideChar(Message.NotifyRec.MsgLParam)
+ else
+ S := PAnsiChar(Message.NotifyRec.MsgLParam);
+ { Search for first CR/LF and end string there }
+ for I := 1 to Length(S) do
+ if S[I] in [CR, LF] then
+ begin
+ SetLength(S, I - 1);
+ Break;
+ end;
+ TTntTabSheet(Page).Caption := S;
+ end;
+end;
+
+procedure TTntPageControl.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
+ inherited;
+end;
+
+function TTntPageControl.GetActionLinkClass: TControlActionLinkClass;
+begin
+ Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
+end;
+
+{ TTntTrackBar }
+
+procedure TTntTrackBar.CreateWindowHandle(const Params: TCreateParams);
+begin
+ CreateUnicodeHandle_ComCtl(Self, Params, TRACKBAR_CLASS);
+end;
+
+procedure TTntTrackBar.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntTrackBar.IsHintStored: Boolean;
+begin
+ Result := TntControl_IsHintStored(Self);
+end;
+
+function TTntTrackBar.GetHint: WideString;
+begin
+ Result := TntControl_GetHint(Self);
+end;
+
+procedure TTntTrackBar.SetHint(const Value: WideString);
+begin
+ TntControl_SetHint(Self, Value);
+end;
+
+procedure TTntTrackBar.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
+ inherited;
+end;
+
+function TTntTrackBar.GetActionLinkClass: TControlActionLinkClass;
+begin
+ Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
+end;
+
+{ TTntProgressBar }
+
+procedure TTntProgressBar.CreateWindowHandle(const Params: TCreateParams);
+begin
+ CreateUnicodeHandle_ComCtl(Self, Params, PROGRESS_CLASS);
+end;
+
+procedure TTntProgressBar.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntProgressBar.IsHintStored: Boolean;
+begin
+ Result := TntControl_IsHintStored(Self);
+end;
+
+function TTntProgressBar.GetHint: WideString;
+begin
+ Result := TntControl_GetHint(Self);
+end;
+
+procedure TTntProgressBar.SetHint(const Value: WideString);
+begin
+ TntControl_SetHint(Self, Value);
+end;
+
+procedure TTntProgressBar.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
+ inherited;
+end;
+
+function TTntProgressBar.GetActionLinkClass: TControlActionLinkClass;
+begin
+ Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
+end;
+
+{ TTntCustomUpDown }
+
+procedure TTntCustomUpDown.CreateWindowHandle(const Params: TCreateParams);
+begin
+ CreateUnicodeHandle_ComCtl(Self, Params, UPDOWN_CLASS);
+end;
+
+procedure TTntCustomUpDown.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntCustomUpDown.IsHintStored: Boolean;
+begin
+ Result := TntControl_IsHintStored(Self);
+end;
+
+function TTntCustomUpDown.GetHint: WideString;
+begin
+ Result := TntControl_GetHint(Self);
+end;
+
+procedure TTntCustomUpDown.SetHint(const Value: WideString);
+begin
+ TntControl_SetHint(Self, Value);
+end;
+
+procedure TTntCustomUpDown.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
+ inherited;
+end;
+
+function TTntCustomUpDown.GetActionLinkClass: TControlActionLinkClass;
+begin
+ Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
+end;
+
+{ TTntDateTimePicker }
+
+procedure TTntDateTimePicker.CreateWindowHandle(const Params: TCreateParams);
+begin
+ CreateUnicodeHandle_ComCtl(Self, Params, DATETIMEPICK_CLASS);
+end;
+
+procedure TTntDateTimePicker.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntDateTimePicker.IsHintStored: Boolean;
+begin
+ Result := TntControl_IsHintStored(Self);
+end;
+
+function TTntDateTimePicker.GetHint: WideString;
+begin
+ Result := TntControl_GetHint(Self);
+end;
+
+procedure TTntDateTimePicker.SetHint(const Value: WideString);
+begin
+ TntControl_SetHint(Self, Value);
+end;
+
+procedure TTntDateTimePicker.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
+ inherited;
+end;
+
+function TTntDateTimePicker.GetActionLinkClass: TControlActionLinkClass;
+begin
+ Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
+end;
+
+procedure TTntDateTimePicker.CreateWnd;
+var
+ SaveChecked: Boolean;
+begin
+ FHadFirstMouseClick := False;
+ SaveChecked := Checked;
+ inherited;
+ // This fixes an issue where TDateTimePicker.CNNotify causes "FChecked := True" to occur
+ // during window creation. This issue results in .Checked to read True even though
+ // it is not visually checked.
+ Checked := SaveChecked;
+end;
+
+procedure TTntDateTimePicker.WMLButtonDown(var Message: TWMLButtonDown);
+
+ procedure UpdateValues;
+ var
+ Hdr: TNMDateTimeChange;
+ begin
+ Hdr.nmhdr.hwndFrom := Handle;
+ Hdr.nmhdr.idFrom := 0;
+ Hdr.nmhdr.code := DTN_DATETIMECHANGE;
+ Hdr.dwFlags := DateTime_GetSystemTime(Handle, Hdr.st);
+ if (Hdr.dwFlags <> Cardinal(GDT_ERROR)) then begin
+ if Hdr.dwFlags = GDT_NONE then
+ ZeroMemory(@Hdr.st, SizeOf(Hdr.st));
+ Perform(CN_NOTIFY, Integer(Handle), Integer(@Hdr));
+ end;
+ end;
+
+begin
+ inherited;
+ if ShowCheckBox and (not FHadFirstMouseClick) then begin
+ FHadFirstMouseClick := True;
+ UpdateValues; // Sometimes the first mouse click doesn't result in WM_NOTIFY.
+ end;
+end;
+
+{ TTntMonthCalendar }
+
+procedure TTntMonthCalendar.CreateWindowHandle(const Params: TCreateParams);
+begin
+ CreateUnicodeHandle_ComCtl(Self, Params, MONTHCAL_CLASS);
+ if Win32PlatformIsUnicode then begin
+ { For some reason WM_NOTIFY:MCN_GETDAYSTATE never gets called. }
+ ForceGetMonthInfo;
+ end;
+end;
+
+procedure TTntMonthCalendar.ForceGetMonthInfo;
+var
+ Hdr: TNMDayState;
+ Days: array of TMonthDayState;
+ Range: array[1..2] of TSystemTime;
+begin
+ // populate Days array
+ Hdr.nmhdr.hwndFrom := Handle;
+ Hdr.nmhdr.idFrom := 0;
+ Hdr.nmhdr.code := MCN_GETDAYSTATE;
+ Hdr.cDayState := MonthCal_GetMonthRange(Handle, GMR_DAYSTATE, @Range[1]);
+ Hdr.stStart := Range[1];
+ SetLength(Days, Hdr.cDayState);
+ Hdr.prgDayState := @Days[0];
+ SendMessage(Handle, CN_NOTIFY, Integer(Handle), Integer(@Hdr));
+ // update day state
+ SendMessage(Handle, MCM_SETDAYSTATE, Hdr.cDayState, Longint(Hdr.prgDayState))
+end;
+
+procedure TTntMonthCalendar.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntMonthCalendar.IsHintStored: Boolean;
+begin
+ Result := TntControl_IsHintStored(Self);
+end;
+
+function TTntMonthCalendar.GetHint: WideString;
+begin
+ Result := TntControl_GetHint(Self);
+end;
+
+procedure TTntMonthCalendar.SetHint(const Value: WideString);
+begin
+ TntControl_SetHint(Self, Value);
+end;
+
+function TTntMonthCalendar.GetDate: TDate;
+begin
+ Result := Trunc(inherited Date); { Fixes issue where Date always reflects time of saving dfm. }
+end;
+
+procedure TTntMonthCalendar.SetDate(const Value: TDate);
+begin
+ inherited Date := Trunc(Value);
+end;
+
+procedure TTntMonthCalendar.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
+ inherited;
+end;
+
+function TTntMonthCalendar.GetActionLinkClass: TControlActionLinkClass;
+begin
+ Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
+end;
+
+{ TTntPageScroller }
+
+procedure TTntPageScroller.CreateWindowHandle(const Params: TCreateParams);
+begin
+ CreateUnicodeHandle_ComCtl(Self, Params, WC_PAGESCROLLER);
+end;
+
+procedure TTntPageScroller.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntPageScroller.IsHintStored: Boolean;
+begin
+ Result := TntControl_IsHintStored(Self);
+end;
+
+function TTntPageScroller.GetHint: WideString;
+begin
+ Result := TntControl_GetHint(Self);
+end;
+
+procedure TTntPageScroller.SetHint(const Value: WideString);
+begin
+ TntControl_SetHint(Self, Value);
+end;
+
+procedure TTntPageScroller.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
+ inherited;
+end;
+
+function TTntPageScroller.GetActionLinkClass: TControlActionLinkClass;
+begin
+ Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
+end;
+
+{ TTntStatusPanel }
+
+procedure TTntStatusPanel.Assign(Source: TPersistent);
+begin
+ inherited;
+ if Source is TTntStatusPanel then
+ Text := TTntStatusPanel(Source).Text;
+end;
+
+procedure TTntStatusPanel.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntStatusPanel.GetText: Widestring;
+begin
+ Result := GetSyncedWideString(FText, inherited Text);
+end;
+
+procedure TTntStatusPanel.SetInheritedText(const Value: AnsiString);
+begin
+ inherited Text := Value;
+end;
+
+procedure TTntStatusPanel.SetText(const Value: Widestring);
+begin
+ SetSyncedWideString(Value, FText, inherited Text, SetInheritedText);
+end;
+
+{ TTntStatusPanels }
+
+function TTntStatusPanels.GetItem(Index: Integer): TTntStatusPanel;
+begin
+ Result := (inherited GetItem(Index)) as TTntStatusPanel;
+end;
+
+procedure TTntStatusPanels.SetItem(Index: Integer; Value: TTntStatusPanel);
+begin
+ inherited SetItem(Index, Value);
+end;
+
+function TTntStatusPanels.Add: TTntStatusPanel;
+begin
+ Result := (inherited Add) as TTntStatusPanel;
+end;
+
+function TTntStatusPanels.AddItem(Item: TTntStatusPanel; Index: Integer): TTntStatusPanel;
+begin
+ Result := (inherited AddItem(Item, Index)) as TTntStatusPanel;
+end;
+
+function TTntStatusPanels.Insert(Index: Integer): TTntStatusPanel;
+begin
+ Result := (inherited Insert(Index)) as TTntStatusPanel;
+end;
+
+{ TTntCustomStatusBar }
+
+function TTntCustomStatusBar.GetHint: WideString;
+begin
+ Result := TntControl_GetHint(Self);
+end;
+
+procedure TTntCustomStatusBar.SetHint(const Value: WideString);
+begin
+ TntControl_SetHint(Self, Value);
+end;
+
+function TTntCustomStatusBar.IsHintStored: Boolean;
+begin
+ Result := TntControl_IsHintStored(Self);
+end;
+
+function TTntCustomStatusBar.CreatePanels: TStatusPanels{TNT-ALLOW TStatusPanels};
+begin
+ Result := TTntStatusPanels.Create(Self);
+end;
+
+function TTntCustomStatusBar.GetPanelClass: TStatusPanelClass;
+begin
+ Result := TTntStatusPanel;
+end;
+
+function TTntCustomStatusBar.SyncLeadingTabs(const WideVal: WideString; const AnsiVal: AnsiString): WideString;
+
+ function CountLeadingTabs(const Val: WideString): Integer;
+ var
+ i: integer;
+ begin
+ Result := 0;
+ for i := 1 to Length(Val) do begin
+ if Val[i] <> #9 then break;
+ Inc(Result);
+ end;
+ end;
+
+var
+ AnsiTabCount: Integer;
+ WideTabCount: Integer;
+begin
+ AnsiTabCount := CountLeadingTabs(AnsiVal);
+ WideTabCount := CountLeadingTabs(WideVal);
+ Result := WideVal;
+ while WideTabCount < AnsiTabCount do begin
+ Insert(#9, Result, 1);
+ Inc(WideTabCount);
+ end;
+ while WideTabCount > AnsiTabCount do begin
+ Delete(Result, 1, 1);
+ Dec(WideTabCount);
+ end;
+end;
+
+function TTntCustomStatusBar.GetSimpleText: WideString;
+begin
+ FSimpleText := SyncLeadingTabs(FSimpleText, inherited SimpleText);
+ Result := GetSyncedWideString(FSimpleText, inherited SimpleText);
+end;
+
+procedure TTntCustomStatusBar.SetInheritedSimpleText(const Value: AnsiString);
+begin
+ inherited SimpleText := Value;
+end;
+
+procedure TTntCustomStatusBar.SetSimpleText(const Value: WideString);
+begin
+ SetSyncedWideString(Value, FSimpleText, inherited SimpleText, SetInheritedSimpleText);
+end;
+
+procedure TTntCustomStatusBar.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+procedure TTntCustomStatusBar.CreateWindowHandle(const Params: TCreateParams);
+begin
+ CreateUnicodeHandle_ComCtl(Self, Params, STATUSCLASSNAME);
+end;
+
+procedure TTntCustomStatusBar.WndProc(var Msg: TMessage);
+const
+ SB_SIMPLEID = Integer($FF);
+var
+ iPart: Integer;
+ szText: PAnsiChar;
+ WideText: WideString;
+begin
+ if Win32PlatformIsUnicode and (Msg.Msg = SB_SETTEXTA) and ((Msg.WParam and SBT_OWNERDRAW) = 0)
+ then begin
+ // convert SB_SETTEXTA message to Unicode
+ iPart := (Msg.WParam and SB_SIMPLEID);
+ szText := PAnsiChar(Msg.LParam);
+ if iPart = SB_SIMPLEID then
+ WideText := SimpleText
+ else if Panels.Count > 0 then
+ WideText := Panels[iPart].Text
+ else begin
+ WideText := szText;
+ end;
+ WideText := SyncLeadingTabs(WideText, szText);
+ Msg.Result := SendMessageW(Handle, SB_SETTEXTW, Msg.wParam, Integer(PWideChar(WideText)));
+ end else
+ inherited;
+end;
+
+procedure TTntCustomStatusBar.WMGetTextLength(var Message: TWMGetTextLength);
+begin
+ Message.Result := Length(SimpleText);
+end;
+
+procedure TTntCustomStatusBar.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
+ inherited;
+end;
+
+function TTntCustomStatusBar.GetActionLinkClass: TControlActionLinkClass;
+begin
+ Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
+end;
+
+function TTntCustomStatusBar.GetPanels: TTntStatusPanels;
+begin
+ Result := inherited Panels as TTntStatusPanels;
+end;
+
+procedure TTntCustomStatusBar.SetPanels(const Value: TTntStatusPanels);
+begin
+ inherited Panels := Value;
+end;
+
+function TTntCustomStatusBar.ExecuteAction(Action: TBasicAction): Boolean;
+begin
+ if AutoHint and (Action is TTntHintAction) and not DoHint then
+ begin
+ if SimplePanel or (Panels.Count = 0) then
+ SimpleText := TTntHintAction(Action).Hint else
+ Panels[0].Text := TTntHintAction(Action).Hint;
+ Result := True;
+ end
+ else Result := inherited ExecuteAction(Action);
+end;
+
+{ TTntStatusBar }
+
+function TTntStatusBar.GetOnDrawPanel: TDrawPanelEvent;
+begin
+ Result := TDrawPanelEvent(inherited OnDrawPanel);
+end;
+
+procedure TTntStatusBar.SetOnDrawPanel(const Value: TDrawPanelEvent);
+begin
+ inherited OnDrawPanel := TCustomDrawPanelEvent(Value);
+end;
+
+{ TTntTreeNode }
+
+function TTntTreeNode.IsEqual(Node: TTntTreeNode): Boolean;
+begin
+ Result := (Text = Node.Text) and (Data = Node.Data);
+end;
+
+procedure TTntTreeNode.ReadData(Stream: TStream; Info: PNodeInfo);
+var
+ I, Size, ItemCount: Integer;
+ LNode: TTntTreeNode;
+ Utf8Text: AnsiString;
+begin
+ Owner.ClearCache;
+ Stream.ReadBuffer(Size, SizeOf(Size));
+ Stream.ReadBuffer(Info^, Size);
+
+ if Pos(UTF8_BOM, Info^.Text) = 1 then begin
+ Utf8Text := Copy(Info^.Text, Length(UTF8_BOM) + 1, MaxInt);
+ try
+ Text := UTF8ToWideString(Utf8Text);
+ except
+ Text := Utf8Text;
+ end;
+ end else
+ Text := Info^.Text;
+
+ ImageIndex := Info^.ImageIndex;
+ SelectedIndex := Info^.SelectedIndex;
+ StateIndex := Info^.StateIndex;
+ OverlayIndex := Info^.OverlayIndex;
+ Data := Info^.Data;
+ ItemCount := Info^.Count;
+ for I := 0 to ItemCount - 1 do
+ begin
+ LNode := Owner.AddChild(Self, '');
+ LNode.ReadData(Stream, Info);
+ Owner.Owner.Added(LNode);
+ end;
+end;
+
+procedure TTntTreeNode.WriteData(Stream: TStream; Info: PNodeInfo);
+var
+ I, Size, L, ItemCount: Integer;
+ WideLen: Integer; Utf8Text: AnsiString;
+begin
+ WideLen := 255;
+ repeat
+ Utf8Text := UTF8_BOM + WideStringToUTF8(Copy(Text, 1, WideLen));
+ L := Length(Utf8Text);
+ Dec(WideLen);
+ until
+ L <= 255;
+
+ Size := SizeOf(TNodeInfo) + L - 255;
+ Info^.Text := Utf8Text;
+ Info^.ImageIndex := ImageIndex;
+ Info^.SelectedIndex := SelectedIndex;
+ Info^.OverlayIndex := OverlayIndex;
+ Info^.StateIndex := StateIndex;
+ Info^.Data := Data;
+ ItemCount := Count;
+ Info^.Count := ItemCount;
+ Stream.WriteBuffer(Size, SizeOf(Size));
+ Stream.WriteBuffer(Info^, Size);
+ for I := 0 to ItemCount - 1 do
+ Item[I].WriteData(Stream, Info);
+end;
+
+procedure TTntTreeNode.Assign(Source: TPersistent);
+var
+ Node: TTntTreeNode;
+begin
+ inherited;
+ if (not Deleting) and (Source is TTntTreeNode) then
+ begin
+ Node := TTntTreeNode(Source);
+ Text := Node.Text;
+ end;
+end;
+
+function TTntTreeNode.GetText: WideString;
+begin
+ Result := GetSyncedWideString(FText, inherited Text);
+end;
+
+procedure TTntTreeNode.SetInheritedText(const Value: AnsiString);
+begin
+ inherited Text := Value;
+end;
+
+procedure TTntTreeNode.SetText(const Value: WideString);
+begin
+ SetSyncedWideString(Value, FText, inherited Text, SetInheritedText);
+end;
+
+function TTntTreeNode.getFirstChild: TTntTreeNode;
+begin
+ Result := inherited getFirstChild as TTntTreeNode;
+end;
+
+function TTntTreeNode.GetItem(Index: Integer): TTntTreeNode;
+begin
+ Result := inherited Item[Index] as TTntTreeNode;
+end;
+
+procedure TTntTreeNode.SetItem(Index: Integer; const Value: TTntTreeNode);
+begin
+ inherited Item[Index] := Value;
+end;
+
+function TTntTreeNode.GetLastChild: TTntTreeNode;
+begin
+ Result := inherited GetLastChild as TTntTreeNode;
+end;
+
+function TTntTreeNode.GetNext: TTntTreeNode;
+begin
+ Result := inherited GetNext as TTntTreeNode;
+end;
+
+function TTntTreeNode.GetNextChild(Value: TTntTreeNode): TTntTreeNode;
+begin
+ Result := inherited GetNextChild(Value) as TTntTreeNode;
+end;
+
+function TTntTreeNode.getNextSibling: TTntTreeNode;
+begin
+ Result := inherited getNextSibling as TTntTreeNode;
+end;
+
+function TTntTreeNode.GetNextVisible: TTntTreeNode;
+begin
+ Result := inherited GetNextVisible as TTntTreeNode;
+end;
+
+function TTntTreeNode.GetNodeOwner: TTntTreeNodes;
+begin
+ Result := inherited Owner as TTntTreeNodes;
+end;
+
+function TTntTreeNode.GetParent: TTntTreeNode;
+begin
+ Result := inherited Parent as TTntTreeNode;
+end;
+
+function TTntTreeNode.GetPrev: TTntTreeNode;
+begin
+ Result := inherited GetPrev as TTntTreeNode;
+end;
+
+function TTntTreeNode.GetPrevChild(Value: TTntTreeNode): TTntTreeNode;
+begin
+ Result := inherited GetPrevChild(Value) as TTntTreeNode;
+end;
+
+function TTntTreeNode.getPrevSibling: TTntTreeNode;
+begin
+ Result := inherited getPrevSibling as TTntTreeNode;
+end;
+
+function TTntTreeNode.GetPrevVisible: TTntTreeNode;
+begin
+ Result := inherited GetPrevVisible as TTntTreeNode;
+end;
+
+function TTntTreeNode.GetTreeView: TTntCustomTreeView;
+begin
+ Result := inherited TreeView as TTntCustomTreeView;
+end;
+
+{ TTntTreeNodesEnumerator }
+
+constructor TTntTreeNodesEnumerator.Create(ATreeNodes: TTntTreeNodes);
+begin
+ inherited Create;
+ FIndex := -1;
+ FTreeNodes := ATreeNodes;
+end;
+
+function TTntTreeNodesEnumerator.GetCurrent: TTntTreeNode;
+begin
+ Result := FTreeNodes[FIndex];
+end;
+
+function TTntTreeNodesEnumerator.MoveNext: Boolean;
+begin
+ Result := FIndex < FTreeNodes.Count - 1;
+ if Result then
+ Inc(FIndex);
+end;
+
+{ TTntTreeNodes }
+
+{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
+type
+ THackTreeNodes = class(TPersistent)
+ protected
+ FxxxOwner: TCustomTreeView{TNT-ALLOW TCustomTreeView};
+ FxxxUpdateCount: Integer;
+ FNodeCache: TNodeCache;
+ FReading: Boolean;
+ end;
+{$ENDIF}
+{$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
+type
+ THackTreeNodes = class(TPersistent)
+ protected
+ FxxxOwner: TCustomTreeView{TNT-ALLOW TCustomTreeView};
+ FxxxUpdateCount: Integer;
+ FNodeCache: TNodeCache;
+ FReading: Boolean;
+ end;
+{$ENDIF}
+{$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
+type
+ THackTreeNodes = class(TPersistent)
+ protected
+ FxxxOwner: TCustomTreeView{TNT-ALLOW TCustomTreeView};
+ FxxxUpdateCount: Integer;
+ FNodeCache: TNodeCache;
+ FReading: Boolean;
+ end;
+{$ENDIF}
+{$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
+type
+ THackTreeNodes = class(TPersistent)
+ protected
+ FxxxOwner: TCustomTreeView{TNT-ALLOW TCustomTreeView};
+ FxxxUpdateCount: Integer;
+ FNodeCache: TNodeCache;
+ FReading: Boolean;
+ end;
+{$ENDIF}
+
+procedure SaveNodeTextToStrings(Nodes: TTntTreeNodes; sList: TTntStrings);
+var
+ ANode: TTntTreeNode;
+begin
+ sList.Clear;
+ if Nodes.Count > 0 then
+ begin
+ ANode := Nodes[0];
+ while ANode <> nil do
+ begin
+ sList.Add(ANode.Text);
+ ANode := ANode.GetNext;
+ end;
+ end;
+end;
+
+procedure TTntTreeNodes.Assign(Source: TPersistent);
+var
+ TreeNodes: TTntTreeNodes;
+ MemStream: TTntMemoryStream;
+begin
+ ClearCache;
+ if Source is TTntTreeNodes then
+ begin
+ TreeNodes := TTntTreeNodes(Source);
+ Clear;
+ MemStream := TTntMemoryStream.Create;
+ try
+ TreeNodes.WriteData(MemStream);
+ MemStream.Position := 0;
+ ReadData(MemStream);
+ finally
+ MemStream.Free;
+ end;
+ end else
+ inherited Assign(Source);
+end;
+
+function TTntTreeNodes.GetNodeFromIndex(Index: Integer): TTntTreeNode;
+begin
+ Result := inherited Item[Index] as TTntTreeNode;
+end;
+
+function TTntTreeNodes.AddChildFirst(Parent: TTntTreeNode; const S: WideString): TTntTreeNode;
+begin
+ Result := AddNode(nil, Parent, S, nil, naAddChildFirst);
+end;
+
+function TTntTreeNodes.AddChildObjectFirst(Parent: TTntTreeNode; const S: WideString;
+ Ptr: Pointer): TTntTreeNode;
+begin
+ Result := AddNode(nil, Parent, S, Ptr, naAddChildFirst);
+end;
+
+function TTntTreeNodes.AddChild(Parent: TTntTreeNode; const S: WideString): TTntTreeNode;
+begin
+ Result := AddNode(nil, Parent, S, nil, naAddChild);
+end;
+
+function TTntTreeNodes.AddChildObject(Parent: TTntTreeNode; const S: WideString;
+ Ptr: Pointer): TTntTreeNode;
+begin
+ Result := AddNode(nil, Parent, S, Ptr, naAddChild);
+end;
+
+function TTntTreeNodes.AddFirst(Sibling: TTntTreeNode; const S: WideString): TTntTreeNode;
+begin
+ Result := AddNode(nil, Sibling, S, nil, naAddFirst);
+end;
+
+function TTntTreeNodes.AddObjectFirst(Sibling: TTntTreeNode; const S: WideString;
+ Ptr: Pointer): TTntTreeNode;
+begin
+ Result := AddNode(nil, Sibling, S, Ptr, naAddFirst);
+end;
+
+function TTntTreeNodes.Add(Sibling: TTntTreeNode; const S: WideString): TTntTreeNode;
+begin
+ Result := AddNode(nil, Sibling, S, nil, naAdd);
+end;
+
+function TTntTreeNodes.AddObject(Sibling: TTntTreeNode; const S: WideString;
+ Ptr: Pointer): TTntTreeNode;
+begin
+ Result := AddNode(nil, Sibling, S, Ptr, naAdd);
+end;
+
+function TTntTreeNodes.Insert(Sibling: TTntTreeNode; const S: WideString): TTntTreeNode;
+begin
+ Result := AddNode(nil, Sibling, S, nil, naInsert);
+end;
+
+function TTntTreeNodes.InsertObject(Sibling: TTntTreeNode; const S: WideString;
+ Ptr: Pointer): TTntTreeNode;
+begin
+ Result := AddNode(nil, Sibling, S, Ptr, naInsert);
+end;
+
+function TTntTreeNodes.InsertNode(Node, Sibling: TTntTreeNode; const S: WideString;
+ Ptr: Pointer): TTntTreeNode;
+begin
+ Result := AddNode(Node, Sibling, S, Ptr, naInsert);
+end;
+
+function TTntTreeNodes.AddNode(Node, Relative: TTntTreeNode; const S: WideString;
+ Ptr: Pointer; Method: TNodeAttachMode): TTntTreeNode;
+begin
+ Result := inherited AddNode(Node, Relative, '', Ptr, Method) as TTntTreeNode;
+ Result.Text := S;
+end;
+
+function TTntTreeNodes.GetNode(ItemId: HTreeItem): TTntTreeNode;
+begin
+ Result := inherited GetNode(ItemID) as TTntTreeNode;
+end;
+
+function TTntTreeNodes.GetFirstNode: TTntTreeNode;
+begin
+ Result := inherited GetFirstNode as TTntTreeNode;
+end;
+
+function TTntTreeNodes.GetEnumerator: TTntTreeNodesEnumerator;
+begin
+ Result := TTntTreeNodesEnumerator.Create(Self);
+end;
+
+function TTntTreeNodes.GetNodesOwner: TTntCustomTreeView;
+begin
+ Result := inherited Owner as TTntCustomTreeView;
+end;
+
+procedure TTntTreeNodes.ClearCache;
+begin
+ THackTreeNodes(Self).FNodeCache.CacheNode := nil;
+end;
+
+procedure TTntTreeNodes.DefineProperties(Filer: TFiler);
+
+ function WriteNodes: Boolean;
+ var
+ I: Integer;
+ Nodes: TTntTreeNodes;
+ begin
+ Nodes := TTntTreeNodes(Filer.Ancestor);
+ if Nodes = nil then
+ Result := Count > 0
+ else if Nodes.Count <> Count then
+ Result := True
+ else
+ begin
+ Result := False;
+ for I := 0 to Count - 1 do
+ begin
+ Result := not Item[I].IsEqual(Nodes[I]);
+ if Result then
+ Break;
+ end
+ end;
+ end;
+
+begin
+ inherited DefineProperties(Filer);
+ Filer.DefineBinaryProperty('Utf8Data', ReadData, WriteData, WriteNodes);
+end;
+
+procedure TTntTreeNodes.ReadData(Stream: TStream);
+var
+ I, Count: Integer;
+ NodeInfo: TNodeInfo;
+ LNode: TTntTreeNode;
+ LHandleAllocated: Boolean;
+begin
+ LHandleAllocated := Owner.HandleAllocated;
+ if LHandleAllocated then
+ BeginUpdate;
+ THackTreeNodes(Self).FReading := True;
+ try
+ Clear;
+ Stream.ReadBuffer(Count, SizeOf(Count));
+ for I := 0 to Count - 1 do
+ begin
+ LNode := Add(nil, '');
+ LNode.ReadData(Stream, @NodeInfo);
+ Owner.Added(LNode);
+ end;
+ finally
+ THackTreeNodes(Self).FReading := False;
+ if LHandleAllocated then
+ EndUpdate;
+ end;
+end;
+
+procedure TTntTreeNodes.WriteData(Stream: TStream);
+var
+ I: Integer;
+ Node: TTntTreeNode;
+ NodeInfo: TNodeInfo;
+begin
+ I := 0;
+ Node := GetFirstNode;
+ while Node <> nil do
+ begin
+ Inc(I);
+ Node := Node.GetNextSibling;
+ end;
+ Stream.WriteBuffer(I, SizeOf(I));
+ Node := GetFirstNode;
+ while Node <> nil do
+ begin
+ Node.WriteData(Stream, @NodeInfo);
+ Node := Node.GetNextSibling;
+ end;
+end;
+
+{ TTntTreeStrings }
+
+type
+ TTntTreeStrings = class(TTntStringList)
+ protected
+ function GetBufStart(Buffer: PWideChar; var Level: Integer): PWideChar;
+ public
+ procedure SaveToTree(Tree: TTntCustomTreeView);
+ procedure LoadFromTree(Tree: TTntCustomTreeView);
+ end;
+
+function TTntTreeStrings.GetBufStart(Buffer: PWideChar; var Level: Integer): PWideChar;
+begin
+ Level := 0;
+ while Buffer^ in [WideChar(' '), WideChar(#9)] do
+ begin
+ Inc(Buffer);
+ Inc(Level);
+ end;
+ Result := Buffer;
+end;
+
+procedure TTntTreeStrings.SaveToTree(Tree: TTntCustomTreeView);
+var
+ ANode, NextNode: TTntTreeNode;
+ ALevel, i: Integer;
+ CurrStr: WideString;
+ Owner: TTntTreeNodes;
+begin
+ Owner := Tree.Items;
+ Owner.BeginUpdate;
+ try
+ try
+ Owner.Clear;
+ ANode := nil;
+ for i := 0 to Count - 1 do
+ begin
+ CurrStr := GetBufStart(PWideChar(Strings[i]), ALevel);
+ if ANode = nil then
+ ANode := Owner.AddChild(nil, CurrStr)
+ else if ANode.Level = ALevel then
+ ANode := Owner.AddChild(ANode.Parent, CurrStr)
+ else if ANode.Level = (ALevel - 1) then
+ ANode := Owner.AddChild(ANode, CurrStr)
+ else if ANode.Level > ALevel then
+ begin
+ NextNode := ANode.Parent;
+ while NextNode.Level > ALevel do
+ NextNode := NextNode.Parent;
+ ANode := Owner.AddChild(NextNode.Parent, CurrStr);
+ end
+ else
+ raise ETreeViewError.CreateFmt(sInvalidLevelEx, [ALevel, CurrStr]);
+ end;
+ finally
+ Owner.EndUpdate;
+ end;
+ except
+ Owner.Owner.Invalidate; // force repaint on exception
+ raise;
+ end;
+end;
+
+procedure TTntTreeStrings.LoadFromTree(Tree: TTntCustomTreeView);
+const
+ TabChar = #9;
+var
+ i: Integer;
+ ANode: TTntTreeNode;
+ NodeStr: WideString;
+ Owner: TTntTreeNodes;
+begin
+ Clear;
+ Owner := Tree.Items;
+ if Owner.Count > 0 then
+ begin
+ ANode := Owner[0];
+ while ANode <> nil do
+ begin
+ NodeStr := '';
+ for i := 0 to ANode.Level - 1 do NodeStr := NodeStr + TabChar;
+ NodeStr := NodeStr + ANode.Text;
+ Add(NodeStr);
+ ANode := ANode.GetNext;
+ end;
+ end;
+end;
+
+{ _TntInternalCustomTreeView }
+
+function _TntInternalCustomTreeView.FindNextToSelect: TTreeNode{TNT-ALLOW TTreeNode};
+begin
+ Result := Wide_FindNextToSelect;
+end;
+
+function _TntInternalCustomTreeView.Inherited_FindNextToSelect: TTreeNode{TNT-ALLOW TTreeNode};
+begin
+ Result := inherited FindNextToSelect;
+end;
+
+{ TTntCustomTreeView }
+
+function TntDefaultTreeViewSort(Node1, Node2: TTntTreeNode; lParam: Integer): Integer; stdcall;
+begin
+ with Node1 do
+ if Assigned(TreeView.OnCompare) then
+ TreeView.OnCompare(TreeView, Node1, Node2, lParam, Result)
+ else Result := lstrcmpw(PWideChar(Node1.Text), PWideChar(Node2.Text));
+end;
+
+constructor TTntCustomTreeView.Create(AOwner: TComponent);
+begin
+ inherited;
+ FEditInstance := Classes.MakeObjectInstance(EditWndProcW);
+end;
+
+destructor TTntCustomTreeView.Destroy;
+begin
+ Destroying;
+ Classes.FreeObjectInstance(FEditInstance);
+ FreeAndNil(FSavedNodeText);
+ inherited;
+end;
+
+var
+ ComCtrls_DefaultTreeViewSort: TTVCompare = nil;
+
+procedure TTntCustomTreeView.CreateWindowHandle(const Params: TCreateParams);
+
+ procedure Capture_ComCtrls_DefaultTreeViewSort;
+ begin
+ FTestingForSortProc := True;
+ try
+ AlphaSort;
+ finally
+ FTestingForSortProc := False;
+ end;
+ end;
+
+begin
+ CreateUnicodeHandle_ComCtl(Self, Params, WC_TREEVIEW);
+ if (Win32PlatformIsUnicode) then begin
+ if not Assigned(ComCtrls_DefaultTreeViewSort) then
+ Capture_ComCtrls_DefaultTreeViewSort;
+ end;
+end;
+
+procedure TTntCustomTreeView.CreateWnd;
+begin
+ inherited;
+ if FSavedNodeText <> nil then begin
+ FreeAndNil(FSavedNodeText);
+ SortType := FSavedSortType;
+ end;
+end;
+
+procedure TTntCustomTreeView.DestroyWnd;
+begin
+ if (not (csDestroying in ComponentState)) then begin
+ FSavedNodeText := TTntStringList.Create;
+ FSavedSortType := SortType;
+ SortType := stNone; // when recreating window, we are expecting items to come back in same order
+ SaveNodeTextToStrings(Items, FSavedNodeText);
+ end;
+ inherited;
+end;
+
+procedure TTntCustomTreeView.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntCustomTreeView.IsHintStored: Boolean;
+begin
+ Result := TntControl_IsHintStored(Self);
+end;
+
+function TTntCustomTreeView.GetHint: WideString;
+begin
+ Result := TntControl_GetHint(Self)
+end;
+
+procedure TTntCustomTreeView.SetHint(const Value: WideString);
+begin
+ TntControl_SetHint(Self, Value);
+end;
+
+procedure TTntCustomTreeView.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
+ inherited;
+end;
+
+function TTntCustomTreeView.GetActionLinkClass: TControlActionLinkClass;
+begin
+ Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
+end;
+
+function TTntCustomTreeView.CreateNode: TTreeNode{TNT-ALLOW TTreeNode};
+var
+ LClass: TClass;
+ TntLClass: TTntTreeNodeClass;
+begin
+ LClass := TTntTreeNode;
+ if Assigned(OnCreateNodeClass) then
+ OnCreateNodeClass(Self, TTreeNodeClass(LClass));
+ if not LClass.InheritsFrom(TTntTreeNode) then
+ raise ETntInternalError.Create('Internal Error: OnCreateNodeClass.ItemClass must inherit from TTntTreeNode.');
+ TntLClass := TTntTreeNodeClass(LClass);
+ Result := TntLClass.Create(inherited Items);
+end;
+
+function TTntCustomTreeView.CreateNodes: TTreeNodes{TNT-ALLOW TTreeNodes};
+begin
+ Result := TTntTreeNodes.Create(Self);
+end;
+
+function TTntCustomTreeView.GetTreeNodes: TTntTreeNodes;
+begin
+ Result := inherited Items as TTntTreeNodes;
+end;
+
+procedure TTntCustomTreeView.SetTreeNodes(const Value: TTntTreeNodes);
+begin
+ Items.Assign(Value);
+end;
+
+function TTntCustomTreeView.GetNodeFromItem(const Item: TTVItem): TTntTreeNode;
+begin
+ Result := nil;
+ if Items <> nil then
+ with Item do
+ if (state and TVIF_PARAM) <> 0 then
+ Result := Pointer(lParam)
+ else
+ Result := Items.GetNode(hItem);
+end;
+
+function TTntCustomTreeView.Wide_FindNextToSelect: TTntTreeNode;
+begin
+ Result := FindNextToSelect;
+end;
+
+function TTntCustomTreeView.FindNextToSelect: TTntTreeNode;
+begin
+ Result := Inherited_FindNextToSelect as TTntTreeNode;
+end;
+
+function TTntCustomTreeView.GetDropTarget: TTntTreeNode;
+begin
+ Result := inherited DropTarget as TTntTreeNode;
+end;
+
+function TTntCustomTreeView.GetNodeAt(X, Y: Integer): TTntTreeNode;
+begin
+ Result := inherited GetNodeAt(X, Y) as TTntTreeNode;
+end;
+
+function TTntCustomTreeView.GetSelected: TTntTreeNode;
+begin
+ Result := inherited Selected as TTntTreeNode;
+end;
+
+function TTntCustomTreeView.GetSelection(Index: Integer): TTntTreeNode;
+begin
+ Result := inherited Selections[Index] as TTntTreeNode;
+end;
+
+function TTntCustomTreeView.GetSelections(AList: TList): TTntTreeNode;
+begin
+ Result := inherited GetSelections(AList) as TTntTreeNode;
+end;
+
+function TTntCustomTreeView.GetTopItem: TTntTreeNode;
+begin
+ Result := inherited TopItem as TTntTreeNode;
+end;
+
+procedure TTntCustomTreeView.SetDropTarget(const Value: TTntTreeNode);
+begin
+ inherited DropTarget := Value;
+end;
+
+procedure TTntCustomTreeView.SetSelected(const Value: TTntTreeNode);
+begin
+ inherited Selected := Value;
+end;
+
+procedure TTntCustomTreeView.SetTopItem(const Value: TTntTreeNode);
+begin
+ inherited TopItem := Value;
+end;
+
+procedure TTntCustomTreeView.WndProc(var Message: TMessage);
+type
+ PTVSortCB = ^TTVSortCB;
+begin
+ with Message do begin
+ // capture ANSI version of DefaultTreeViewSort from ComCtrls
+ if (FTestingForSortProc)
+ and (Msg = TVM_SORTCHILDRENCB) then begin
+ ComCtrls_DefaultTreeViewSort := PTVSortCB(lParam).lpfnCompare;
+ exit;
+ end;
+
+ if (Win32PlatformIsUnicode)
+ and (Msg = TVM_SORTCHILDRENCB)
+ and (@PTVSortCB(lParam).lpfnCompare = @ComCtrls_DefaultTreeViewSort) then
+ begin
+ // Unicode:: call wide version of sort proc instead
+ PTVSortCB(lParam)^.lpfnCompare := TTVCompare(@TntDefaultTreeViewSort);
+ Result := SendMessageW(Handle, TVM_SORTCHILDRENCB, wParam, lParam);
+ end else
+ inherited;
+ end;
+end;
+
+procedure TTntCustomTreeView.CNNotify(var Message: TWMNotify);
+var
+ Node: TTntTreeNode;
+begin
+ if (not Win32PlatformIsUnicode) then
+ inherited
+ else begin
+ with Message do begin
+ case NMHdr^.code of
+ TVN_BEGINDRAGW:
+ begin
+ NMHdr^.code := TVN_BEGINDRAGA;
+ try
+ inherited;
+ finally
+ NMHdr^.code := TVN_BEGINDRAGW;
+ end;
+ end;
+ TVN_BEGINLABELEDITW:
+ begin
+ with PTVDispInfo(NMHdr)^ do
+ if Dragging or not CanEdit(GetNodeFromItem(item)) then
+ Result := 1;
+ if Result = 0 then
+ begin
+ FEditHandle := TreeView_GetEditControl(Handle);
+ FDefEditProc := Pointer(GetWindowLongW(FEditHandle, GWL_WNDPROC));
+ SetWindowLongW(FEditHandle, GWL_WNDPROC, LongInt(FEditInstance));
+ end;
+ end;
+ TVN_ENDLABELEDITW:
+ Edit(PTVDispInfo(NMHdr)^.item);
+ TVN_ITEMEXPANDINGW:
+ begin
+ NMHdr^.code := TVN_ITEMEXPANDINGA;
+ try
+ inherited;
+ finally
+ NMHdr^.code := TVN_ITEMEXPANDINGW;
+ end;
+ end;
+ TVN_ITEMEXPANDEDW:
+ begin
+ NMHdr^.code := TVN_ITEMEXPANDEDA;
+ try
+ inherited;
+ finally
+ NMHdr^.code := TVN_ITEMEXPANDEDW;
+ end;
+ end;
+ TVN_DELETEITEMW:
+ begin
+ NMHdr^.code := TVN_DELETEITEMA;
+ try
+ inherited;
+ finally
+ NMHdr^.code := TVN_DELETEITEMW;
+ end;
+ end;
+ TVN_SETDISPINFOW:
+ with PTVDispInfo(NMHdr)^ do
+ begin
+ Node := GetNodeFromItem(item);
+ if (Node <> nil) and ((item.mask and TVIF_TEXT) <> 0) then
+ Node.Text := TTVItemW(item).pszText;
+ end;
+ TVN_GETDISPINFOW:
+ with PTVDispInfo(NMHdr)^ do
+ begin
+ Node := GetNodeFromItem(item);
+ if Node <> nil then
+ begin
+ if (item.mask and TVIF_TEXT) <> 0 then begin
+ if (FSavedNodeText <> nil)
+ and (FSavedNodeText.Count > 0)
+ and (AnsiString(FSavedNodeText[0]) = AnsiString(Node.Text)) then
+ begin
+ Node.FText := FSavedNodeText[0]; // recover saved text
+ FSavedNodeText.Delete(0);
+ end;
+ WStrLCopy(TTVItemW(item).pszText, PWideChar(Node.Text), item.cchTextMax - 1);
+ end;
+
+ if (item.mask and TVIF_IMAGE) <> 0 then
+ begin
+ GetImageIndex(Node);
+ item.iImage := Node.ImageIndex;
+ end;
+ if (item.mask and TVIF_SELECTEDIMAGE) <> 0 then
+ begin
+ GetSelectedIndex(Node);
+ item.iSelectedImage := Node.SelectedIndex;
+ end;
+ end;
+ end;
+ else
+ inherited;
+ end;
+ end;
+ end;
+end;
+
+procedure TTntCustomTreeView.WMNotify(var Message: TWMNotify);
+var
+ Node: TTntTreeNode;
+ FWideText: WideString;
+ MaxTextLen: Integer;
+ Pt: TPoint;
+begin
+ with Message do
+ if NMHdr^.code = TTN_NEEDTEXTW then
+ begin
+ // Work around NT COMCTL32 problem with tool tips >= 80 characters
+ GetCursorPos(Pt);
+ Pt := ScreenToClient(Pt);
+ Node := GetNodeAt(Pt.X, Pt.Y);
+ if (Node = nil) or (Node.Text = '') or
+ (PToolTipTextW(NMHdr)^.uFlags and TTF_IDISHWND = 0) then Exit;
+ if (GetComCtlVersion >= ComCtlVersionIE4)
+ or {Borland's VCL wrongly uses "and"} (Length(Node.Text) < 80) then
+ begin
+ DefaultHandler(Message);
+ Exit;
+ end;
+ FWideText := Node.Text;
+ MaxTextLen := SizeOf(PToolTipTextW(NMHdr)^.szText) div SizeOf(WideChar);
+ if Length(FWideText) >= MaxTextLen then
+ SetLength(FWideText, MaxTextLen - 1);
+ PToolTipTextW(NMHdr)^.lpszText := PWideChar(FWideText);
+ FillChar(PToolTipTextW(NMHdr)^.szText, MaxTextLen, 0);
+ Move(Pointer(FWideText)^, PToolTipTextW(NMHdr)^.szText, Length(FWideText) * SizeOf(WideChar));
+ PToolTipTextW(NMHdr)^.hInst := 0;
+ SetWindowPos(NMHdr^.hwndFrom, HWND_TOP, 0, 0, 0, 0, SWP_NOACTIVATE or
+ SWP_NOSIZE or SWP_NOMOVE or SWP_NOOWNERZORDER);
+ Result := 1;
+ end
+ else inherited;
+end;
+
+procedure TTntCustomTreeView.Edit(const Item: TTVItem);
+var
+ S: WideString;
+ AnsiS: AnsiString;
+ Node: TTntTreeNode;
+ AnsiEvent: TTVEditedEvent;
+begin
+ with Item do
+ begin
+ Node := GetNodeFromItem(Item);
+ if pszText <> nil then
+ begin
+ if Win32PlatformIsUnicode then
+ S := TTVItemW(Item).pszText
+ else
+ S := pszText;
+
+ if Assigned(FOnEdited) then
+ FOnEdited(Self, Node, S)
+ else if Assigned(inherited OnEdited) then
+ begin
+ AnsiEvent := inherited OnEdited;
+ AnsiS := S;
+ AnsiEvent(Self, Node, AnsiS);
+ S := AnsiS;
+ end;
+
+ if Node <> nil then Node.Text := S;
+ end
+ else if Assigned(OnCancelEdit) then
+ OnCancelEdit(Self, Node);
+ end;
+end;
+
+procedure TTntCustomTreeView.EditWndProcW(var Message: TMessage);
+begin
+ Assert(Win32PlatformIsUnicode);
+ try
+ with Message do
+ begin
+ case Msg of
+ WM_KEYDOWN,
+ WM_SYSKEYDOWN: if DoKeyDown(TWMKey(Message)) then Exit;
+ WM_CHAR:
+ begin
+ MakeWMCharMsgSafeForAnsi(Message);
+ try
+ if DoKeyPress(TWMKey(Message)) then Exit;
+ finally
+ RestoreWMCharMsg(Message);
+ end;
+ end;
+ WM_KEYUP,
+ WM_SYSKEYUP: if DoKeyUp(TWMKey(Message)) then Exit;
+ CN_KEYDOWN,
+ CN_CHAR, CN_SYSKEYDOWN,
+ CN_SYSCHAR:
+ begin
+ WndProc(Message);
+ Exit;
+ end;
+ end;
+ Result := CallWindowProcW(FDefEditProc, FEditHandle, Msg, WParam, LParam);
+ end;
+ except
+ Application.HandleException(Self);
+ end;
+end;
+
+procedure TTntCustomTreeView.LoadFromFile(const FileName: WideString);
+var
+ TreeStrings: TTntTreeStrings;
+begin
+ TreeStrings := TTntTreeStrings.Create;
+ try
+ TreeStrings.LoadFromFile(FileName);
+ TreeStrings.SaveToTree(Self);
+ finally
+ TreeStrings.Free;
+ end;
+end;
+
+procedure TTntCustomTreeView.LoadFromStream(Stream: TStream);
+var
+ TreeStrings: TTntTreeStrings;
+begin
+ TreeStrings := TTntTreeStrings.Create;
+ try
+ TreeStrings.LoadFromStream(Stream);
+ TreeStrings.SaveToTree(Self);
+ finally
+ TreeStrings.Free;
+ end;
+end;
+
+procedure TTntCustomTreeView.SaveToFile(const FileName: WideString);
+var
+ TreeStrings: TTntTreeStrings;
+begin
+ TreeStrings := TTntTreeStrings.Create;
+ try
+ TreeStrings.LoadFromTree(Self);
+ TreeStrings.SaveToFile(FileName);
+ finally
+ TreeStrings.Free;
+ end;
+end;
+
+procedure TTntCustomTreeView.SaveToStream(Stream: TStream);
+var
+ TreeStrings: TTntTreeStrings;
+begin
+ TreeStrings := TTntTreeStrings.Create;
+ try
+ TreeStrings.LoadFromTree(Self);
+ TreeStrings.SaveToStream(Stream);
+ finally
+ TreeStrings.Free;
+ end;
+end;
+
+initialization
+
+finalization
+ if Assigned(AIMM) then
+ AIMM.Deactivate;
+ if FRichEdit20Module <> 0 then
+ FreeLibrary(FRichEdit20Module);
+
+end.
|