开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
fctreeview.pas
资源名称：qqdelphiprog.rar　[点击查看]
上传用户：hylc_2004
上传日期：2014-01-23
资源大小：46800k
文件大小：166k
源码类别：

Delphi控件源码

开发平台：

Delphi

fctreeview.pas：源码内容
  1. unit fcTreeView;
  2. {
  3. //
  4. // Components : TfcTreeView
  5. //
  6. // Copyright (c) 1999 by Woll2Woll Software
  7. // 3/3/99 - (RSW) Remove tvoUnderscoreAllowed Option
  8. // 5/21/99 - Complete editing
  9. // 6/14/99 - Fix disappearing tree when going into edit mode
  10. // 6/23/99 - Fire OnDblClick event even when ExpandOnDblClick is False
  11. // 7/3/99 - Only call Invalidate if not in expanding/collapsing
  12. // 7/6/99 - Support streaming of TfcTreeView Items to TfcTreecombo's tree
  13. // 11/12/99 - If right mouse button, then exit so multi-selected records are
  14. //          not unselected
  15. // 1/5/2000 - Fix TFrame duplicate streaming problem
  16. // 2/3/2000 - Optimize imagelist usage so that resources are better
  17. //            managed with regards to bitmaps
  18. //
  19. // 2/28/2000 - Always increment refcount so that treeview does not incorrectly
  20. //             free temp image list.
  21. // 5/16/2000 - PYW - Fix Memory leak from code left over from Delphi 3
  22. // 6/9/2000 - PYW - Prevent default button handling for treeview
  23. // 12/13/2001 - Don't use temp canvas for XP Themes. TreeView not painted in some cases otherwise
  24. // 1/31/2002 - In WMPaint call inherited if nodes are in beginupdate/endupdate.
  25. // 1/31/2002 - PYW - Added new property to respect expanded node settings.
  26. // 5/10/2002 - Use DrawText to calculate font based on current canvas settings from OnCalcNodeAttributes event.
  27. }
  28. interface
  30. {$i fcIfdef.pas}
  31. {$R-}
  33. uses
  34.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  35.   CommCtrl, ComStrs, consts, comctrls, fccustomdraw, fccanvas, extctrls, fccommon,
  36. {$ifdef fcdelphi6Up}
  37. variants,
  38. {$endif}
  39. {$ifdef fcdelphi7Up}
  40.   themes,
  41. {$endif}
  42.   {$ifdef ThemeManager}
  43.   thememgr, themesrv, uxtheme,
  44.   {$endif}
  45.   shellapi
  46.   {$ifdef fcDelphi4Up}, ImgList{$endif};
  48. type
  49.   TfcCustomTreeView = class;
  50.   TfcTreeNode = class;
  51.   TfcItemState = (fcisSelected, fcisGrayed, fcisDisabled, fcisChecked,
  52.     fcisFocused, fcisDefault, fcisHot, fcisMarked, fcisIndeterminate);
  53.   TfcItemStates = set of TfcItemState;
  54.   TfcTVDrawTextEvent = procedure (TreeView: TfcCustomTreeview;
  55.     Node: TfcTreeNode; ARect: TRect; AItemState: TfcItemStates;
  56.     var DefaultDrawing: boolean) of object;
  57.   TfcTreeMouseMoveEvent = procedure(TreeView: TfcCustomTreeView;
  58.       Node: TfcTreeNode;
  59.       Shift: TShiftState; X, Y: Integer)of object;
  60.   TfcTreeMouseEvent = procedure(TreeView: TfcCustomTreeView;
  61.       Node: TfcTreeNode;
  62.       Button: TMouseButton; Shift: TShiftState; X, Y: Integer) of object;
  65.   TfcTreeNodes = class;
  67.   TfcNodeState = (fcnsCut, fcnsDropHilited, fcnsFocused, fcnsSelected,
  68.                   fcnsExpanded);
  69.   TfcNodeAttachMode = (fcnaAdd, fcnaAddFirst, fcnaAddChild, fcnaAddChildFirst,
  70.                        fcnaInsert, fcnaInsertAfter);
  71.   TfcAddMode = (fctaAddFirst, fctaAdd, fctaInsert);
  73.   TfcTreeViewCheckboxType = (tvctNone, tvctCheckbox, tvctRadioGroup);
  75.   TfcTreeViewOption = (tvoExpandOnDblClk, tvoExpandButtons3D,
  76.      tvoFlatCheckBoxes, tvoHideSelection,
  77.      tvoRowSelect, tvoShowButtons,
  78.      tvoShowLines, tvoShowRoot,
  79.      {tvoUnderscoreAllowed,} tvoHotTrack, tvoAutoURL, tvoToolTips,
  80.      tvoEditText, tvo3StateCheckbox);
  81.   TfcTreeViewOptions = set of TfcTreeViewOption;
  83.   PfcNodeInfo = ^TfcNodeInfo;
  84.   TfcNodeInfo = packed record
  85.     ImageIndex: Integer;
  86.     SelectedIndex: Integer;
  87.     StateIndex: Integer;
  88.     OverlayIndex: Integer;
  89.     CheckboxType: TfcTreeViewCheckboxType;
  90.     Checked: byte;
  91.     Expanded: boolean;
  92.     DummyPad: packed array[1..3] of char;  { Allow Future growth }
  93.     Data: Pointer;
  94.     StringDataSize1: integer;
  95.     StringDataSize2: integer;
  96.     Count: Integer;
  97.     Text: string[255];
  99.     { Future growth so that old executables can still run with newer tree view formats }
  100. //    Dummy1: integer;
  101. //    Dummy2: integer;
  102. //    Dummy3: integer;
  103. //    Dummy4: integer;
  104.   end;
  106.   TfcTreeNode = class(TPersistent)
  107.   private
  108.     FMultiSelected: boolean;
  109.     FCheckboxType: TfcTreeViewCheckboxType;
  110.     FChecked: boolean;
  112.     FOwner: TfcTreeNodes;
  113.     FText: string;
  114.     FStringData1, FStringData2: String;
  116.     FData: Pointer;
  117.     FItemId: HTreeItem;
  118.     FImageIndex: Integer;
  119.     FSelectedIndex: Integer;
  120.     FOverlayIndex: Integer;
  121.     FStateIndex: Integer;
  122.     FDeleting: Boolean;
  123.     FInTree: Boolean;
  124.     FGrayed: boolean;
  126.     procedure SetCheckboxType(val: TfcTreeViewCheckboxType);
  128.     function CompareCount(CompareMe: Integer): Boolean;
  129.     function DoCanExpand(Expand: Boolean): Boolean;
  130.     procedure DoExpand(Expand: Boolean);
  131.     procedure ExpandItem(Expand: Boolean; Recurse: Boolean);
  132.     function GetAbsoluteIndex: Integer;
  133.     function GetExpanded: Boolean;
  134.     function GetLevel: Integer;
  135.     function GetParent: TfcTreeNode;
  136.     function GetChildren: Boolean;
  137.     function GetCut: Boolean;
  138.     function GetDropTarget: Boolean;
  139.     function GetFocused: Boolean;
  140.     function GetIndex: Integer;
  141.     function GetItem(Index: Integer): TfcTreeNode;
  142.     function GetSelected: Boolean;
  143.     function GetState(NodeState: TfcNodeState): Boolean;
  144.     function GetCount: Integer;
  145.     function GetTreeView: TfcCustomTreeView;
  146.     procedure InternalMove(ParentNode, Node: TfcTreeNode; HItem: HTreeItem;
  147.       AddMode: TfcAddMode);
  148. //    function IsEqual(Node: TfcTreeNode): Boolean;
  149.     function IsNodeVisible: Boolean;
  150.     procedure SetChildren(Value: Boolean);
  151.     procedure SetCut(Value: Boolean);
  152.     procedure SetData(Value: Pointer);
  153.     procedure SetDropTarget(Value: Boolean);
  154.     procedure SetItem(Index: Integer; Value: TfcTreeNode);
  155.     procedure SetExpanded(Value: Boolean);
  156.     procedure SetFocused(Value: Boolean);
  157.     procedure SetImageIndex(Value: Integer);
  158.     procedure SetOverlayIndex(Value: Integer);
  159.     procedure SetSelectedIndex(Value: Integer);
  160.     procedure SetSelected(Value: Boolean);
  161.     procedure SetStateIndex(Value: Integer);
  162.     procedure SetText(const S: string);
  164.     function GetMultiSelected: Boolean;
  165.     procedure SetMultiSelected(Value: Boolean);
  167.     procedure SetChecked(val: boolean);
  168.     procedure SetGrayed(val: boolean);
  169.   protected
  170. //    function ShowBlankImage: boolean; virtual;
  171.     {$ifdef fcDelphi4Up}
  172.     ReadDataSize: integer;
  173.     {$endif}
  174.     procedure Invalidate; virtual;
  175.     Function GetSizeOfNodeInfo: integer; virtual;
  176.     procedure ReadData(Stream: TStream; Info: PfcNodeInfo); virtual;
  177.     procedure WriteData(Stream: TStream; Info: PfcNodeInfo); virtual;
  178.   public
  179.     Patch: Variant;
  180.     function GetStateIndex: integer;
  181.     Function IsRadioGroup: boolean;
  182.     function GetSortText: string; virtual;
  184.     constructor Create(AOwner: TfcTreeNodes); virtual;
  185.     destructor Destroy; override;
  186.     function AlphaSort: Boolean;
  187.     procedure Assign(Source: TPersistent); override;
  188.     procedure Collapse(Recurse: Boolean);
  189.     function CustomSort(SortProc: TTVCompare; Data: Longint): Boolean;
  190.     procedure Delete;
  191.     procedure DeleteChildren;
  192.     function DisplayRect(TextOnly: Boolean): TRect;
  193.     function EditText: Boolean;
  194.     procedure EndEdit(Cancel: Boolean);
  195.     procedure Expand(Recurse: Boolean);
  196.     function GetFirstChild: TfcTreeNode;
  197.     function GetHandle: HWND;
  198.     function GetLastChild: TfcTreeNode;
  199.     function GetNext: TfcTreeNode;
  200.     function GetNextChild(Value: TfcTreeNode): TfcTreeNode;
  201.     function GetNextSibling: TfcTreeNode;
  202.     function GetNextVisible: TfcTreeNode;
  203.     function GetPrev: TfcTreeNode;
  204.     function GetPrevChild(Value: TfcTreeNode): TfcTreeNode;
  205.     function GetPrevSibling: TfcTreeNode;
  206.     function GetPrevVisible: TfcTreeNode;
  207.     function HasAsParent(Value: TfcTreeNode): Boolean;
  208.     function IndexOf(Value: TfcTreeNode): Integer;
  209.     procedure MakeVisible;
  210.     procedure MoveTo(Destination: TfcTreeNode; Mode: TfcNodeAttachMode); virtual;
  211.     property AbsoluteIndex: Integer read GetAbsoluteIndex;
  212.     property Count: Integer read GetCount;
  213.     property Cut: Boolean read GetCut write SetCut;
  214.     property Data: Pointer read FData write SetData;
  215.     property Deleting: Boolean read FDeleting;
  216.     property Focused: Boolean read GetFocused write SetFocused;
  217.     property DropTarget: Boolean read GetDropTarget write SetDropTarget;
  218.     property Selected: Boolean read GetSelected write SetSelected;
  219.     property Expanded: Boolean read GetExpanded write SetExpanded;
  220.     property Handle: HWND read GetHandle;
  221.     property HasChildren: Boolean read GetChildren write SetChildren;
  222.     property ImageIndex: Integer read FImageIndex write SetImageIndex;
  223.     property Index: Integer read GetIndex;
  224.     property IsVisible: Boolean read IsNodeVisible;
  225.     property Item[Index: Integer]: TfcTreeNode read GetItem write SetItem; default;
  226.     property ItemId: HTreeItem read FItemId;
  227.     property Level: Integer read GetLevel;
  228.     property OverlayIndex: Integer read FOverlayIndex write SetOverlayIndex;
  229.     property Owner: TfcTreeNodes read FOwner;
  230.     property Parent: TfcTreeNode read GetParent;
  231.     property SelectedIndex: Integer read FSelectedIndex write SetSelectedIndex;
  232.     property StateIndex: Integer read FStateIndex write SetStateIndex;
  233.     property Text: string read FText write SetText;
  234.     property StringData: string read FStringData1 write FStringData1;
  235.     property StringData2: string read FStringData2 write FStringData2;
  236.     property TreeView: TfcCustomTreeView read GetTreeView;
  238.     property Checked: boolean read FChecked write SetChecked;
  239.     property Grayed: boolean read FGRayed write SetGrayed;
  240.     property CheckboxType: TfcTreeViewCheckboxType read FCheckboxType write SetCheckboxType;
  241.     property MultiSelected: Boolean read GetMultiSelected write SetMultiSelected;
  242.   end;
  244. { TfcTreeNodes }
  246.   PfcNodeCache = ^TfcNodeCache;
  247.   TfcNodeCache = record
  248.     CacheNode: TfcTreeNode;
  249.     CacheIndex: Integer;
  250.   end;
  252.   TwwStoreData = (sdStoreText, sdStoreData1, sdStoreData2);
  254.   TfcTreeNodes = class(TPersistent)
  255.   private
  256.     FOwner: TfcCustomTreeView;
  257.     FUpdateCount: Integer;
  258.     FNodeCache: TfcNodeCache;
  259.     InDestroy: boolean;
  260.     procedure AddedNode(Value: TfcTreeNode);
  261.     function GetHandle: HWND;
  262.     function GetNodeFromIndex(Index: Integer): TfcTreeNode;
  263.     procedure ReadData(Stream: TStream);
  264.     procedure Repaint(Node: TfcTreeNode);
  265.     procedure WriteData(Stream: TStream);
  266.     procedure ClearCache;
  267.     procedure ReadStreamVersion(Reader: TReader);
  268.     procedure WriteStreamVersion(Writer: TWriter);
  269.   protected
  270.     function AddItem(Parent, Target: HTreeItem; const Item: TTVItem;
  271.       AddMode: TfcAddMode): HTreeItem;
  272.     function InternalAddObject(Node: TfcTreeNode; const S: string;
  273.       Ptr: Pointer; AddMode: TfcAddMode): TfcTreeNode;
  274.     procedure DefineProperties(Filer: TFiler); override;
  275.     function CreateItem(Node: TfcTreeNode): TTVItem;
  276.     function GetCount: Integer;
  277.     procedure SetItem(Index: Integer; Value: TfcTreeNode);
  278.     procedure SetUpdateState(Updating: Boolean);
  279.   public
  280.     constructor Create(AOwner: TfcCustomTreeView);
  281.     destructor Destroy; override;
  282.     function AddChildFirst(Node: TfcTreeNode; const S: string): TfcTreeNode;
  283.     function AddChild(Node: TfcTreeNode; const S: string): TfcTreeNode;
  284.     function AddChildObjectFirst(Node: TfcTreeNode; const S: string;
  285.       Ptr: Pointer): TfcTreeNode;
  286.     function AddChildObject(Node: TfcTreeNode; const S: string;
  287.       Ptr: Pointer): TfcTreeNode;
  288.     function AddFirst(Node: TfcTreeNode; const S: string): TfcTreeNode;
  289.     function Add(Node: TfcTreeNode; const S: string): TfcTreeNode;
  290.     function AddObjectFirst(Node: TfcTreeNode; const S: string;
  291.       Ptr: Pointer): TfcTreeNode;
  292.     function AddObject(Node: TfcTreeNode; const S: string;
  293.       Ptr: Pointer): TfcTreeNode;
  294.     procedure Assign(Source: TPersistent); override;
  295.     procedure BeginUpdate;
  296.     procedure Clear;
  297.     procedure Delete(Node: TfcTreeNode);
  298.     procedure EndUpdate;
  299.     function GetFirstNode: TfcTreeNode;
  300.     function GetNode(ItemId: HTreeItem): TfcTreeNode;
  301.     function Insert(Node: TfcTreeNode; const S: string): TfcTreeNode;
  302.     function InsertObject(Node: TfcTreeNode; const S: string;
  303.       Ptr: Pointer): TfcTreeNode;
  304.     function FindNode(SearchText: string; VisibleOnly: Boolean): TfcTreeNode;
  305.     function FindNodeInfo(SearchText: string; VisibleOnly: Boolean;
  306.        StoreDataUsing: TwwStoreData = sdStoreText): TfcTreeNode;
  307.     property Count: Integer read GetCount;
  308.     property Handle: HWND read GetHandle;
  309.     property Item[Index: Integer]: TfcTreeNode read GetNodeFromIndex; default;
  310.     property Owner: TfcCustomTreeView read FOwner;
  311.   end;
  313. { TfcCustomTreeView }
  315.   TfcTVMultiSelectAttributes = class(TPersistent)
  316.   private
  317.      FEnabled: Boolean;
  318.      FAutoUnselect: boolean;
  319. //     FAlwaysIncludeSelectedItem: Boolean;
  320.      FMultiSelectLevel: integer;
  321.      FMultiSelectCheckbox: boolean;
  322.      TreeView: TfcCustomTreeView;
  323.      procedure SetEnabled(val: boolean);
  324.      procedure SetMultiSelectLevel(val: integer);
  325.      procedure SetMultiSelectCheckBox(val: boolean);
  327.   public
  328.      constructor Create(Owner: TComponent);
  329.      procedure Assign(Source: TPersistent); override;
  331.   published
  332.      property AutoUnselect : boolean read FAutoUnselect write FAutoUnselect default True;
  333. //     property AlwaysIncludeSelectedItem: Boolean read FAlwaysIncludeSelectedItem write FAlwaysIncludeSelectedItem default False;
  334.      property Enabled: boolean read FEnabled write SetEnabled default False;
  335.      property MultiSelectLevel: integer read FMultiSelectLevel write SetMultiSelectLevel default 0;
  336.      property MultiSelectCheckbox: boolean read FMultiSelectCheckbox write SetMultiSelectCheckbox default True;
  337.   end;
  339.   TfcHitTest = (fchtAbove, fchtBelow, fchtNowhere, fchtOnItem, fchtOnButton, fchtOnIcon,
  340.     fchtOnIndent, fchtOnLabel, fchtOnRight, fchtOnStateIcon, fchtToLeft, fchtToRight);
  341.   TfcHitTests = set of TfcHitTest;
  342.   TfcSortType = (fcstNone, fcstData, fcstText, fcstBoth);
  343.   EfcTreeViewError = class(Exception);
  345.   TfcTVChangingEvent = procedure(TreeView: TfcCustomTreeView; Node: TfcTreeNode;
  346.     var AllowChange: Boolean) of object;
  347.   TfcTVChangedEvent = procedure(TreeView: TfcCustomTreeView; Node: TfcTreeNode) of object;
  348.   TfcTVEditingEvent = procedure(TreeView: TfcCustomTreeView; Node: TfcTreeNode;
  349.     var AllowEdit: Boolean) of object;
  350.   TfcTVEditedEvent = procedure(TreeView: TfcCustomTreeView; Node: TfcTreeNode; var S: string) of object;
  351.   TfcTVExpandingEvent = procedure(TreeView: TfcCustomTreeView; Node: TfcTreeNode;
  352.     var AllowExpansion: Boolean) of object;
  353.   TfcTVCollapsingEvent = procedure(TreeView: TfcCustomTreeView; Node: TfcTreeNode;
  354.     var AllowCollapse: Boolean) of object;
  355.   TfcTVExpandedEvent = procedure(TreeView: TfcCustomTreeView; Node: TfcTreeNode) of object;
  356.   TfcTVCompareEvent = procedure(TreeView: TfcCustomTreeView; Node1, Node2: TfcTreeNode;
  357.     Data: Integer; var Compare: Integer) of object;
  358.   TfcTVCustomDrawEvent = procedure(TreeView: TfcCustomTreeView; const ARect: TRect;
  359.     var DefaultDraw: Boolean) of object;
  360.   TfcCalcNodeAttributesEvent = procedure(TreeView: TfcCustomTreeView;
  361.           Node: TfcTreeNode; State: TfcItemStates) of object;
  363.   TfcItemChangeAction = (icaAdd, icaDelete, icaText, icaImageIndex);
  364.   TfcItemChangeEvent = procedure(TreeView: TfcCustomTreeView; Node: TfcTreeNode;
  365.     Action: TfcItemChangeAction; NewValue: Variant) of object;
  366.   TfcToggleCheckboxEvent = procedure(TreeView: TfcCustomTreeView; Node: TfcTreeNode) of object;
  368.   TfcTreeNodeClass = class of TfcTreeNode;
  370.   TfcCustomTreeView = class(TWinControl)
  371.   private
  372.     FOnItemChange: TfcItemChangeEvent;
  373. //    FOnItemChanging: TfcItemChangeEvent;
  374.     FAutoExpand: Boolean;
  375.     FBorderStyle: TBorderStyle;
  376.     FCanvas: TfcCanvas;
  377.     FPaintCanvas: TfcCanvas;
  378.     FCanvasChanged: Boolean;
  379.     FDefEditProc: Pointer;
  380.     FDragged: Boolean;
  381.     FDragImage: {$ifdef fcDelphi4Up}TDragImageList{$else}TCustomImageList{$endif};
  382.     FDragNode: TfcTreeNode;
  383.     FEditHandle: HWND;
  384.     FEditInstance: Pointer;
  385.     FImageChangeLink: TChangeLink;
  386.     FImages: TCustomImageList;
  387.     FLastDropTarget: TfcTreeNode;
  388.     FManualNotify: Boolean;
  389.     FMemStream: TMemoryStream;
  390.     FRClickNode: TfcTreeNode;
  391.     FRightClickSelects: Boolean;
  392.     FReadOnly: Boolean;
  393.     FSaveIndex: Integer;
  394.     FSaveIndent: Integer;
  395.     FSaveItems: TStringList;
  396.     FSaveTopIndex: Integer;
  397.     FSortType: TfcSortType;
  398.     FStateChanging: Boolean;
  399.     FStateImages: TCustomImageList;
  400.     FStateChangeLink: TChangeLink;
  401.     FStreamExpandedNode: Boolean;
  402. //    FToolTips: Boolean;
  403.     FTreeNodes: TfcTreeNodes;
  404.     FWideText: WideString;
  405.     FOnEditing: TfcTVEditingEvent;
  406.     FOnEdited: TfcTVEditedEvent;
  407.     FOnExpanded: TfcTVExpandedEvent;
  408.     FOnExpanding: TfcTVExpandingEvent;
  409.     FOnCollapsed: TfcTVExpandedEvent;
  410.     FOnCollapsing: TfcTVCollapsingEvent;
  411.     FOnChanging: TfcTVChangingEvent;
  412.     FOnChange: TfcTVChangedEvent;
  413.     FOnCompare: TfcTVCompareEvent;
  414.     FOnDeletion: TfcTVExpandedEvent;
  415.     FOnGetImageIndex: TfcTVExpandedEvent;
  416.     FOnGetSelectedIndex: TfcTVExpandedEvent;
  417.     FLineColor: TColor;
  418.     FInactiveFocusColor: TColor;
  419.     FOnMouseDown, FOnMouseUp, FOnDblClick: TfcTreeMouseEvent;
  420.     FOnMouseMove: TfcTreeMouseMoveEvent;
  421.     FOnToggleCheckbox: TfcToggleCheckboxEvent;
  423.     FNodeClass: TfcTreeNodeClass;
  424.     FMultiSelectAttributes: TfcTVMultiSelectAttributes;
  425.     FOnCalcNodeAttributes: TfcCalcNodeAttributesEvent;
  426.     FBorderWidth: Integer;
  427.     FOnDrawText: TfcTVDrawTextEvent;
  428. //    FFixBugImageList: TImageList;
  429.     FOptions: TfcTreeViewOptions;
  430.     FDisableThemes: boolean;
  432.     FPaintBitmap: TBitmap;
  433.     FIndent: Integer;
  434.     LastSelectedNode: TfcTreeNode;
  435.     MouseNode: TfcTreeNode;
  436.     LastMouseMoveNode: TfcTreeNode;  // For themes with checkboxes and radiobuttons invalidation
  437.     LastMouseHitTest: TfcHitTests;
  438.     ClickedNode: TfcTreeNode;
  439.     Down: boolean;
  440.     EditNode, BeforeMouseDownNode: TfcTreeNode;
  441.     FStreamVersion: integer;
  442.     FUsePaintBuffering: boolean;
  443. //    FEditControl: TWinControl;
  445.     procedure CanvasChanged(Sender: TObject);
  446.     procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
  447.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  448.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  449.     procedure CMDrag(var Message: TCMDrag); message CM_DRAG;
  450.     procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
  451.     procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  452.     procedure EditWndProc(var Message: TMessage);
  453.     procedure DoDragOver(Source: TDragObject; X, Y: Integer; CanDrop: Boolean);
  454.     function GetChangeDelay: Integer;
  455.     function GetDropTarget: TfcTreeNode;
  456.     function GetIndent: Integer;
  457.     function GetNodeFromItem(const Item: TTVItem): TfcTreeNode;
  458.     function GetSelection: TfcTreeNode;
  459.     function GetTopItem: TfcTreeNode;
  460.     procedure ImageListChange(Sender: TObject);
  461.     procedure SetAutoExpand(Value: Boolean);
  462.     procedure SetBorderStyle(Value: TBorderStyle);
  463.     procedure SetChangeDelay(Value: Integer);
  464.     procedure SetDropTarget(Value: TfcTreeNode);
  465.     procedure SetImageList(Value: HImageList; Flags: Integer);
  466.     procedure SetIndent(Value: Integer);
  467.     procedure SetImages(Value: TCustomImageList);
  468.     procedure SetReadOnly(Value: Boolean);
  469.     procedure SetSelection(Value: TfcTreeNode);
  470.     procedure SetSortType(Value: TfcSortType);
  471.     procedure SetStateImages(Value: TCustomImageList);
  472. //    procedure SetToolTips(Value: Boolean);
  473.     procedure SeTfcTreeNodes(Value: TfcTreeNodes);
  474.     procedure SetTopItem(Value: TfcTreeNode);
  475.     procedure OnChangeTimer(Sender: TObject);
  476.     procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  477.     procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
  478.     procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
  479.     procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
  480.     procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
  481.     procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
  482.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  483.     procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBkgnd;
  484.     procedure CMExit(var Message: TMessage); message CM_EXIT;
  485.     procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST;
  487.     procedure WMDestroy(var Message: TWMDestroy); message WM_DESTROY;
  488.     function ValidMultiSelectLevel(ALevel: Integer): Boolean;
  489.     Function CheckboxNeeded(Node: TfcTreeNode): boolean;
  490.     Function GetCenterPoint(ARect: TRect): TPoint;
  491.     procedure SetOptions(Value: TfcTreeViewOptions);
  492.     procedure SetLineColor(Value: TColor);
  493.     procedure SetInactiveFocusColor(Value: TColor);
  494.     function GetItemHeight: ShortInt;
  495.     procedure SetItemHeight(Value: ShortInt);
  496.     function GetScrollTime: Integer;
  497.     procedure SetScrollTime(Value: Integer);
  498.     function GetMultiSelectListCount: integer;
  499.     function GetMultiSelectItem(Index: integer): TfcTreeNode;
  500.     procedure HintTimerEvent(Sender: TObject);
  501.     function GetPaintCanvas: TfcCanvas;
  502.   protected
  503.     FMultiSelectList: TList;
  504.     SkipErase: boolean;
  505.     SkipChangeMessages: boolean;  { Notify method skips processing of change notifications }
  506.     InLoading: boolean; { During expansion of Reference tree,
  507.                           do not recursively expand item's children.
  508.                           Calling MoveTo expands parent so we prevent this}
  510.     FChangeTimer: TTimer;
  511.     DisplayedItems: integer;
  512.     FMouseInControl : boolean;
  514.     { Implement hint handling }
  515.     HintWindow: THintWindow;
  516.     HintTimer: TTimer;
  517.     HintTimerCount: integer;
  518.     LastHintNode: TfcTreeNode;
  520.     function CanEdit(Node: TfcTreeNode): Boolean; dynamic;
  521.     function CanChange(Node: TfcTreeNode): Boolean; dynamic;
  522.     function CanCollapse(Node: TfcTreeNode): Boolean; dynamic;
  523.     function CanExpand(Node: TfcTreeNode): Boolean; dynamic;
  524.     procedure Change(Node: TfcTreeNode); dynamic;
  525.     procedure Collapse(Node: TfcTreeNode); dynamic;
  526.     function CreateNode: TfcTreeNode; virtual;
  527.     procedure CreateParams(var Params: TCreateParams); override;
  528.     procedure CreateWnd; override;
  529.     procedure Delete(Node: TfcTreeNode); dynamic;
  530.     procedure DestroyWnd; override;
  531.     procedure DoEndDrag(Target: TObject; X, Y: Integer); override;
  532.     procedure DoStartDrag(var DragObject: TDragObject); override;
  533.     procedure Edit(const Item: TTVItem); dynamic;
  534.     procedure Expand(Node: TfcTreeNode); dynamic;
  535.     function GetDragImages: {$ifdef fcDelphi4Up}TDragImageList{$else}TCustomImageList{$endif}; override;
  536.     procedure GetImageIndex(Node: TfcTreeNode); virtual;
  537.     procedure GetSelectedIndex(Node: TfcTreeNode); virtual;
  538.     procedure Loaded; override;
  539.     procedure KeyPress(var Key: Char); override;
  540.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  541.     procedure Notification(AComponent: TComponent;
  542.       Operation: TOperation); override;
  543.     procedure SetDragMode(Value: TDragMode); override;
  544.     procedure WndProc(var Message: TMessage); override;
  545.     property AutoExpand: Boolean read FAutoExpand write SetAutoExpand default False;
  546.     property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
  547.     property ChangeDelay: Integer read GetChangeDelay write SetChangeDelay default 0;
  548.     property Images: TCustomImageList read FImages write SetImages;
  549.     property Indent: Integer read GetIndent write SetIndent;
  550.     property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
  551.     property RightClickSelects: Boolean read FRightClickSelects write FRightClickSelects default False;
  552.     property SortType: TfcSortType read FSortType write SetSortType default fcstNone;
  553.     property StateImages: TCustomImageList read FStateImages write SetStateImages;
  554.     property StreamExpandedNode: Boolean read FStreamExpandedNode write FStreamExpandedNode default False;
  555. //    property ToolTips: Boolean read FToolTips write SetToolTips default False;
  556.     property OnEditing: TfcTVEditingEvent read FOnEditing write FOnEditing;
  557.     property OnEdited: TfcTVEditedEvent read FOnEdited write FOnEdited;
  558.     property OnExpanding: TfcTVExpandingEvent read FOnExpanding write FOnExpanding;
  559.     property OnExpanded: TfcTVExpandedEvent read FOnExpanded write FOnExpanded;
  560.     property OnCollapsing: TfcTVCollapsingEvent read FOnCollapsing write FOnCollapsing;
  561.     property OnCollapsed: TfcTVExpandedEvent read FOnCollapsed write FOnCollapsed;
  562.     property OnChanging: TfcTVChangingEvent read FOnChanging write FOnChanging;
  563.     property OnChange: TfcTVChangedEvent read FOnChange write FOnChange;
  564.     property OnCompare: TfcTVCompareEvent read FOnCompare write FOnCompare;
  565.     property OnDeletion: TfcTVExpandedEvent read FOnDeletion write FOnDeletion;
  566.     property OnGetImageIndex: TfcTVExpandedEvent read FOnGetImageIndex write FOnGetImageIndex;
  567.     property OnGetSelectedIndex: TfcTVExpandedEvent read FOnGetSelectedIndex write FOnGetSelectedIndex;
  569.     procedure MultiSelectNode(Node: TfcTreeNode; Select: boolean; redraw: boolean); virtual;
  570.     function IsVisible(Node: TfcTreeNode; PartialOK: Boolean): Boolean; virtual;
  571.     function ItemRect(Node: TfcTreeNode; LabelOnly: Boolean): TRect;
  572.     procedure PaintButton(Node: TfcTreeNode; pt: TPoint; size: integer);
  573.     procedure PaintLines(Node: TfcTreeNode);
  574.     procedure PaintImage(Node: TfcTreeNode; State: TfcItemStates);
  575.     function LevelRect(ANode: TfcTreeNode): TRect;
  576.     procedure DoDrawText(TreeView: TfcCustomTreeView;
  577.          Node: TfcTreeNode; ARect: TRect; AItemState: TfcItemStates;
  578.          var DefaultDrawing: boolean); virtual;
  579.     procedure Compare(Node1, Node2: TfcTreeNode; lParam: integer; var Result: integer); virtual;
  580.     procedure CalcNodeAttributes(Node: TfcTreeNode; AItemState: TfcItemStates); virtual;
  581.     function GetDisplayText(Node: TfcTreeNode): string; virtual;
  582.     procedure LoadCanvasDefaults(Node: TfcTreeNode; AItemState: TfcItemStates);
  583.     function ProcessKeyPress(Key: char; shift: TShiftState): boolean; virtual;
  584.     function IsRowSelect: boolean; virtual;
  585.     procedure MouseLoop(X, Y: Integer); virtual;
  586.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  587.                  X, Y: Integer); override;
  588.     function UseImages(Node: TfcTreeNode): Boolean;
  589.     function UseStateImages(Node: TfcTreeNode): Boolean;
  590.     procedure BeginPainting; virtual;
  591.     procedure EndPainting; virtual;
  592.     procedure BeginItemPainting(Node: TfcTreeNode; ARect: TRect; AItemState: TfcItemStates); virtual;
  593.     procedure EndItemPainting(Node: TfcTreeNode; ARect: TRect; AItemState: TfcItemStates); virtual;
  594.     procedure PaintItem(Node: TfcTreeNode); virtual;
  595.     procedure ClearStateImageIndexes;
  596.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  597.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  598.       X, Y: Integer); override;
  599.     procedure DoToggleCheckbox(Node: TfcTreeNode); virtual;
  600.     procedure FreeHintWindow; virtual;
  601.     Function CreateHintWindow(Node: TfcTreeNode): THintWindow; virtual;
  602.     Procedure UnselectAllNodes(IgnoreNode: TfcTreeNode);
  603.     procedure InvalidateNoErase;
  605.     property ItemHeight: ShortInt read GetItemHeight write SetItemHeight;
  606.     property OnCalcNodeAttributes: TfcCalcNodeAttributesEvent read FOnCalcNodeAttributes write FOnCalcNodeAttributes;
  607.     property ScrollTime: Integer read GetScrollTime write SetScrollTime;
  608.     property NodeClass: TfcTreeNodeClass read FNodeClass write FNodeClass;
  609.   public
  610.     Patch: Variant;
  612.     procedure ResetStateImages;
  613.     property StreamVersion: integer read FStreamVersion;
  614.     Function GetFirstSibling(Node: TfcTreeNode): TfcTreeNode;
  615.     Procedure InvalidateNode(Node: TfcTreeNode);
  616.     Function MultiSelectCheckboxNeeded(Node: TfcTreeNode): boolean;
  617.     Procedure UnselectAll;
  619.     constructor Create(AOwner: TComponent); override;
  620.     destructor Destroy; override;
  621.     function AlphaSort: Boolean;
  622.     function CustomSort(SortProc: TTVCompare; Data: Longint): Boolean;
  623.     procedure FullCollapse;
  624.     procedure FullExpand;
  625.     function GetHitTestInfoAt(X, Y: Integer): TfcHitTests;
  626.     function GetNodeAt(X, Y: Integer): TfcTreeNode;
  627.     function IsEditing: Boolean;
  628.     procedure LoadFromFile(const FileName: string);
  629.     procedure LoadFromStream(Stream: TStream);
  630.     procedure SaveToFile(const FileName: string);
  631.     procedure SaveToStream(Stream: TStream);
  632.     property Canvas: TfcCanvas read GetPaintCanvas;
  633.     property DropTarget: TfcTreeNode read GetDropTarget write SetDropTarget;
  634.     property Selected: TfcTreeNode read GetSelection write SetSelection;
  635.     property TopItem: TfcTreeNode read GetTopItem write SetTopItem;
  637.     property RightClickNode: TfcTreeNode read FRClickNode;
  638.     property Options: TfcTreeViewOptions read FOptions write SetOptions default
  639.         [tvoExpandOnDblClk, tvoShowButtons, tvoShowRoot, tvoShowLines, tvoHideSelection, tvoToolTips];
  640.     property Items: TfcTreeNodes read FTreeNodes write SeTfcTreeNodes;
  641.     property MultiSelectAttributes: TfcTVMultiSelectAttributes
  642.         read FMultiSelectAttributes write FMultiSelectAttributes;
  643.     property OnDrawText: TfcTVDrawTextEvent read FOnDrawText write FOnDrawText;
  644.     property OnItemChange: TfcItemChangeEvent read FOnItemChange write FOnItemChange;
  646.     property MultiSelectList[Index: Integer]: TfcTreeNode read GetMultiSelectItem;
  647.     property MultiSelectListCount : integer read GetMultiSelectListCount;
  648.     property LineColor: TColor read FLineColor write SetLineColor default clBtnShadow;
  649.     property InactiveFocusColor: TColor read FInactiveFocusColor write SetInactiveFocusColor default clBtnFace;
  650.     property OnMouseMove: TfcTreeMouseMoveEvent read FOnMouseMove write FOnMouseMove;
  651.     property OnMouseDown: TfcTreeMouseEvent read FOnMouseDown write FOnMouseDown;
  652.     property OnMouseUp: TfcTreeMouseEvent read FOnMouseUp write FOnMouseUp;
  653.     property OnDblClick: TfcTreeMouseEvent read FOnDblClick write FOnDblClick;
  654.     property OnToggleCheckbox: TfcToggleCheckboxEvent read FOnToggleCheckbox write FOnToggleCheckbox;
  655.     property UsePaintBuffering: boolean read FUsePaintBuffering write FUsePaintBuffering default False;
  656.     property DisableThemes : boolean read FDisableThemes write FDisableThemes default False;
  658.   end;
  660.   TfcTreeView = class(TfcCustomTreeView)
  661.   published
  662.     property DisableThemes;
  663.     property Align;
  664.     {$ifdef fcDelphi4Up}
  665.     property Anchors;
  666.     {$endif}
  667.     property AutoExpand;
  668.     {$ifdef fcDelphi4Up}
  669.     property BiDiMode;
  670.     {$endif}
  671.     property BorderStyle;
  672. //    property BorderWidth;
  673.     property ChangeDelay;
  674.     property Color;
  675.     property LineColor;
  676.     property InactiveFocusColor;
  677.     property Ctl3D;
  678.     {$ifdef fcDelphi4Up}
  679.     property Constraints;
  680.     property DragKind;
  681.     {$endIf}
  682.     property DragCursor;
  683.     property DragMode;
  684.     property Enabled;
  685.     property Font;
  686.     property Images;
  687.     property Indent;
  688.     property MultiSelectAttributes;
  689.     property Options;
  690.     property Items;
  691.     {$ifdef fcDelphi4Up}
  692.     property ParentBiDiMode;
  693.     {$endif}
  694.     property ParentColor default False;
  695.     property ParentCtl3D;
  696.     property ParentFont;
  697.     property ParentShowHint;
  698.     property UsePaintBuffering;
  699.     property PopupMenu;
  700.     property ReadOnly;
  701.     property RightClickSelects;
  702.     {$ifdef fcDelphi4Up}
  703.     property ShowHint;
  704.     {$endif}
  705.     property SortType;
  706.     property StateImages;
  707.     property StreamExpandedNode;
  708.     property TabOrder;
  709.     property TabStop default True;
  710. //    property ToolTips;
  711.     property Visible;
  712.     property OnChange;
  713.     property OnChanging;
  714.     property OnClick;
  715.     property OnCollapsing;
  716.     property OnCollapsed;
  717.     property OnCompare;
  718.     property OnDblClick;
  719.     property OnDeletion;
  720.     property OnDragDrop;
  721.     property OnDragOver;
  722.     property OnEdited;
  723.     property OnEditing;
  724.     {$ifdef fcDelphi4Up}
  725.     property OnEndDock;
  726.     {$endif}
  727.     property OnEndDrag;
  728.     property OnEnter;
  729.     property OnExit;
  730.     property OnExpanding;
  731.     property OnExpanded;
  732.     property OnGetImageIndex;
  733.     property OnGetSelectedIndex;
  734.     property OnKeyDown;
  735.     property OnKeyPress;
  736.     property OnKeyUp;
  737.     property OnMouseDown;
  738.     property OnMouseMove;
  739.     property OnMouseUp;
  740.     property OnToggleCheckbox;
  741.     {$ifdef fcDelphi4Up}
  742.     property OnStartDock;
  743.     {$endif}
  744.     property OnStartDrag;
  746.     property OnCalcNodeAttributes;
  747.     property OnDrawText;
  749.   end;
  751.   procedure fcTreeViewError(const Msg: string);
  753. implementation
  754. { TfcTreeNode }
  756. {$ifdef fcDelphi6Up}
  757. uses RTLConsts;
  758. {$endif}
  760. const MaxCheckboxSize = 6;
  761.       FixBugImageListSize = 16;
  763. var FFixBugImageList: TImageList;
  764.     RefCount: integer;
  766. procedure SetComCtlStyle(Ctl: TWinControl; Value: Integer; UseStyle: Boolean);
  767. var
  768.   Style: Integer;
  769. begin
  770.   if Ctl.HandleAllocated then
  771.   begin
  772.     Style := GetWindowLong(Ctl.Handle, GWL_STYLE);
  773.     if not UseStyle then Style := Style and not Value
  774.     else Style := Style or Value;
  775.     SetWindowLong(Ctl.Handle, GWL_STYLE, Style);
  776.   end;
  777. end;
  779. function DefaultTreeViewSort(Node1, Node2: TfcTreeNode; lParam: Integer): Integer; stdcall;
  780. begin
  781. //    Result := lstrcmp(PChar(Node1.Text), PChar(Node2.Text));
  782.    Node1.TreeView.Compare(Node1, Node2, lParam, Result);
  783. end;
  785. {
  786. function DefaultTreeViewSort(Node1, Node2: TfcTreeNode; lParam: Integer): Integer; stdcall;
  787. begin
  788.   with Node1 do
  789.     if Assigned(TreeView.OnCompare) then
  790.       TreeView.OnCompare(TreeView, Node1, Node2, lParam, Result)
  791.     else Result := lstrcmp(PChar(Node1.Text), PChar(Node2.Text));
  792. end;
  793. }
  795. procedure TreeViewError(const Msg: string);
  796. begin
  797.   raise ETreeViewError.Create(Msg);
  798. end;
  800. {procedure TreeViewErrorFmt(const Msg: string; Format: array of const);
  801. begin
  802.   raise ETreeViewError.CreateFmt(Msg, Format);
  803. end;
  804. }
  805. constructor TfcTreeNode.Create(AOwner: TfcTreeNodes);
  806. begin
  807.   inherited Create;
  808.   FOverlayIndex := -1;
  809.   FStateIndex := -1;
  810.   FOwner := AOwner;
  811. end;
  813. destructor TfcTreeNode.Destroy;
  814. var
  815.   Node: TfcTreeNode;
  816.   CheckValue: Integer;
  817.   i: integer;
  818.   MultiSelectList: TList;
  819. begin
  820.    Owner.ClearCache;
  821.    FDeleting := True;
  823.    // 6/30/03 - Clear LastMouseMoveNode
  824.    if fcUseThemes(TreeView) then
  825.    begin
  826.       if TfcCustomTreeView(TreeView).LastMouseMoveNode = Self then
  827.          TfcCustomTreeView(TreeView).LastMouseMoveNode:= nil;
  828.    end;
  830.    if FMultiSelected then begin
  831.       if TfcCustomTreeView(TreeView).LastSelectedNode= self then
  832.          TfcCustomTreeView(TreeView).LastSelectedNode:= nil;
  834.       MultiSelectList:= (TreeView as TfcCustomTreeView).FMultiSelectList;
  835.       for i:= 0 to MultiSelectList.count-1 do begin  { Bad code }
  836.          if self=TfcTreeNode(MultiSelectList[i]) then
  837.          begin
  838.             MultiSelectList.delete(i);
  839.             break;
  840.          end
  841.       end
  842.    end;
  844.    if Owner.Owner.FLastDropTarget = Self then
  845.       Owner.Owner.FLastDropTarget := nil;
  846.    Node := Parent;
  847.    if (Node <> nil) and (not Node.Deleting) then
  848.    begin
  849.       if Node.IndexOf(Self) <> -1 then CheckValue := 1
  850.       else CheckValue := 0;
  851.       if Node.CompareCount(CheckValue) then
  852.       begin
  853.          Expanded := False;
  854.          Node.HasChildren := False;
  855.       end;
  856.    end;
  857.    if ItemId <> nil then TreeView_DeleteItem(Handle, ItemId);
  858.    Data := nil;
  859.    inherited Destroy;
  860. end;
  862. function TfcTreeNode.GetHandle: HWND;
  863. begin
  864.   Result := TreeView.Handle;
  865. end;
  867. function TfcTreeNode.GetTreeView: TfcCustomTreeView;
  868. begin
  869.   Result := Owner.Owner;
  870. end;
  872. function TfcTreeNode.HasAsParent(Value: TfcTreeNode): Boolean;
  873. begin
  874.   if Value <> Nil then
  875.   begin
  876.     if Parent = nil then Result := False
  877.     else if Parent = Value then Result := True
  878.     else Result := Parent.HasAsParent(Value);
  879.   end
  880.   else Result := True;
  881. end;
  883. procedure TfcTreeNode.SetText(const S: string);
  884. var
  885.   Item: TTVItem;
  886.   AVariant: Variant;
  887. begin
  888.   if s = '' then AVariant := NULL else AVariant := s;
  889.   if Assigned(TreeView.OnItemChange) then TreeView.OnItemChange(TreeView, self, icaText, AVariant);
  890.   FText := S;
  891.   with Item do
  892.   begin
  893.     mask := TVIF_TEXT;
  894.     hItem := ItemId;
  895.     pszText := LPSTR_TEXTCALLBACK;
  896.   end;
  897.   TreeView_SetItem(Handle, Item);
  898.   if (TreeView.SortType in [fcstText, fcstBoth]) and FInTree then
  899.   begin
  900.     if (Parent <> nil) then Parent.AlphaSort
  901.     else TreeView.AlphaSort;
  902.   end;
  903. end;
  905. procedure TfcTreeNode.SetData(Value: Pointer);
  906. begin
  907.   FData := Value;
  908.   if (TreeView.SortType in [fcstData, fcstBoth]) and Assigned(TreeView.OnCompare)
  909.     and (not Deleting) and FInTree then
  910.   begin
  911.     if Parent <> nil then Parent.AlphaSort
  912.     else TreeView.AlphaSort;
  913.   end;
  914. end;
  916. function TfcTreeNode.GetState(NodeState: TfcNodeState): Boolean;
  917. var
  918.   Item: TTVItem;
  919. begin
  920.   Result := False;
  921.   with Item do
  922.   begin
  923.     mask := TVIF_STATE;
  924.     hItem := ItemId;
  925.     if TreeView_GetItem(Handle, Item) then
  926.       case NodeState of
  927.         fcnsCut: Result := (state and TVIS_CUT) <> 0;
  928.         fcnsFocused: Result := (state and TVIS_FOCUSED) <> 0;
  929.         fcnsSelected: Result := (state and TVIS_SELECTED) <> 0;
  930.         fcnsExpanded: Result := (state and TVIS_EXPANDED) <> 0;
  931.         fcnsDropHilited: Result := (state and TVIS_DROPHILITED) <> 0;
  932.       end;
  933.   end;
  934. end;
  936. procedure TfcTreeNode.SetImageIndex(Value: Integer);
  937. var
  938.   Item: TTVItem;
  939. begin
  940.   if Assigned(TreeView.OnItemChange) then TreeView.OnItemChange(TreeView, self, icaImageIndex, Value);
  941.   FImageIndex := Value;
  942.   with Item do
  943.   begin
  944.     mask := TVIF_IMAGE or TVIF_HANDLE;
  945.     hItem := ItemId;
  946.     iImage := I_IMAGECALLBACK;
  947.   end;
  948.   TreeView_SetItem(Handle, Item);
  949. end;
  951. procedure TfcTreeNode.SetSelectedIndex(Value: Integer);
  952. var
  953.   Item: TTVItem;
  954. begin
  955.   FSelectedIndex := Value;
  956.   with Item do
  957.   begin
  958.     mask := TVIF_SELECTEDIMAGE or TVIF_HANDLE;
  959.     hItem := ItemId;
  960.     iSelectedImage := I_IMAGECALLBACK;
  961.   end;
  962.   TreeView_SetItem(Handle, Item);
  963. end;
  965. procedure TfcTreeNode.SetOverlayIndex(Value: Integer);
  966. var
  967.   Item: TTVItem;
  968. begin
  969.   FOverlayIndex := Value;
  970.   with Item do
  971.   begin
  972.     mask := TVIF_STATE or TVIF_HANDLE;
  973.     stateMask := TVIS_OVERLAYMASK;
  974.     hItem := ItemId;
  975.     state := IndexToOverlayMask(OverlayIndex + 1);
  976.   end;
  977.   TreeView_SetItem(Handle, Item);
  978. end;
  980. procedure TfcTreeNode.SetStateIndex(Value: Integer);
  981. var
  982.   Item: TTVItem;
  983. begin
  984.   if Value=0 then Value:= -1;  // 11/21/98 - (RSW) Don't allow 0 as state index
  985.   if (CheckboxType = tvctCheckbox) and (Value<>-1) and (Value<>1) then exit; { 3/8/99}
  987.   FStateIndex := Value;
  988.   if Value >= 0 then Dec(Value);
  989.   with Item do
  990.   begin
  991.     mask := TVIF_STATE or TVIF_HANDLE;
  992.     stateMask := TVIS_STATEIMAGEMASK;
  993.     hItem := ItemId;
  994.     state := IndexToStateImageMask(Value + 1);
  995.   end;
  996.   TreeView_SetItem(Handle, Item);
  997. end;
  999. function TfcTreeNode.CompareCount(CompareMe: Integer): Boolean;
  1000. var
  1001.   Count: integer;
  1002.   Node: TfcTreeNode;
  1003. Begin
  1004.   Count := 0;
  1005.   Result := False;
  1006.   Node := GetFirstChild;
  1007.   while Node <> nil do
  1008.   begin
  1009.     Inc(Count);
  1010.     Node := Node.GetNextChild(Node);
  1011.     if Count > CompareMe then Exit;
  1012.   end;
  1013.   if Count = CompareMe then Result := True;
  1014. end;
  1016. function TfcTreeNode.DoCanExpand(Expand: Boolean): Boolean;
  1017. begin
  1018.   Result := False;
  1019.   if HasChildren then
  1020.   begin
  1021.     if Expand then Result := TreeView.CanExpand(Self)
  1022.     else Result := TreeView.CanCollapse(Self);
  1023.   end;
  1024. end;
  1026. procedure TfcTreeNode.DoExpand(Expand: Boolean);
  1027. begin
  1028.   if HasChildren then
  1029.   begin
  1030.     if Expand then TreeView.Expand(Self)
  1031.     else TreeView.Collapse(Self);
  1032.   end;
  1033. end;
  1035. procedure TfcTreeNode.ExpandItem(Expand: Boolean; Recurse: Boolean);
  1036. var
  1037.   Flag: Integer;
  1038.   Node: TfcTreeNode;
  1039. begin
  1040.   if Recurse then
  1041.   begin
  1042.     Node := Self;
  1043.     repeat
  1044.       Node.ExpandItem(Expand, False);
  1045.       Node := Node.GetNext;
  1046.     until (Node = nil) or (not Node.HasAsParent(Self));
  1047.   end
  1048.   else begin
  1049.     TreeView.FManualNotify := True;
  1050.     try
  1051.       Flag := 0;
  1052.       if Expand then
  1053.       begin
  1054.         if DoCanExpand(True) then
  1055.         begin
  1056.           Flag := TVE_EXPAND;
  1057.           DoExpand(True);
  1058.         end;
  1059.       end
  1060.       else begin
  1061.         if DoCanExpand(False) then
  1062.         begin
  1063.           Flag := TVE_COLLAPSE;
  1064.           DoExpand(False);
  1065.         end;
  1066.       end;
  1067.       if Flag <> 0 then TreeView_Expand(Handle, ItemId, Flag);
  1068.     finally
  1069.       TreeView.FManualNotify := False;
  1070.     end;
  1071.   end;
  1072. end;
  1074. procedure TfcTreeNode.Expand(Recurse: Boolean);
  1075. begin
  1076.   ExpandItem(True, Recurse);
  1077. end;
  1079. procedure TfcTreeNode.Collapse(Recurse: Boolean);
  1080. begin
  1081.   ExpandItem(False, Recurse);
  1082. end;
  1084. function TfcTreeNode.GetExpanded: Boolean;
  1085. begin
  1086.   Result := GetState(fcnsExpanded);
  1087. end;
  1089. procedure TfcTreeNode.SetExpanded(Value: Boolean);
  1090. begin
  1091.   if Value then Expand(False)
  1092.   else Collapse(False);
  1093. end;
  1095. function TfcTreeNode.GetSelected: Boolean;
  1096. begin
  1097.   Result := GetState(fcnsSelected);
  1098. end;
  1100. procedure TfcTreeNode.SetSelected(Value: Boolean);
  1101. begin
  1102.   if Value then TreeView_SelectItem(Handle, ItemId)
  1103.   else if Selected then TreeView_SelectItem(Handle, nil);
  1104. end;
  1106. function TfcTreeNode.GetCut: Boolean;
  1107. begin
  1108.   Result := GetState(fcnsCut);
  1109. end;
  1111. procedure TfcTreeNode.SetCut(Value: Boolean);
  1112. var
  1113.   Item: TTVItem;
  1114.   Template: DWORD;
  1115. begin
  1116.   if Value then Template := DWORD(-1)
  1117.   else Template := 0;
  1118.   with Item do
  1119.   begin
  1120.     mask := TVIF_STATE;
  1121.     hItem := ItemId;
  1122.     stateMask := TVIS_CUT;
  1123.     state := stateMask and Template;
  1124.   end;
  1125.   TreeView_SetItem(Handle, Item);
  1126. end;
  1128. function TfcTreeNode.GetDropTarget: Boolean;
  1129. begin
  1130.   Result := GetState(fcnsDropHilited);
  1131. end;
  1133. procedure TfcTreeNode.SetDropTarget(Value: Boolean);
  1134. begin
  1135.   if Value then TreeView_SelectDropTarget(Handle, ItemId)
  1136.   else if DropTarget then TreeView_SelectDropTarget(Handle, nil);
  1137. end;
  1139. function TfcTreeNode.GetChildren: Boolean;
  1140. var
  1141.   Item: TTVItem;
  1142. begin
  1143.   Item.mask := TVIF_CHILDREN;
  1144.   Item.hItem := ItemId;
  1145.   if TreeView_GetItem(Handle, Item) then Result := Item.cChildren > 0
  1146.   else Result := False;
  1147. end;
  1149. procedure TfcTreeNode.SetFocused(Value: Boolean);
  1150. var
  1151.   Item: TTVItem;
  1152.   Template: DWORD;
  1153. begin
  1154.   if Value then Template := DWORD(-1)
  1155.   else Template := 0;
  1156.   with Item do
  1157.   begin
  1158.     mask := TVIF_STATE;
  1159.     hItem := ItemId;
  1160.     stateMask := TVIS_FOCUSED;
  1161.     state := stateMask and Template;
  1162.   end;
  1163.   TreeView_SetItem(Handle, Item);
  1164. end;
  1166. function TfcTreeNode.GetFocused: Boolean;
  1167. begin
  1168.   Result := GetState(fcnsFocused);
  1169. end;
  1171. procedure TfcTreeNode.SetChildren(Value: Boolean);
  1172. var
  1173.   Item: TTVItem;
  1174. begin
  1175.   with Item do
  1176.   begin
  1177.     mask := TVIF_CHILDREN;
  1178.     hItem := ItemId;
  1179.     cChildren := Ord(Value);
  1180.   end;
  1181.   TreeView_SetItem(Handle, Item);
  1182. end;
  1184. function TfcTreeNode.GetParent: TfcTreeNode;
  1185. begin
  1186.   with FOwner do
  1187.     Result := GetNode(TreeView_GetParent(Handle, ItemId));
  1188. end;
  1190. function TfcTreeNode.GetNextSibling: TfcTreeNode;
  1191. begin
  1192.   with FOwner do
  1193.     Result := GetNode(TreeView_GetNextSibling(Handle, ItemId));
  1194. end;
  1196. function TfcTreeNode.GetPrevSibling: TfcTreeNode;
  1197. begin
  1198.   with FOwner do
  1199.     Result := GetNode(TreeView_GetPrevSibling(Handle, ItemId));
  1200. end;
  1202. function TfcTreeNode.GetNextVisible: TfcTreeNode;
  1203. begin
  1204.   if IsVisible then
  1205.     with FOwner do
  1206.       Result := GetNode(TreeView_GetNextVisible(Handle, ItemId))
  1207.   else Result := nil;
  1208. end;
  1210. function TfcTreeNode.GetPrevVisible: TfcTreeNode;
  1211. begin
  1212.   with FOwner do
  1213.     Result := GetNode(TreeView_GetPrevVisible(Handle, ItemId));
  1214. end;
  1216. function TfcTreeNode.GetNextChild(Value: TfcTreeNode): TfcTreeNode;
  1217. begin
  1218.   if Value <> nil then Result := Value.GetNextSibling
  1219.   else Result := nil;
  1220. end;
  1222. function TfcTreeNode.GetPrevChild(Value: TfcTreeNode): TfcTreeNode;
  1223. begin
  1224.   if Value <> nil then Result := Value.GetPrevSibling
  1225.   else Result := nil;
  1226. end;
  1228. function TfcTreeNode.GetFirstChild: TfcTreeNode;
  1229. begin
  1230.   with FOwner do
  1231.     Result := GetNode(TreeView_GetChild(Handle, ItemId));
  1232. end;
  1234. function TfcTreeNode.GetLastChild: TfcTreeNode;
  1235. var
  1236.   Node: TfcTreeNode;
  1237. begin
  1238.   Result := GetFirstChild;
  1239.   if Result <> nil then
  1240.   begin
  1241.     Node := Result;
  1242.     repeat
  1243.       Result := Node;
  1244.       Node := Result.GetNextSibling;
  1245.     until Node = nil;
  1246.   end;
  1247. end;
  1249. function TfcTreeNode.GetNext: TfcTreeNode;
  1250. var
  1251.   NodeID, ParentID: HTreeItem;
  1252.   Handle: HWND;
  1253. begin
  1254.   Handle := FOwner.Handle;
  1255.   NodeID := TreeView_GetChild(Handle, ItemId);
  1256.   if NodeID = nil then NodeID := TreeView_GetNextSibling(Handle, ItemId);
  1257.   ParentID := ItemId;
  1258.   while (NodeID = nil) and (ParentID <> nil) do
  1259.   begin
  1260.     ParentID := TreeView_GetParent(Handle, ParentID);
  1261.     NodeID := TreeView_GetNextSibling(Handle, ParentID);
  1262.   end;
  1263.   Result := FOwner.GetNode(NodeID);
  1264. end;
  1266. function TfcTreeNode.GetPrev: TfcTreeNode;
  1267. var
  1268.   Node: TfcTreeNode;
  1269. begin
  1270.   Result := GetPrevSibling;
  1271.   if Result <> nil then
  1272.   begin
  1273.     Node := Result;
  1274.     repeat
  1275.       Result := Node;
  1276.       Node := Result.GetLastChild;
  1277.     until Node = nil;
  1278.   end else
  1279.     Result := Parent;
  1280. end;
  1282. function TfcTreeNode.GetAbsoluteIndex: Integer;
  1283. var
  1284.   Node: TfcTreeNode;
  1285. begin
  1286.   if Owner.FNodeCache.CacheNode = Self then
  1287.     Result := Owner.FNodeCache.CacheIndex
  1288.   else begin
  1289.     Result := -1;
  1290.     Node := Self;
  1291.     while Node <> nil do
  1292.     begin
  1293.       Inc(Result);
  1294.       Node := Node.GetPrev;
  1295.     end;
  1296.   end;
  1297. end;
  1299. function TfcTreeNode.GetIndex: Integer;
  1300. var
  1301.   Node: TfcTreeNode;
  1302. begin
  1303.   Result := -1;
  1304.   Node := Self;
  1305.   while Node <> nil do
  1306.   begin
  1307.     Inc(Result);
  1308.     Node := Node.GetPrevSibling;
  1309.   end;
  1310. end;
  1312. function TfcTreeNode.GetItem(Index: Integer): TfcTreeNode;
  1313. begin
  1314.   Result := GetFirstChild;
  1315.   while (Result <> nil) and (Index > 0) do
  1316.   begin
  1317.     Result := GetNextChild(Result);
  1318.     Dec(Index);
  1319.   end;
  1320.   if Result = nil then TreeViewError(SListIndexError);
  1321. end;
  1323. procedure TfcTreeNode.SetItem(Index: Integer; Value: TfcTreeNode);
  1324. begin
  1325.   item[Index].Assign(Value);
  1326. end;
  1328. function TfcTreeNode.IndexOf(Value: TfcTreeNode): Integer;
  1329. var
  1330.   Node: TfcTreeNode;
  1331. begin
  1332.   Result := -1;
  1333.   Node := GetFirstChild;
  1334.   while (Node <> nil) do
  1335.   begin
  1336.     Inc(Result);
  1337.     if Node = Value then Break;
  1338.     Node := GetNextChild(Node);
  1339.   end;
  1340.   if Node = nil then Result := -1;
  1341. end;
  1343. function TfcTreeNode.GetCount: Integer;
  1344. var
  1345.   Node: TfcTreeNode;
  1346. begin
  1347.   Result := 0;
  1348.   Node := GetFirstChild;
  1349.   while Node <> nil do
  1350.   begin
  1351.     Inc(Result);
  1352.     Node := Node.GetNextChild(Node);
  1353.   end;
  1354. end;
  1356. procedure TfcTreeNode.EndEdit(Cancel: Boolean);
  1357. begin
  1358.   TreeView_EndEditLabelNow(Handle, Cancel);
  1359. end;
  1361. procedure TfcTreeNode.InternalMove(ParentNode, Node: TfcTreeNode;
  1362.   HItem: HTreeItem; AddMode: TfcAddMode);
  1363. var
  1364.   I: Integer;
  1365.   NodeId: HTreeItem;
  1366.   TreeViewItem: TTVItem;
  1367.   Children: Boolean;
  1368.   IsSelected: Boolean;
  1369. begin
  1370.   { if ParentNode = Node then Exit; }
  1371.   Owner.ClearCache;
  1372.   if (AddMode = fctaInsert) and (Node <> nil) then
  1373.     NodeId := Node.ItemId else
  1374.     NodeId := nil;
  1375.   Children := HasChildren;
  1376.   IsSelected := Selected;
  1377.   if (Parent <> nil) and (Parent.CompareCount(1)) then
  1378.   begin
  1379.     Parent.Expanded := False;
  1380.     Parent.HasChildren := False;
  1381.   end;
  1382.   with TreeViewItem do
  1383.   begin
  1384.     mask := TVIF_PARAM;
  1385.     hItem := ItemId;
  1386.     lParam := 0;
  1387.   end;
  1388.   TreeView_SetItem(Handle, TreeViewItem);
  1389.   with Owner do
  1390.     HItem := AddItem(HItem, NodeId, CreateItem(Self), AddMode);
  1391.   if HItem = nil then
  1392.     raise EOutOfResources.Create(sInsertError);
  1393.   for I := Count - 1 downto 0 do
  1394.     Item[I].InternalMove(Self, nil, HItem, fctaAddFirst);
  1395.   TreeView_DeleteItem(Handle, ItemId);
  1396.   FItemId := HItem;
  1397.   Assign(Self);
  1398.   HasChildren := Children;
  1399.   Selected := IsSelected;
  1400. end;
  1402. procedure TfcTreeNode.MoveTo(Destination: TfcTreeNode; Mode: TfcNodeAttachMode);
  1403. var
  1404.   AddMode: TfcAddMode;
  1405.   Node: TfcTreeNode;
  1406.   HItem: HTreeItem;
  1407.   OldOnChanging: TfcTVChangingEvent;
  1408.   OldOnChange: TfcTVChangedEvent;
  1409. begin
  1410.   OldOnChanging := TreeView.OnChanging;
  1411.   OldOnChange := TreeView.OnChange;
  1412.   TreeView.OnChanging := nil;
  1413.   TreeView.OnChange := nil;
  1414.   try
  1415.     if (Destination = nil) or not Destination.HasAsParent(Self) then
  1416.     begin
  1417.       AddMode := fctaAdd;
  1418.       if (Destination <> nil) and not (Mode in [fcnaAddChild, fcnaAddChildFirst]) then
  1419.         Node := Destination.Parent else
  1420.         Node := Destination;
  1421.       case Mode of
  1422.         fcnaAdd,
  1423.         fcnaAddChild: AddMode := fctaAdd;
  1424.         fcnaAddFirst,
  1425.         fcnaAddChildFirst: AddMode := fctaAddFirst;
  1426.         fcnaInsert:
  1427.           begin
  1428.             Destination := Destination.GetPrevSibling;
  1429.             if Destination = Self then exit;
  1430.             if Destination = nil then AddMode := fctaAddFirst
  1431.             else AddMode := fctaInsert;
  1432.           end;
  1433.         fcnaInsertAfter:
  1434.           begin
  1435.             if Destination.GetNextSibling = nil then AddMode := fctaAdd
  1436.             else AddMode := fctaInsert;
  1437.           end;
  1438.       end;
  1439.       if Node <> nil then
  1440.         HItem := Node.ItemId else
  1441.         HItem := nil;
  1442.       InternalMove(Node, Destination, HItem, AddMode);
  1443.       Node := Parent;
  1444.       if Node <> nil then
  1445.       begin
  1446.         Node.HasChildren := True;
  1447.         Node.Expanded := True;
  1448.       end;
  1449.     end;
  1450.   finally
  1451.     TreeView.OnChanging := OldOnChanging;
  1452.     TreeView.OnChange := OldOnChange;
  1453.     Invalidate;
  1454.   end;
  1455. end;
  1457. procedure TfcTreeNode.MakeVisible;
  1458. begin
  1459.   TreeView_EnsureVisible(Handle, ItemId);
  1460. end;
  1462. function TfcTreeNode.GetLevel: Integer;
  1463. var
  1464.   Node: TfcTreeNode;
  1465. begin
  1466.   Result := 0;
  1467.   Node := Parent;
  1468.   while Node <> nil do
  1469.   begin
  1470.     Inc(Result);
  1471.     Node := Node.Parent;
  1472.   end;
  1473. end;
  1475. function TfcTreeNode.IsNodeVisible: Boolean;
  1476. var
  1477.   Rect: TRect;
  1478. begin
  1479.   Result := TreeView_GetItemRect(Handle, ItemId, Rect, True);
  1480. end;
  1482. function TfcTreeNode.EditText: Boolean;
  1483. begin
  1484.   Result := TreeView_EditLabel(Handle, ItemId) <> 0;
  1485. end;
  1487. {function TfcTreeNode.ShowBlankImage: boolean;
  1488. begin
  1489.   result:= not ((TreeView.Images<>nil) and (ImageIndex=-2));
  1490. end;
  1491. }
  1492. function TfcTreeNode.DisplayRect(TextOnly: Boolean): TRect;
  1493. begin
  1494.   FillChar(Result, SizeOf(Result), 0);
  1495.   TreeView_GetItemRect(Handle, ItemId, Result, TextOnly);
  1497.   { Special case of imageindex=-2, do not show blank image }
  1498.   if TextOnly and (TreeView.Images<>nil) and not TreeView.UseImages(self) then
  1499.       result.Left:= result.Left - TImageList(TreeView.Images).Width-1
  1500. end;
  1502. function TfcTreeNode.AlphaSort: Boolean;
  1503. begin
  1504.   Result := CustomSort(nil, 0);
  1505. end;
  1507. function TfcTreeNode.CustomSort(SortProc: TTVCompare; Data: Longint): Boolean;
  1508. var
  1509.   SortCB: TTVSortCB;
  1510. begin
  1511.   Owner.ClearCache;
  1512.   with SortCB do
  1513.   begin
  1514.     if not Assigned(SortProc) then lpfnCompare := @DefaultTreeViewSort
  1515.     else lpfnCompare := SortProc;
  1516.     hParent := ItemId;
  1517.     lParam := Data;
  1518.   end;
  1519.   Result := TreeView_SortChildrenCB(Handle, SortCB, 0);
  1520. end;
  1522. procedure TfcTreeNode.Delete;
  1523. begin
  1524.   if not Deleting then Free;
  1525. end;
  1527. procedure TfcTreeNode.DeleteChildren;
  1528. begin
  1529.   Owner.ClearCache;
  1530.   TreeView_Expand(TreeView.Handle, ItemID, TVE_COLLAPSE or TVE_COLLAPSERESET);
  1531.   HasChildren := False;
  1532. end;
  1534. procedure TfcTreeNode.Assign(Source: TPersistent);
  1535. var
  1536.   Node: TfcTreeNode;
  1537. begin
  1538.   Owner.ClearCache;
  1539.   if Source is TfcTreeNode then
  1540.   begin
  1541.     Node := TfcTreeNode(Source);
  1542.     Text := Node.Text;
  1543.     Data := Node.Data;
  1544.     CheckboxType:= Node.CheckboxType;  { 4/26/99 - Do before assign State Index }
  1545.     StringData:= Node.StringData;
  1546.     StringData2:= Node.StringData2;
  1547.     ImageIndex := Node.ImageIndex;
  1548.     SelectedIndex := Node.SelectedIndex;
  1549.     StateIndex := Node.StateIndex;
  1550.     OverlayIndex := Node.OverlayIndex;
  1551.     Focused := Node.Focused;
  1552.     DropTarget := Node.DropTarget;
  1553.     Cut := Node.Cut;
  1554.     HasChildren := Node.HasChildren;
  1555. //    CheckboxType:= Node.CheckboxType;
  1556.     Checked:= Node.Checked;
  1557.   end
  1558.   else inherited Assign(Source);
  1559. end;
  1561. {function TfcTreeNode.IsEqual(Node: TfcTreeNode): Boolean;
  1562. begin
  1563.   Result := (Text = Node.Text) and (Data = Node.Data);
  1564. end;
  1565. }
  1566. procedure TfcTreeNode.ReadData(Stream: TStream; Info: PfcNodeInfo);
  1567. var
  1568.   I, Size, ItemCount: Integer;
  1569.   StrBuffer: PChar;
  1570.   Temp: Integer;
  1571.   UseExpanded:Boolean;
  1572. begin
  1573.   Owner.ClearCache;
  1574.   Stream.ReadBuffer(Size, SizeOf(Size));
  1576.   { 7/6/99 - Save for fcTreeCombo streaming }
  1577.   {$ifdef fcDelphi4Up}
  1578.   ReadDataSize:= Size;
  1579.   {$endif}
  1581.   { RSW - Advance if somehow size is greater than node size }
  1582.   Stream.ReadBuffer(Info^, fcmin(Size, SizeOf(Info^)));
  1583.   Temp := SizeOf(TfcNodeInfo) - (255 - Length(Info^.Text));
  1585.   { Support StringData property }
  1586.   if Info^.StringDataSize1>0 then
  1587.   begin
  1588.      StrBuffer:= StrAlloc(Info^.StringDataSize1+1);
  1589.      StrBuffer[Info^.StringDataSize1]:= #0;
  1590.      Stream.ReadBuffer(StrBuffer^, Info^.StringDataSize1);
  1591.      StringData:= StrPas(StrBuffer);
  1592.      StrDispose(StrBuffer);
  1593.   end
  1594.   else StringData:= '';
  1596.   { Support StringData property }
  1597.   if Info^.StringDataSize2>0 then
  1598.   begin
  1599.      StrBuffer:= StrAlloc(Info^.StringDataSize2+1);
  1600.      StrBuffer[Info^.StringDataSize2]:= #0;
  1601.      Stream.ReadBuffer(StrBuffer^, Info^.StringDataSize2);
  1602.      StringData2:= StrPas(StrBuffer);
  1603.      StrDispose(StrBuffer);
  1604.   end
  1605.   else StringData2:= '';
  1607.   Text := Info^.Text;
  1608.   ImageIndex := Info^.ImageIndex;
  1609.   SelectedIndex := Info^.SelectedIndex;
  1610.   StateIndex := Info^.StateIndex;
  1611.   OverlayIndex := Info^.OverlayIndex;
  1612.   Data := Info^.Data;
  1613.   ItemCount := Info^.Count;
  1614.   CheckboxType:= Info^.CheckboxType;
  1615.   Checked:= (Info^.Checked and $01)<>0;
  1617.   Grayed:= (Info^.Checked and $02)<>0;
  1619.   UseExpanded:= Info^.Expanded;
  1621.   for I := 0 to ItemCount - 1 do
  1622.     with Owner.AddChild(Self, '') do ReadData(Stream, Info);
  1624.   // 1/31/2002-PYW-Added new property to respect expanded node settings.
  1625.   if (Owner.Owner<>nil) and (Owner.Owner.StreamExpandedNode) then
  1626.      Expanded := UseExpanded;
  1628.   if TreeView.StreamVersion=1 then
  1629.      if Size > Temp then Stream.Position:= Stream.Position + (Size - Temp);
  1630. end;
  1632. Function TfcTreeNode.GetSizeOfNodeInfo: integer;
  1633. begin
  1634.   result:= SizeOf(TfcNodeInfo);
  1635. end;
  1637. procedure TfcTreeNode.WriteData(Stream: TStream; Info: PfcNodeInfo);
  1638. var
  1639.   Size, L, ItemCount: Integer;
  1640.   Node: TfcTreeNode;
  1641. begin
  1642.   L := Length(Text);
  1643.   if L > 255 then L := 255;
  1644.   Size := GetSizeOfNodeInfo + L - 255;
  1645. //  Size := SizeOf(TfcNodeInfo) + L - 255;
  1646.   FillChar(Info^, SizeOf(TfcNodeInfo), 0);
  1647.   Info^.Text := Text;
  1648.   Info^.ImageIndex := ImageIndex;
  1649.   Info^.SelectedIndex := SelectedIndex;
  1650.   Info^.OverlayIndex := OverlayIndex;
  1651.   Info^.StateIndex := StateIndex;
  1652.   Info^.Data := Data;
  1653.   ItemCount := Count;
  1654.   Info^.Count := ItemCount;
  1655.   Info^.CheckboxType:= CheckboxType;
  1656.   Info^.Checked:= ord(Checked) + $02 * Ord(Grayed);
  1657.   Info^.Expanded := Expanded;
  1658.   Info^.StringDataSize1:= length(StringData);
  1659.   Info^.StringDataSize2:= length(StringData2);
  1660.   Stream.WriteBuffer(Size, SizeOf(Size));
  1661.   Stream.WriteBuffer(Info^, Size);
  1663.   { Support StringData properties }
  1664.   if Info^.StringDataSize1>0 then begin
  1665.      Stream.WriteBuffer(PChar(StringData)^, length(StringData));
  1666.   end;
  1668.   if Info^.StringDataSize2>0 then begin
  1669.      Stream.WriteBuffer(PChar(StringData2)^, length(StringData2));
  1670.   end;
  1672.   Node := GetFirstChild;
  1673.   while Node <> nil do
  1674.   begin
  1675.     Node.WriteData(Stream, Info);
  1676.     Node := Node.GetNextSibling;
  1677.   end;
  1679. //  for I := 0 to ItemCount - 1 do Item[I].WriteData(Stream, Info);
  1680. end;
  1682. { TfcTreeNodes }
  1684. constructor TfcTreeNodes.Create(AOwner: TfcCustomTreeView);
  1685. begin
  1686.   inherited Create;
  1687.   FOwner := AOwner;
  1688. end;
  1690. destructor TfcTreeNodes.Destroy;
  1691. begin
  1692.   InDestroy:= True;
  1693.   Clear;
  1694. //  FOwner := nil;
  1695.   inherited Destroy;
  1696. end;
  1698. function TfcTreeNodes.GetCount: Integer;
  1699. begin
  1700.   if Owner.HandleAllocated then Result := TreeView_GetCount(Handle)
  1701.   else Result := 0;
  1702. end;
  1704. function TfcTreeNodes.GetHandle: HWND;
  1705. begin
  1706.   Result := Owner.Handle;
  1707. end;
  1709. procedure TfcTreeNodes.Delete(Node: TfcTreeNode);
  1710. begin
  1711.   if (Node.ItemId = nil) then
  1712.     Owner.Delete(Node);
  1713.   Node.Delete;
  1714. end;
  1716. procedure TfcTreeNodes.Clear;
  1717. var PrevNode, Node: TfcTreeNode;
  1718. begin
  1719.   ClearCache;
  1720.   if { (Owner <> nil) and ksw - prevent problem }Owner.HandleAllocated then
  1721.   begin
  1722.      if count<=0 then exit;
  1724.      Owner.SkipChangeMessages:= True;
  1726.      try
  1727.         BeginUpdate;
  1729.         Owner.Selected:= nil;
  1731.         { Clearing by scanning backwards seems to be significantly faster }
  1732.         { TreeView_DeleteAllItem's current implementation is slower than this
  1733.         { technique. Scanning forwards is also slower. }
  1734.         Node := GetFirstNode;
  1735.         Owner.TopItem:= Node;
  1737.         { Retrieve last node }
  1738.         while Node.GetNextSibling <> nil do Node:= Node.GetNextSibling;
  1739.         while Node.GetNext <> nil do Node:= Node.GetNext;
  1741.         While Node<>Nil do
  1742.         begin
  1743.             PrevNode:= Node;
  1744.             Node := Node.GetPrev;
  1745.             TreeView_DeleteItem(PrevNode.Handle, PrevNode.ItemId);
  1746.         end;
  1747.      finally
  1748.         Owner.SkipChangeMessages:= False;
  1749.         if not inDestroy then EndUpdate;
  1750.      end
  1751.   end
  1752. end;
  1754. {procedure TfcTreeNodes.Clear;
  1755. begin
  1756.   ClearCache;
  1757.   if Owner.HandleAllocated then
  1758.     TreeView_DeleteAllItems(Handle);
  1759. end;}
  1761. function TfcTreeNodes.AddChildFirst(Node: TfcTreeNode; const S: string): TfcTreeNode;
  1762. begin
  1763.   Result := AddChildObjectFirst(Node, S, nil);
  1764. end;
  1766. function TfcTreeNodes.AddChildObjectFirst(Node: TfcTreeNode; const S: string;
  1767.   Ptr: Pointer): TfcTreeNode;
  1768. begin
  1769.   Result := InternalAddObject(Node, S, Ptr, fctaAddFirst);
  1770. end;
  1772. function TfcTreeNodes.AddChild(Node: TfcTreeNode; const S: string): TfcTreeNode;
  1773. begin
  1774.   Result := AddChildObject(Node, S, nil);
  1775. end;
  1777. function TfcTreeNodes.AddChildObject(Node: TfcTreeNode; const S: string;
  1778.   Ptr: Pointer): TfcTreeNode;
  1779. begin
  1780.   Result := InternalAddObject(Node, S, Ptr, fctaAdd);
  1781. end;
  1783. function TfcTreeNodes.AddFirst(Node: TfcTreeNode; const S: string): TfcTreeNode;
  1784. begin
  1785.   Result := AddObjectFirst(Node, S, nil);
  1786. end;
  1788. function TfcTreeNodes.AddObjectFirst(Node: TfcTreeNode; const S: string;
  1789.   Ptr: Pointer): TfcTreeNode;
  1790. begin
  1791.   if Node <> nil then Node := Node.Parent;
  1792.   Result := InternalAddObject(Node, S, Ptr, fctaAddFirst);
  1793. end;
  1795. function TfcTreeNodes.Add(Node: TfcTreeNode; const S: string): TfcTreeNode;
  1796. begin
  1797.   Result := AddObject(Node, S, nil);
  1798. end;
  1800. procedure TfcTreeNodes.Repaint(Node: TfcTreeNode);
  1801. var
  1802.   R: TRect;
  1803. begin
  1804.   if FUpdateCount < 1 then
  1805.   begin
  1806.     while (Node <> nil) and not Node.IsVisible do Node := Node.Parent;
  1807.     if Node <> nil then
  1808.     begin
  1809.       R := Node.DisplayRect(False);
  1810.       InvalidateRect(Owner.Handle, @R, True);
  1811.     end;
  1812.   end;
  1813. end;
  1815. function TfcTreeNodes.AddObject(Node: TfcTreeNode; const S: string;
  1816.   Ptr: Pointer): TfcTreeNode;
  1817. begin
  1818.   if Node <> nil then Node := Node.Parent;
  1819.   Result := InternalAddObject(Node, S, Ptr, fctaAdd);
  1820. end;
  1822. function TfcTreeNodes.Insert(Node: TfcTreeNode; const S: string): TfcTreeNode;
  1823. begin
  1824.   Result := InsertObject(Node, S, nil);
  1825. end;
  1827. procedure TfcTreeNodes.AddedNode(Value: TfcTreeNode);
  1828. begin
  1829.   if Value <> nil then
  1830.   begin
  1831.     Value.HasChildren := True;
  1832.     Repaint(Value);
  1833.   end;
  1834. end;
  1836. function TfcTreeNodes.InsertObject(Node: TfcTreeNode; const S: string;
  1837.   Ptr: Pointer): TfcTreeNode;
  1838. var
  1839.   Item, ItemId: HTreeItem;
  1840.   Parent: TfcTreeNode;
  1841.   AddMode: TfcAddMode;
  1842. begin
  1843.   Result := Owner.CreateNode;
  1844.   try
  1845.     Item := nil;
  1846.     ItemId := nil;
  1847.     Parent := nil;
  1848.     AddMode := fctaInsert;
  1849.     if Node <> nil then
  1850.     begin
  1851.       Parent := Node.Parent;
  1852.       if Parent <> nil then Item := Parent.ItemId;
  1853.       Node := Node.GetPrevSibling;
  1854.       if Node <> nil then ItemId := Node.ItemId
  1855.       else AddMode := fctaAddFirst;
  1856.     end;
  1857.     Result.Data := Ptr;
  1858.     Result.Text := S;
  1859.     Item := AddItem(Item, ItemId, CreateItem(Result), AddMode);
  1860.     if Item = nil then
  1861.       raise EOutOfResources.Create(sInsertError);
  1862.     Result.FItemId := Item;
  1863.     AddedNode(Parent);
  1864.     if not Owner.MultiSelectCheckboxNeeded(Result) then
  1865.        Result.StateIndex:= -1; { 5/15/98 - Required since its not initialized to -1}
  1866.   except
  1867.     Result.Free;
  1868.     raise;
  1869.   end;
  1870. end;
  1872. function TfcTreeNodes.InternalAddObject(Node: TfcTreeNode; const S: string;
  1873.   Ptr: Pointer; AddMode: TfcAddMode): TfcTreeNode;
  1874. var
  1875.   Item: HTreeItem;
  1876. begin
  1877.   Result := Owner.CreateNode;
  1878.   try
  1879.     if Node <> nil then Item := Node.ItemId
  1880.     else Item := nil;
  1881.     Result.Data := Ptr;
  1882.     Result.Text := S;
  1883.     Item := AddItem(Item, nil, CreateItem(Result), AddMode);
  1884.     if Item = nil then
  1885.       raise EOutOfResources.Create(sInsertError);
  1886.     Result.FItemId := Item;
  1887.     AddedNode(Node);
  1888.     if not Owner.MultiSelectCheckboxNeeded(Result) then
  1889.        Result.StateIndex:= -1; { 5/15/98 - Required since its not initialized to -1}
  1890.   except
  1891.     Result.Free;
  1892.     raise;
  1893.   end;
  1894. end;
  1896. function TfcTreeNodes.CreateItem(Node: TfcTreeNode): TTVItem;
  1897. begin
  1898.   Node.FInTree := True;
  1899.   with Result do
  1900.   begin
  1901.     mask := TVIF_TEXT or TVIF_PARAM or TVIF_IMAGE or TVIF_SELECTEDIMAGE;
  1902.     lParam := Longint(Node);
  1903.     pszText := LPSTR_TEXTCALLBACK;
  1904.     iImage := I_IMAGECALLBACK;
  1905.     iSelectedImage := I_IMAGECALLBACK;
  1906.   end;
  1907. end;
  1909. function TfcTreeNodes.AddItem(Parent, Target: HTreeItem;
  1910.   const Item: TTVItem; AddMode: TfcAddMode): HTreeItem;
  1911. var
  1912.   InsertStruct: TTVInsertStruct;
  1913. begin
  1914.   ClearCache;
  1915.   with InsertStruct do
  1916.   begin
  1917.     hParent := Parent;
  1918.     case AddMode of
  1919.       fctaAddFirst:
  1920.         hInsertAfter := TVI_FIRST;
  1921.       fctaAdd:
  1922.         hInsertAfter := TVI_LAST;
  1923.       fctaInsert:
  1924.         hInsertAfter := Target;
  1925.     end;
  1926.   end;
  1927.   InsertStruct.item := Item;
  1928.   FOwner.FChangeTimer.Enabled := False;
  1929.   Result := TreeView_InsertItem(Handle, InsertStruct);
  1930. end;
  1932. function TfcTreeNodes.GetFirstNode: TfcTreeNode;
  1933. begin
  1934.   Result := GetNode(TreeView_GetRoot(Handle));
  1935. end;
  1937. function TfcTreeNodes.GetNodeFromIndex(Index: Integer): TfcTreeNode;
  1938. var
  1939.   I: Integer;
  1940. begin
  1941.   if Index < 0 then TreeViewError(sInvalidIndex);
  1942.   if (FNodeCache.CacheNode <> nil) and (Abs(FNodeCache.CacheIndex - Index) <= 1) then
  1943.   begin
  1944.     with FNodeCache do
  1945.     begin
  1946.       if Index = CacheIndex then Result := CacheNode
  1947.       else if Index < CacheIndex then Result := CacheNode.GetPrev
  1948.       else Result := CacheNode.GetNext;
  1949.     end;
  1950.   end
  1951.   else begin
  1952.     Result := GetFirstNode;
  1953.     I := Index;
  1954.     while (I <> 0) and (Result <> nil) do
  1955.     begin
  1956.       Result := Result.GetNext;
  1957.       Dec(I);
  1958.     end;
  1959.   end;
  1960.   if Result = nil then TreeViewError(sInvalidIndex);
  1961.   FNodeCache.CacheNode := Result;
  1962.   FNodeCache.CacheIndex := Index;
  1963. end;
  1965. function TfcTreeNodes.GetNode(ItemId: HTreeItem): TfcTreeNode;
  1966. var
  1967.   Item: TTVItem;
  1968. begin
  1969.   with Item do
  1970.   begin
  1971.     hItem := ItemId;
  1972.     mask := TVIF_PARAM;
  1973.   end;
  1974.   if TreeView_GetItem(Handle, Item) then Result := TfcTreeNode(Item.lParam)
  1975.   else Result := nil;
  1976. end;
  1978. procedure TfcTreeNodes.SetItem(Index: Integer; Value: TfcTreeNode);
  1979. begin
  1980.   GetNodeFromIndex(Index).Assign(Value);
  1981. end;
  1983. procedure TfcTreeNodes.BeginUpdate;
  1984. begin
  1985.   if FUpdateCount = 0 then SetUpdateState(True);
  1986.   Inc(FUpdateCount);
  1987. end;
  1989. procedure TfcTreeNodes.SetUpdateState(Updating: Boolean);
  1990. begin
  1991.   SendMessage(Handle, WM_SETREDRAW, Ord(not Updating), 0);
  1992.   if not Updating then Owner.Refresh;
  1993. end;
  1995. procedure TfcTreeNodes.EndUpdate;
  1996. begin
  1997.   Dec(FUpdateCount);
  1998.   if FUpdateCount = 0 then SetUpdateState(False);
  1999. end;
  2001. procedure TfcTreeNodes.Assign(Source: TPersistent);
  2002. var
  2003.   TreeNodes: TfcTreeNodes;
  2004.   MemStream: TMemoryStream;
  2005. begin
  2006.   ClearCache;
  2008.   { 12/1/98 (RSW) Clear treeview display }
  2009.   SendMessage(Owner.Handle, WM_ERASEBkgnd, Owner.Canvas.Handle, 0);
  2011.   if Source is TfcTreeNodes then
  2012.   begin
  2013.     Owner.FStreamVersion:= 1;
  2015.     TreeNodes := TfcTreeNodes(Source);
  2016.     Clear;
  2017.     MemStream := TMemoryStream.Create;
  2018.     try
  2019.       TreeNodes.WriteData(MemStream);
  2020.       MemStream.Position := 0;
  2021.       ReadData(MemStream);
  2022.     finally
  2023.       MemStream.Free;
  2024.     end;
  2025.   end
  2026.   else inherited Assign(Source);
  2028.   if Count>0 then Owner.Selected:= Owner.Items[0];
  2029.   Owner.invalidate;
  2030.   // RSW - 1/13/99 Make sure some node is selected as the treeview common control
  2031.   // has problems in repainting in certain cases if no control has the selection
  2033. end;
  2035. procedure TfcTreeNodes.DefineProperties(Filer: TFiler);
  2036. {
  2037.   function WriteNodes: Boolean;
  2038.   var
  2039.     I: Integer;
  2040.     Nodes: TfcTreeNodes;
  2041.   begin
  2042.     Nodes := TfcTreeNodes(Filer.Ancestor);
  2043.     if Nodes = nil then
  2044.       Result := Count > 0
  2045.     else if Nodes.Count <> Count then
  2046.       Result := True
  2047.     else
  2048.     begin
  2049.       Result := False;
  2050.       for I := 0 to Count - 1 do
  2051.       begin
  2052.         Result := not Item[I].IsEqual(Nodes[I]);
  2053.         if Result then Break;
  2054.       end
  2055.     end;
  2056.   end;
  2057. }
  2058. begin
  2059.   inherited DefineProperties(Filer);
  2060. //  Filer.DefineBinaryProperty('Data', ReadData, WriteData, WriteNodes);
  2061.   Filer.DefineProperty('StreamVersion',
  2062.      ReadStreamVersion, WriteStreamVersion, True);
  2063.   Filer.DefineBinaryProperty('Data', ReadData, WriteData, True);
  2064. end;
  2066. procedure TfcTreeNodes.ReadStreamVersion(Reader: TReader);
  2067. begin
  2068.   Owner.FStreamVersion:= Reader.ReadInteger;
  2069. end;
  2071. procedure TfcTreeNodes.WriteStreamVersion(Writer: TWriter);
  2072. begin
  2073.    Owner.FStreamVersion:= 1;
  2074.    Writer.WriteInteger(Owner.StreamVersion)
  2075. end;
  2079. procedure TfcTreeNodes.ReadData(Stream: TStream);
  2080. var
  2081.   I, Count: Integer;
  2082.   NodeInfo: TfcNodeInfo;
  2083. begin
  2084.   FillChar(NodeInfo, SizeOf(TfcNodeInfo), 0);
  2085.   Clear;
  2086.   Stream.ReadBuffer(Count, SizeOf(Count));
  2087.   for I := 0 to Count - 1 do
  2088.     Add(nil, '').ReadData(Stream, @NodeInfo);
  2089.   Owner.FStreamVersion:= 1;
  2090. end;
  2092. procedure TfcTreeNodes.WriteData(Stream: TStream);
  2093. var
  2094.   I: Integer;
  2095.   Node: TfcTreeNode;
  2096.   NodeInfo: TfcNodeInfo;
  2097. begin
  2098.   Owner.FStreamVersion:=1;
  2099.   I := 0;
  2100.   Node := GetFirstNode;
  2101.   while Node <> nil do
  2102.   begin
  2103.     Inc(I);
  2104.     Node := Node.GetNextSibling;
  2105.   end;
  2106.   Stream.WriteBuffer(I, SizeOf(I));
  2107.   Node := GetFirstNode;
  2108.   while Node <> nil do
  2109.   begin
  2110.     Node.WriteData(Stream, @NodeInfo);
  2111.     Node := Node.GetNextSibling;
  2112.   end;
  2113. end;
  2115. procedure TfcTreeNodes.ClearCache;
  2116. begin
  2117.   FNodeCache.CacheNode := nil;
  2118. end;
  2120. {type
  2121.   TTreeStrings = class(TStrings)
  2122.   private
  2123.     FOwner: TfcTreeNodes;
  2124.   protected
  2125.     function Get(Index: Integer): string; override;
  2126.     function GetBufStart(Buffer: PChar; var Level: Integer): PChar;
  2127.     function GetCount: Integer; override;
  2128.     function GetObject(Index: Integer): TObject; override;
  2129.     procedure PutObject(Index: Integer; AObject: TObject); override;
  2130.     procedure SetUpdateState(Updating: Boolean); override;
  2131.   public
  2132.     constructor Create(AOwner: TfcTreeNodes);
  2133.     function Add(const S: string): Integer; override;
  2134.     procedure Clear; override;
  2135.     procedure Delete(Index: Integer); override;
  2136.     procedure Insert(Index: Integer; const S: string); override;
  2137.     procedure LoadTreeFromStream(Stream: TStream);
  2138.     procedure SaveTreeToStream(Stream: TStream);
  2139.     property Owner: TfcTreeNodes read FOwner;
  2140.   end;
  2142. constructor TTreeStrings.Create(AOwner: TfcTreeNodes);
  2143. begin
  2144.   inherited Create;
  2145.   FOwner := AOwner;
  2146. end;
  2148. function TTreeStrings.Get(Index: Integer): string;
  2149. const
  2150.   TabChar = #9;
  2151. var
  2152.   Level, I: Integer;
  2153.   Node: TfcTreeNode;
  2154. begin
  2155.   Result := '';
  2156.   Node := Owner.GetNodeFromIndex(Index);
  2157.   Level := Node.Level;
  2158.   for I := 0 to Level - 1 do Result := Result + TabChar;
  2159.   Result := Result + Node.Text;
  2160. end;
  2162. function TTreeStrings.GetBufStart(Buffer: PChar; var Level: Integer): PChar;
  2163. begin
  2164.   Level := 0;
  2165.   while Buffer^ in [' ', #9] do
  2166.   begin
  2167.     Inc(Buffer);
  2168.     Inc(Level);
  2169.   end;
  2170.   Result := Buffer;
  2171. end;
  2173. function TTreeStrings.GetObject(Index: Integer): TObject;
  2174. begin
  2175.   Result := Owner.GetNodeFromIndex(Index).Data;
  2176. end;
  2178. procedure TTreeStrings.PutObject(Index: Integer; AObject: TObject);
  2179. begin
  2180.   Owner.GetNodeFromIndex(Index).Data := AObject;
  2181. end;
  2183. function TTreeStrings.GetCount: Integer;
  2184. begin
  2185.   Result := Owner.Count;
  2186. end;
  2188. procedure TTreeStrings.Clear;
  2189. begin
  2190.   Owner.Clear;
  2191. end;
  2193. procedure TTreeStrings.Delete(Index: Integer);
  2194. begin
  2195.   Owner.GetNodeFromIndex(Index).Delete;
  2196. end;
  2198. procedure TTreeStrings.SetUpdateState(Updating: Boolean);
  2199. begin
  2200.   SendMessage(Owner.Handle, WM_SETREDRAW, Ord(not Updating), 0);
  2201.   if not Updating then Owner.Owner.Refresh;
  2202. end;
  2204. function TTreeStrings.Add(const S: string): Integer;
  2205. var
  2206.   Level, OldLevel, I: Integer;
  2207.   NewStr: string;
  2208.   Node: TfcTreeNode;
  2209. begin
  2210.   Result := GetCount;
  2211.   if (Length(S) = 1) and (S[1] = Chr($1A)) then Exit;
  2212.   Node := nil;
  2213.   OldLevel := 0;
  2214.   NewStr := GetBufStart(PChar(S), Level);
  2215.   if Result > 0 then
  2216.   begin
  2217.     Node := Owner.GetNodeFromIndex(Result - 1);
  2218.     OldLevel := Node.Level;
  2219.   end;
  2220.   if (Level > OldLevel) or (Node = nil) then
  2221.   begin
  2222.     if Level - OldLevel > 1 then TreeViewError(sInvalidLevel);
  2223.   end
  2224.   else begin
  2225.     for I := OldLevel downto Level do
  2226.     begin
  2227.       Node := Node.Parent;
  2228.       if (Node = nil) and (I - Level > 0) then
  2229.         TreeViewError(sInvalidLevel);
  2230.     end;
  2231.   end;
  2232.   Owner.AddChild(Node, NewStr);
  2233. end;
  2235. procedure TTreeStrings.Insert(Index: Integer; const S: string);
  2236. begin
  2237.   with Owner do
  2238.     Insert(GetNodeFromIndex(Index), S);
  2239. end;
  2241. procedure TTreeStrings.LoadTreeFromStream(Stream: TStream);
  2242. var
  2243.   List: TStringList;
  2244.   ANode, NextNode: TfcTreeNode;
  2245.   ALevel, i: Integer;
  2246.   CurrStr: string;
  2247. begin
  2248.   List := TStringList.Create;
  2249.   Owner.BeginUpdate;
  2250.   try
  2251.     try
  2252.       Clear;
  2253.       List.LoadFromStream(Stream);
  2254.       ANode := nil;
  2255.       for i := 0 to List.Count - 1 do
  2256.       begin
  2257.         CurrStr := GetBufStart(PChar(List[i]), ALevel);
  2258.         if ANode = nil then
  2259.           ANode := Owner.AddChild(nil, CurrStr)
  2260.         else if ANode.Level = ALevel then
  2261.           ANode := Owner.AddChild(ANode.Parent, CurrStr)
  2262.         else if ANode.Level = (ALevel - 1) then
  2263.           ANode := Owner.AddChild(ANode, CurrStr)
  2264.         else if ANode.Level > ALevel then
  2265.         begin
  2266.           NextNode := ANode.Parent;
  2267.           while NextNode.Level > ALevel do
  2268.             NextNode := NextNode.Parent;
  2269.           ANode := Owner.AddChild(NextNode.Parent, CurrStr);
  2270.         end
  2271.         else TreeViewErrorFmt(sInvalidLevelEx, [ALevel, CurrStr]);
  2272.       end;
  2273.     finally
  2274.       Owner.EndUpdate;
  2275.       List.Free;
  2276.     end;
  2277.   except
  2278.     Owner.Owner.Invalidate;  // force repaint on exception
  2279.     raise;
  2280.   end;
  2281. end;
  2283. procedure TTreeStrings.SaveTreeToStream(Stream: TStream);
  2284. const
  2285.   TabChar = #9;
  2286.   EndOfLine = #13#10;
  2287. var
  2288.   i: Integer;
  2289.   ANode: TfcTreeNode;
  2290.   NodeStr: string;
  2291. begin
  2292.   if Count > 0 then
  2293.   begin
  2294.     ANode := Owner[0];
  2295.     while ANode <> nil do
  2296.     begin
  2297.       NodeStr := '';
  2298.       for i := 0 to ANode.Level - 1 do NodeStr := NodeStr + TabChar;
  2299.       NodeStr := NodeStr + ANode.Text + EndOfLine;
  2300.       Stream.Write(Pointer(NodeStr)^, Length(NodeStr));
  2301.       ANode := ANode.GetNext;
  2302.     end;
  2303.   end;
  2304. end;
  2305. }
  2307. { TfcCustomTreeView }
  2309. constructor TfcCustomTreeView.Create(AOwner: TComponent);
  2310. begin
  2311.   inherited Create(AOwner);
  2312.   ControlStyle := ControlStyle - [csCaptureMouse] + [csDisplayDragImage, csReflector];
  2313.   Width := 121;
  2314.   Height := 97;
  2315.   TabStop := True;
  2316.   ParentColor := False;
  2317.   NodeClass := TfcTreeNode;
  2318.   FCanvas := TfcCanvas.Create;
  2319.   TControlCanvas(FCanvas).Control := Self;
  2320.   FTreeNodes := TfcTreeNodes.Create(Self);
  2321.   FBorderStyle := bsSingle;
  2322. //  FShowButtons := True;
  2323. //  FShowRoot := True;
  2324. //  FShowLines := True;
  2325. //  FHideSelection := True;
  2326.   FOptions:= [tvoExpandOnDblClk, tvoShowButtons, tvoShowRoot,
  2327.     tvoShowLines, tvoHideSelection, tvoToolTips];
  2328.   FSaveIndent := -1;
  2329.   FChangeTimer := TTimer.Create(Self);
  2330.   FChangeTimer.Enabled := False;
  2331.   FChangeTimer.Interval := 0;
  2332.   FChangeTimer.OnTimer := OnChangeTimer;
  2333. //  FToolTips := False;
  2334.   {$Warnings Off}
  2335.   FEditInstance := MakeObjectInstance(EditWndProc);
  2336.   {$Warnings On}
  2337.   FImageChangeLink := TChangeLink.Create;
  2338.   FImageChangeLink.OnChange := ImageListChange;
  2339.   FStateChangeLink := TChangeLink.Create;
  2340.   FStateChangeLink.OnChange := ImageListChange;
  2342. //  FOptions := [tvoExpandOnDblClk];
  2343.   FMultiSelectAttributes:= TfcTVMultiSelectAttributes.create(self);
  2344.   FMultiSelectList:= TList.create;
  2345.   FBorderWidth := GetSystemMetrics(SM_CXBORDER);
  2346.   if FFixBugImageList=nil then begin
  2347.      FFixBugImageList:= TImageList.create(nil);
  2348.      FFixBugImageList.Width:= FixBugImageListSize;
  2349.      FFixBugImageList.Height:= FixBugImageListSize;
  2350.   end;
  2351.   inc(RefCount); { 2/28/00 - Always increment refcount}
  2353.   FPaintBitmap:= TBitmap.create;
  2354.   FPaintCanvas:= TfcCanvas(FPaintBitmap.Canvas);
  2356.   FLineColor:= clBtnShadow;
  2357.   FInactiveFocusColor:= clBtnFace;
  2358.   FReadOnly:= False;
  2360.   Patch:= VarArrayCreate([0, 0], varVariant);
  2361.   Patch[0]:= False;
  2362. //  Patch[1]:= 0; { Used by TfcTreeNode ReadData }
  2364. end;
  2366. destructor TfcCustomTreeView.Destroy;
  2367. begin
  2368.   FPaintBitmap.Free;
  2370.   FMultiSelectList.Free;
  2371.   FMultiSelectAttributes.Free;
  2372.   dec(RefCount);
  2373.   if RefCount<=0 then
  2374.   begin
  2375.      FFixBugImageList.Free;
  2376.      FFixBugimageList:=nil;
  2377.   end;
  2379. //  Items.Free;
  2380.   FTreeNodes.Free;
  2381.   FTreeNodes:= nil;
  2382.   FChangeTimer.Free;
  2383.   FSaveItems.Free;
  2384.   FDragImage.Free;
  2385.   FMemStream.Free;
  2386.   {$Warnings Off}
  2387.   FreeObjectInstance(FEditInstance);
  2388.   {$Warnings On}
  2389.   FImageChangeLink.Free;
  2390.   FStateChangeLink.Free;
  2391.   FCanvas.Free;
  2393.   inherited Destroy;
  2394. end;
  2396. procedure TfcCustomTreeView.CreateParams(var Params: TCreateParams);
  2397. const
  2398.   TVS_TRACKSELECT         = $0200;
  2399.   TVS_NOTOOLTIPS          = $0080;
  2400.   TVS_INFOTIP             = $0800;
  2401.   TVS_SINGLEEXPAND        = $0400;
  2402.   BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
  2403.   LineStyles: array[Boolean] of DWORD = (0, TVS_HASLINES);
  2404.   RootStyles: array[Boolean] of DWORD = (0, TVS_LINESATROOT);
  2405.   ButtonStyles: array[Boolean] of DWORD = (0, TVS_HASBUTTONS);
  2406.   EditStyles: array[Boolean] of DWORD = (TVS_EDITLABELS, 0);
  2407.   HideSelections: array[Boolean] of DWORD = (TVS_SHOWSELALWAYS, 0);
  2408.   DragStyles: array[TDragMode] of DWORD = (TVS_DISABLEDRAGDROP, 0);
  2409.   HotTrackStyles: array[Boolean] of DWORD = (0, TVS_TRACKSELECT);
  2410.   ToolTipStyles: array[Boolean] of DWORD = (TVS_NOTOOLTIPS, TVS_NOTOOLTIPS);
  2411.   AutoExpandStyles: array[Boolean] of DWORD = (0, TVS_SINGLEEXPAND);
  2412.   {$ifdef fcDelphi4Up}
  2413.   RTLStyles: array[Boolean] of DWORD = (0, TVS_RTLREADING);
  2414.   RowSelectStyles: array[Boolean] of DWORD = (0, TVS_FULLROWSELECT);
  2415.   {$endif}
  2416.   TVS_NOSCROLL = $2000;
  2417. begin
  2418.   InitCommonControl(ICC_TREEVIEW_CLASSES);
  2419.   inherited CreateParams(Params);
  2420.   CreateSubClass(Params, WC_TREEVIEW);
  2421.   with Params do
  2422.   begin
  2423.     Style := Style or LineStyles[tvoShowLines in Options] or BorderStyles[FBorderStyle] or
  2424.       RootStyles[tvoShowRoot in Options] or ButtonStyles[tvoShowButtons in Options] or
  2425.       EditStyles[not (tvoEditText in Options)] or HideSelections[not (tvoHideSelection in Options)] or
  2426.       DragStyles[DragMode] or
  2427.       ToolTipStyles[False] or // FToolTips] or
  2428.       HotTrackStyles[tvoHotTrack in Options] or
  2429.       AutoExpandStyles[FAutoExpand]
  2430.       {$ifdef fcDelphi4Up}
  2431.        or
  2432.       RTLStyles[UseRightToLeftReading]
  2433.       {$endif};
  2434.     if Ctl3D and NewStyleControls and (FBorderStyle = bsSingle) then
  2435.     begin
  2436.       Style := Style and not WS_BORDER;
  2437.       ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
  2438.     end;
  2439.     WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
  2440.   end;
  2441.   Params.Style := Params.Style or TVS_CHECKBOXES;
  2443. end;
  2445. function TreeView_SetBkColor(hwnd: HWND; clr: COLORREF): COLORREF;
  2446. const
  2447.   TVM_SETBKCOLOR              = TV_FIRST + 29;
  2448. begin
  2449.   Result := COLORREF(SendMessage(hwnd, TVM_SETBKCOLOR, 0, LPARAM(clr)));
  2450. end;
  2452. function TreeView_SetTextColor(hwnd: HWND; clr: COLORREF): COLORREF;
  2453. const
  2454.   TVM_SETTEXTCOLOR              = TV_FIRST + 30;
  2455. begin
  2456.   Result := COLORREF(SendMessage(hwnd, TVM_SETTEXTCOLOR, 0, LPARAM(clr)));
  2457. end;
  2459. procedure TfcCustomTreeView.CreateWnd;
  2460. var
  2461.   DC: HDC;
  2462.   SaveFont: HFont;
  2463.   TextSize: TSize;
  2464. begin
  2465.   FStateChanging := False;
  2466.   inherited CreateWnd;
  2467.   TreeView_SetBkColor(Handle, ColorToRGB(Color));
  2468.   TreeView_SetTextColor(Handle, ColorToRGB(Font.Color));
  2469.   if FMemStream <> nil then
  2470.   begin
  2471.     Items.ReadData(FMemStream);
  2472.     FMemStream.Destroy;
  2473.     FMemStream := nil;
  2474.     SetTopItem(Items.GetNodeFromIndex(FSaveTopIndex));
  2475.     FSaveTopIndex := 0;
  2476.     SetSelection(Items.GetNodeFromIndex(FSaveIndex));
  2477.     FSaveIndex := 0;
  2478.   end;
  2479.   if FSaveIndent <> -1 then Indent := FSaveIndent;
  2480.   if (Images <> nil) and Images.HandleAllocated then
  2481.     SetImageList(Images.Handle, TVSIL_NORMAL);
  2482.   if (StateImages <> nil) and StateImages.HandleAllocated then
  2483.     SetImageList(StateImages.Handle, TVSIL_STATE);
  2485.   { Create StateImageList if not assigned }
  2486.   DC := GetDC(0);
  2487.   SaveFont := SelectObject(DC, Font.Handle);
  2488.   GetTextExtentPoint32(DC, 'A', 1, TextSize);
  2489.   SelectObject(DC, SaveFont);
  2490.   ReleaseDC(0, DC);
  2491.   FFixBugImageList.Width:= fcMin(TextSize.cy+2, FixBugImageListSize);
  2492.   FFixBugImageList.Width:= fcMax(FixBugImageListSize, 16); { 2/1/99}
  2493.   FFixBugImageList.Height:= FFixBugImageList.Width;
  2495.   if HandleAllocated and (StateImages=Nil) then
  2496.      TreeView_SetImageList(Handle, FFixBugImageList.Handle, TVSIL_STATE);
  2498.   { 5/5/99 - Workaround for TreeView common control problem where this property is reset }
  2499.   if not (tvoHideSelection in Options) and HandleAllocated then
  2500.      SetComCtlStyle(Self, TVS_SHOWSELALWAYS, True);
  2503. end;
  2505. procedure TfcCustomTreeView.DestroyWnd;
  2506. var
  2507.   Node: TfcTreeNode;
  2508.   parentIsFrame: boolean;
  2509. begin
  2510.   FStateChanging := True;
  2511.   {$ifdef fcDelphi5Up}
  2512.   parentIsFrame:= parent is TCustomFrame;
  2513.   {$else}
  2514.   parentIsFrame:= false;
  2515.   {$endif}
  2516.   if (Items.Count > 0) and
  2517.     { 1/5/2000 - Fix TFrame duplicate streaming problem }
  2518.      not (parentIsFrame and (csLoading in ComponentState)) then
  2519.   begin
  2520.     FMemStream := TMemoryStream.Create;
  2521.     Items.WriteData(FMemStream);
  2522.     FMemStream.Position := 0;
  2523.     Node := GetTopItem;
  2524.     if Node <> nil then FSaveTopIndex := Node.AbsoluteIndex;
  2525.     Node := Selected;
  2526.     if Node <> nil then FSaveIndex := Node.AbsoluteIndex;
  2527.   end;
  2528.   FSaveIndent := Indent;
  2529.   inherited DestroyWnd;
  2530. end;
  2532. procedure TfcCustomTreeView.EditWndProc(var Message: TMessage);
  2533. var DisplayRect: TRect;
  2534. begin
  2535.   try
  2536.     with Message do
  2537.     begin
  2538.       case Msg of
  2539.         WM_WINDOWPOSCHANGED, WM_SIZE:
  2540.           begin
  2541.             If (EditNode<>Nil) and (Images<>Nil) and (EditNode.imageindex=-2) then
  2542.             begin
  2543.               DisplayRect:= EditNode.DisplayRect(True);
  2544.               SetWindowPos(FEditHandle, 0, fcmax(DisplayRect.Left, 0),DisplayRect.Top,0,0, //sp.x + DisplayRect.Left, sp.y + DisplayRect.Top, 0, 0,
  2545.                 SWP_NOZORDER OR SWP_NOSIZE OR SWP_NOACTIVATE);
  2546.               ValidateRect(Handle, nil);
  2547. //            Message.Result:= 1;
  2548.             end
  2549.             else if (EditNode<>Nil) and (Msg=WM_SIZE) then begin
  2550.                if (Patch[0]=False) then
  2551.                   ValidateRect(Handle, nil) // RSW (4/8/99 } Prevent flicker when edit box size changes
  2552.                else Patch[0]:= False;
  2553.             end
  2554.           end;
  2557.         WM_KEYDOWN,
  2558.         WM_SYSKEYDOWN: if DoKeyDown(TWMKey(Message)) then Exit;
  2559.         WM_CHAR: if DoKeyPress(TWMKey(Message)) then Exit;
  2560.         WM_KEYUP,
  2561.         WM_SYSKEYUP: if DoKeyUp(TWMKey(Message)) then Exit;
  2562.         CN_KEYDOWN,
  2563.         CN_CHAR, CN_SYSKEYDOWN,
  2564.         CN_SYSCHAR:
  2565.           begin
  2566.             WndProc(Message);
  2567.             Exit;
  2568.           end;
  2569.       end;
  2570.       Result := CallWindowProc(FDefEditProc, FEditHandle, Msg, WParam, LParam);
  2571.     end;
  2572.   except
  2573.     Application.HandleException(Self);
  2574.   end;
  2575. end;
  2577. procedure TfcCustomTreeView.CMColorChanged(var Message: TMessage);
  2578. begin
  2579.   inherited;
  2580.   RecreateWnd;
  2581. end;
  2583. procedure TfcCustomTreeView.CMCtl3DChanged(var Message: TMessage);
  2584. begin
  2585.   inherited;
  2586.   if FBorderStyle = bsSingle then RecreateWnd;
  2587. end;
  2589. procedure TfcCustomTreeView.CMFontChanged(var Message: TMessage);
  2590. begin
  2591.   inherited;
  2592.   TreeView_SetTextColor(Handle, ColorToRGB(Font.Color));
  2593. end;
  2595. procedure TfcCustomTreeView.CMSysColorChange(var Message: TMessage);
  2596. begin
  2597.   inherited;
  2598.   if not (csLoading in ComponentState) then
  2599.   begin
  2600.     Message.Msg := WM_SYSCOLORCHANGE;
  2601.     DefaultHandler(Message);
  2602.   end;
  2603. end;
  2605. function TfcCustomTreeView.AlphaSort: Boolean;
  2606. var
  2607.   Node: TfcTreeNode;
  2608. begin
  2609.   if HandleAllocated then
  2610.   begin
  2611.     Result := CustomSort(nil, 0);
  2612.     Node := FTreeNodes.GetFirstNode;
  2613.     while Node <> nil do
  2614.     begin
  2615.       if Node.HasChildren then Node.AlphaSort;
  2616.       Node := Node.GetNext;
  2617.     end;
  2618.   end
  2619.   else
  2620.     Result := False;
  2621. end;
  2623. function TfcCustomTreeView.CustomSort(SortProc: TTVCompare; Data: Longint): Boolean;
  2624. var
  2625.   SortCB: TTVSortCB;
  2626. //  Node: TfcTreeNode;
  2627. begin
  2628.   Result := False;
  2629.   if HandleAllocated then
  2630.   begin
  2631.     with SortCB do
  2632.     begin
  2633.       if not Assigned(SortProc) then lpfnCompare := @DefaultTreeViewSort
  2634.       else lpfnCompare := SortProc;
  2635.       hParent := TVI_ROOT;
  2636.       lParam := Data;
  2637.       Result := TreeView_SortChildrenCB(Handle, SortCB, 0);
  2638.     end;
  2639. {    Node := FTreeNodes.GetFirstNode;
  2640.     while Node <> nil do
  2641.     begin
  2642.       if Node.HasChildren then Node.CustomSort(SortProc, Data);
  2643.       Node := Node.GetNext;
  2644.     end;}
  2645.     Items.ClearCache;
  2646.   end;
  2647. end;
  2649. procedure TfcCustomTreeView.SetAutoExpand(Value: Boolean);
  2650. const
  2651.   TVS_SINGLEEXPAND        = $0400;
  2652. begin
  2653.   if FAutoExpand <> Value then
  2654.   begin
  2655.     FAutoExpand := Value;
  2656.     SetComCtlStyle(Self, TVS_SINGLEEXPAND, Value);
  2657.   end;
  2658. end;
  2660. {
  2661. procedure TfcCustomTreeView.SetHotTrack(Value: Boolean);
  2662. const
  2663.   TVS_TRACKSELECT         = $0200;
  2664. begin
  2665.   if FHotTrack <> Value then
  2666.   begin
  2667.     FHotTrack := Value;
  2668.     SetComCtlStyle(Self, TVS_TRACKSELECT, Value);
  2669.   end;
  2670. end;
  2671. }
  2673. {procedure TfcCustomTreeView.SetRowSelect(Value: Boolean);
  2674. const
  2675.   TVS_FULLROWSELECT       = $1000;
  2676. begin
  2677.   if (tvoRowSelect in Options) <> Value then
  2678.   begin
  2679.     FRowSelect := Value;
  2680.     SetComCtlStyle(Self, TVS_FULLROWSELECT, Value);
  2681.   end;
  2682. end;
  2683. }
  2684. {procedure TfcCustomTreeView.SetToolTips(Value: Boolean);
  2685. const TVS_NOTOOLTIPS          = $0080;
  2686. begin
  2687.   if FToolTips <> Value then
  2688.   begin
  2689.     FToolTips := Value;
  2690.     SetComCtlStyle(Self, TVS_NOTOOLTIPS, not Value);
  2691.   end;
  2692. end;
  2693. }
  2694. procedure TfcCustomTreeView.SetSortType(Value: TfcSortType);
  2695. begin
  2696.   if SortType <> Value then
  2697.   begin
  2698.     FSortType := Value;
  2699.     if ((SortType in [fcstData, fcstBoth]) and Assigned(OnCompare)) or
  2700.       (SortType in [fcstText, fcstBoth]) then
  2701.       AlphaSort;
  2702.   end;
  2703. end;
  2705. procedure TfcCustomTreeView.SetBorderStyle(Value: TBorderStyle);
  2706. begin
  2707.   if BorderStyle <> Value then
  2708.   begin
  2709.     FBorderStyle := Value;
  2710.     RecreateWnd;
  2711.   end;
  2712. end;
  2714. procedure TfcCustomTreeView.SetDragMode(Value: TDragMode);
  2715. begin
  2716.   if Value <> DragMode then
  2717.     SetComCtlStyle(Self, TVS_DISABLEDRAGDROP, Value = dmManual);
  2718.   inherited;
  2719. end;
  2721. {
  2722. procedure TfcCustomTreeView.SetButtonStyle(Value: Boolean);
  2723. begin
  2724.   if ShowButtons <> Value then
  2725.   begin
  2726.     FShowButtons := Value;
  2727.     SetComCtlStyle(Self, TVS_HASBUTTONS, Value);
  2728.   end;
  2729. end;
  2730. }
  2732. {
  2733. procedure TfcCustomTreeView.SetLineStyle(Value: Boolean);
  2734. begin
  2735.   if ShowLines <> Value then
  2736.   begin
  2737.     FShowLines := Value;
  2738.     SetComCtlStyle(Self, TVS_HASLINES, Value);
  2739.     SetComCtlStyle(Self, TVS_HASBUTTONS, Value);
  2740.   end;
  2741. end;
  2742. }
  2743. {
  2744. procedure TfcCustomTreeView.SetRootStyle(Value: Boolean);
  2745. begin
  2746.   if ShowRoot <> Value then
  2747.   begin
  2748.     FShowRoot := Value;
  2749.   end;
  2750. end;
  2751. }
  2752. procedure TfcCustomTreeView.SetReadOnly(Value: Boolean);
  2753. begin
  2754.   if ReadOnly <> Value then
  2755.   begin
  2756.     FReadOnly := Value;
  2758.     if FReadOnly then
  2759.     begin
  2760.        if (tvoEditText in Options) then SetComCtlStyle(Self, TVS_EDITLABELS, False);
  2761.     end