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 deletions(-) delete mode 100644 plugins/Chess4Net/lib/TntUnicodeControls/Source/TntComCtrls.pas (limited to 'plugins/Chess4Net/lib/TntUnicodeControls/Source/TntComCtrls.pas') diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntComCtrls.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntComCtrls.pas deleted file mode 100644 index 42bec4cd46..0000000000 --- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntComCtrls.pas +++ /dev/null @@ -1,5058 +0,0 @@ - -{*****************************************************************************} -{ } -{ 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