fctreeview.pas

一套及时通讯的原码

unit fcTreeView;
{
//
// Components : TfcTreeView
//
// Copyright (c) 1999 by Woll2Woll Software
// 3/3/99 - (RSW) Remove tvoUnderscoreAllowed Option
// 5/21/99 - Complete editing
// 6/14/99 - Fix disappearing tree when going into edit mode
// 6/23/99 - Fire OnDblClick event even when ExpandOnDblClick is False
// 7/3/99 - Only call Invalidate if not in expanding/collapsing
// 7/6/99 - Support streaming of TfcTreeView Items to TfcTreecombo's tree
// 11/12/99 - If right mouse button, then exit so multi-selected records are
//          not unselected
// 1/5/2000 - Fix TFrame duplicate streaming problem
// 2/3/2000 - Optimize imagelist usage so that resources are better
//            managed with regards to bitmaps
//
// 2/28/2000 - Always increment refcount so that treeview does not incorrectly
//             free temp image list.
// 5/16/2000 - PYW - Fix Memory leak from code left over from Delphi 3
// 6/9/2000 - PYW - Prevent default button handling for treeview
// 12/13/2001 - Don't use temp canvas for XP Themes. TreeView not painted in some cases otherwise
// 1/31/2002 - In WMPaint call inherited if nodes are in beginupdate/endupdate.
// 1/31/2002 - PYW - Added new property to respect expanded node settings.
// 5/10/2002 - Use DrawText to calculate font based on current canvas settings from OnCalcNodeAttributes event.
}
interface

{$i fcIfdef.pas}
{$R-}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  CommCtrl, ComStrs, consts, comctrls, fccustomdraw, fccanvas, extctrls, fccommon,
{$ifdef fcdelphi6Up}
variants,
{$endif}
{$ifdef fcdelphi7Up}
  themes,
{$endif}
  {$ifdef ThemeManager}
  thememgr, themesrv, uxtheme,
  {$endif}
  shellapi
  {$ifdef fcDelphi4Up}, ImgList{$endif};

type
  TfcCustomTreeView = class;
  TfcTreeNode = class;
  TfcItemState = (fcisSelected, fcisGrayed, fcisDisabled, fcisChecked,
    fcisFocused, fcisDefault, fcisHot, fcisMarked, fcisIndeterminate);
  TfcItemStates = set of TfcItemState;
  TfcTVDrawTextEvent = procedure (TreeView: TfcCustomTreeview;
    Node: TfcTreeNode; ARect: TRect; AItemState: TfcItemStates;
    var DefaultDrawing: boolean) of object;
  TfcTreeMouseMoveEvent = procedure(TreeView: TfcCustomTreeView;
      Node: TfcTreeNode;
      Shift: TShiftState; X, Y: Integer)of object;
  TfcTreeMouseEvent = procedure(TreeView: TfcCustomTreeView;
      Node: TfcTreeNode;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer) of object;


  TfcTreeNodes = class;

  TfcNodeState = (fcnsCut, fcnsDropHilited, fcnsFocused, fcnsSelected,
                  fcnsExpanded);
  TfcNodeAttachMode = (fcnaAdd, fcnaAddFirst, fcnaAddChild, fcnaAddChildFirst,
                       fcnaInsert, fcnaInsertAfter);
  TfcAddMode = (fctaAddFirst, fctaAdd, fctaInsert);

  TfcTreeViewCheckboxType = (tvctNone, tvctCheckbox, tvctRadioGroup);

  TfcTreeViewOption = (tvoExpandOnDblClk, tvoExpandButtons3D,
     tvoFlatCheckBoxes, tvoHideSelection,
     tvoRowSelect, tvoShowButtons,
     tvoShowLines, tvoShowRoot,
     {tvoUnderscoreAllowed,} tvoHotTrack, tvoAutoURL, tvoToolTips,
     tvoEditText, tvo3StateCheckbox);
  TfcTreeViewOptions = set of TfcTreeViewOption;

  PfcNodeInfo = ^TfcNodeInfo;
  TfcNodeInfo = packed record
    ImageIndex: Integer;
    SelectedIndex: Integer;
    StateIndex: Integer;
    OverlayIndex: Integer;
    CheckboxType: TfcTreeViewCheckboxType;
    Checked: byte;
    Expanded: boolean;
    DummyPad: packed array[1..3] of char;  { Allow Future growth }
    Data: Pointer;
    StringDataSize1: integer;
    StringDataSize2: integer;
    Count: Integer;
    Text: string[255];

    { Future growth so that old executables can still run with newer tree view formats }
