home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d56 / RMCTL.ZIP / rmPathTreeView.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-22  |  109KB  |  3,556 lines
  1. {================================================================================
  2. Copyright (C) 1997-2001 Mills Enterprise
  3.  
  4. Unit     : rmPathTreeView
  5. Purpose  : Visual treeview that supports operations on nodes via path structures
  6. Date     : 08-15-2000
  7. Author   : Ryan J. Mills
  8. Version  : 1.80
  9. Notes    : This unit was originally based upon the work of Patrick O'Keeffe.
  10.            It was at his request that I took the component over and rm'ified it.
  11. ================================================================================}
  12.  
  13. unit rmPathTreeView;
  14.  
  15. interface
  16.  
  17. {$I CompilerDefines.INC}
  18.  
  19. uses
  20.    Windows, Messages, controls, classes, commctrl, comctrls, forms, ImgList,
  21.    extctrls, sysutils, Graphics, Contnrs;
  22.  
  23. type
  24.    TrmCustomPathTreeView = class;
  25.    TrmTreeNodes = class;
  26.    TrmTreeNode = class;
  27.  
  28.    TrmNodeInfo = class(TComponent)
  29.    private
  30.       fImageIndex: Integer;
  31.       fSelectedIndex: Integer;
  32.       fStateIndex: Integer;
  33.       fOverlayIndex: Integer;
  34.       fData: Integer;
  35.       fPath: string;
  36.    published
  37.       property ImageIndex: integer read fImageIndex write fImageIndex default -1;
  38.       property SelectedIndex: integer read fSelectedIndex write fSelectedIndex default -1;
  39.       property StateIndex: integer read fStateIndex write fStateIndex default -1;
  40.       property OverlayIndex: integer read fOverlayIndex write fOverlayIndex default -1;
  41.       property Data: Integer read fData write fData;
  42.       property Path: String read fPath write fPath;
  43.    end;
  44.  
  45. { TrmCustomPathTreeView Events }
  46.  
  47.    TrmTVChangingEvent = procedure(Sender: TObject; Node: TrmTreeNode;
  48.       var AllowChange: Boolean) of object;
  49.    TrmTVChangedEvent = procedure(Sender: TObject; Node: TrmTreeNode) of object;
  50.    TrmTVEditingEvent = procedure(Sender: TObject; Node: TrmTreeNode;
  51.       var AllowEdit: Boolean) of object;
  52.    TrmTVEditedEvent = procedure(Sender: TObject; Node: TrmTreeNode; var S: string) of object;
  53.    TrmTVExpandingEvent = procedure(Sender: TObject; Node: TrmTreeNode;
  54.       var AllowExpansion: Boolean) of object;
  55.    TrmTVCollapsingEvent = procedure(Sender: TObject; Node: TrmTreeNode;
  56.       var AllowCollapse: Boolean) of object;
  57.    TrmTVExpandedEvent = procedure(Sender: TObject; Node: TrmTreeNode) of object;
  58.    TrmTVCompareEvent = procedure(Sender: TObject; Node1, Node2: TrmTreeNode;
  59.       Data: Integer; var Compare: Integer) of object;
  60.    TrmTVCustomDrawEvent = procedure(Sender: TrmCustomPathTreeView; const ARect: TRect;
  61.       var DefaultDraw: Boolean) of object;
  62.    TrmTVCustomDrawItemEvent = procedure(Sender: TrmCustomPathTreeView; Node: TrmTreeNode;
  63.       State: TCustomDrawState; var DefaultDraw: Boolean) of object;
  64.    TrmTVAdvancedCustomDrawEvent = procedure(Sender: TrmCustomPathTreeView; const ARect: TRect;
  65.       Stage: TCustomDrawStage; var DefaultDraw: Boolean) of object;
  66.    TrmTVAdvancedCustomDrawItemEvent = procedure(Sender: TrmCustomPathTreeView; Node: TrmTreeNode;
  67.       State: TCustomDrawState; Stage: TCustomDrawStage; var PaintImages, DefaultDraw: Boolean) of object;
  68.  
  69. { TrmTreeNode }
  70.  
  71.    TrmTreeNode = class(TPersistent)
  72.    private
  73.       FOwner: TrmTreeNodes;
  74.       FText: string;
  75.       FData: Pointer;
  76.       FItemId: HTreeItem;
  77.       FImageIndex: TImageIndex;
  78.       FSelectedIndex: Integer;
  79.       FOverlayIndex: Integer;
  80.       FStateIndex: Integer;
  81.       FDeleting: Boolean;
  82.       FInTree: Boolean;
  83.       function CompareCount(CompareMe: Integer) : Boolean;
  84.       function DoCanExpand(Expand: Boolean) : Boolean;
  85.       procedure DoExpand(Expand: Boolean) ;
  86.       procedure ExpandItem(Expand: Boolean; Recurse: Boolean) ;
  87.       function GetAbsoluteIndex: Integer;
  88.       function GetExpanded: Boolean;
  89.       function GetLevel: Integer;
  90.       function GetParent: TrmTreeNode;
  91.       function GetChildren: Boolean;
  92.       function GetCut: Boolean;
  93.       function GetDropTarget: Boolean;
  94.       function GetFocused: Boolean;
  95.       function GetIndex: Integer;
  96.       function GetItem(Index: Integer) : TrmTreeNode;
  97.       function GetSelected: Boolean;
  98.       function GetState(NodeState: TNodeState) : Boolean;
  99.       function GetCount: Integer;
  100.       function GetTreeView: TrmCustomPathTreeView;
  101.       procedure InternalMove(ParentNode, Node: TrmTreeNode; HItem: HTreeItem;
  102.          AddMode: TAddMode) ;
  103.       function IsEqual(Node: TrmTreeNode) : Boolean;
  104.       function IsNodeVisible: Boolean;
  105.       procedure ReadData(Stream: TStream; Info: PNodeInfo) ;
  106.       procedure SetChildren(Value: Boolean) ;
  107.       procedure SetCut(Value: Boolean) ;
  108.       procedure SetData(Value: Pointer) ;
  109.       procedure SetDropTarget(Value: Boolean) ;
  110.       procedure SetItem(Index: Integer; Value: TrmTreeNode) ;
  111.       procedure SetExpanded(Value: Boolean) ;
  112.       procedure SetFocused(Value: Boolean) ;
  113.       procedure SetImageIndex(Value: TImageIndex) ;
  114.       procedure SetOverlayIndex(Value: Integer) ;
  115.       procedure SetSelectedIndex(Value: Integer) ;
  116.       procedure SetSelected(Value: Boolean) ;
  117.       procedure SetStateIndex(Value: Integer) ;
  118.       procedure SetText(const S: string) ;
  119.       procedure WriteData(Stream: TStream; Info: PNodeInfo) ;
  120.       procedure RemoveHash;
  121.       procedure RenewHash;
  122.    public
  123.       constructor Create(AOwner: TrmTreeNodes) ;
  124.       destructor Destroy; override;
  125.       function AlphaSort: Boolean;
  126.       procedure Assign(Source: TPersistent) ; override;
  127.       procedure Collapse(Recurse: Boolean) ;
  128.       function CustomSort(SortProc: TTVCompare; Data: Longint) : Boolean;
  129.       procedure Delete;
  130.       procedure DeleteChildren;
  131.       function DisplayRect(TextOnly: Boolean) : TRect;
  132.       function EditText: Boolean;
  133.       procedure EndEdit(Cancel: Boolean) ;
  134.       procedure Expand(Recurse: Boolean) ;
  135.       function getFirstChild: TrmTreeNode; {GetFirstChild conflicts with C++ macro}
  136.       function GetHandle: HWND;
  137.       function GetLastChild: TrmTreeNode;
  138.       function GetNext: TrmTreeNode;
  139.       function GetNextChild(Value: TrmTreeNode) : TrmTreeNode;
  140.       function getNextSibling: TrmTreeNode; {GetNextSibling conflicts with C++ macro}
  141.       function GetNextVisible: TrmTreeNode;
  142.       function GetPrev: TrmTreeNode;
  143.       function GetPrevChild(Value: TrmTreeNode) : TrmTreeNode;
  144.       function getPrevSibling: TrmTreeNode; {GetPrevSibling conflicts with a C++ macro}
  145.       function GetPrevVisible: TrmTreeNode;
  146.       function HasAsParent(Value: TrmTreeNode) : Boolean;
  147.       function IndexOf(Value: TrmTreeNode) : Integer;
  148.       procedure MakeVisible;
  149.       procedure MoveTo(Destination: TrmTreeNode; Mode: TNodeAttachMode) ; virtual;
  150.       property AbsoluteIndex: Integer read GetAbsoluteIndex;
  151.       property Count: Integer read GetCount;
  152.       property Cut: Boolean read GetCut write SetCut;
  153.       property Data: Pointer read FData write SetData;
  154.       property Deleting: Boolean read FDeleting;
  155.       property Focused: Boolean read GetFocused write SetFocused;
  156.       property DropTarget: Boolean read GetDropTarget write SetDropTarget;
  157.       property Selected: Boolean read GetSelected write SetSelected;
  158.       property Expanded: Boolean read GetExpanded write SetExpanded;
  159.       property Handle: HWND read GetHandle;
  160.       property HasChildren: Boolean read GetChildren write SetChildren;
  161.       property ImageIndex: TImageIndex read FImageIndex write SetImageIndex;
  162.       property Index: Integer read GetIndex;
  163.       property IsVisible: Boolean read IsNodeVisible;
  164.       property Item[Index: Integer]: TrmTreeNode read GetItem write SetItem; default;
  165.       property ItemId: HTreeItem read FItemId;
  166.       property Level: Integer read GetLevel;
  167.       property OverlayIndex: Integer read FOverlayIndex write SetOverlayIndex;
  168.       property Owner: TrmTreeNodes read FOwner;
  169.       property Parent: TrmTreeNode read GetParent;
  170.       property SelectedIndex: Integer read FSelectedIndex write SetSelectedIndex;
  171.       property StateIndex: Integer read FStateIndex write SetStateIndex;
  172.       property Text: string read FText write SetText;
  173.       property TreeView: TrmCustomPathTreeView read GetTreeView;
  174.    end;
  175.  
  176. { TrmTreeNodes }
  177.  
  178.    TrmHashData = class(TObject)
  179.       Hash: longint;
  180.       IDLength: Integer;
  181.       Node: TrmTreeNode;
  182.    end;
  183.  
  184.    PrmNodeCache = ^TrmNodeCache;
  185.    TrmNodeCache = record
  186.       CacheNode: TrmTreeNode;
  187.       CacheIndex: Integer;
  188.    end;
  189.  
  190.    TrmTreeNodes = class(TPersistent)
  191.    private
  192.       FOwner: TrmCustomPathTreeView;
  193.       FUpdateCount: Integer;
  194.       FNodeCache: TrmNodeCache;
  195.       FHashList: TObjectList;
  196.       procedure AddedNode(Value: TrmTreeNode) ;
  197.       function GetHandle: HWND;
  198.       function GetNodeFromIndex(Index: Integer) : TrmTreeNode;
  199.       procedure ReadData(Stream: TStream) ;
  200.       procedure Repaint(Node: TrmTreeNode) ;
  201.       procedure WriteData(Stream: TStream) ;
  202.       procedure ClearCache;
  203.       procedure WriteExpandedState(Stream: TStream) ;
  204.       procedure ReadExpandedState(Stream: TStream) ;
  205.     //Path Index Hashing
  206.       function HashValue(St: string) : LongInt;
  207.       function LocateHashIndex(Path: string) : integer;
  208.       procedure BinaryInsert(Path: string; Node: TrmTreeNode) ;
  209.       procedure RemoveHash(Node: TrmTreeNode) ;
  210.    protected
  211.       function AddItem(Parent, Target: HTreeItem; const Item: TTVItem;
  212.          AddMode: TAddMode) : HTreeItem;
  213.       function InternalAddObject(Node: TrmTreeNode; const S: string;
  214.          Ptr: Pointer; AddMode: TAddMode) : TrmTreeNode;
  215.       procedure DefineProperties(Filer: TFiler) ; override;
  216.       function CreateItem(Node: TrmTreeNode) : TTVItem;
  217.       function GetCount: Integer;
  218.       procedure SetItem(Index: Integer; Value: TrmTreeNode) ;
  219.       procedure SetUpdateState(Updating: Boolean) ;
  220.    public
  221.       procedure DumpHash;
  222.       constructor Create(AOwner: TrmCustomPathTreeView) ;
  223.       destructor Destroy; override;
  224.       function AddChildFirst(Node: TrmTreeNode; const S: string) : TrmTreeNode;
  225.       function AddChild(Node: TrmTreeNode; const S: string) : TrmTreeNode;
  226.       function AddChildObjectFirst(Node: TrmTreeNode; const S: string;
  227.          Ptr: Pointer) : TrmTreeNode;
  228.       function AddChildObject(Node: TrmTreeNode; const S: string;
  229.          Ptr: Pointer) : TrmTreeNode;
  230.       function AddFirst(Node: TrmTreeNode; const S: string) : TrmTreeNode;
  231.       function Add(Node: TrmTreeNode; const S: string) : TrmTreeNode;
  232.       function AddObjectFirst(Node: TrmTreeNode; const S: string;
  233.          Ptr: Pointer) : TrmTreeNode;
  234.       function AddObject(Node: TrmTreeNode; const S: string;
  235.          Ptr: Pointer) : TrmTreeNode;
  236.       procedure Assign(Source: TPersistent) ; override;
  237.       procedure BeginUpdate;
  238.       procedure Clear;
  239.       procedure Delete(Node: TrmTreeNode) ;
  240.       procedure EndUpdate;
  241.       function GetFirstNode: TrmTreeNode;
  242.       function GetNode(ItemId: HTreeItem) : TrmTreeNode;
  243.       function Insert(Node: TrmTreeNode; const S: string) : TrmTreeNode;
  244.       function InsertObject(Node: TrmTreeNode; const S: string;
  245.          Ptr: Pointer) : TrmTreeNode;
  246.       function LocateNode(Path: string) : TrmTreeNode;
  247.       property Count: Integer read GetCount;
  248.       property Handle: HWND read GetHandle;
  249.       property Item[Index: Integer]: TrmTreeNode read GetNodeFromIndex; default;
  250.       property Owner: TrmCustomPathTreeView read FOwner;
  251.    end;
  252.  
  253. { TrmCustomPathTreeView }
  254.    TrmCustomPathTreeView = class(TWinControl)
  255.    private
  256.       FAutoExpand: Boolean;
  257.       FBorderStyle: TBorderStyle;
  258.       FCanvas: TCanvas;
  259.       FCanvasChanged: Boolean;
  260.       FDefEditProc: Pointer;
  261.       FDragged: Boolean;
  262.       FDragImage: TDragImageList;
  263.       FDragNode: TrmTreeNode;
  264.       FEditHandle: HWND;
  265.       FEditInstance: Pointer;
  266.       FHideSelection: Boolean;
  267.       FHotTrack: Boolean;
  268.       FImageChangeLink: TChangeLink;
  269.       FImages: TCustomImageList;
  270.       FLastDropTarget: TrmTreeNode;
  271.       FMemStream: TMemoryStream;
  272.       FRClickNode: TrmTreeNode;
  273.       FRightClickSelect: Boolean;
  274.       FManualNotify: Boolean;
  275.       FReadOnly: Boolean;
  276.       FRowSelect: Boolean;
  277.       FSaveIndex: Integer;
  278.       FSaveIndent: Integer;
  279.       FSaveItems: TStringList;
  280.       FSaveTopIndex: Integer;
  281.       FShowButtons: Boolean;
  282.       FShowLines: Boolean;
  283.       FShowRoot: Boolean;
  284.       FSortType: TSortType;
  285.       FStateChanging: Boolean;
  286.       FStateImages: TCustomImageList;
  287.       FStateChangeLink: TChangeLink;
  288.       FToolTips: Boolean;
  289.       FTreeNodes: TrmTreeNodes;
  290.       FWideText: WideString;
  291.       FOnAdvancedCustomDraw: TrmTVAdvancedCustomDrawEvent;
  292.       FOnAdvancedCustomDrawItem: TrmTVAdvancedCustomDrawItemEvent;
  293.       FOnChange: TrmTVChangedEvent;
  294.       FOnChanging: TrmTVChangingEvent;
  295.       FOnCollapsed: TrmTVExpandedEvent;
  296.       FOnCollapsing: TrmTVCollapsingEvent;
  297.       FOnCompare: TrmTVCompareEvent;
  298.       FOnCustomDraw: TrmTVCustomDrawEvent;
  299.       FOnCustomDrawItem: TrmTVCustomDrawItemEvent;
  300.       FOnDeletion: TrmTVExpandedEvent;
  301.       FOnEditing: TrmTVEditingEvent;
  302.       FOnEdited: TrmTVEditedEvent;
  303.       FOnExpanded: TrmTVExpandedEvent;
  304.       FOnExpanding: TrmTVExpandingEvent;
  305.       FOnGetImageIndex: TrmTVExpandedEvent;
  306.       FOnGetSelectedIndex: TrmTVExpandedEvent;
  307.  
  308.     //Path seperator character
  309.       FSepChar: Char;
  310.  
  311.       procedure CanvasChanged(Sender: TObject) ;
  312.       procedure CMColorChanged(var Message: TMessage) ; message CM_COLORCHANGED;
  313.       procedure CMCtl3DChanged(var Message: TMessage) ; message CM_CTL3DCHANGED;
  314.       procedure CMFontChanged(var Message: TMessage) ; message CM_FONTCHANGED;
  315.       procedure CMDrag(var Message: TCMDrag) ; message CM_DRAG;
  316.       procedure CNNotify(var Message: TWMNotify) ; message CN_NOTIFY;
  317.       procedure EditWndProc(var Message: TMessage) ;
  318.       procedure DoDragOver(Source: TDragObject; X, Y: Integer; CanDrop: Boolean) ;
  319.       function GetChangeDelay: Integer;
  320.       function GetDropTarget: TrmTreeNode;
  321.       function GetIndent: Integer;
  322.       function GetNodeFromItem(const Item: TTVItem) : TrmTreeNode;
  323.       function GetSelection: TrmTreeNode;
  324.       function GetTopItem: TrmTreeNode;
  325.       procedure ImageListChange(Sender: TObject) ;
  326.       procedure SetAutoExpand(Value: Boolean) ;
  327.       procedure SetBorderStyle(Value: TBorderStyle) ;
  328.       procedure SetButtonStyle(Value: Boolean) ;
  329.       procedure SetChangeDelay(Value: Integer) ;
  330.       procedure SetDropTarget(Value: TrmTreeNode) ;
  331.       procedure SetHideSelection(Value: Boolean) ;
  332.       procedure SetHotTrack(Value: Boolean) ;
  333.       procedure SetImageList(Value: HImageList; Flags: Integer) ;
  334.       procedure SetIndent(Value: Integer) ;
  335.       procedure SetImages(Value: TCustomImageList) ;
  336.       procedure SetLineStyle(Value: Boolean) ;
  337.       procedure SetReadOnly(Value: Boolean) ;
  338.       procedure SetRootStyle(Value: Boolean) ;
  339.       procedure SetRowSelect(Value: Boolean) ;
  340.       procedure SetSelection(Value: TrmTreeNode) ;
  341.       procedure SetSortType(Value: TSortType) ;
  342.       procedure SetStateImages(Value: TCustomImageList) ;
  343.       procedure SetToolTips(Value: Boolean) ;
  344.       procedure SetrmTreeNodes(Value: TrmTreeNodes) ;
  345.       procedure SetTopItem(Value: TrmTreeNode) ;
  346.       procedure OnChangeTimer(Sender: TObject) ;
  347.       procedure WMLButtonDown(var Message: TWMLButtonDown) ; message WM_LBUTTONDOWN;
  348.       procedure WMNotify(var Message: TWMNotify) ; message WM_NOTIFY;
  349.       procedure WMContextMenu(var Message: TWMContextMenu) ; message WM_CONTEXTMENU;
  350.       procedure CMSysColorChange(var Message: TMessage) ; message CM_SYSCOLORCHANGE;
  351.  
  352.     //Pathing functions...
  353.       function ChildName(s: string) : string;
  354.       function ParentName(s: string) : string;
  355.  
  356.     //Fix for MS ComCtrl bug with treeviews and hintwindows...
  357.       procedure SetNewHint(Node: TrmTreeNode) ;
  358.       procedure CMCancelMode(var Message: TMessage) ; message CM_CancelMode;
  359.       procedure CMMouseLeave(var Message: TMessage) ; message CM_MouseLeave;
  360.  
  361.     //Extranous functions from Pat's original code...
  362.       function GetFocussedNode: TrmTreeNode;
  363.       procedure SetFocussedNode(const Value: TrmTreeNode) ;
  364.    protected
  365.       FChangeTimer: TTimer;
  366.       function CanEdit(Node: TrmTreeNode) : Boolean; dynamic;
  367.       function CanChange(Node: TrmTreeNode) : Boolean; dynamic;
  368.       function CanCollapse(Node: TrmTreeNode) : Boolean; dynamic;
  369.       function CanExpand(Node: TrmTreeNode) : Boolean; dynamic;
  370.       procedure Change(Node: TrmTreeNode) ; dynamic;
  371.       procedure Collapse(Node: TrmTreeNode) ; dynamic;
  372.       function CreateNode: TrmTreeNode; virtual;
  373.       procedure CreateParams(var Params: TCreateParams) ; override;
  374.       procedure CreateWnd; override;
  375.       function CustomDraw(const ARect: TRect; Stage: TCustomDrawStage) : Boolean; virtual;
  376.       function CustomDrawItem(Node: TrmTreeNode; State: TCustomDrawState;
  377.          Stage: TCustomDrawStage; var PaintImages: Boolean) : Boolean; virtual;
  378.       procedure Delete(Node: TrmTreeNode) ; dynamic;
  379.       procedure DestroyWnd; override;
  380.       procedure DoEndDrag(Target: TObject; X, Y: Integer) ; override;
  381.       procedure DoStartDrag(var DragObject: TDragObject) ; override;
  382.       procedure Edit(const Item: TTVItem) ; dynamic;
  383.       procedure Expand(Node: TrmTreeNode) ; dynamic;
  384.       function GetDragImages: TDragImageList; override;
  385.       procedure GetImageIndex(Node: TrmTreeNode) ; virtual;
  386.       procedure GetSelectedIndex(Node: TrmTreeNode) ; virtual;
  387.       function IsCustomDrawn(Target: TCustomDrawTarget; Stage: TCustomDrawStage) : Boolean;
  388.       procedure Loaded; override;
  389.       procedure Notification(AComponent: TComponent;
  390.          Operation: TOperation) ; override;
  391.       procedure SetDragMode(Value: TDragMode) ; override;
  392.       procedure WndProc(var Message: TMessage) ; override;
  393.  
  394.     //Fix for MS ComCtrl bug with treeviews and hintwindows...
  395.       procedure MouseMove(Shift: TShiftState; X, Y: Integer) ; override;
  396.       procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer) ; override;
  397.  
  398.       property AutoExpand: Boolean read FAutoExpand write SetAutoExpand default False;
  399.       property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
  400.       property ChangeDelay: Integer read GetChangeDelay write SetChangeDelay default 0;
  401.       property HideSelection: Boolean read FHideSelection write SetHideSelection default True;
  402.       property HotTrack: Boolean read FHotTrack write SetHotTrack default False;
  403.       property Images: TCustomImageList read FImages write SetImages;
  404.       property Indent: Integer read GetIndent write SetIndent;
  405.       property Items: TrmTreeNodes read FTreeNodes write SeTrmTreeNodes;
  406.       property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
  407.       property RightClickSelect: Boolean read FRightClickSelect write FRightClickSelect default False;
  408.       property RowSelect: Boolean read FRowSelect write SetRowSelect default False;
  409.       property ShowButtons: Boolean read FShowButtons write SetButtonStyle default True;
  410.       property ShowLines: Boolean read FShowLines write SetLineStyle default True;
  411.       property ShowRoot: Boolean read FShowRoot write SetRootStyle default True;
  412.       property SortType: TSortType read FSortType write SetSortType default stNone;
  413.       property StateImages: TCustomImageList read FStateImages write SetStateImages;
  414.       property ToolTips: Boolean read FToolTips write SetToolTips default True;
  415.       property OnAdvancedCustomDraw: TrmTVAdvancedCustomDrawEvent read FOnAdvancedCustomDraw write FOnAdvancedCustomDraw;
  416.       property OnAdvancedCustomDrawItem: TrmTVAdvancedCustomDrawItemEvent read FOnAdvancedCustomDrawItem write FOnAdvancedCustomDrawItem;
  417.       property OnChange: TrmTVChangedEvent read FOnChange write FOnChange;
  418.       property OnChanging: TrmTVChangingEvent read FOnChanging write FOnChanging;
  419.       property OnCollapsed: TrmTVExpandedEvent read FOnCollapsed write FOnCollapsed;
  420.       property OnCollapsing: TrmTVCollapsingEvent read FOnCollapsing write FOnCollapsing;
  421.       property OnCompare: TrmTVCompareEvent read FOnCompare write FOnCompare;
  422.       property OnCustomDraw: TrmTVCustomDrawEvent read FOnCustomDraw write FOnCustomDraw;
  423.       property OnCustomDrawItem: TrmTVCustomDrawItemEvent read FOnCustomDrawItem write FOnCustomDrawItem;
  424.       property OnDeletion: TrmTVExpandedEvent read FOnDeletion write FOnDeletion;
  425.       property OnEditing: TrmTVEditingEvent read FOnEditing write FOnEditing;
  426.       property OnEdited: TrmTVEditedEvent read FOnEdited write FOnEdited;
  427.       property OnExpanding: TrmTVExpandingEvent read FOnExpanding write FOnExpanding;
  428.       property OnExpanded: TrmTVExpandedEvent read FOnExpanded write FOnExpanded;
  429.       property OnGetImageIndex: TrmTVExpandedEvent read FOnGetImageIndex write FOnGetImageIndex;
  430.       property OnGetSelectedIndex: TrmTVExpandedEvent read FOnGetSelectedIndex write FOnGetSelectedIndex;
  431.    public
  432.       constructor Create(AOwner: TComponent) ; override;
  433.       destructor Destroy; override;
  434.       function AlphaSort: Boolean;
  435.       function CustomSort(SortProc: TTVCompare; Data: Longint) : Boolean;
  436.       procedure FullCollapse;
  437.       procedure FullExpand;
  438.       function GetHitTestInfoAt(X, Y: Integer) : THitTests;
  439.       function GetNodeAt(X, Y: Integer) : TrmTreeNode;
  440.       function IsEditing: Boolean;
  441.       procedure LoadFromFile(const FileName: string) ;
  442.       procedure LoadFromStream(Stream: TStream) ;
  443.       procedure SaveToFile(const FileName: string) ;
  444.       procedure SaveToStream(Stream: TStream) ;
  445.  
  446.     //Pathing functions...
  447.       function AddPathNode(Node: TrmTreeNode; Path: string) : TrmTreeNode;
  448.       function FindPathNode(Path: string) : TrmTreeNode;
  449.       function NodePath(Node: TrmTreeNode) : string;
  450.  
  451.       property Canvas: TCanvas read FCanvas;
  452.       property DropTarget: TrmTreeNode read GetDropTarget write SetDropTarget;
  453.       property Selected: TrmTreeNode read GetSelection write SetSelection;
  454.       property TopItem: TrmTreeNode read GetTopItem write SetTopItem;
  455.  
  456.     //Original PathTreeView property.  Not exactly sure why Pat had this in here but....
  457.       property FocussedNode: TrmTreeNode read GetFocussedNode write SetFocussedNode;
  458.    published
  459.     //Path seperator character
  460.       property SepChar: Char read FSepChar write FSepChar default #47;
  461.    end;
  462.  
  463.    TrmPathTreeView = class(TrmCustomPathTreeView)
  464.    published
  465.       property Align;
  466.       property Anchors;
  467.       property AutoExpand;
  468.       property BiDiMode;
  469.       property BorderStyle;
  470.       property BorderWidth;
  471.       property ChangeDelay;
  472.       property Color;
  473.       property Ctl3D;
  474.       property Constraints;
  475.       property DragKind;
  476.       property DragCursor;
  477.       property DragMode;
  478.       property Enabled;
  479.       property Font;
  480.       property HideSelection;
  481.       property HotTrack;
  482.       property Images;
  483.       property Indent;
  484.       property ParentBiDiMode;
  485.       property ParentColor default False;
  486.       property ParentCtl3D;
  487.       property ParentFont;
  488.       property ParentShowHint;
  489.       property PopupMenu;
  490.       property ReadOnly;
  491.       property RightClickSelect;
  492.       property RowSelect;
  493.       property ShowButtons;
  494.       property ShowHint;
  495.       property ShowLines;
  496.       property ShowRoot;
  497.       property SortType;
  498.       property StateImages;
  499.       property TabOrder;
  500.       property TabStop default True;
  501.       property ToolTips;
  502.       property Visible;
  503.       property OnAdvancedCustomDraw;
  504.       property OnAdvancedCustomDrawItem;
  505.       property OnChange;
  506.       property OnChanging;
  507.       property OnClick;
  508.       property OnCollapsed;
  509.       property OnCollapsing;
  510.       property OnCompare;
  511.       property OnContextPopup;
  512.       property OnCustomDraw;
  513.       property OnCustomDrawItem;
  514.       property OnDblClick;
  515.       property OnDeletion;
  516.       property OnDragDrop;
  517.       property OnDragOver;
  518.       property OnEdited;
  519.       property OnEditing;
  520.       property OnEndDock;
  521.       property OnEndDrag;
  522.       property OnEnter;
  523.       property OnExit;
  524.       property OnExpanding;
  525.       property OnExpanded;
  526.       property OnGetImageIndex;
  527.       property OnGetSelectedIndex;
  528.       property OnKeyDown;
  529.       property OnKeyPress;
  530.       property OnKeyUp;
  531.       property OnMouseDown;
  532.       property OnMouseMove;
  533.       property OnMouseUp;
  534.       property OnStartDock;
  535.       property OnStartDrag;
  536.     { Items must be published after OnGetImageIndex and OnGetSelectedIndex }
  537.       property Items;
  538.    end;
  539.  
  540. implementation
  541.  
  542. {$ifdef BD6}
  543. uses rmHint, RTLConsts, comstrs, rmLibrary;
  544. {$else}
  545. uses rmHint, Consts, comstrs, rmLibrary;
  546. {$endif}
  547.  
  548. type
  549.    PFontHandles = ^TFontHandles;
  550.    TFontHandles = record
  551.       OurFont,
  552.          StockFont: Integer;
  553.    end;
  554.  
  555. var
  556.    fHint: TrmHintWindow;
  557.  
  558. procedure SetComCtlStyle(Ctl: TWinControl; Value: Integer; UseStyle: Boolean) ;
  559. var
  560.    Style: Integer;
  561. begin
  562.    if Ctl.HandleAllocated then
  563.    begin
  564.       Style := GetWindowLong(Ctl.Handle, GWL_STYLE) ;
  565.       if not UseStyle then Style := Style and not Value
  566.       else Style := Style or Value;
  567.       SetWindowLong(Ctl.Handle, GWL_STYLE, Style) ;
  568.    end;
  569. end;
  570.  
  571. { TrmTreeNode }
  572.  
  573. function DefaultTreeViewSort(Node1, Node2: TrmTreeNode; lParam: Integer) : Integer; stdcall;
  574. begin
  575.    with Node1 do
  576.       if Assigned(TreeView.OnCompare) then
  577.          TreeView.OnCompare(TreeView, Node1, Node2, lParam, Result)
  578.       else Result := lstrcmp(PChar(Node1.Text) , PChar(Node2.Text) ) ;
  579. end;
  580.  
  581. procedure TreeViewError(const Msg: string) ;
  582. begin
  583.    raise ETreeViewError.Create(Msg) ;
  584. end;
  585.  
  586. procedure TreeViewErrorFmt(const Msg: string; Format: array of const) ;
  587. begin
  588.    raise ETreeViewError.CreateFmt(Msg, Format) ;
  589. end;
  590.  
  591. constructor TrmTreeNode.Create(AOwner: TrmTreeNodes) ;
  592. begin
  593.    inherited Create;
  594.    FOverlayIndex := -1;
  595.    FStateIndex := -1;
  596.    FOwner := AOwner;
  597. end;
  598.  
  599. destructor TrmTreeNode.Destroy;
  600. var
  601.    Node: TrmTreeNode;
  602.    CheckValue: Integer;
  603. begin
  604.    Owner.ClearCache;
  605.    FDeleting := True;
  606.    Owner.RemoveHash(self) ;
  607.    if Owner.Owner.FLastDropTarget = Self then
  608.       Owner.Owner.FLastDropTarget := nil;
  609.    Node := Parent;
  610.    if (Node <> nil) and (not Node.Deleting) then
  611.    begin
  612.       if Node.IndexOf(Self) <> -1 then CheckValue := 1
  613.       else CheckValue := 0;
  614.       if Node.CompareCount(CheckValue) then
  615.       begin
  616.          Expanded := False;
  617.          Node.HasChildren := False;
  618.       end;
  619.    end;
  620.    if ItemId <> nil then TreeView_DeleteItem(Handle, ItemId) ;
  621.    Data := nil;
  622.    inherited Destroy;
  623. end;
  624.  
  625. function TrmTreeNode.GetHandle: HWND;
  626. begin
  627.    Result := TreeView.Handle;
  628. end;
  629.  
  630. function TrmTreeNode.GetTreeView: TrmCustomPathTreeView;
  631. begin
  632.    Result := Owner.Owner;
  633. end;
  634.  
  635. function TrmTreeNode.HasAsParent(Value: TrmTreeNode) : Boolean;
  636. begin
  637.    if Value <> Nil then
  638.    begin
  639.       if Parent = nil then Result := False
  640.       else if Parent = Value then Result := True
  641.       else Result := Parent.HasAsParent(Value) ;
  642.    end
  643.    else Result := True;
  644. end;
  645.  
  646. procedure TrmTreeNode.SetText(const S: string) ;
  647. var
  648.    Item: TTVItem;
  649.    fRemoved: boolean;
  650. begin
  651.  
  652.    fRemoved := false;
  653.    if not (FText = '') and (FText <> S) then
  654.    begin
  655.       Self.RemoveHash;
  656.       fRemoved := true;
  657.    end;
  658.  
  659.    FText := S;
  660.    with Item do
  661.    begin
  662.       mask := TVIF_TEXT;
  663.       hItem := ItemId;
  664.       pszText := LPSTR_TEXTCALLBACK;
  665.    end;
  666.    TreeView_SetItem(Handle, Item) ;
  667.    if (TreeView.SortType in [stText, stBoth]) and FInTree then
  668.    begin
  669.       if (Parent <> nil) then Parent.AlphaSort
  670.       else TreeView.AlphaSort;
  671.    end;
  672.  
  673.    if fremoved and not (fText = '') then
  674.    begin
  675.       Self.RenewHash;
  676.    end;
  677. end;
  678.  
  679. procedure TrmTreeNode.SetData(Value: Pointer) ;
  680. begin
  681.    FData := Value;
  682.    if (TreeView.SortType in [stData, stBoth]) and Assigned(TreeView.OnCompare)
  683.       and (not Deleting) and FInTree then
  684.    begin
  685.       if Parent <> nil then Parent.AlphaSort
  686.       else TreeView.AlphaSort;
  687.    end;
  688. end;
  689.  
  690. function TrmTreeNode.GetState(NodeState: TNodeState) : Boolean;
  691. var
  692.    Item: TTVItem;
  693. begin
  694.    Result := False;
  695.    with Item do
  696.    begin
  697.       mask := TVIF_STATE;
  698.       hItem := ItemId;
  699.       if TreeView_GetItem(Handle, Item) then
  700.          case NodeState of
  701.             nsCut: Result := (state and TVIS_CUT) <> 0;
  702.             nsFocused: Result := (state and TVIS_FOCUSED) <> 0;
  703.             nsSelected: Result := (state and TVIS_SELECTED) <> 0;
  704.             nsExpanded: Result := (state and TVIS_EXPANDED) <> 0;
  705.             nsDropHilited: Result := (state and TVIS_DROPHILITED) <> 0;
  706.          end;
  707.    end;
  708. end;
  709.  
  710. procedure TrmTreeNode.SetImageIndex(Value: TImageIndex) ;
  711. var
  712.    Item: TTVItem;
  713. begin
  714.    FImageIndex := Value;
  715.    with Item do
  716.    begin
  717.       mask := TVIF_IMAGE or TVIF_HANDLE;
  718.       hItem := ItemId;
  719.       if Assigned(TrmCustomPathTreeView(Owner.Owner) .OnGetImageIndex) then
  720.          iImage := I_IMAGECALLBACK
  721.       else
  722.          iImage := FImageIndex;
  723.    end;
  724.    TreeView_SetItem(Handle, Item) ;
  725. end;
  726.  
  727. procedure TrmTreeNode.SetSelectedIndex(Value: Integer) ;
  728. var
  729.    Item: TTVItem;
  730. begin
  731.    FSelectedIndex := Value;
  732.    with Item do
  733.    begin
  734.       mask := TVIF_SELECTEDIMAGE or TVIF_HANDLE;
  735.       hItem := ItemId;
  736.       if Assigned(TrmCustomPathTreeView(Owner.Owner) .OnGetSelectedIndex) then
  737.          iSelectedImage := I_IMAGECALLBACK
  738.       else
  739.          iSelectedImage := FSelectedIndex;
  740.    end;
  741.    TreeView_SetItem(Handle, Item) ;
  742. end;
  743.  
  744. procedure TrmTreeNode.SetOverlayIndex(Value: Integer) ;
  745. var
  746.    Item: TTVItem;
  747. begin
  748.    FOverlayIndex := Value;
  749.    with Item do
  750.    begin
  751.       mask := TVIF_STATE or TVIF_HANDLE;
  752.       stateMask := TVIS_OVERLAYMASK;
  753.       hItem := ItemId;
  754.       state := IndexToOverlayMask(FOverlayIndex + 1) ;
  755.    end;
  756.    TreeView_SetItem(Handle, Item) ;
  757. end;
  758.  
  759. procedure TrmTreeNode.SetStateIndex(Value: Integer) ;
  760. var
  761.    Item: TTVItem;
  762. begin
  763.    FStateIndex := Value;
  764.    if Value >= 0 then Dec(Value) ;
  765.    with Item do
  766.    begin
  767.       mask := TVIF_STATE or TVIF_HANDLE;
  768.       stateMask := TVIS_STATEIMAGEMASK;
  769.       hItem := ItemId;
  770.       state := IndexToStateImageMask(Value + 1) ;
  771.    end;
  772.    TreeView_SetItem(Handle, Item) ;
  773. end;
  774.  
  775. function TrmTreeNode.CompareCount(CompareMe: Integer) : Boolean;
  776. var
  777.    Count: integer;
  778.    Node: TrmTreeNode;
  779. Begin
  780.    Count := 0;
  781.    Result := False;
  782.    Node := GetFirstChild;
  783.    while Node <> nil do
  784.    begin
  785.       Inc(Count) ;
  786.       Node := Node.GetNextChild(Node) ;
  787.       if Count > CompareMe then Exit;
  788.    end;
  789.    if Count = CompareMe then Result := True;
  790. end;
  791.  
  792. function TrmTreeNode.DoCanExpand(Expand: Boolean) : Boolean;
  793. begin
  794.    Result := False;
  795.    if HasChildren then
  796.    begin
  797.       if Expand then Result := TreeView.CanExpand(Self)
  798.       else Result := TreeView.CanCollapse(Self) ;
  799.    end;
  800. end;
  801.  
  802. procedure TrmTreeNode.DoExpand(Expand: Boolean) ;
  803. begin
  804.    if HasChildren then
  805.    begin
  806.       if Expand then TreeView.Expand(Self)
  807.       else TreeView.Collapse(Self) ;
  808.    end;
  809. end;
  810.  
  811. procedure TrmTreeNode.ExpandItem(Expand: Boolean; Recurse: Boolean) ;
  812. var
  813.    Flag: Integer;
  814.    Node: TrmTreeNode;
  815. begin
  816.    if Recurse then
  817.    begin
  818.       Node := Self;
  819.       repeat
  820.          Node.ExpandItem(Expand, False) ;
  821.          Node := Node.GetNext;
  822.       until (Node = nil) or (not Node.HasAsParent(Self) ) ;
  823.    end
  824.    else
  825.    begin
  826.       TreeView.FManualNotify := True;
  827.       try
  828.          Flag := 0;
  829.          if Expand then
  830.          begin
  831.             if DoCanExpand(True) then
  832.             begin
  833.                Flag := TVE_EXPAND;
  834.                DoExpand(True) ;
  835.             end;
  836.          end
  837.          else
  838.          begin
  839.             if DoCanExpand(False) then
  840.             begin
  841.                Flag := TVE_COLLAPSE;
  842.                DoExpand(False) ;
  843.             end;
  844.          end;
  845.          if Flag <> 0 then TreeView_Expand(Handle, ItemId, Flag) ;
  846.       finally
  847.          TreeView.FManualNotify := False;
  848.       end;
  849.    end;
  850. end;
  851.  
  852. procedure TrmTreeNode.Expand(Recurse: Boolean) ;
  853. begin
  854.    ExpandItem(True, Recurse) ;
  855. end;
  856.  
  857. procedure TrmTreeNode.Collapse(Recurse: Boolean) ;
  858. begin
  859.    ExpandItem(False, Recurse) ;
  860. end;
  861.  
  862. function TrmTreeNode.GetExpanded: Boolean;
  863. begin
  864.    Result := GetState(nsExpanded) ;
  865. end;
  866.  
  867. procedure TrmTreeNode.SetExpanded(Value: Boolean) ;
  868. begin
  869.    if Value then Expand(False)
  870.    else Collapse(False) ;
  871. end;
  872.  
  873. function TrmTreeNode.GetSelected: Boolean;
  874. begin
  875.    Result := GetState(nsSelected) ;
  876. end;
  877.  
  878. procedure TrmTreeNode.SetSelected(Value: Boolean) ;
  879. begin
  880.    if Value then TreeView_SelectItem(Handle, ItemId)
  881.    else if Selected then TreeView_SelectItem(Handle, nil) ;
  882. end;
  883.  
  884. function TrmTreeNode.GetCut: Boolean;
  885. begin
  886.    Result := GetState(nsCut) ;
  887. end;
  888.  
  889. procedure TrmTreeNode.SetCut(Value: Boolean) ;
  890. var
  891.    Item: TTVItem;
  892.    Template: DWORD;
  893. begin
  894.    if Value then Template := DWORD(-1)
  895.    else Template := 0;
  896.    with Item do
  897.    begin
  898.       mask := TVIF_STATE;
  899.       hItem := ItemId;
  900.       stateMask := TVIS_CUT;
  901.       state := stateMask and Template;
  902.    end;
  903.    TreeView_SetItem(Handle, Item) ;
  904. end;
  905.  
  906. function TrmTreeNode.GetDropTarget: Boolean;
  907. begin
  908.    Result := GetState(nsDropHilited) ;
  909. end;
  910.  
  911. procedure TrmTreeNode.SetDropTarget(Value: Boolean) ;
  912. begin
  913.    if Value then TreeView_SelectDropTarget(Handle, ItemId)
  914.    else if DropTarget then TreeView_SelectDropTarget(Handle, nil) ;
  915. end;
  916.  
  917. function TrmTreeNode.GetChildren: Boolean;
  918. var
  919.    Item: TTVItem;
  920. begin
  921.    Item.mask := TVIF_CHILDREN;
  922.    Item.hItem := ItemId;
  923.    if TreeView_GetItem(Handle, Item) then Result := Item.cChildren > 0
  924.    else Result := False;
  925. end;
  926.  
  927. procedure TrmTreeNode.SetFocused(Value: Boolean) ;
  928. var
  929.    Item: TTVItem;
  930.    Template: DWORD;
  931. begin
  932.    if Value then Template := DWORD(-1)
  933.    else Template := 0;
  934.    with Item do
  935.    begin
  936.       mask := TVIF_STATE;
  937.       hItem := ItemId;
  938.       stateMask := TVIS_FOCUSED;
  939.       state := stateMask and Template;
  940.    end;
  941.    TreeView_SetItem(Handle, Item) ;
  942. end;
  943.  
  944. function TrmTreeNode.GetFocused: Boolean;
  945. begin
  946.    Result := GetState(nsFocused) ;
  947. end;
  948.  
  949. procedure TrmTreeNode.SetChildren(Value: Boolean) ;
  950. var
  951.    Item: TTVItem;
  952. begin
  953.    with Item do
  954.    begin
  955.       mask := TVIF_CHILDREN;
  956.       hItem := ItemId;
  957.       cChildren := Ord(Value) ;
  958.    end;
  959.    TreeView_SetItem(Handle, Item) ;
  960. end;
  961.  
  962. function TrmTreeNode.GetParent: TrmTreeNode;
  963. begin
  964.    with FOwner do
  965.       Result := GetNode(TreeView_GetParent(Handle, ItemId) ) ;
  966. end;
  967.  
  968. function TrmTreeNode.GetNextSibling: TrmTreeNode;
  969. begin
  970.    with FOwner do
  971.       Result := GetNode(TreeView_GetNextSibling(Handle, ItemId) ) ;
  972. end;
  973.  
  974. function TrmTreeNode.GetPrevSibling: TrmTreeNode;
  975. begin
  976.    with FOwner do
  977.       Result := GetNode(TreeView_GetPrevSibling(Handle, ItemId) ) ;
  978. end;
  979.  
  980. function TrmTreeNode.GetNextVisible: TrmTreeNode;
  981. begin
  982.    if IsVisible then
  983.       with FOwner do
  984.          Result := GetNode(TreeView_GetNextVisible(Handle, ItemId) )
  985.    else Result := nil;
  986. end;
  987.  
  988. function TrmTreeNode.GetPrevVisible: TrmTreeNode;
  989. begin
  990.    with FOwner do
  991.       Result := GetNode(TreeView_GetPrevVisible(Handle, ItemId) ) ;
  992. end;
  993.  
  994. function TrmTreeNode.GetNextChild(Value: TrmTreeNode) : TrmTreeNode;
  995. begin
  996.    if Value <> nil then Result := Value.GetNextSibling
  997.    else Result := nil;
  998. end;
  999.  
  1000. function TrmTreeNode.GetPrevChild(Value: TrmTreeNode) : TrmTreeNode;
  1001. begin
  1002.    if Value <> nil then Result := Value.GetPrevSibling
  1003.    else Result := nil;
  1004. end;
  1005.  
  1006. function TrmTreeNode.GetFirstChild: TrmTreeNode;
  1007. begin
  1008.    with FOwner do
  1009.       Result := GetNode(TreeView_GetChild(Handle, ItemId) ) ;
  1010. end;
  1011.  
  1012. function TrmTreeNode.GetLastChild: TrmTreeNode;
  1013. var
  1014.    Node: TrmTreeNode;
  1015. begin
  1016.    Result := GetFirstChild;
  1017.    if Result <> nil then
  1018.    begin
  1019.       Node := Result;
  1020.       repeat
  1021.          Result := Node;
  1022.          Node := Result.GetNextSibling;
  1023.       until Node = nil;
  1024.    end;
  1025. end;
  1026.  
  1027. function TrmTreeNode.GetNext: TrmTreeNode;
  1028. var
  1029.    NodeID, ParentID: HTreeItem;
  1030.    Handle: HWND;
  1031. begin
  1032.    Handle := FOwner.Handle;
  1033.    NodeID := TreeView_GetChild(Handle, ItemId) ;
  1034.    if NodeID = nil then NodeID := TreeView_GetNextSibling(Handle, ItemId) ;
  1035.    ParentID := ItemId;
  1036.    while (NodeID = nil) and (ParentID <> nil) do
  1037.    begin
  1038.       ParentID := TreeView_GetParent(Handle, ParentID) ;
  1039.       NodeID := TreeView_GetNextSibling(Handle, ParentID) ;
  1040.    end;
  1041.    Result := FOwner.GetNode(NodeID) ;
  1042. end;
  1043.  
  1044. function TrmTreeNode.GetPrev: TrmTreeNode;
  1045. var
  1046.    Node: TrmTreeNode;
  1047. begin
  1048.    Result := GetPrevSibling;
  1049.    if Result <> nil then
  1050.    begin
  1051.       Node := Result;
  1052.       repeat
  1053.          Result := Node;
  1054.          Node := Result.GetLastChild;
  1055.       until Node = nil;
  1056.    end else
  1057.       Result := Parent;
  1058. end;
  1059.  
  1060. function TrmTreeNode.GetAbsoluteIndex: Integer;
  1061. var
  1062.    Node: TrmTreeNode;
  1063. begin
  1064.    if Owner.FNodeCache.CacheNode = Self then
  1065.       Result := Owner.FNodeCache.CacheIndex
  1066.    else
  1067.    begin
  1068.       Result := -1;
  1069.       Node := Self;
  1070.       while Node <> nil do
  1071.       begin
  1072.          Inc(Result) ;
  1073.          Node := Node.GetPrev;
  1074.       end;
  1075.    end;
  1076. end;
  1077.  
  1078. function TrmTreeNode.GetIndex: Integer;
  1079. var
  1080.    Node: TrmTreeNode;
  1081. begin
  1082.    Result := -1;
  1083.    Node := Self;
  1084.    while Node <> nil do
  1085.    begin
  1086.       Inc(Result) ;
  1087.       Node := Node.GetPrevSibling;
  1088.    end;
  1089. end;
  1090.  
  1091. function TrmTreeNode.GetItem(Index: Integer) : TrmTreeNode;
  1092. begin
  1093.    Result := GetFirstChild;
  1094.    while (Result <> nil) and (Index > 0) do
  1095.    begin
  1096.       Result := GetNextChild(Result) ;
  1097.       Dec(Index) ;
  1098.    end;
  1099.    if Result = nil then TreeViewError(SListIndexError) ;
  1100. end;
  1101.  
  1102. procedure TrmTreeNode.SetItem(Index: Integer; Value: TrmTreeNode) ;
  1103. begin
  1104.    item[Index].Assign(Value) ;
  1105. end;
  1106.  
  1107. function TrmTreeNode.IndexOf(Value: TrmTreeNode) : Integer;
  1108. var
  1109.    Node: TrmTreeNode;
  1110. begin
  1111.    Result := -1;
  1112.    Node := GetFirstChild;
  1113.    while (Node <> nil) do
  1114.    begin
  1115.       Inc(Result) ;
  1116.       if Node = Value then Break;
  1117.       Node := GetNextChild(Node) ;
  1118.    end;
  1119.    if Node = nil then Result := -1;
  1120. end;
  1121.  
  1122. function TrmTreeNode.GetCount: Integer;
  1123. var
  1124.    Node: TrmTreeNode;
  1125. begin
  1126.    Result := 0;
  1127.    Node := GetFirstChild;
  1128.    while Node <> nil do
  1129.    begin
  1130.       Inc(Result) ;
  1131.       Node := Node.GetNextChild(Node) ;
  1132.    end;
  1133. end;
  1134.  
  1135. procedure TrmTreeNode.EndEdit(Cancel: Boolean) ;
  1136. begin
  1137.    TreeView_EndEditLabelNow(Handle, Cancel) ;
  1138. end;
  1139.  
  1140. procedure TrmTreeNode.InternalMove(ParentNode, Node: TrmTreeNode;
  1141.    HItem: HTreeItem; AddMode: TAddMode) ;
  1142. var
  1143.    I: Integer;
  1144.    NodeId: HTreeItem;
  1145.    TreeViewItem: TTVItem;
  1146.    Children: Boolean;
  1147.    IsSelected: Boolean;
  1148. begin
  1149.    Owner.ClearCache;
  1150.    if (AddMode = taInsert) and (Node <> nil) then
  1151.       NodeId := Node.ItemId else
  1152.       NodeId := nil;
  1153.    Children := HasChildren;
  1154.    IsSelected := Selected;
  1155.    if (Parent <> nil) and (Parent.CompareCount(1) ) then
  1156.    begin
  1157.       Parent.Expanded := False;
  1158.       Parent.HasChildren := False;
  1159.    end;
  1160.    with TreeViewItem do
  1161.    begin
  1162.       mask := TVIF_PARAM;
  1163.       hItem := ItemId;
  1164.       lParam := 0;
  1165.    end;
  1166.    TreeView_SetItem(Handle, TreeViewItem) ;
  1167.    with Owner do
  1168.       HItem := AddItem(HItem, NodeId, CreateItem(Self) , AddMode) ;
  1169.    if HItem = nil then
  1170.       raise EOutOfResources.Create(sInsertError) ;
  1171.    for I := Count - 1 downto 0 do
  1172.       Item[I].InternalMove(Self, nil, HItem, taAddFirst) ;
  1173.    TreeView_DeleteItem(Handle, ItemId) ;
  1174.    FItemId := HItem;
  1175.    Assign(Self) ;
  1176.    HasChildren := Children;
  1177.    Selected := IsSelected;
  1178. end;
  1179.  
  1180. procedure TrmTreeNode.MoveTo(Destination: TrmTreeNode; Mode: TNodeAttachMode) ;
  1181. var
  1182.    AddMode: TAddMode;
  1183.    Node: TrmTreeNode;
  1184.    HItem: HTreeItem;
  1185.    OldOnChanging: TrmTVChangingEvent;
  1186.    OldOnChange: TrmTVChangedEvent;
  1187. begin
  1188.    OldOnChanging := TreeView.OnChanging;
  1189.    OldOnChange := TreeView.OnChange;
  1190.    TreeView.OnChanging := nil;
  1191.    TreeView.OnChange := nil;
  1192.    try
  1193.       if (Destination = nil) or not Destination.HasAsParent(Self) then
  1194.       begin
  1195.          AddMode := taAdd;
  1196.          if (Destination <> nil) and not (Mode in [naAddChild, naAddChildFirst]) then
  1197.             Node := Destination.Parent else
  1198.             Node := Destination;
  1199.          case Mode of
  1200.             naAdd,
  1201.                naAddChild: AddMode := taAdd;
  1202.             naAddFirst,
  1203.                naAddChildFirst: AddMode := taAddFirst;
  1204.             naInsert:
  1205.                begin
  1206.                   Destination := Destination.GetPrevSibling;
  1207.                   if Destination = nil then AddMode := taAddFirst
  1208.                   else AddMode := taInsert;
  1209.                end;
  1210.          end;
  1211.          if Node <> nil then
  1212.             HItem := Node.ItemId else
  1213.             HItem := nil;
  1214.          if (Destination <> Self) then
  1215.             InternalMove(Node, Destination, HItem, AddMode) ;
  1216.          Node := Parent;
  1217.          if Node <> nil then
  1218.          begin
  1219.             Node.HasChildren := True;
  1220.             Node.Expanded := True;
  1221.          end;
  1222.       end;
  1223.    finally
  1224.       TreeView.OnChanging := OldOnChanging;
  1225.       TreeView.OnChange := OldOnChange;
  1226.    end;
  1227. end;
  1228.  
  1229. procedure TrmTreeNode.MakeVisible;
  1230. begin
  1231.    TreeView_EnsureVisible(Handle, ItemId) ;
  1232. end;
  1233.  
  1234. function TrmTreeNode.GetLevel: Integer;
  1235. var
  1236.    Node: TrmTreeNode;
  1237. begin
  1238.    Result := 0;
  1239.    Node := Parent;
  1240.    while Node <> nil do
  1241.    begin
  1242.       Inc(Result) ;
  1243.       Node := Node.Parent;
  1244.    end;
  1245. end;
  1246.  
  1247. function TrmTreeNode.IsNodeVisible: Boolean;
  1248. var
  1249.    Rect: TRect;
  1250. begin
  1251.    Result := TreeView_GetItemRect(Handle, ItemId, Rect, True) ;
  1252. end;
  1253.  
  1254. function TrmTreeNode.EditText: Boolean;
  1255. begin
  1256.    Result := TreeView_EditLabel(Handle, ItemId) <> 0;
  1257. end;
  1258.  
  1259. function TrmTreeNode.DisplayRect(TextOnly: Boolean) : TRect;
  1260. begin
  1261.    FillChar(Result, SizeOf(Result) , 0) ;
  1262.    TreeView_GetItemRect(Handle, ItemId, Result, TextOnly) ;
  1263. end;
  1264.  
  1265. function TrmTreeNode.AlphaSort: Boolean;
  1266. begin
  1267.    Result := CustomSort(nil, 0) ;
  1268. end;
  1269.  
  1270. function TrmTreeNode.CustomSort(SortProc: TTVCompare; Data: Longint) : Boolean;
  1271. var
  1272.    SortCB: TTVSortCB;
  1273. begin
  1274.    Owner.ClearCache;
  1275.    with SortCB do
  1276.    begin
  1277.       if not Assigned(SortProc) then lpfnCompare := @DefaultTreeViewSort
  1278.       else lpfnCompare := SortProc;
  1279.       hParent := ItemId;
  1280.       lParam := Data;
  1281.    end;
  1282.    Result := TreeView_SortChildrenCB(Handle, SortCB, 0) ;
  1283. end;
  1284.  
  1285. procedure TrmTreeNode.Delete;
  1286. begin
  1287.    if not Deleting then
  1288.    begin
  1289.       Owner.RemoveHash(self) ;
  1290.       Free;
  1291.    end;
  1292. end;
  1293.  
  1294. procedure TrmTreeNode.DeleteChildren;
  1295.  
  1296.    procedure recurseChildren(Node: TrmTreeNode) ;
  1297.    begin
  1298.       if assigned(Node) then
  1299.       begin
  1300.          Node := Node.getFirstChild;
  1301.          while node <> nil do
  1302.          begin
  1303.             Node.removeHash;
  1304.             recurseChildren(node) ;
  1305.             node := node.getNextSibling;
  1306.          end;
  1307.       end;
  1308.    end;
  1309.  
  1310. begin
  1311.    recurseChildren(self) ;
  1312.  
  1313.    Owner.ClearCache;
  1314.  
  1315.    TreeView_Expand(TreeView.Handle, ItemID, TVE_COLLAPSE or TVE_COLLAPSERESET) ;
  1316.    HasChildren := False;
  1317. end;
  1318.  
  1319. procedure TrmTreeNode.Assign(Source: TPersistent) ;
  1320. var
  1321.    Node: TrmTreeNode;
  1322. begin
  1323.    Owner.ClearCache;
  1324.    if Source is TrmTreeNode then
  1325.    begin
  1326.       Node := TrmTreeNode(Source) ;
  1327.       Text := Node.Text;
  1328.       Data := Node.Data;
  1329.       ImageIndex := Node.ImageIndex;
  1330.       SelectedIndex := Node.SelectedIndex;
  1331.       StateIndex := Node.StateIndex;
  1332.       OverlayIndex := Node.OverlayIndex;
  1333.       Focused := Node.Focused;
  1334.       DropTarget := Node.DropTarget;
  1335.       Cut := Node.Cut;
  1336.       HasChildren := Node.HasChildren;
  1337.    end
  1338.    else inherited Assign(Source) ;
  1339. end;
  1340.  
  1341. function TrmTreeNode.IsEqual(Node: TrmTreeNode) : Boolean;
  1342. begin
  1343.    Result := (Text = Node.Text) and (Data = Node.Data) ;
  1344. end;
  1345.  
  1346. procedure TrmTreeNode.ReadData(Stream: TStream; Info: PNodeInfo) ;
  1347. var
  1348.    I, Size, ItemCount: Integer;
  1349. begin
  1350.    Owner.ClearCache;
  1351.    Stream.ReadBuffer(Size, SizeOf(Size) ) ;
  1352.    Stream.ReadBuffer(Info^, Size) ;
  1353.    Text := Info^.Text;
  1354.    ImageIndex := Info^.ImageIndex;
  1355.    SelectedIndex := Info^.SelectedIndex;
  1356.    StateIndex := Info^.StateIndex;
  1357.    OverlayIndex := Info^.OverlayIndex;
  1358.    Data := Info^.Data;
  1359.    ItemCount := Info^.Count;
  1360.  
  1361.    for I := 0 to ItemCount - 1 do
  1362.       Owner.AddChild(Self, '') .ReadData(Stream, Info) ;
  1363. end;
  1364.  
  1365. procedure TrmTreeNode.WriteData(Stream: TStream; Info: PNodeInfo) ;
  1366. var
  1367.    I, Size, L, ItemCount: Integer;
  1368. begin
  1369.    L := Length(Text) ;
  1370.    if L > 255 then L := 255;
  1371.    Size := SizeOf(TNodeInfo) + L - 255;
  1372.    Info^.Text := Text;
  1373.    Info^.ImageIndex := ImageIndex;
  1374.    Info^.SelectedIndex := SelectedIndex;
  1375.    Info^.OverlayIndex := OverlayIndex;
  1376.    Info^.StateIndex := StateIndex;
  1377.    Info^.Data := Data;
  1378.    ItemCount := Count;
  1379.    Info^.Count := ItemCount;
  1380.    Stream.WriteBuffer(Size, SizeOf(Size) ) ;
  1381.    Stream.WriteBuffer(Info^, Size) ;
  1382.    for I := 0 to ItemCount - 1 do Item[I].WriteData(Stream, Info) ;
  1383. end;
  1384.  
  1385. procedure TrmTreeNode.RemoveHash;
  1386. var
  1387.    wNode: TrmTreeNode;
  1388. begin
  1389.    FOwner.RemoveHash(self) ;
  1390.    wNode := getFirstChild;
  1391.    while wNode <> nil do
  1392.    begin
  1393.       wNode.RemoveHash;
  1394.       wNode := wNode.getNextSibling;
  1395.    end;
  1396. end;
  1397.  
  1398. procedure TrmTreeNode.RenewHash;
  1399. var
  1400.    wNode: TrmTreeNode;
  1401. begin
  1402.    FOwner.BinaryInsert(FOwner.Owner.NodePath(self) , self) ;
  1403.    wNode := getFirstChild;
  1404.    while wNode <> nil do
  1405.    begin
  1406.       wNode.RenewHash;
  1407.       wNode := wNode.getNextSibling;
  1408.    end;
  1409. end;
  1410.  
  1411. procedure TrmTreeNodes.DumpHash;
  1412. var
  1413.    fstr: TextFile;
  1414.    loop: integer;
  1415.    wdata: trmhashdata;
  1416. begin
  1417.    AssignFile(fstr, 'c:\tvhash.txt') ;
  1418.    rewrite(fstr) ;
  1419.    for loop := 0 to fhashlist.count - 1 do
  1420.    begin
  1421.       wData := Trmhashdata(fhashlist[loop]) ;
  1422.       writeln(fstr, owner.nodepath(wdata.node) ) ;
  1423.    end;
  1424.    closefile(fstr) ;
  1425. end;
  1426.  
  1427. { TrmTreeNodes }
  1428.  
  1429. constructor TrmTreeNodes.Create(AOwner: TrmCustomPathTreeView) ;
  1430. begin
  1431.    inherited Create;
  1432.    FOwner := AOwner;
  1433.    FHashList := TObjectList.Create;
  1434.    FHashList.OwnsObjects := true;
  1435. end;
  1436.  
  1437. destructor TrmTreeNodes.Destroy;
  1438. begin
  1439.    Clear;
  1440.    FHashList.Free;
  1441.    inherited Destroy;
  1442. end;
  1443.  
  1444. function TrmTreeNodes.GetCount: Integer;
  1445. begin
  1446.    if Owner.HandleAllocated then Result := TreeView_GetCount(Handle)
  1447.    else Result := 0;
  1448. end;
  1449.  
  1450. function TrmTreeNodes.GetHandle: HWND;
  1451. begin
  1452.    Result := Owner.Handle;
  1453. end;
  1454.  
  1455. procedure TrmTreeNodes.Delete(Node: TrmTreeNode) ;
  1456. var
  1457.    wIndex: integer;
  1458. begin
  1459.   //Remove the path index reference...
  1460.    wIndex := LocateHashIndex(Owner.NodePath(Node) ) ;
  1461.    if wIndex > -1 then
  1462.       FHashList.delete(wIndex) ;
  1463.  
  1464.    if (Node.ItemId = nil) then
  1465.       Owner.Delete(Node) ;
  1466.    Node.Delete;
  1467. end;
  1468.  
  1469. procedure TrmTreeNodes.Clear;
  1470. begin
  1471.    ClearCache;
  1472.    if not (csDestroying in Owner.ComponentState) and Owner.HandleAllocated then
  1473.    begin
  1474.       FHashList.Clear;
  1475.       TreeView_DeleteAllItems(Owner.Handle) ;
  1476.    end;
  1477. end;
  1478.  
  1479. function TrmTreeNodes.AddChildFirst(Node: TrmTreeNode; const S: string) : TrmTreeNode;
  1480. begin
  1481.    Result := AddChildObjectFirst(Node, S, nil) ;
  1482. end;
  1483.  
  1484. function TrmTreeNodes.AddChildObjectFirst(Node: TrmTreeNode; const S: string;
  1485.    Ptr: Pointer) : TrmTreeNode;
  1486. begin
  1487.    Result := InternalAddObject(Node, S, Ptr, taAddFirst) ;
  1488. end;
  1489.  
  1490. function TrmTreeNodes.AddChild(Node: TrmTreeNode; const S: string) : TrmTreeNode;
  1491. begin
  1492.    Result := AddChildObject(Node, S, nil) ;
  1493. end;
  1494.  
  1495. function TrmTreeNodes.AddChildObject(Node: TrmTreeNode; const S: string;
  1496.    Ptr: Pointer) : TrmTreeNode;
  1497. begin
  1498.    Result := InternalAddObject(Node, S, Ptr, taAdd) ;
  1499. end;
  1500.  
  1501. function TrmTreeNodes.AddFirst(Node: TrmTreeNode; const S: string) : TrmTreeNode;
  1502. begin
  1503.    Result := AddObjectFirst(Node, S, nil) ;
  1504. end;
  1505.  
  1506. function TrmTreeNodes.AddObjectFirst(Node: TrmTreeNode; const S: string;
  1507.    Ptr: Pointer) : TrmTreeNode;
  1508. begin
  1509.    if Node <> nil then Node := Node.Parent;
  1510.    Result := InternalAddObject(Node, S, Ptr, taAddFirst) ;
  1511. end;
  1512.  
  1513. function TrmTreeNodes.Add(Node: TrmTreeNode; const S: string) : TrmTreeNode;
  1514. begin
  1515.    Result := AddObject(Node, S, nil) ;
  1516. end;
  1517.  
  1518. procedure TrmTreeNodes.Repaint(Node: TrmTreeNode) ;
  1519. var
  1520.    R: TRect;
  1521. begin
  1522.    if FUpdateCount < 1 then
  1523.    begin
  1524.       while (Node <> nil) and not Node.IsVisible do Node := Node.Parent;
  1525.       if Node <> nil then
  1526.       begin
  1527.          R := Node.DisplayRect(False) ;
  1528.          InvalidateRect(Owner.Handle, @R, True) ;
  1529.       end;
  1530.    end;
  1531. end;
  1532.  
  1533. function TrmTreeNodes.AddObject(Node: TrmTreeNode; const S: string;
  1534.    Ptr: Pointer) : TrmTreeNode;
  1535. begin
  1536.    if Node <> nil then Node := Node.Parent;
  1537.    Result := InternalAddObject(Node, S, Ptr, taAdd) ;
  1538. end;
  1539.  
  1540. function TrmTreeNodes.Insert(Node: TrmTreeNode; const S: string) : TrmTreeNode;
  1541. begin
  1542.    Result := InsertObject(Node, S, nil) ;
  1543. end;
  1544.  
  1545. procedure TrmTreeNodes.AddedNode(Value: TrmTreeNode) ;
  1546. begin
  1547.    if Value <> nil then
  1548.    begin
  1549.       Value.HasChildren := True;
  1550.       Repaint(Value) ;
  1551.    end;
  1552. end;
  1553.  
  1554. function TrmTreeNodes.InsertObject(Node: TrmTreeNode; const S: string;
  1555.    Ptr: Pointer) : TrmTreeNode;
  1556. var
  1557.    Item, ItemId: HTreeItem;
  1558.    Parent: TrmTreeNode;
  1559.    AddMode: TAddMode;
  1560. begin
  1561.    Result := Owner.CreateNode;
  1562.    try
  1563.       Item := nil;
  1564.       ItemId := nil;
  1565.       Parent := nil;
  1566.       AddMode := taInsert;
  1567.       if Node <> nil then
  1568.       begin
  1569.          Parent := Node.Parent;
  1570.          if Parent <> nil then Item := Parent.ItemId;
  1571.          Node := Node.GetPrevSibling;
  1572.          if Node <> nil then ItemId := Node.ItemId
  1573.          else AddMode := taAddFirst;
  1574.       end;
  1575.       Result.Data := Ptr;
  1576.       Result.Text := S;
  1577.       Item := AddItem(Item, ItemId, CreateItem(Result) , AddMode) ;
  1578.       if Item = nil then
  1579.          raise EOutOfResources.Create(sInsertError) ;
  1580.       Result.FItemId := Item;
  1581.       AddedNode(Parent) ;
  1582.    except
  1583.       Result.Free;
  1584.       raise;
  1585.    end;
  1586. end;
  1587.  
  1588. function TrmTreeNodes.InternalAddObject(Node: TrmTreeNode; const S: string;
  1589.    Ptr: Pointer; AddMode: TAddMode) : TrmTreeNode;
  1590. var
  1591.    Item: HTreeItem;
  1592. begin
  1593.    Result := Owner.CreateNode;
  1594.    try
  1595.       if Node <> nil then Item := Node.ItemId
  1596.       else Item := nil;
  1597.       Result.Data := Ptr;
  1598.       Result.Text := S;
  1599.       Item := AddItem(Item, nil, CreateItem(Result) , AddMode) ;
  1600.       if Item = nil then
  1601.          raise EOutOfResources.Create(sInsertError) ;
  1602.       Result.FItemId := Item;
  1603.  
  1604.     //Setting up the path index...
  1605.       if not (s = '') then
  1606.          BinaryInsert(Owner.NodePath(Result) , Result) ;
  1607.  
  1608.       if (FUpdateCount = 0) and (Result = GetFirstNode) then
  1609.          SendMessage(Handle, WM_SETREDRAW, 1, 0) ;
  1610.       AddedNode(Node) ;
  1611.    except
  1612.       Result.Free;
  1613.       raise;
  1614.    end;
  1615. end;
  1616.  
  1617. function TrmTreeNodes.CreateItem(Node: TrmTreeNode) : TTVItem;
  1618. begin
  1619.    Node.FInTree := True;
  1620.    with Result do
  1621.    begin
  1622.       mask := TVIF_TEXT or TVIF_PARAM or TVIF_IMAGE or TVIF_SELECTEDIMAGE;
  1623.       lParam := Longint(Node) ;
  1624.       pszText := LPSTR_TEXTCALLBACK;
  1625.       iImage := I_IMAGECALLBACK;
  1626.       iSelectedImage := I_IMAGECALLBACK;
  1627.    end;
  1628. end;
  1629.  
  1630. function TrmTreeNodes.AddItem(Parent, Target: HTreeItem;
  1631.    const Item: TTVItem; AddMode: TAddMode) : HTreeItem;
  1632. var
  1633.    InsertStruct: TTVInsertStruct;
  1634. begin
  1635.    ClearCache;
  1636.    with InsertStruct do
  1637.    begin
  1638.       hParent := Parent;
  1639.       case AddMode of
  1640.          taAddFirst:
  1641.             hInsertAfter := TVI_FIRST;
  1642.          taAdd:
  1643.             hInsertAfter := TVI_LAST;
  1644.          taInsert:
  1645.             hInsertAfter := Target;
  1646.       end;
  1647.    end;
  1648.    InsertStruct.item := Item;
  1649.    FOwner.FChangeTimer.Enabled := False;
  1650.    Result := TreeView_InsertItem(Handle, InsertStruct) ;
  1651. end;
  1652.  
  1653. function TrmTreeNodes.GetFirstNode: TrmTreeNode;
  1654. begin
  1655.    Result := GetNode(TreeView_GetRoot(Handle) ) ;
  1656. end;
  1657.  
  1658. function TrmTreeNodes.GetNodeFromIndex(Index: Integer) : TrmTreeNode;
  1659. var
  1660.    I: Integer;
  1661. begin
  1662.    if Index < 0 then TreeViewError(sInvalidIndex) ;
  1663.    if (FNodeCache.CacheNode <> nil) and (Abs(FNodeCache.CacheIndex - Index) <= 1) then
  1664.    begin
  1665.       with FNodeCache do
  1666.       begin
  1667.          if Index = CacheIndex then Result := CacheNode
  1668.          else if Index < CacheIndex then Result := CacheNode.GetPrev
  1669.          else Result := CacheNode.GetNext;
  1670.       end;
  1671.    end
  1672.    else
  1673.    begin
  1674.       Result := GetFirstNode;
  1675.       I := Index;
  1676.       while (I <> 0) and (Result <> nil) do
  1677.       begin
  1678.          Result := Result.GetNext;
  1679.          Dec(I) ;
  1680.       end;
  1681.    end;
  1682.    if Result = nil then TreeViewError(sInvalidIndex) ;
  1683.    FNodeCache.CacheNode := Result;
  1684.    FNodeCache.CacheIndex := Index;
  1685. end;
  1686.  
  1687. function TrmTreeNodes.GetNode(ItemId: HTreeItem) : TrmTreeNode;
  1688. var
  1689.    Item: TTVItem;
  1690. begin
  1691.    with Item do
  1692.    begin
  1693.       hItem := ItemId;
  1694.       mask := TVIF_PARAM;
  1695.    end;
  1696.    if TreeView_GetItem(Handle, Item) then Result := TrmTreeNode(Item.lParam)
  1697.    else Result := nil;
  1698. end;
  1699.  
  1700. procedure TrmTreeNodes.SetItem(Index: Integer; Value: TrmTreeNode) ;
  1701. begin
  1702.    GetNodeFromIndex(Index) .Assign(Value) ;
  1703. end;
  1704.  
  1705. procedure TrmTreeNodes.BeginUpdate;
  1706. begin
  1707.    if FUpdateCount = 0 then SetUpdateState(True) ;
  1708.    Inc(FUpdateCount) ;
  1709. end;
  1710.  
  1711. procedure TrmTreeNodes.SetUpdateState(Updating: Boolean) ;
  1712. begin
  1713.    SendMessage(Handle, WM_SETREDRAW, Ord(not Updating) , 0) ;
  1714.    if not Updating then Owner.Refresh;
  1715. end;
  1716.  
  1717. procedure TrmTreeNodes.EndUpdate;
  1718. begin
  1719.    Dec(FUpdateCount) ;
  1720.    if FUpdateCount = 0 then SetUpdateState(False) ;
  1721. end;
  1722.  
  1723. procedure TrmTreeNodes.Assign(Source: TPersistent) ;
  1724. var
  1725.    TreeNodes: TrmTreeNodes;
  1726.    MemStream: TMemoryStream;
  1727.    wNode: TrmTreeNode;
  1728. begin
  1729.    ClearCache;
  1730.    if Source is TrmTreeNodes then
  1731.    begin
  1732.       TreeNodes := TrmTreeNodes(Source) ;
  1733.       Clear;
  1734.       MemStream := TMemoryStream.Create;
  1735.       try
  1736.          TreeNodes.WriteData(MemStream) ;
  1737.          MemStream.Position := 0;
  1738.          ReadData(MemStream) ;
  1739.       finally
  1740.          MemStream.Free;
  1741.       end;
  1742.  
  1743.       //Now that we've assigned all the nodes
  1744.       //we need to redo that hashlist
  1745.       wNode := Self.GetFirstNode;
  1746.       while wNode <> nil do
  1747.       begin
  1748.          wNode.RenewHash;
  1749.          wNode := wNode.GetNextSibling;
  1750.       end;
  1751.    end
  1752.    else inherited Assign(Source) ;
  1753. end;
  1754.  
  1755. procedure TrmTreeNodes.DefineProperties(Filer: TFiler) ;
  1756.  
  1757.    function WriteNodes: Boolean;
  1758.    var
  1759.       I: Integer;
  1760.       Nodes: TrmTreeNodes;
  1761.    begin
  1762.       Nodes := TrmTreeNodes(Filer.Ancestor) ;
  1763.       if Nodes = nil then
  1764.          Result := Count > 0
  1765.       else if Nodes.Count <> Count then
  1766.          Result := True
  1767.       else
  1768.       begin
  1769.          Result := False;
  1770.          for I := 0 to Count - 1 do
  1771.          begin
  1772.             Result := not Item[I].IsEqual(Nodes[I]) ;
  1773.             if Result then Break;
  1774.          end
  1775.       end;
  1776.    end;
  1777.  
  1778. begin
  1779.    inherited DefineProperties(Filer) ;
  1780.    Filer.DefineBinaryProperty('Data', ReadData, WriteData, WriteNodes) ;
  1781. end;
  1782.  
  1783. procedure TrmTreeNodes.ReadData(Stream: TStream) ;
  1784. var
  1785.    I, Count: Integer;
  1786.    NodeInfo: TNodeInfo;
  1787. begin
  1788.    if Owner.HandleAllocated then BeginUpdate;
  1789.    try
  1790.       Clear;
  1791.       Stream.ReadBuffer(Count, SizeOf(Count) ) ;
  1792.       for I := 0 to Count - 1 do
  1793.       begin
  1794.          Add(nil, '') .ReadData(Stream, @NodeInfo) ;
  1795.       end;
  1796.    finally
  1797.       if Owner.HandleAllocated then EndUpdate;
  1798.    end;
  1799. end;
  1800.  
  1801. procedure TrmTreeNodes.WriteData(Stream: TStream) ;
  1802. var
  1803.    I: Integer;
  1804.    NodeInfo: TNodeInfo;
  1805.    Node: TrmTreeNode;
  1806. begin
  1807.    I := 0;
  1808.    Node := GetFirstNode;
  1809.    while Node <> nil do
  1810.    begin
  1811.       Inc(I) ;
  1812.       Node := Node.GetNextSibling;
  1813.    end;
  1814.    Stream.WriteBuffer(I, SizeOf(I) ) ;
  1815.    Node := GetFirstNode;
  1816.    while Node <> nil do
  1817.    begin
  1818.       Node.WriteData(Stream, @NodeInfo) ;
  1819.       Node := Node.GetNextSibling;
  1820.    end;
  1821. end;
  1822.  
  1823. procedure TrmTreeNodes.ReadExpandedState(Stream: TStream) ;
  1824. var
  1825.    ItemCount,
  1826.       Index: Integer;
  1827.    Node: TrmTreeNode;
  1828.    NodeExpanded: Boolean;
  1829. begin
  1830.    if Stream.Position < Stream.Size then
  1831.       Stream.ReadBuffer(ItemCount, SizeOf(ItemCount) )
  1832.    else Exit;
  1833.    Index := 0;
  1834.    Node := GetFirstNode;
  1835.    while (Index < ItemCount) and (Node <> nil) do
  1836.    begin
  1837.       Stream.ReadBuffer(NodeExpanded, SizeOf(NodeExpanded) ) ;
  1838.       Node.Expanded := NodeExpanded;
  1839.       Inc(Index) ;
  1840.       Node := Node.GetNext;
  1841.    end;
  1842. end;
  1843.  
  1844. procedure TrmTreeNodes.WriteExpandedState(Stream: TStream) ;
  1845. var
  1846.    Size: Integer;
  1847.    Node: TrmTreeNode;
  1848.    NodeExpanded: Boolean;
  1849. begin
  1850.    Size := SizeOf(Boolean) * Count;
  1851.    Stream.WriteBuffer(Size, SizeOf(Size) ) ;
  1852.    Node := GetFirstNode;
  1853.    while (Node <> nil) do
  1854.    begin
  1855.       NodeExpanded := Node.Expanded;
  1856.       Stream.WriteBuffer(NodeExpanded, SizeOf(Boolean) ) ;
  1857.       Node := Node.GetNext;
  1858.    end;
  1859. end;
  1860.  
  1861. procedure TrmTreeNodes.ClearCache;
  1862. begin
  1863.    FNodeCache.CacheNode := nil;
  1864. end;
  1865.  
  1866. type
  1867.    TTreeStrings = class(TStrings)
  1868.    private
  1869.       FOwner: TrmTreeNodes;
  1870.    protected
  1871.       function Get(Index: Integer) : string; override;
  1872.       function GetBufStart(Buffer: PChar; var Level: Integer) : PChar;
  1873.       function GetCount: Integer; override;
  1874.       function GetObject(Index: Integer) : TObject; override;
  1875.       procedure PutObject(Index: Integer; AObject: TObject) ; override;
  1876.       procedure SetUpdateState(Updating: Boolean) ; override;
  1877.    public
  1878.       constructor Create(AOwner: TrmTreeNodes) ;
  1879.       function Add(const S: string) : Integer; override;
  1880.       procedure Clear; override;
  1881.       procedure Delete(Index: Integer) ; override;
  1882.       procedure Insert(Index: Integer; const S: string) ; override;
  1883.       procedure LoadTreeFromStream(Stream: TStream) ;
  1884.       procedure SaveTreeToStream(Stream: TStream) ;
  1885.       property Owner: TrmTreeNodes read FOwner;
  1886.    end;
  1887.  
  1888. constructor TTreeStrings.Create(AOwner: TrmTreeNodes) ;
  1889. begin
  1890.    inherited Create;
  1891.    FOwner := AOwner;
  1892. end;
  1893.  
  1894. function TTreeStrings.Get(Index: Integer) : string;
  1895. const
  1896.    TabChar = #9;
  1897. var
  1898.    Level, I: Integer;
  1899.    Node: TrmTreeNode;
  1900. begin
  1901.    Result := '';
  1902.    Node := Owner.GetNodeFromIndex(Index) ;
  1903.    Level := Node.Level;
  1904.    for I := 0 to Level - 1 do Result := Result + TabChar;
  1905.    Result := Result + Node.Text;
  1906. end;
  1907.  
  1908. function TTreeStrings.GetBufStart(Buffer: PChar; var Level: Integer) : PChar;
  1909. begin
  1910.    Level := 0;
  1911.    while Buffer^ in [' ', #9] do
  1912.    begin
  1913.       Inc(Buffer) ;
  1914.       Inc(Level) ;
  1915.    end;
  1916.    Result := Buffer;
  1917. end;
  1918.  
  1919. function TTreeStrings.GetObject(Index: Integer) : TObject;
  1920. begin
  1921.    Result := Owner.GetNodeFromIndex(Index) .Data;
  1922. end;
  1923.  
  1924. procedure TTreeStrings.PutObject(Index: Integer; AObject: TObject) ;
  1925. begin
  1926.    Owner.GetNodeFromIndex(Index) .Data := AObject;
  1927. end;
  1928.  
  1929. function TTreeStrings.GetCount: Integer;
  1930. begin
  1931.    Result := Owner.Count;
  1932. end;
  1933.  
  1934. procedure TTreeStrings.Clear;
  1935. begin
  1936.    Owner.Clear;
  1937. end;
  1938.  
  1939. procedure TTreeStrings.Delete(Index: Integer) ;
  1940. begin
  1941.    Owner.GetNodeFromIndex(Index) .Delete;
  1942. end;
  1943.  
  1944. procedure TTreeStrings.SetUpdateState(Updating: Boolean) ;
  1945. begin
  1946.    SendMessage(Owner.Handle, WM_SETREDRAW, Ord(not Updating) , 0) ;
  1947.    if not Updating then Owner.Owner.Refresh;
  1948. end;
  1949.  
  1950. function TTreeStrings.Add(const S: string) : Integer;
  1951. var
  1952.    Level, OldLevel, I: Integer;
  1953.    NewStr: string;
  1954.    Node: TrmTreeNode;
  1955. begin
  1956.    Result := GetCount;
  1957.    if (Length(S) = 1) and (S[1] = Chr($1A) ) then Exit;
  1958.    Node := nil;
  1959.    OldLevel := 0;
  1960.    NewStr := GetBufStart(PChar(S) , Level) ;
  1961.    if Result > 0 then
  1962.    begin
  1963.       Node := Owner.GetNodeFromIndex(Result - 1) ;
  1964.       OldLevel := Node.Level;
  1965.    end;
  1966.    if (Level > OldLevel) or (Node = nil) then
  1967.    begin
  1968.       if Level - OldLevel > 1 then TreeViewError(sInvalidLevel) ;
  1969.    end
  1970.    else
  1971.    begin
  1972.       for I := OldLevel downto Level do
  1973.       begin
  1974.          Node := Node.Parent;
  1975.          if (Node = nil) and (I - Level > 0) then
  1976.             TreeViewError(sInvalidLevel) ;
  1977.       end;
  1978.    end;
  1979.    Owner.AddChild(Node, NewStr) ;
  1980. end;
  1981.  
  1982. procedure TTreeStrings.Insert(Index: Integer; const S: string) ;
  1983. begin
  1984.    with Owner do
  1985.       Insert(GetNodeFromIndex(Index) , S) ;
  1986. end;
  1987.  
  1988. procedure TTreeStrings.LoadTreeFromStream(Stream: TStream) ;
  1989. var
  1990.    List: TStringList;
  1991.    ANode, NextNode: TrmTreeNode;
  1992.    ALevel, i: Integer;
  1993.    CurrStr: string;
  1994. begin
  1995.    List := TStringList.Create;
  1996.    Owner.BeginUpdate;
  1997.    try
  1998.       try
  1999.          Clear;
  2000.          List.LoadFromStream(Stream) ;
  2001.          ANode := nil;
  2002.          for i := 0 to List.Count - 1 do
  2003.          begin
  2004.             CurrStr := GetBufStart(PChar(List[i]) , ALevel) ;
  2005.             if ANode = nil then
  2006.                ANode := Owner.AddChild(nil, CurrStr)
  2007.             else if ANode.Level = ALevel then
  2008.                ANode := Owner.AddChild(ANode.Parent, CurrStr)
  2009.             else if ANode.Level = (ALevel - 1) then
  2010.                ANode := Owner.AddChild(ANode, CurrStr)
  2011.             else if ANode.Level > ALevel then
  2012.             begin
  2013.                NextNode := ANode.Parent;
  2014.                while NextNode.Level > ALevel do
  2015.                   NextNode := NextNode.Parent;
  2016.                ANode := Owner.AddChild(NextNode.Parent, CurrStr) ;
  2017.             end
  2018.             else TreeViewErrorFmt(sInvalidLevelEx, [ALevel, CurrStr]) ;
  2019.          end;
  2020.       finally
  2021.          Owner.EndUpdate;
  2022.          List.Free;
  2023.       end;
  2024.    except
  2025.       Owner.Owner.Invalidate; // force repaint on exception
  2026.       raise;
  2027.    end;
  2028. end;
  2029.  
  2030. procedure TTreeStrings.SaveTreeToStream(Stream: TStream) ;
  2031. const
  2032.    TabChar = #9;
  2033.    EndOfLine = #13#10;
  2034. var
  2035.    i: Integer;
  2036.    ANode: TrmTreeNode;
  2037.    NodeStr: string;
  2038. begin
  2039.    if Count > 0 then
  2040.    begin
  2041.       ANode := Owner[0];
  2042.       while ANode <> nil do
  2043.       begin
  2044.          NodeStr := '';
  2045.          for i := 0 to ANode.Level - 1 do NodeStr := NodeStr + TabChar;
  2046.          NodeStr := NodeStr + ANode.Text + EndOfLine;
  2047.          Stream.Write(Pointer(NodeStr) ^, Length(NodeStr) ) ;
  2048.          ANode := ANode.GetNext;
  2049.       end;
  2050.    end;
  2051. end;
  2052.  
  2053. procedure TrmTreeNodes.BinaryInsert(Path: string;
  2054.    Node: TrmTreeNode) ;
  2055. var
  2056.    wHash: longint;
  2057.    wLen: integer;
  2058.    wData: TrmHashData;
  2059.    First, Middle, Last: longint;
  2060.    wFound: boolean;
  2061. begin
  2062.    wHash := HashValue(Path) ;
  2063.    wLen := Length(Path) ;
  2064.  
  2065.    First := 0;
  2066.    Last := FHashList.count - 1;
  2067.    wFound := false;
  2068.  
  2069.    while (not wFound) and (first <= last) do
  2070.    begin
  2071.       middle := round((last + first) / 2) ;
  2072.       wData := TrmHashData(fHashlist[middle]) ;
  2073.  
  2074.       if wHash = wData.hash then
  2075.          wFound := true
  2076.       else
  2077.       begin
  2078.          if wHash < wData.hash then
  2079.             last := middle - 1
  2080.          else
  2081.             first := middle + 1;
  2082.       end;
  2083.    end;
  2084.  
  2085.    if wFound then
  2086.    begin
  2087.       middle := round((last + first) / 2) ;
  2088.       wFound := false;
  2089.  
  2090.       while (Middle > 0) and (Middle - 1 >= First) and (TrmHashData(FHashList[middle - 1]) .Hash = wHash) do
  2091.          dec(Middle) ;
  2092.  
  2093.       while (not wfound) and (Middle < FHashList.Count) and (Middle + 1 < Last) and (TrmHashData(FHashList[middle + 1]) .Hash = wHash) do
  2094.       begin
  2095.          wData := TrmHashData(FHashList[middle]) ;
  2096.          if (Owner.NodePath(wData.Node) = Path) then
  2097.             wFound := true
  2098.          else
  2099.             inc(Middle) ;
  2100.       end;
  2101.       if not wFound then
  2102.          first := middle;
  2103.    end;
  2104.  
  2105.    if not wfound then
  2106.    begin
  2107.       wData := TrmHashData.create;
  2108.       wData.Hash := wHash;
  2109.       wData.IDLength := wLen;
  2110.       wData.Node := Node;
  2111.       fHashList.Insert(first, wData) ;
  2112.    end;
  2113. end;
  2114.  
  2115. function TrmTreeNodes.HashValue(St: string) : LongInt;
  2116. begin
  2117.    result := GetStrCRC32(St) ;
  2118. end;
  2119.  
  2120. function TrmTreeNodes.LocateHashIndex(Path: string) : integer;
  2121. var
  2122.    wHash: longint;
  2123.    wData: TrmHashData;
  2124.    First, Middle, Last, Temp: longint;
  2125.    wFound: boolean;
  2126. begin
  2127.    wHash := HashValue(Path) ;
  2128.  
  2129.    result := -1;
  2130.    First := 0;
  2131.    Last := FHashList.count - 1;
  2132.    wFound := false;
  2133.    middle := round((last + first) / 2) ;
  2134.  
  2135.    while (not wFound) and (first <= last) do
  2136.    begin
  2137.       middle := round((last + first) / 2) ;
  2138.       wData := TrmHashData(fHashlist[middle]) ;
  2139.  
  2140.       if wHash = wData.hash then
  2141.          wFound := true
  2142.       else
  2143.       begin
  2144.          if wHash < wData.hash then
  2145.             last := middle - 1
  2146.          else
  2147.             first := middle + 1;
  2148.       end;
  2149.    end;
  2150.  
  2151.    if wFound then
  2152.    begin
  2153.       Temp := middle;
  2154.  
  2155.       while (Middle > 0) and (Middle - 1 >= First) and (TrmHashData(FHashList[middle - 1]) .Hash = wHash) do
  2156.          dec(Middle) ;
  2157.  
  2158.       while (result = -1) and (Middle < FHashList.Count) and (Middle + 1 < Last) and (TrmHashData(FHashList[middle + 1]) .Hash = wHash) do
  2159.       begin
  2160.          wData := TrmHashData(FHashList[middle]) ;
  2161.          if (Owner.NodePath(wData.Node) = Path) then
  2162.             result := middle
  2163.          else
  2164.             inc(Middle) ;
  2165.       end;
  2166.  
  2167.       if result = -1 then
  2168.          result := temp;
  2169.    end;
  2170. end;
  2171.  
  2172. procedure TrmTreeNodes.RemoveHash(Node: TrmTreeNode) ;
  2173. var
  2174.    wIndex: integer;
  2175. begin
  2176.    wIndex := LocateHashIndex(Owner.NodePath(Node) ) ;
  2177.    if wIndex > -1 then
  2178.       FHashList.delete(wIndex) ;
  2179. end;
  2180.  
  2181. function TrmTreeNodes.LocateNode(Path: string) : TrmTreeNode;
  2182. var
  2183.    wIndex: integer;
  2184. begin
  2185.    wIndex := LocateHashIndex(Path) ;
  2186.    if wIndex = -1 then
  2187.       result := nil
  2188.    else
  2189.       result := TrmHashData(FHashList[wIndex]) .Node;
  2190. end;
  2191.  
  2192. { TrmCustomPathTreeView }
  2193.  
  2194. constructor TrmCustomPathTreeView.Create(AOwner: TComponent) ;
  2195. begin
  2196.    inherited Create(AOwner) ;
  2197.    ControlStyle := ControlStyle - [csCaptureMouse] + [csDisplayDragImage, csReflector];
  2198.    Width := 121;
  2199.    Height := 97;
  2200.    TabStop := True;
  2201.    ParentColor := False;
  2202.    FCanvas := TControlCanvas.Create;
  2203.    TControlCanvas(FCanvas) .Control := Self;
  2204.    FTreeNodes := TrmTreeNodes.Create(Self) ;
  2205.    FBorderStyle := bsSingle;
  2206.    FShowButtons := True;
  2207.    FShowRoot := True;
  2208.    FShowLines := True;
  2209.    FHideSelection := True;
  2210.    FDragImage := TDragImageList.CreateSize(32, 32) ;
  2211.    FSaveIndent := -1;
  2212.    FChangeTimer := TTimer.Create(Self) ;
  2213.    FChangeTimer.Enabled := False;
  2214.    FChangeTimer.Interval := 0;
  2215.    FChangeTimer.OnTimer := OnChangeTimer;
  2216.    FToolTips := True;
  2217.    {$ifdef BD6}
  2218.    FEditInstance := Classes.MakeObjectInstance(EditWndProc) ;
  2219.    {$else}
  2220.    FEditInstance := MakeObjectInstance(EditWndProc) ;
  2221.    {$endif}
  2222.    FImageChangeLink := TChangeLink.Create;
  2223.    FImageChangeLink.OnChange := ImageListChange;
  2224.    FStateChangeLink := TChangeLink.Create;
  2225.    FStateChangeLink.OnChange := ImageListChange;
  2226.   { Version 5.01: DesignInfo is used here to store information necessary for
  2227.     deleting font handles allocated in CustomDraw routines. Fields can't be
  2228.     added now since class signatures must not be modified in a minor version.
  2229.     This will be removed in the next major version }
  2230.    if not (csDesigning in ComponentState) then
  2231.       DesignInfo := Integer(New(PFontHandles) ) ;
  2232.  
  2233.    FSepChar := '/';
  2234. end;
  2235.  
  2236. destructor TrmCustomPathTreeView.Destroy;
  2237. begin
  2238.    Try
  2239.       SetNewHint(nil) ;
  2240.    except
  2241.      //Do Nothing...
  2242.    end;
  2243.    FreeAndNil(FTreeNodes) ;
  2244.    FChangeTimer.Free;
  2245.    FSaveItems.Free;
  2246.    FDragImage.Free;
  2247.    FMemStream.Free;
  2248.    {$ifdef BD6}
  2249.    Classes.FreeObjectInstance(FEditInstance) ;
  2250.    {$else}
  2251.    FreeObjectInstance(FEditInstance) ;
  2252.    {$endif}
  2253.    FImageChangeLink.Free;
  2254.    FStateChangeLink.Free;
  2255.    FCanvas.Free;
  2256.    if not (csDesigning in ComponentState) then
  2257.       Dispose(PFontHandles(DesignInfo) ) ;
  2258.    inherited Destroy;
  2259. end;
  2260.  
  2261. procedure TrmCustomPathTreeView.CreateParams(var Params: TCreateParams) ;
  2262. const
  2263.    BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER) ;
  2264.    LineStyles: array[Boolean] of DWORD = (0, TVS_HASLINES) ;
  2265.    RootStyles: array[Boolean] of DWORD = (0, TVS_LINESATROOT) ;
  2266.    ButtonStyles: array[Boolean] of DWORD = (0, TVS_HASBUTTONS) ;
  2267.    EditStyles: array[Boolean] of DWORD = (TVS_EDITLABELS, 0) ;
  2268.    HideSelections: array[Boolean] of DWORD = (TVS_SHOWSELALWAYS, 0) ;
  2269.    DragStyles: array[TDragMode] of DWORD = (TVS_DISABLEDRAGDROP, 0) ;
  2270.    RTLStyles: array[Boolean] of DWORD = (0, TVS_RTLREADING) ;
  2271.    ToolTipStyles: array[Boolean] of DWORD = (TVS_NOTOOLTIPS, 0) ;
  2272.    AutoExpandStyles: array[Boolean] of DWORD = (0, TVS_SINGLEEXPAND) ;
  2273.    HotTrackStyles: array[Boolean] of DWORD = (0, TVS_TRACKSELECT) ;
  2274.    RowSelectStyles: array[Boolean] of DWORD = (0, TVS_FULLROWSELECT) ;
  2275. begin
  2276.    InitCommonControl(ICC_TREEVIEW_CLASSES) ;
  2277.    inherited CreateParams(Params) ;
  2278.    CreateSubClass(Params, WC_TREEVIEW) ;
  2279.    with Params do
  2280.    begin
  2281.       Style := Style or LineStyles[FShowLines] or BorderStyles[FBorderStyle] or
  2282.          RootStyles[FShowRoot] or ButtonStyles[FShowButtons] or
  2283.          EditStyles[FReadOnly] or HideSelections[FHideSelection] or
  2284.          DragStyles[DragMode] or RTLStyles[UseRightToLeftReading] or
  2285.          AutoExpandStyles[FAutoExpand] or HotTrackStyles[FHotTrack] or
  2286.          RowSelectStyles[FRowSelect] or TVS_NOTOOLTIPS;
  2287.       if Ctl3D and NewStyleControls and (FBorderStyle = bsSingle) then
  2288.       begin
  2289.          Style := Style and not WS_BORDER;
  2290.          ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
  2291.       end;
  2292.       WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW) ;
  2293.    end;
  2294. end;
  2295.  
  2296. procedure TrmCustomPathTreeView.CreateWnd;
  2297. begin
  2298.    FStateChanging := False;
  2299.    inherited CreateWnd;
  2300.    TreeView_SetBkColor(Handle, ColorToRGB(Color) ) ;
  2301.    TreeView_SetTextColor(Handle, ColorToRGB(Font.Color) ) ;
  2302.    if FMemStream <> nil then
  2303.    begin
  2304.       Items.ReadData(FMemStream) ;
  2305.       Items.ReadExpandedState(FMemStream) ;
  2306.       FMemStream.Destroy;
  2307.       FMemStream := nil;
  2308.       SetTopItem(Items.GetNodeFromIndex(FSaveTopIndex) ) ;
  2309.       FSaveTopIndex := 0;
  2310.       SetSelection(Items.GetNodeFromIndex(FSaveIndex) ) ;
  2311.       FSaveIndex := 0;
  2312.    end;
  2313.    if FSaveIndent <> -1 then Indent := FSaveIndent;
  2314.    if (Images <> nil) and Images.HandleAllocated then
  2315.       SetImageList(Images.Handle, TVSIL_NORMAL) ;
  2316.    if (StateImages <> nil) and StateImages.HandleAllocated then
  2317.       SetImageList(StateImages.Handle, TVSIL_STATE) ;
  2318. end;
  2319.  
  2320. procedure TrmCustomPathTreeView.DestroyWnd;
  2321. var
  2322.    Node: TrmTreeNode;
  2323. begin
  2324.    FStateChanging := True;
  2325.    if Items.Count > 0 then
  2326.    begin
  2327.       FMemStream := TMemoryStream.Create;
  2328.       Items.WriteData(FMemStream) ;
  2329.       Items.WriteExpandedState(FMemStream) ;
  2330.       FMemStream.Position := 0;
  2331.       Node := GetTopItem;
  2332.       if Node <> nil then FSaveTopIndex := Node.AbsoluteIndex;
  2333.       Node := Selected;
  2334.       if Node <> nil then FSaveIndex := Node.AbsoluteIndex;
  2335.       Items.BeginUpdate;
  2336.       try
  2337.          Items.Clear;
  2338.       finally
  2339.          Items.EndUpdate;
  2340.       end;
  2341.    end;
  2342.    FSaveIndent := Indent;
  2343.    inherited DestroyWnd;
  2344. end;
  2345.  
  2346. procedure TrmCustomPathTreeView.EditWndProc(var Message: TMessage) ;
  2347. begin
  2348.    try
  2349.       with Message do
  2350.       begin
  2351.          case Msg of
  2352.             WM_KEYDOWN,
  2353.                WM_SYSKEYDOWN: if DoKeyDown(TWMKey(Message) ) then Exit;
  2354.             WM_CHAR: if DoKeyPress(TWMKey(Message) ) then Exit;
  2355.             WM_KEYUP,
  2356.                WM_SYSKEYUP: if DoKeyUp(TWMKey(Message) ) then Exit;
  2357.             CN_KEYDOWN,
  2358.                CN_CHAR, CN_SYSKEYDOWN,
  2359.                CN_SYSCHAR:
  2360.                begin
  2361.                   WndProc(Message) ;
  2362.                   Exit;
  2363.                end;
  2364.          end;
  2365.          Result := CallWindowProc(FDefEditProc, FEditHandle, Msg, WParam, LParam) ;
  2366.       end;
  2367.    except
  2368.       Application.HandleException(Self) ;
  2369.    end;
  2370. end;
  2371.  
  2372. procedure TrmCustomPathTreeView.CMColorChanged(var Message: TMessage) ;
  2373. begin
  2374.    inherited;
  2375.    RecreateWnd;
  2376. end;
  2377.  
  2378. procedure TrmCustomPathTreeView.CMCtl3DChanged(var Message: TMessage) ;
  2379. begin
  2380.    inherited;
  2381.    if FBorderStyle = bsSingle then RecreateWnd;
  2382. end;
  2383.  
  2384. procedure TrmCustomPathTreeView.CMFontChanged(var Message: TMessage) ;
  2385. begin
  2386.    inherited;
  2387.    TreeView_SetTextColor(Handle, ColorToRGB(Font.Color) ) ;
  2388. end;
  2389.  
  2390. procedure TrmCustomPathTreeView.CMSysColorChange(var Message: TMessage) ;
  2391. begin
  2392.    inherited;
  2393.    if not (csLoading in ComponentState) then
  2394.    begin
  2395.       Message.Msg := WM_SYSCOLORCHANGE;
  2396.       DefaultHandler(Message) ;
  2397.    end;
  2398. end;
  2399.  
  2400. function TrmCustomPathTreeView.AlphaSort: Boolean;
  2401. var
  2402.    Node: TrmTreeNode;
  2403. begin
  2404.    if HandleAllocated then
  2405.    begin
  2406.       Result := CustomSort(nil, 0) ;
  2407.       Node := FTreeNodes.GetFirstNode;
  2408.       while Node <> nil do
  2409.       begin
  2410.          if Node.HasChildren then Node.AlphaSort;
  2411.          Node := Node.GetNext;
  2412.       end;
  2413.    end
  2414.    else
  2415.       Result := False;
  2416. end;
  2417.  
  2418. function TrmCustomPathTreeView.CustomSort(SortProc: TTVCompare; Data: Longint) : Boolean;
  2419. var
  2420.    SortCB: TTVSortCB;
  2421.    Node: TrmTreeNode;
  2422. begin
  2423.    Result := False;
  2424.    if HandleAllocated then
  2425.    begin
  2426.       with SortCB do
  2427.       begin
  2428.          if not Assigned(SortProc) then lpfnCompare := @DefaultTreeViewSort
  2429.          else lpfnCompare := SortProc;
  2430.          hParent := TVI_ROOT;
  2431.          lParam := Data;
  2432.          Result := TreeView_SortChildrenCB(Handle, SortCB, 0) ;
  2433.       end;
  2434.       Node := FTreeNodes.GetFirstNode;
  2435.       while Node <> nil do
  2436.       begin
  2437.          if Node.HasChildren then Node.CustomSort(SortProc, Data) ;
  2438.          Node := Node.GetNext;
  2439.       end;
  2440.       Items.ClearCache;
  2441.    end;
  2442. end;
  2443.  
  2444. procedure TrmCustomPathTreeView.SetAutoExpand(Value: Boolean) ;
  2445. begin
  2446.    if FAutoExpand <> Value then
  2447.    begin
  2448.       FAutoExpand := Value;
  2449.       SetComCtlStyle(Self, TVS_SINGLEEXPAND, Value) ;
  2450.    end;
  2451. end;
  2452.  
  2453. procedure TrmCustomPathTreeView.SetHotTrack(Value: Boolean) ;
  2454. begin
  2455.    if FHotTrack <> Value then
  2456.    begin
  2457.       FHotTrack := Value;
  2458.       SetComCtlStyle(Self, TVS_TRACKSELECT, Value) ;
  2459.    end;
  2460. end;
  2461.  
  2462. procedure TrmCustomPathTreeView.SetRowSelect(Value: Boolean) ;
  2463. begin
  2464.    if FRowSelect <> Value then
  2465.    begin
  2466.       FRowSelect := Value;
  2467.       SetComCtlStyle(Self, TVS_FULLROWSELECT, Value) ;
  2468.    end;
  2469. end;
  2470.  
  2471. procedure TrmCustomPathTreeView.SetToolTips(Value: Boolean) ;
  2472. begin
  2473.    if FToolTips <> Value then
  2474.       FToolTips := Value;
  2475.  
  2476.    Try
  2477.       SetNewHint(nil) ;
  2478.    except
  2479.      //Do Nothing...
  2480.    end;
  2481. end;
  2482.  
  2483. procedure TrmCustomPathTreeView.SetSortType(Value: TSortType) ;
  2484. begin
  2485.    if SortType <> Value then
  2486.    begin
  2487.       FSortType := Value;
  2488.       if ((SortType in [stData, stBoth]) and Assigned(OnCompare) ) or
  2489.          (SortType in [stText, stBoth]) then
  2490.          AlphaSort;
  2491.    end;
  2492. end;
  2493.  
  2494. procedure TrmCustomPathTreeView.SetBorderStyle(Value: TBorderStyle) ;
  2495. begin
  2496.    if BorderStyle <> Value then
  2497.    begin
  2498.       FBorderStyle := Value;
  2499.       RecreateWnd;
  2500.    end;
  2501. end;
  2502.  
  2503. procedure TrmCustomPathTreeView.SetDragMode(Value: TDragMode) ;
  2504. begin
  2505.    if Value <> DragMode then
  2506.       SetComCtlStyle(Self, TVS_DISABLEDRAGDROP, Value = dmManual) ;
  2507.    inherited;
  2508. end;
  2509.  
  2510. procedure TrmCustomPathTreeView.SetButtonStyle(Value: Boolean) ;
  2511. begin
  2512.    if ShowButtons <> Value then
  2513.    begin
  2514.       FShowButtons := Value;
  2515.       SetComCtlStyle(Self, TVS_HASBUTTONS, Value) ;
  2516.    end;
  2517. end;
  2518.  
  2519. procedure TrmCustomPathTreeView.SetLineStyle(Value: Boolean) ;
  2520. begin
  2521.    if ShowLines <> Value then
  2522.    begin
  2523.       FShowLines := Value;
  2524.       SetComCtlStyle(Self, TVS_HASLINES, Value) ;
  2525.    end;
  2526. end;
  2527.  
  2528. procedure TrmCustomPathTreeView.SetRootStyle(Value: Boolean) ;
  2529. begin
  2530.    if ShowRoot <> Value then
  2531.    begin
  2532.       FShowRoot := Value;
  2533.       SetComCtlStyle(Self, TVS_LINESATROOT, Value) ;
  2534.    end;
  2535. end;
  2536.  
  2537. procedure TrmCustomPathTreeView.SetReadOnly(Value: Boolean) ;
  2538. begin
  2539.    if ReadOnly <> Value then
  2540.    begin
  2541.       FReadOnly := Value;
  2542.       SetComCtlStyle(Self, TVS_EDITLABELS, not Value) ;
  2543.    end;
  2544. end;
  2545.  
  2546. procedure TrmCustomPathTreeView.SetHideSelection(Value: Boolean) ;
  2547. begin
  2548.    if HideSelection <> Value then
  2549.    begin
  2550.       FHideSelection := Value;
  2551.       SetComCtlStyle(Self, TVS_SHOWSELALWAYS, not Value) ;
  2552.       Invalidate;
  2553.    end;
  2554. end;
  2555.  
  2556. function TrmCustomPathTreeView.GetNodeAt(X, Y: Integer) : TrmTreeNode;
  2557. var
  2558.    HitTest: TTVHitTestInfo;
  2559. begin
  2560.    with HitTest do
  2561.    begin
  2562.       pt.X := X;
  2563.       pt.Y := Y;
  2564.       if TreeView_HitTest(Handle, HitTest) <> nil then
  2565.          Result := Items.GetNode(HitTest.hItem)
  2566.       else Result := nil;
  2567.    end;
  2568. end;
  2569.  
  2570. function TrmCustomPathTreeView.GetHitTestInfoAt(X, Y: Integer) : THitTests;
  2571. var
  2572.    HitTest: TTVHitTestInfo;
  2573. begin
  2574.    Result := [];
  2575.    with HitTest do
  2576.    begin
  2577.       pt.X := X;
  2578.       pt.Y := Y;
  2579.       TreeView_HitTest(Handle, HitTest) ;
  2580.       if (flags and TVHT_ABOVE) <> 0 then Include(Result, htAbove) ;
  2581.       if (flags and TVHT_BELOW) <> 0 then Include(Result, htBelow) ;
  2582.       if (flags and TVHT_NOWHERE) <> 0 then Include(Result, htNowhere) ;
  2583.       if (flags and TVHT_ONITEM) = TVHT_ONITEM then
  2584.          Include(Result, htOnItem)
  2585.       else
  2586.       begin
  2587.          if (flags and TVHT_ONITEM) <> 0 then Include(Result, htOnItem) ;
  2588.          if (flags and TVHT_ONITEMICON) <> 0 then Include(Result, htOnIcon) ;
  2589.          if (flags and TVHT_ONITEMLABEL) <> 0 then Include(Result, htOnLabel) ;
  2590.          if (flags and TVHT_ONITEMSTATEICON) <> 0 then Include(Result, htOnStateIcon) ;
  2591.       end;
  2592.       if (flags and TVHT_ONITEMBUTTON) <> 0 then Include(Result, htOnButton) ;
  2593.       if (flags and TVHT_ONITEMINDENT) <> 0 then Include(Result, htOnIndent) ;
  2594.       if (flags and TVHT_ONITEMRIGHT) <> 0 then Include(Result, htOnRight) ;
  2595.       if (flags and TVHT_TOLEFT) <> 0 then Include(Result, htToLeft) ;
  2596.       if (flags and TVHT_TORIGHT) <> 0 then Include(Result, htToRight) ;
  2597.    end;
  2598. end;
  2599.  
  2600. procedure TrmCustomPathTreeView.SetrmTreeNodes(Value: TrmTreeNodes) ;
  2601. begin
  2602.    Items.Assign(Value) ;
  2603. end;
  2604.  
  2605. procedure TrmCustomPathTreeView.SetIndent(Value: Integer) ;
  2606. begin
  2607.    if Value <> Indent then TreeView_SetIndent(Handle, Value) ;
  2608. end;
  2609.  
  2610. function TrmCustomPathTreeView.GetIndent: Integer;
  2611. begin
  2612.    Result := TreeView_GetIndent(Handle)
  2613. end;
  2614.  
  2615. procedure TrmCustomPathTreeView.FullExpand;
  2616. var
  2617.    Node: TrmTreeNode;
  2618. begin
  2619.    Node := Items.GetFirstNode;
  2620.    while Node <> nil do
  2621.    begin
  2622.       Node.Expand(True) ;
  2623.       Node := Node.GetNextSibling;
  2624.    end;
  2625. end;
  2626.  
  2627. procedure TrmCustomPathTreeView.FullCollapse;
  2628. var
  2629.    Node: TrmTreeNode;
  2630. begin
  2631.    Node := Items.GetFirstNode;
  2632.    while Node <> nil do
  2633.    begin
  2634.       Node.Collapse(True) ;
  2635.       Node := Node.GetNextSibling;
  2636.    end;
  2637. end;
  2638.  
  2639. procedure TrmCustomPathTreeView.Loaded;
  2640. begin
  2641.    inherited Loaded;
  2642.    if csDesigning in ComponentState then FullExpand;
  2643. end;
  2644.  
  2645. function TrmCustomPathTreeView.GetTopItem: TrmTreeNode;
  2646. begin
  2647.    if HandleAllocated then
  2648.       Result := Items.GetNode(TreeView_GetFirstVisible(Handle) )
  2649.    else Result := nil;
  2650. end;
  2651.  
  2652. procedure TrmCustomPathTreeView.SetTopItem(Value: TrmTreeNode) ;
  2653. begin
  2654.    if HandleAllocated and (Value <> nil) then
  2655.       TreeView_SelectSetFirstVisible(Handle, Value.ItemId) ;
  2656. end;
  2657.  
  2658. procedure TrmCustomPathTreeView.OnChangeTimer(Sender: TObject) ;
  2659. begin
  2660.    FChangeTimer.Enabled := False;
  2661.    Change(TrmTreeNode(FChangeTimer.Tag) ) ;
  2662. end;
  2663.  
  2664. function TrmCustomPathTreeView.GetSelection: TrmTreeNode;
  2665. begin
  2666.    if HandleAllocated then
  2667.    begin
  2668.       if FRightClickSelect and Assigned(FRClickNode) then
  2669.          Result := FRClickNode
  2670.       else
  2671.          Result := Items.GetNode(TreeView_GetSelection(Handle) ) ;
  2672.    end
  2673.    else Result := nil;
  2674. end;
  2675.  
  2676. procedure TrmCustomPathTreeView.SetSelection(Value: TrmTreeNode) ;
  2677. begin
  2678.    if Value <> nil then Value.Selected := True
  2679.    else TreeView_SelectItem(Handle, nil) ;
  2680. end;
  2681.  
  2682. procedure TrmCustomPathTreeView.SetChangeDelay(Value: Integer) ;
  2683. begin
  2684.    FChangeTimer.Interval := Value;
  2685. end;
  2686.  
  2687. function TrmCustomPathTreeView.GetChangeDelay: Integer;
  2688. begin
  2689.    Result := FChangeTimer.Interval;
  2690. end;
  2691.  
  2692. function TrmCustomPathTreeView.GetDropTarget: TrmTreeNode;
  2693. begin
  2694.    if HandleAllocated then
  2695.    begin
  2696.       Result := Items.GetNode(TreeView_GetDropHilite(Handle) ) ;
  2697.       if Result = nil then Result := FLastDropTarget;
  2698.    end
  2699.    else Result := nil;
  2700. end;
  2701.  
  2702. procedure TrmCustomPathTreeView.SetDropTarget(Value: TrmTreeNode) ;
  2703. begin
  2704.    if HandleAllocated then
  2705.       if Value <> nil then Value.DropTarget := True
  2706.       else TreeView_SelectDropTarget(Handle, nil) ;
  2707. end;
  2708.  
  2709. function TrmCustomPathTreeView.GetNodeFromItem(const Item: TTVItem) : TrmTreeNode;
  2710. begin
  2711.    Result := nil;
  2712.    if Items <> nil then
  2713.       with Item do
  2714.          if (state and TVIF_PARAM) <> 0 then Result := Pointer(lParam)
  2715.          else Result := Items.GetNode(hItem) ;
  2716. end;
  2717.  
  2718. function TrmCustomPathTreeView.IsEditing: Boolean;
  2719. var
  2720.    ControlHand: HWnd;
  2721. begin
  2722.    ControlHand := TreeView_GetEditControl(Handle) ;
  2723.    Result := (ControlHand <> 0) and IsWindowVisible(ControlHand) ;
  2724. end;
  2725.  
  2726. procedure TrmCustomPathTreeView.CNNotify(var Message: TWMNotify) ;
  2727. var
  2728.    Node: TrmTreeNode;
  2729.    MousePos: TPoint;
  2730.    R: TRect;
  2731.    DefaultDraw, PaintImages: Boolean;
  2732.    TmpItem: TTVItem;
  2733.    LogFont: TLogFont;
  2734. begin
  2735.    with Message do
  2736.       case NMHdr^.code of
  2737.          NM_CUSTOMDRAW:
  2738.             with PNMCustomDraw(NMHdr) ^ do
  2739.             begin
  2740.                FCanvas.Lock;
  2741.                try
  2742.                   Result := CDRF_DODEFAULT;
  2743.                   if (dwDrawStage and CDDS_ITEM) = 0 then
  2744.                   begin
  2745.                      R := ClientRect;
  2746.                      case dwDrawStage of
  2747.                         CDDS_PREPAINT:
  2748.                            begin
  2749.                               if IsCustomDrawn(dtControl, cdPrePaint) then
  2750.                               begin
  2751.                                  try
  2752.                                     FCanvas.Handle := hdc;
  2753.                                     FCanvas.Font := Font;
  2754.                                     FCanvas.Brush := Brush;
  2755.                                     DefaultDraw := CustomDraw(R, cdPrePaint) ;
  2756.                                  finally
  2757.                                     FCanvas.Handle := 0;
  2758.                                  end;
  2759.                                  if not DefaultDraw then
  2760.                                  begin
  2761.                                     Result := CDRF_SKIPDEFAULT;
  2762.                                     Exit;
  2763.                                  end;
  2764.                               end;
  2765.                               if IsCustomDrawn(dtItem, cdPrePaint) or IsCustomDrawn(dtItem, cdPreErase) then
  2766.                                  Result := Result or CDRF_NOTIFYITEMDRAW;
  2767.                               if IsCustomDrawn(dtItem, cdPostPaint) then
  2768.                                  Result := Result or CDRF_NOTIFYPOSTPAINT;
  2769.                               if IsCustomDrawn(dtItem, cdPostErase) then
  2770.                                  Result := Result or CDRF_NOTIFYPOSTERASE;
  2771.                            end;
  2772.                         CDDS_POSTPAINT:
  2773.                            if IsCustomDrawn(dtControl, cdPostPaint) then
  2774.                               CustomDraw(R, cdPostPaint) ;
  2775.                         CDDS_PREERASE:
  2776.                            if IsCustomDrawn(dtControl, cdPreErase) then
  2777.                               CustomDraw(R, cdPreErase) ;
  2778.                         CDDS_POSTERASE:
  2779.                            if IsCustomDrawn(dtControl, cdPostErase) then
  2780.                               CustomDraw(R, cdPostErase) ;
  2781.                      end;
  2782.                   end else
  2783.                   begin
  2784.                      FillChar(TmpItem, SizeOf(TmpItem) , 0) ;
  2785.                      TmpItem.hItem := HTREEITEM(dwItemSpec) ;
  2786.                      Node := GetNodeFromItem(TmpItem) ;
  2787.                      if Node = nil then Exit;
  2788.                      case dwDrawStage of
  2789.                         CDDS_ITEMPREPAINT:
  2790.                            begin
  2791.                     //release the font we may have loaned during item drawing.
  2792.                               if (dwDrawStage and CDDS_ITEMPOSTPAINT <> 0)
  2793.                                  and (PFontHandles(DesignInfo) .OurFont + PFontHandles(DesignInfo) .StockFont <> 0) then
  2794.                               begin
  2795.                                  SelectObject(hdc, PFontHandles(DesignInfo) .StockFont) ;
  2796.                                  DeleteObject(PFontHandles(DesignInfo) .OurFont) ;
  2797.                                  PFontHandles(DesignInfo) .OurFont := 0;
  2798.                                  PFontHandles(DesignInfo) .StockFont := 0;
  2799.                               end;
  2800.  
  2801.                               try
  2802.                                  FCanvas.Handle := hdc;
  2803.                                  FCanvas.Font := Font;
  2804.                                  FCanvas.Brush := Brush;
  2805.                       { Unlike the list view, the tree view doesn't override the text
  2806.                         foreground and background colors of selected items. }
  2807.                                  if uItemState and CDIS_SELECTED <> 0 then
  2808.                                  begin
  2809.                                     FCanvas.Font.Color := clHighlightText;
  2810.                                     FCanvas.Brush.Color := clHighlight;
  2811.                                  end;
  2812.                                  FCanvas.Font.OnChange := CanvasChanged;
  2813.                                  FCanvas.Brush.OnChange := CanvasChanged;
  2814.                                  FCanvasChanged := False;
  2815.                                  DefaultDraw := CustomDrawItem(Node,
  2816.                                     TCustomDrawState(Word(uItemState) ) , cdPrePaint, PaintImages) ;
  2817.                                  if not PaintImages then
  2818.                                     Result := Result or TVCDRF_NOIMAGES;
  2819.                                  if not DefaultDraw then
  2820.                                     Result := Result or CDRF_SKIPDEFAULT
  2821.                                  else if FCanvasChanged then
  2822.                                  begin
  2823.                                     FCanvasChanged := False;
  2824.                                     FCanvas.Font.OnChange := nil;
  2825.                                     FCanvas.Brush.OnChange := nil;
  2826.                                     with PNMTVCustomDraw(NMHdr) ^ do
  2827.                                     begin
  2828.                                        clrText := ColorToRGB(FCanvas.Font.Color) ;
  2829.                                        clrTextBk := ColorToRGB(FCanvas.Brush.Color) ;
  2830.                                        if GetObject(FCanvas.Font.Handle, SizeOf(LogFont) , @LogFont) <> 0 then
  2831.                                        begin
  2832.                                           FCanvas.Handle := 0; // disconnect from hdc
  2833.                             // don't delete the stock font
  2834.                                           PFontHandles(DesignInfo) .OurFont := CreateFontIndirect(LogFont) ;
  2835.                                           PFontHandles(DesignInfo) .StockFont :=
  2836.                                              SelectObject(hdc, PFontHandles(DesignInfo) .OurFont) ;
  2837.                                           Result := Result or CDRF_NEWFONT;
  2838.                                        end;
  2839.                                     end;
  2840.                                  end;
  2841.                                  if IsCustomDrawn(dtItem, cdPostPaint) then
  2842.                                     Result := Result or CDRF_NOTIFYPOSTPAINT;
  2843.                               finally
  2844.                                  FCanvas.Handle := 0;
  2845.                               end;
  2846.                            end;
  2847.                         CDDS_ITEMPOSTPAINT:
  2848.                            if IsCustomDrawn(dtItem, cdPostPaint) then
  2849.                               CustomDrawItem(Node, TCustomDrawState(Word(uItemState) ) , cdPostPaint, PaintImages) ;
  2850.                         CDDS_ITEMPREERASE:
  2851.                            if IsCustomDrawn(dtItem, cdPreErase) then
  2852.                               CustomDrawItem(Node, TCustomDrawState(Word(uItemState) ) , cdPreErase, PaintImages) ;
  2853.                         CDDS_ITEMPOSTERASE:
  2854.                            if IsCustomDrawn(dtItem, cdPostErase) then
  2855.                               CustomDrawItem(Node, TCustomDrawState(Word(uItemState) ) , cdPostErase, PaintImages) ;
  2856.                      end;
  2857.                   end;
  2858.                finally
  2859.                   FCanvas.Unlock;
  2860.                end;
  2861.             end;
  2862.          TVN_BEGINDRAG:
  2863.             begin
  2864.                FDragged := True;
  2865.                with PNMTreeView(NMHdr) ^ do
  2866.                   FDragNode := GetNodeFromItem(ItemNew) ;
  2867.             end;
  2868.          TVN_BEGINLABELEDIT:
  2869.             begin
  2870.                Try
  2871.                   SetNewHint(nil) ;
  2872.                except
  2873.              //Do Nothing...
  2874.                end;
  2875.                with PTVDispInfo(NMHdr) ^ do
  2876.                   if Dragging or not CanEdit(GetNodeFromItem(item) ) then
  2877.                      Result := 1;
  2878.                if Result = 0 then
  2879.                begin
  2880.                   FEditHandle := TreeView_GetEditControl(Handle) ;
  2881.                   FDefEditProc := Pointer(GetWindowLong(FEditHandle, GWL_WNDPROC) ) ;
  2882.                   SetWindowLong(FEditHandle, GWL_WNDPROC, LongInt(FEditInstance) ) ;
  2883.                end;
  2884.             end;
  2885.          TVN_ENDLABELEDIT: Edit(PTVDispInfo(NMHdr) ^.item) ;
  2886.          TVN_ITEMEXPANDING:
  2887.             if not FManualNotify then
  2888.             begin
  2889.                with PNMTreeView(NMHdr) ^ do
  2890.                begin
  2891.                   Node := GetNodeFromItem(ItemNew) ;
  2892.                   if (action = TVE_EXPAND) and not CanExpand(Node) then
  2893.                      Result := 1
  2894.                   else if (action = TVE_COLLAPSE) and
  2895.                      not CanCollapse(Node) then Result := 1;
  2896.                end;
  2897.             end;
  2898.          TVN_ITEMEXPANDED:
  2899.             if not FManualNotify then
  2900.             begin
  2901.                with PNMTreeView(NMHdr) ^ do
  2902.                begin
  2903.                   Node := GetNodeFromItem(itemNew) ;
  2904.                   if (action = TVE_EXPAND) then Expand(Node)
  2905.                   else if (action = TVE_COLLAPSE) then Collapse(Node) ;
  2906.                end;
  2907.             end;
  2908.          TVN_SELCHANGINGA, TVN_SELCHANGINGW:
  2909.             if not CanChange(GetNodeFromItem(PNMTreeView(NMHdr) ^.itemNew) ) then
  2910.                Result := 1;
  2911.          TVN_SELCHANGEDA, TVN_SELCHANGEDW:
  2912.             with PNMTreeView(NMHdr) ^ do
  2913.                if FChangeTimer.Interval > 0 then
  2914.                   with FChangeTimer do
  2915.                   begin
  2916.                      Enabled := False;
  2917.                      Tag := Integer(GetNodeFromItem(itemNew) ) ;
  2918.                      Enabled := True;
  2919.                   end
  2920.                else
  2921.                   Change(GetNodeFromItem(itemNew) ) ;
  2922.          TVN_DELETEITEM:
  2923.             begin
  2924.                Node := GetNodeFromItem(PNMTreeView(NMHdr) ^.itemOld) ;
  2925.                if Node <> nil then
  2926.                begin
  2927.                   Node.FItemId := nil;
  2928.                   FChangeTimer.Enabled := False;
  2929.                   if FStateChanging then Node.Delete
  2930.                   else Items.Delete(Node) ;
  2931.                end;
  2932.             end;
  2933.          TVN_SETDISPINFO:
  2934.             with PTVDispInfo(NMHdr) ^ do
  2935.             begin
  2936.                Node := GetNodeFromItem(item) ;
  2937.                if (Node <> nil) and ((item.mask and TVIF_TEXT) <> 0) then
  2938.                   Node.Text := item.pszText;
  2939.             end;
  2940.          TVN_GETDISPINFO:
  2941.             with PTVDispInfo(NMHdr) ^ do
  2942.             begin
  2943.                Node := GetNodeFromItem(item) ;
  2944.                if Node <> nil then
  2945.                begin
  2946.                   if (item.mask and TVIF_TEXT) <> 0 then
  2947.                      StrLCopy(item.pszText, PChar(Node.Text) , item.cchTextMax) ;
  2948.                   if (item.mask and TVIF_IMAGE) <> 0 then
  2949.                   begin
  2950.                      GetImageIndex(Node) ;
  2951.                      item.iImage := Node.ImageIndex;
  2952.                   end;
  2953.                   if (item.mask and TVIF_SELECTEDIMAGE) <> 0 then
  2954.                   begin
  2955.                      GetSelectedIndex(Node) ;
  2956.                      item.iSelectedImage := Node.SelectedIndex;
  2957.                   end;
  2958.                end;
  2959.             end;
  2960.          NM_RCLICK:
  2961.             begin
  2962.                FRClickNode := nil;
  2963.                GetCursorPos(MousePos) ;
  2964.                if RightClickSelect then
  2965.                   with PointToSmallPoint(ScreenToClient(MousePos) ) do
  2966.                   begin
  2967.                      FRClickNode := GetNodeAt(X, Y) ;
  2968.                      Perform(WM_CONTEXTMENU, Handle, Integer(PointToSmallPoint(MousePos) ) ) ;
  2969.                      FRClickNode := nil;
  2970.                   end
  2971.                else
  2972.             // Win95/98 eat WM_CONTEXTMENU when posted to the message queue
  2973.                   PostMessage(Handle, CN_BASE + WM_CONTEXTMENU, Handle, Integer(PointToSmallPoint(MousePos) ) ) ;
  2974.                Message.Result := 1; // tell treeview not to perform default response
  2975.             end;
  2976.       end;
  2977. end;
  2978.  
  2979. function TrmCustomPathTreeView.GetDragImages: TDragImageList;
  2980. begin
  2981.    if FDragImage.Count > 0 then
  2982.       Result := FDragImage else
  2983.       Result := nil;
  2984. end;
  2985.  
  2986. procedure TrmCustomPathTreeView.WndProc(var Message: TMessage) ;
  2987. begin
  2988.    if not (csDesigning in ComponentState) and ((Message.Msg = WM_LBUTTONDOWN) or
  2989.       (Message.Msg = WM_LBUTTONDBLCLK) ) and not Dragging and
  2990.       (DragMode = dmAutomatic) and (DragKind = dkDrag) then
  2991.    begin
  2992.       if not IsControlMouseMsg(TWMMouse(Message) ) then
  2993.       begin
  2994.          ControlState := ControlState + [csLButtonDown];
  2995.          Dispatch(Message) ;
  2996.       end;
  2997.    end
  2998.    else if Message.Msg = CN_BASE + WM_CONTEXTMENU then
  2999.       Message.Result := Perform(WM_CONTEXTMENU, Message.WParam, Message.LParam)
  3000.    else inherited WndProc(Message) ;
  3001. end;
  3002.  
  3003. procedure TrmCustomPathTreeView.DoStartDrag(var DragObject: TDragObject) ;
  3004. var
  3005.    ImageHandle: HImageList;
  3006.    DragNode: TrmTreeNode;
  3007.    P: TPoint;
  3008. begin
  3009.    inherited DoStartDrag(DragObject) ;
  3010.    DragNode := FDragNode;
  3011.    FLastDropTarget := nil;
  3012.    FDragNode := nil;
  3013.    if DragNode = nil then
  3014.    begin
  3015.       GetCursorPos(P) ;
  3016.       with ScreenToClient(P) do DragNode := GetNodeAt(X, Y) ;
  3017.    end;
  3018.    if DragNode <> nil then
  3019.    begin
  3020.       ImageHandle := TreeView_CreateDragImage(Handle, DragNode.ItemId) ;
  3021.       if ImageHandle <> 0 then
  3022.          with FDragImage do
  3023.          begin
  3024.             Handle := ImageHandle;
  3025.             SetDragImage(0, 2, 2) ;
  3026.          end;
  3027.    end;
  3028. end;
  3029.  
  3030. procedure TrmCustomPathTreeView.DoEndDrag(Target: TObject; X, Y: Integer) ;
  3031. begin
  3032.    inherited DoEndDrag(Target, X, Y) ;
  3033.    FLastDropTarget := nil;
  3034. end;
  3035.  
  3036. procedure TrmCustomPathTreeView.CMDrag(var Message: TCMDrag) ;
  3037. begin
  3038.    inherited;
  3039.    with Message, DragRec^ do
  3040.       case DragMessage of
  3041.          dmDragMove:
  3042.             with ScreenToClient(Pos) do
  3043.                DoDragOver(Source, X, Y, Message.Result <> 0) ;
  3044.          dmDragLeave:
  3045.             begin
  3046.                TDragObject(Source) .HideDragImage;
  3047.                FLastDropTarget := DropTarget;
  3048.                DropTarget := nil;
  3049.                TDragObject(Source) .ShowDragImage;
  3050.             end;
  3051.          dmDragDrop: FLastDropTarget := nil;
  3052.       end;
  3053. end;
  3054.  
  3055. procedure TrmCustomPathTreeView.DoDragOver(Source: TDragObject; X, Y: Integer; CanDrop: Boolean) ;
  3056. var
  3057.    Node: TrmTreeNode;
  3058. begin
  3059.    Node := GetNodeAt(X, Y) ;
  3060.    if (Node <> nil) and
  3061.       ((Node <> DropTarget) or (Node = FLastDropTarget) ) then
  3062.    begin
  3063.       FLastDropTarget := nil;
  3064.       TDragObject(Source) .HideDragImage;
  3065.       Node.DropTarget := True;
  3066.       TDragObject(Source) .ShowDragImage;
  3067.    end;
  3068. end;
  3069.  
  3070. procedure TrmCustomPathTreeView.GetImageIndex(Node: TrmTreeNode) ;
  3071. begin
  3072.    if Assigned(FOnGetImageIndex) then FOnGetImageIndex(Self, Node) ;
  3073. end;
  3074.  
  3075. procedure TrmCustomPathTreeView.GetSelectedIndex(Node: TrmTreeNode) ;
  3076. begin
  3077.    if Assigned(FOnGetSelectedIndex) then FOnGetSelectedIndex(Self, Node) ;
  3078. end;
  3079.  
  3080. function TrmCustomPathTreeView.CanChange(Node: TrmTreeNode) : Boolean;
  3081. begin
  3082.    Result := True;
  3083.    if Assigned(FOnChanging) then FOnChanging(Self, Node, Result) ;
  3084. end;
  3085.  
  3086. procedure TrmCustomPathTreeView.Change(Node: TrmTreeNode) ;
  3087. begin
  3088.    if Assigned(FOnChange) then FOnChange(Self, Node) ;
  3089. end;
  3090.  
  3091. procedure TrmCustomPathTreeView.Delete(Node: TrmTreeNode) ;
  3092. begin
  3093.    if Assigned(FOnDeletion) then FOnDeletion(Self, Node) ;
  3094. end;
  3095.  
  3096. procedure TrmCustomPathTreeView.Expand(Node: TrmTreeNode) ;
  3097. begin
  3098.    if Assigned(FOnExpanded) then FOnExpanded(Self, Node) ;
  3099. end;
  3100.  
  3101. function TrmCustomPathTreeView.CanExpand(Node: TrmTreeNode) : Boolean;
  3102. begin
  3103.    Result := True;
  3104.    if Assigned(FOnExpanding) then FOnExpanding(Self, Node, Result) ;
  3105. end;
  3106.  
  3107. procedure TrmCustomPathTreeView.Collapse(Node: TrmTreeNode) ;
  3108. begin
  3109.    if Assigned(FOnCollapsed) then FOnCollapsed(Self, Node) ;
  3110. end;
  3111.  
  3112. function TrmCustomPathTreeView.CanCollapse(Node: TrmTreeNode) : Boolean;
  3113. begin
  3114.    Result := True;
  3115.    if Assigned(FOnCollapsing) then FOnCollapsing(Self, Node, Result) ;
  3116. end;
  3117.  
  3118. function TrmCustomPathTreeView.CanEdit(Node: TrmTreeNode) : Boolean;
  3119. begin
  3120.    Result := True;
  3121.    if Assigned(FOnEditing) then FOnEditing(Self, Node, Result) ;
  3122. end;
  3123.  
  3124. procedure TrmCustomPathTreeView.Edit(const Item: TTVItem) ;
  3125. var
  3126.    S: string;
  3127.    Node: TrmTreeNode;
  3128. begin
  3129.    with Item do
  3130.       if pszText <> nil then
  3131.       begin
  3132.          S := pszText;
  3133.          Node := GetNodeFromItem(Item) ;
  3134.          if Assigned(FOnEdited) then FOnEdited(Self, Node, S) ;
  3135.          if Node <> nil then Node.Text := S;
  3136.       end;
  3137. end;
  3138.  
  3139. function TrmCustomPathTreeView.CreateNode: TrmTreeNode;
  3140. begin
  3141.    Result := TrmTreeNode.Create(Items) ;
  3142. end;
  3143.  
  3144. procedure TrmCustomPathTreeView.SetImageList(Value: HImageList; Flags: Integer) ;
  3145. begin
  3146.    if HandleAllocated then TreeView_SetImageList(Handle, Value, Flags) ;
  3147. end;
  3148.  
  3149. procedure TrmCustomPathTreeView.ImageListChange(Sender: TObject) ;
  3150. var
  3151.    ImageHandle: HImageList;
  3152. begin
  3153.    if HandleAllocated then
  3154.    begin
  3155.       if TCustomImageList(Sender) .HandleAllocated then
  3156.          ImageHandle := TCustomImageList(Sender) .Handle
  3157.       else
  3158.          ImageHandle := 0;
  3159.       if Sender = Images then
  3160.          SetImageList(ImageHandle, TVSIL_NORMAL)
  3161.       else if Sender = StateImages then
  3162.          SetImageList(ImageHandle, TVSIL_STATE) ;
  3163.    end;
  3164. end;
  3165.  
  3166. procedure TrmCustomPathTreeView.Notification(AComponent: TComponent;
  3167.    Operation: TOperation) ;
  3168. begin
  3169.    inherited Notification(AComponent, Operation) ;
  3170.    if Operation = opRemove then
  3171.    begin
  3172.       if AComponent = Images then Images := nil;
  3173.       if AComponent = StateImages then StateImages := nil;
  3174.    end;
  3175. end;
  3176.  
  3177. procedure TrmCustomPathTreeView.SetImages(Value: TCustomImageList) ;
  3178. begin
  3179.    if Images <> nil then
  3180.       Images.UnRegisterChanges(FImageChangeLink) ;
  3181.    FImages := Value;
  3182.    if Images <> nil then
  3183.    begin
  3184.       Images.RegisterChanges(FImageChangeLink) ;
  3185.       Images.FreeNotification(Self) ;
  3186.       SetImageList(Images.Handle, TVSIL_NORMAL)
  3187.    end
  3188.    else SetImageList(0, TVSIL_NORMAL) ;
  3189. end;
  3190.  
  3191. procedure TrmCustomPathTreeView.SetStateImages(Value: TCustomImageList) ;
  3192. begin
  3193.    if StateImages <> nil then
  3194.       StateImages.UnRegisterChanges(FStateChangeLink) ;
  3195.    FStateImages := Value;
  3196.    if StateImages <> nil then
  3197.    begin
  3198.       StateImages.RegisterChanges(FStateChangeLink) ;
  3199.       StateImages.FreeNotification(Self) ;
  3200.       SetImageList(StateImages.Handle, TVSIL_STATE)
  3201.    end
  3202.    else SetImageList(0, TVSIL_STATE) ;
  3203. end;
  3204.  
  3205. procedure TrmCustomPathTreeView.LoadFromFile(const FileName: string) ;
  3206. var
  3207.    Stream: TStream;
  3208. begin
  3209.    Stream := TFileStream.Create(FileName, fmOpenRead) ;
  3210.    try
  3211.       LoadFromStream(Stream) ;
  3212.    finally
  3213.       Stream.Free;
  3214.    end;
  3215. end;
  3216.  
  3217. procedure TrmCustomPathTreeView.LoadFromStream(Stream: TStream) ;
  3218. begin
  3219.    with TTreeStrings.Create(Items) do
  3220.    try
  3221.       LoadTreeFromStream(Stream) ;
  3222.    finally
  3223.       Free;
  3224.    end;
  3225. end;
  3226.  
  3227. procedure TrmCustomPathTreeView.SaveToFile(const FileName: string) ;
  3228. var
  3229.    Stream: TStream;
  3230. begin
  3231.    Stream := TFileStream.Create(FileName, fmCreate) ;
  3232.    try
  3233.       SaveToStream(Stream) ;
  3234.    finally
  3235.       Stream.Free;
  3236.    end;
  3237. end;
  3238.  
  3239. procedure TrmCustomPathTreeView.SaveToStream(Stream: TStream) ;
  3240. begin
  3241.    with TTreeStrings.Create(Items) do
  3242.    try
  3243.       SaveTreeToStream(Stream) ;
  3244.    finally
  3245.       Free;
  3246.    end;
  3247. end;
  3248.  
  3249. procedure TrmCustomPathTreeView.WMContextMenu(var Message: TWMContextMenu) ;
  3250. var
  3251.    R: TRect;
  3252. begin
  3253.    if (Message.XPos < 0) and (Selected <> nil) then
  3254.    begin
  3255.       R := Selected.DisplayRect(True) ;
  3256.       Message.Pos := PointToSmallPoint(ClientToScreen(Point(R.Left, R.Bottom) ) ) ;
  3257.    end;
  3258.    inherited;
  3259. end;
  3260.  
  3261. procedure TrmCustomPathTreeView.WMLButtonDown(var Message: TWMLButtonDown) ;
  3262. var
  3263.    Node: TrmTreeNode;
  3264.    MousePos: TPoint;
  3265. begin
  3266.    FDragged := False;
  3267.    FDragNode := nil;
  3268.    try
  3269.       inherited;
  3270.       if (DragMode = dmAutomatic) and (DragKind = dkDrag) then
  3271.       begin
  3272.          SetFocus;
  3273.          if not FDragged then
  3274.          begin
  3275.             GetCursorPos(MousePos) ;
  3276.             with PointToSmallPoint(ScreenToClient(MousePos) ) do
  3277.                Perform(WM_LBUTTONUP, 0, MakeLong(X, Y) ) ;
  3278.          end
  3279.          else
  3280.          begin
  3281.             Node := GetNodeAt(Message.XPos, Message.YPos) ;
  3282.             if Node <> nil then
  3283.             begin
  3284.                Node.Focused := True;
  3285.                Node.Selected := True;
  3286.                BeginDrag(False) ;
  3287.             end;
  3288.          end;
  3289.       end;
  3290.    finally
  3291.       FDragNode := nil;
  3292.    end;
  3293. end;
  3294.  
  3295. procedure TrmCustomPathTreeView.WMNotify(var Message: TWMNotify) ;
  3296. var
  3297.    Node: TrmTreeNode;
  3298.    MaxTextLen: Integer;
  3299.    Pt: TPoint;
  3300. begin
  3301.    with Message do
  3302.       if NMHdr^.code = TTN_NEEDTEXTW then
  3303.       begin
  3304.       // Work around NT COMCTL32 problem with tool tips >= 80 characters
  3305.          GetCursorPos(Pt) ;
  3306.          Pt := ScreenToClient(Pt) ;
  3307.          Node := GetNodeAt(Pt.X, Pt.Y) ;
  3308.          if (Node = nil) or (Node.Text = '') or
  3309.             (PToolTipTextW(NMHdr) ^.uFlags and TTF_IDISHWND = 0) then Exit;
  3310.          if (GetComCtlVersion >= ComCtlVersionIE4) and (Length(Node.Text) < 80) then
  3311.          begin
  3312.             inherited;
  3313.             Exit;
  3314.          end;
  3315.          FWideText := Node.Text;
  3316.          MaxTextLen := SizeOf(PToolTipTextW(NMHdr) ^.szText) div SizeOf(WideChar) ;
  3317.          if Length(FWideText) >= MaxTextLen then
  3318.             SetLength(FWideText, MaxTextLen - 1) ;
  3319.          PToolTipTextW(NMHdr) ^.lpszText := PWideChar(FWideText) ;
  3320.          FillChar(PToolTipTextW(NMHdr) ^.szText, MaxTextLen, 0) ;
  3321.          Move(Pointer(FWideText) ^, PToolTipTextW(NMHdr) ^.szText, Length(FWideText) * SizeOf(WideChar) ) ;
  3322.          PToolTipTextW(NMHdr) ^.hInst := 0;
  3323.          SetWindowPos(NMHdr^.hwndFrom, HWND_TOP, 0, 0, 0, 0, SWP_NOACTIVATE or
  3324.             SWP_NOSIZE or SWP_NOMOVE or SWP_NOOWNERZORDER) ;
  3325.          Result := 1;
  3326.       end
  3327.       else inherited;
  3328. end;
  3329.  
  3330. { CustomDraw support }
  3331.  
  3332. procedure TrmCustomPathTreeView.CanvasChanged;
  3333. begin
  3334.    FCanvasChanged := True;
  3335. end;
  3336.  
  3337. function TrmCustomPathTreeView.IsCustomDrawn(Target: TCustomDrawTarget;
  3338.    Stage: TCustomDrawStage) : Boolean;
  3339. begin
  3340.   { Tree view doesn't support erase notifications }
  3341.    if Stage = cdPrePaint then
  3342.    begin
  3343.       if Target = dtItem then
  3344.          Result := Assigned(FOnCustomDrawItem) or Assigned(FOnAdvancedCustomDrawItem)
  3345.       else if Target = dtControl then
  3346.          Result := Assigned(FOnCustomDraw) or Assigned(FOnAdvancedCustomDraw) or
  3347.             Assigned(FOnCustomDrawItem) or Assigned(FOnAdvancedCustomDrawItem)
  3348.       else
  3349.          Result := False;
  3350.    end
  3351.    else
  3352.    begin
  3353.       if Target = dtItem then
  3354.          Result := Assigned(FOnAdvancedCustomDrawItem)
  3355.       else if Target = dtControl then
  3356.          Result := Assigned(FOnAdvancedCustomDraw) or Assigned(FOnAdvancedCustomDrawItem)
  3357.       else
  3358.          Result := False;
  3359.    end;
  3360. end;
  3361.  
  3362. function TrmCustomPathTreeView.CustomDraw(const ARect: TRect; Stage: TCustomDrawStage) : Boolean;
  3363. begin
  3364.    Result := True;
  3365.    if (Stage = cdPrePaint) and Assigned(FOnCustomDraw) then FOnCustomDraw(Self, ARect, Result) ;
  3366.    if Assigned(FOnAdvancedCustomDraw) then FOnAdvancedCustomDraw(Self, ARect, Stage, Result) ;
  3367. end;
  3368.  
  3369. function TrmCustomPathTreeView.CustomDrawItem(Node: TrmTreeNode; State: TCustomDrawState;
  3370.    Stage: TCustomDrawStage; var PaintImages: Boolean) : Boolean;
  3371. begin
  3372.    Result := True;
  3373.    PaintImages := True;
  3374.    if (Stage = cdPrePaint) and Assigned(FOnCustomDrawItem) then FOnCustomDrawItem(Self, Node, State, Result) ;
  3375.    if Assigned(FOnAdvancedCustomDrawItem) then FOnAdvancedCustomDrawItem(Self, Node, State, Stage, PaintImages, Result) ;
  3376. end;
  3377.  
  3378. function TrmCustomPathTreeView.ParentName(s: string) : string;
  3379. var
  3380.    wLen: integer;
  3381. begin
  3382.    wLen := length(s) ;
  3383.    if (wlen > 0) and (s[wLen] = SepChar) then
  3384.    begin
  3385.       system.Delete(s, wLen, 1) ;
  3386.       dec(wLen) ;
  3387.    end;
  3388.    while (wlen > 0) and (s[wLen] <> sepchar) do
  3389.    begin
  3390.       system.Delete(s, wLen, 1) ;
  3391.       dec(wLen) ;
  3392.    end;
  3393.    if (wlen > 0) and (s[wLen] = SepChar) then
  3394.       system.Delete(s, wLen, 1) ;
  3395.    result := s;
  3396. end;
  3397.  
  3398. function TrmCustomPathTreeView.ChildName(s: string) : string;
  3399. var
  3400.    wLen: integer;
  3401. begin
  3402.    wLen := length(s) ;
  3403.    if (wlen > 0) and (s[wLen] = SepChar) then
  3404.    begin
  3405.       system.Delete(s, wLen, 1) ;
  3406.       dec(wLen) ;
  3407.    end;
  3408.    while (wlen > 0) and (s[wLen] <> sepchar) do
  3409.       dec(wLen) ;
  3410.    system.delete(s, 1, wLen) ;
  3411.    result := s;
  3412. end;
  3413.  
  3414. function TrmCustomPathTreeView.AddPathNode(Node: TrmTreeNode;
  3415.    Path: string) : TrmTreeNode;
  3416. var
  3417.    wNode, wParent, wChild: TrmTreeNode;
  3418.    wPName, wCName: string;
  3419. begin
  3420.    result := nil;
  3421.    if path = '' then
  3422.       exit;
  3423.  
  3424.    wNode := Items.LocateNode(Path) ;
  3425.    if wNode = nil then
  3426.    begin
  3427.       wPName := ParentName(Path) ;
  3428.       wCName := ChildName(Path) ;
  3429.       wParent := Items.LocateNode(wPName) ;
  3430.       if wParent = nil then
  3431.          wParent := AddPathNode(nil, wPname) ;
  3432.       wChild := Items.AddChild(wParent, wCName) ;
  3433.       result := wChild;
  3434.    end
  3435.    else
  3436.       result := wNode;
  3437. end;
  3438.  
  3439. function TrmCustomPathTreeView.FindPathNode(Path: string) : TrmTreeNode;
  3440. begin
  3441.    result := Items.LocateNode(Path) ;
  3442. end;
  3443.  
  3444. function TrmCustomPathTreeView.NodePath(Node: TrmTreeNode) : string;
  3445. var
  3446.    Temp: string;
  3447. begin
  3448.    Temp := '';
  3449.  
  3450.    while Node <> nil do
  3451.    begin
  3452.       Temp := FSepChar + Node.Text + Temp;
  3453.       Node := Node.Parent;
  3454.    end;
  3455.    Result := Temp;
  3456. end;
  3457.  
  3458. procedure TrmCustomPathTreeView.SetNewHint(Node: TrmTreeNode) ;
  3459. var
  3460.    wRect: TRect;
  3461. begin
  3462.    if FToolTips and assigned(Node) then
  3463.    begin
  3464.       if assigned(fHint) and (Node.text = fHint.Caption) then
  3465.          exit
  3466.       else
  3467.       begin
  3468.          fHint.free;
  3469.          fHint := nil;
  3470.       end;
  3471.  
  3472.       wRect := Node.DisplayRect(true) ;
  3473.       if (wRect.Right > Self.Width) then
  3474.       begin
  3475.          wRect.TopLeft := Self.ClientToScreen(wRect.TopLeft) ;
  3476.          wRect.BottomRight := Self.ClientToScreen(wRect.BottomRight) ;
  3477.  
  3478.          if not assigned(fHint) then
  3479.             fHint := TrmHintWindow.Create(nil) ;
  3480.          fHint.Color := clInfoBk;
  3481.          fHint.Font.Assign(self.font) ;
  3482.          fHint.ActivateHint(wRect, Node.Text) ;
  3483.       end;
  3484.    end
  3485.    else
  3486.    begin
  3487.       fHint.free;
  3488.       fHint := nil;
  3489.    end;
  3490. end;
  3491.  
  3492. function TrmCustomPathTreeView.GetFocussedNode: TrmTreeNode;
  3493. begin
  3494.    if HandleAllocated then
  3495.       Result := Items.GetNode(TreeView_GetSelection(Handle) )
  3496.    else
  3497.       Result := nil;
  3498. end;
  3499.  
  3500. procedure TrmCustomPathTreeView.SetFocussedNode(const Value: TrmTreeNode) ;
  3501. begin
  3502.    Selected := Value; // ie: use SetSelection
  3503. end;
  3504.  
  3505. procedure TrmCustomPathTreeView.CMCancelMode(var Message: TMessage) ;
  3506. begin
  3507.    Try
  3508.       SetNewHint(nil) ;
  3509.    except
  3510.       //Do Nothing...
  3511.    end;
  3512.    inherited;
  3513. end;
  3514.  
  3515. procedure TrmCustomPathTreeView.CMMouseLeave(var Message: TMessage) ;
  3516. begin
  3517.    Try
  3518.       SetNewHint(nil) ;
  3519.    except
  3520.       //Do Nothing...
  3521.    end;
  3522.    inherited;
  3523. end;
  3524.  
  3525. procedure TrmCustomPathTreeView.MouseDown(Button: TMouseButton;
  3526.    Shift: TShiftState; X, Y: Integer) ;
  3527. var
  3528.    N: TrmTreeNode;
  3529. begin
  3530.    if (Button = mbRight) and (RightClickSelect) then
  3531.    begin
  3532.       N := GetNodeAt(X, Y) ;
  3533.       if N <> nil then Selected := N;
  3534.    end;
  3535.    inherited;
  3536. end;
  3537.  
  3538. procedure TrmCustomPathTreeView.MouseMove(Shift: TShiftState; X,
  3539.    Y: Integer) ;
  3540. begin
  3541.    Try
  3542.       if (Application.Active) and (htOnItem in GetHitTestInfoAt(X, y) ) then
  3543.          SetNewHint(GetNodeAt(x, y) )
  3544.       else
  3545.          SetNewHint(nil) ;
  3546.    except
  3547.      //Do Nothing...
  3548.    end;
  3549.    inherited;
  3550. end;
  3551.  
  3552. initialization
  3553.    RegisterClass(TrmNodeInfo) ;
  3554. end.
  3555.  
  3556.