From 194923c172167eb3fc33807ec8009b255f86337e Mon Sep 17 00:00:00 2001 From: Vadim Dashevskiy Date: Mon, 8 Oct 2012 09:10:06 +0000 Subject: Plugin is not adapted until someone can compile it and tell others how to do the same git-svn-id: http://svn.miranda-ng.org/main/trunk@1809 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c --- .../lib/TntUnicodeControls/Source/TntComCtrls.pas | 5058 ++++++++++++++++++++ 1 file changed, 5058 insertions(+) create mode 100644 plugins/!NotAdopted/Chess4Net/lib/TntUnicodeControls/Source/TntComCtrls.pas (limited to 'plugins/!NotAdopted/Chess4Net/lib/TntUnicodeControls/Source/TntComCtrls.pas') 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. -- cgit v1.2.3