//    Dummy1: integer;
//    Dummy2: integer;
//    Dummy3: integer;
//    Dummy4: integer;
  end;

  TfcTreeNode = class(TPersistent)
  private
    FMultiSelected: boolean;
    FCheckboxType: TfcTreeViewCheckboxType;
    FChecked: boolean;

    FOwner: TfcTreeNodes;
    FText: string;
    FStringData1, FStringData2: String;

    FData: Pointer;
    FItemId: HTreeItem;
    FImageIndex: Integer;
    FSelectedIndex: Integer;
    FOverlayIndex: Integer;
    FStateIndex: Integer;
    FDeleting: Boolean;
    FInTree: Boolean;
    FGrayed: boolean;

    procedure SetCheckboxType(val: TfcTreeViewCheckboxType);

    function CompareCount(CompareMe: Integer): Boolean;
    function DoCanExpand(Expand: Boolean): Boolean;
    procedure DoExpand(Expand: Boolean);
    procedure ExpandItem(Expand: Boolean; Recurse: Boolean);
    function GetAbsoluteIndex: Integer;
    function GetExpanded: Boolean;
    function GetLevel: Integer;
    function GetParent: TfcTreeNode;
    function GetChildren: Boolean;
    function GetCut: Boolean;
    function GetDropTarget: Boolean;
    function GetFocused: Boolean;
    function GetIndex: Integer;
    function GetItem(Index: Integer): TfcTreeNode;
    function GetSelected: Boolean;
    function GetState(NodeState: TfcNodeState): Boolean;
    function GetCount: Integer;
    function GetTreeView: TfcCustomTreeView;
    procedure InternalMove(ParentNode, Node: TfcTreeNode; HItem: HTreeItem;
      AddMode: TfcAddMode);
//    function IsEqual(Node: TfcTreeNode): Boolean;
    function IsNodeVisible: Boolean;
    procedure SetChildren(Value: Boolean);
    procedure SetCut(Value: Boolean);
    procedure SetData(Value: Pointer);
    procedure SetDropTarget(Value: Boolean);
    procedure SetItem(Index: Integer; Value: TfcTreeNode);
    procedure SetExpanded(Value: Boolean);
    procedure SetFocused(Value: Boolean);
    procedure SetImageIndex(Value: Integer);
    procedure SetOverlayIndex(Value: Integer);
    procedure SetSelectedIndex(Value: Integer);
    procedure SetSelected(Value: Boolean);
    procedure SetStateIndex(Value: Integer);
    procedure SetText(const S: string);

    function GetMultiSelected: Boolean;
    procedure SetMultiSelected(Value: Boolean);

    procedure SetChecked(val: boolean);
    procedure SetGrayed(val: boolean);
  protected
