5059 lines
149 KiB
ObjectPascal
5059 lines
149 KiB
ObjectPascal
|
|
{*****************************************************************************}
|
|
{ }
|
|
{ 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.
|