//    function ShowBlankImage: boolean; virtual;
    {$ifdef fcDelphi4Up}
    ReadDataSize: integer;
    {$endif}
    procedure Invalidate; virtual;
    Function GetSizeOfNodeInfo: integer; virtual;
    procedure ReadData(Stream: TStream; Info: PfcNodeInfo); virtual;
    procedure WriteData(Stream: TStream; Info: PfcNodeInfo); virtual;
  public
    Patch: Variant;
    function GetStateIndex: integer;
    Function IsRadioGroup: boolean;
    function GetSortText: string; virtual;

    constructor Create(AOwner: TfcTreeNodes); virtual;
    destructor Destroy; override;
    function AlphaSort: Boolean;
    procedure Assign(Source: TPersistent); override;
    procedure Collapse(Recurse: Boolean);
    function CustomSort(SortProc: TTVCompare; Data: Longint): Boolean;
    procedure Delete;
    procedure DeleteChildren;
    function DisplayRect(TextOnly: Boolean): TRect;
    function EditText: Boolean;
    procedure EndEdit(Cancel: Boolean);
    procedure Expand(Recurse: Boolean);
    function GetFirstChild: TfcTreeNode;
    function GetHandle: HWND;
    function GetLastChild: TfcTreeNode;
    function GetNext: TfcTreeNode;
    function GetNextChild(Value: TfcTreeNode): TfcTreeNode;
    function GetNextSibling: TfcTreeNode;
    function GetNextVisible: TfcTreeNode;
    function GetPrev: TfcTreeNode;
    function GetPrevChild(Value: TfcTreeNode): TfcTreeNode;
    function GetPrevSibling: TfcTreeNode;
    function GetPrevVisible: TfcTreeNode;
    function HasAsParent(Value: TfcTreeNode): Boolean;
    function IndexOf(Value: TfcTreeNode): Integer;
    procedure MakeVisible;
    procedure MoveTo(Destination: TfcTreeNode; Mode: TfcNodeAttachMode); virtual;
    property AbsoluteIndex: Integer read GetAbsoluteIndex;
    property Count: Integer read GetCount;
    property Cut: Boolean read GetCut write SetCut;
    property Data: Pointer read FData write SetData;
    property Deleting: Boolean read FDeleting;
    property Focused: Boolean read GetFocused write SetFocused;
    property DropTarget: Boolean read GetDropTarget write SetDropTarget;
    property Selected: Boolean read GetSelected write SetSelected;
    property Expanded: Boolean read GetExpanded write SetExpanded;
    property Handle: HWND read GetHandle;
    property HasChildren: Boolean read GetChildren write SetChildren;
    property ImageIndex: Integer read FImageIndex write SetImageIndex;
    property Index: Integer read GetIndex;
    property IsVisible: Boolean read IsNodeVisible;
    property Item[Index: Integer]: TfcTreeNode read GetItem write SetItem; default;
    property ItemId: HTreeItem read FItemId;
    property Level: Integer read GetLevel;
    property OverlayIndex: Integer read FOverlayIndex write SetOverlayIndex;
    property Owner: TfcTreeNodes read FOwner;
    property Parent: TfcTreeNode read GetParent;
    property SelectedIndex: Integer read FSelectedIndex write SetSelectedIndex;
    property StateIndex: Integer read FStateIndex write SetStateIndex;
    property Text: string read FText write SetText;
    property StringData: string read FStringData1 write FStringData1;
    property StringData2: string read FStringData2 write FStringData2;
    property TreeView: TfcCustomTreeView read GetTreeView;

    property Checked: boolean read FChecked write SetChecked;
    property Grayed: boolean read FGRayed write SetGrayed;
    property CheckboxType: TfcTreeViewCheckboxType read FCheckboxType write SetCheckboxType;
    property MultiSelected: Boolean read GetMultiSelected write SetMultiSelected;
  end;

{ TfcTreeNodes }

  PfcNodeCache = ^TfcNodeCache;
  TfcNodeCache = record
    CacheNode: TfcTreeNode;
    CacheIndex: Integer;
  end;

  TwwStoreData = (sdStoreText, sdStoreData1, sdStoreData2);

  TfcTreeNodes = class(TPersistent)
  private
    FOwner: TfcCustomTreeView;
    FUpdateCount: Integer;
    FNodeCache: TfcNodeCache;
    InDestroy: boolean;
    procedure AddedNode(Value: TfcTreeNode);
    function GetHandle: HWND;
    function GetNodeFromIndex(Index: Integer): TfcTreeNode;
    procedure ReadData(Stream: TStream);
    procedure Repaint(Node: TfcTreeNode);
    procedure WriteData(Stream: TStream);
    procedure ClearCache;
    procedure ReadStreamVersion(Reader: TReader);
    procedure WriteStreamVersion(Writer: TWriter);
  protected
    function AddItem(Parent, Target: HTreeItem; const Item: TTVItem;
      AddMode: TfcAddMode): HTreeItem;
    function InternalAddObject(Node: TfcTreeNode; const S: string;
      Ptr: Pointer; AddMode: TfcAddMode): TfcTreeNode;
    procedure DefineProperties(Filer: TFiler); override;
    function CreateItem(Node: TfcTreeNode): TTVItem;
    function GetCount: Integer;
    procedure SetItem(Index: Integer; Value: TfcTreeNode);
    procedure SetUpdateState(Updating: Boolean);
  public
    constructor Create(AOwner: TfcCustomTreeView);
    destructor Destroy; override;
    function AddChildFirst(Node: TfcTreeNode; const S: string): TfcTreeNode;
    function AddChild(Node: TfcTreeNode; const S: string): TfcTreeNode;
    function AddChildObjectFirst(Node: TfcTreeNode; const S: string;
      Ptr: Pointer): TfcTreeNode;
    function AddChildObject(Node: TfcTreeNode; const S: string;
      Ptr: Pointer): TfcTreeNode;
    function AddFirst(Node: TfcTreeNode; const S: string): TfcTreeNode;
    function Add(Node: TfcTreeNode; const S: string): TfcTreeNode;
    function AddObjectFirst(Node: TfcTreeNode; const S: string;
      Ptr: Pointer): TfcTreeNode;
    function AddObject(Node: TfcTreeNode; const S: string;
      Ptr: Pointer): TfcTreeNode;
    procedure Assign(Source: TPersistent); override;
    procedure BeginUpdate;
    procedure Clear;
    procedure Delete(Node: TfcTreeNode);
    procedure EndUpdate;
    function GetFirstNode: TfcTreeNode;
    function GetNode(ItemId: HTreeItem): TfcTreeNode;
    function Insert(Node: TfcTreeNode; const S: string): TfcTreeNode;
    function InsertObject(Node: TfcTreeNode; const S: string;
      Ptr: Pointer): TfcTreeNode;
    function FindNode(SearchText: string; VisibleOnly: Boolean): TfcTreeNode;
    function FindNodeInfo(SearchText: string; VisibleOnly: Boolean;
       StoreDataUsing: TwwStoreData = sdStoreText): TfcTreeNode;
    property Count: Integer read GetCount;
    property Handle: HWND read GetHandle;
    property Item[Index: Integer]: TfcTreeNode read GetNodeFromIndex; default;
    property Owner: TfcCustomTreeView read FOwner;
  end;

{ TfcCustomTreeView }

  TfcTVMultiSelectAttributes = class(TPersistent)
  private
     FEnabled: Boolean;
     FAutoUnselect: boolean;
//     FAlwaysIncludeSelectedItem: Boolean;
     FMultiSelectLevel: integer;
     FMultiSelectCheckbox: boolean;
     TreeView: TfcCustomTreeView;
     procedure SetEnabled(val: boolean);
     procedure SetMultiSelectLevel(val: integer);
     procedure SetMultiSelectCheckBox(val: boolean);

  public
     constructor Create(Owner: TComponent);
     procedure Assign(Source: TPersistent); override;

  published
     property AutoUnselect : boolean read FAutoUnselect write FAutoUnselect default True;
//     property AlwaysIncludeSelectedItem: Boolean read FAlwaysIncludeSelectedItem write FAlwaysIncludeSelectedItem default False;
     property Enabled: boolean read FEnabled write SetEnabled default False;
     property MultiSelectLevel: integer read FMultiSelectLevel write SetMultiSelectLevel default 0;
     property MultiSelectCheckbox: boolean read FMultiSelectCheckbox write SetMultiSelectCheckbox default True;
  end;

  TfcHitTest = (fchtAbove, fchtBelow, fchtNowhere, fchtOnItem, fchtOnButton, fchtOnIcon,
    fchtOnIndent, fchtOnLabel, fchtOnRight, fchtOnStateIcon, fchtToLeft, fchtToRight);
  TfcHitTests = set of TfcHitTest;
  TfcSortType = (fcstNone, fcstData, fcstText, fcstBoth);
  EfcTreeViewError = class(Exception);

  TfcTVChangingEvent = procedure(TreeView: TfcCustomTreeView; Node: TfcTreeNode;
    var AllowChange: Boolean) of object;
  TfcTVChangedEvent = procedure(TreeView: TfcCustomTreeView; Node: TfcTreeNode) of object;
  TfcTVEditingEvent = procedure(TreeView: TfcCustomTreeView; Node: TfcTreeNode;
    var AllowEdit: Boolean) of object;
  TfcTVEditedEvent = procedure(TreeView: TfcCustomTreeView; Node: TfcTreeNode; var S: string) of object;
  TfcTVExpandingEvent = procedure(TreeView: TfcCustomTreeView; Node: TfcTreeNode;
    var AllowExpansion: Boolean) of object;
  TfcTVCollapsingEvent = procedure(TreeView: TfcCustomTreeView; Node: TfcTreeNode;
    var AllowCollapse: Boolean) of object;
  TfcTVExpandedEvent = procedure(TreeView: TfcCustomTreeView; Node: TfcTreeNode) of object;
  TfcTVCompareEvent = procedure(TreeView: TfcCustomTreeView; Node1, Node2: TfcTreeNode;
    Data: Integer; var Compare: Integer) of object;
  TfcTVCustomDrawEvent = procedure(TreeView: TfcCustomTreeView; const ARect: TRect;
    var DefaultDraw: Boolean) of object;
  TfcCalcNodeAttributesEvent = procedure(TreeView: TfcCustomTreeView;
          Node: TfcTreeNode; State: TfcItemStates) of object;

  TfcItemChangeAction = (icaAdd, icaDelete, icaText, icaImageIndex);
  TfcItemChangeEvent = procedure(TreeView: TfcCustomTreeView; Node: TfcTreeNode;
    Action: TfcItemChangeAction; NewValue: Variant) of object;
  TfcToggleCheckboxEvent = procedure(TreeView: TfcCustomTreeView; Node: TfcTreeNode) of object;

  TfcTreeNodeClass = class of TfcTreeNode;

  TfcCustomTreeView = class(TWinControl)
  private
    FOnItemChange: TfcItemChangeEvent;
//    FOnItemChanging: TfcItemChangeEvent;
    FAutoExpand: Boolean;
    FBorderStyle: TBorderStyle;
    FCanvas: TfcCanvas;
    FPaintCanvas: TfcCanvas;
    FCanvasChanged: Boolean;
    FDefEditProc: Pointer;
    FDragged: Boolean;
    FDragImage: {$ifdef fcDelphi4Up}TDragImageList{$else}TCustomImageList{$endif};
    FDragNode: TfcTreeNode;
    FEditHandle: HWND;
    FEditInstance: Pointer;
    FImageChangeLink: TChangeLink;
    FImages: TCustomImageList;
    FLastDropTarget: TfcTreeNode;
    FManualNotify: Boolean;
    FMemStream: TMemoryStream;
    FRClickNode: TfcTreeNode;
    FRightClickSelects: Boolean;
    FReadOnly: Boolean;
    FSaveIndex: Integer;
    FSaveIndent: Integer;
    FSaveItems: TStringList;
    FSaveTopIndex: Integer;
    FSortType: TfcSortType;
    FStateChanging: Boolean;
    FStateImages: TCustomImageList;
    FStateChangeLink: TChangeLink;
    FStreamExpandedNode: Boolean;
//    FToolTips: Boolean;
    FTreeNodes: TfcTreeNodes;
    FWideText: WideString;
    FOnEditing: TfcTVEditingEvent;
    FOnEdited: TfcTVEditedEvent;
    FOnExpanded: TfcTVExpandedEvent;
    FOnExpanding: TfcTVExpandingEvent;
    FOnCollapsed: TfcTVExpandedEvent;