virtualtrees.pas

Last change: 2008-02-03 This is the source code of KCeasy。

    FAnimationOptions: TVTAnimationOptions;
    FAutoOptions: TVTAutoOptions;
    FSelectionOptions: TVTSelectionOptions;
    FMiscOptions: TVTMiscOptions;
    procedure SetAnimationOptions(const Value: TVTAnimationOptions);
    procedure SetAutoOptions(const Value: TVTAutoOptions);
    procedure SetMiscOptions(const Value: TVTMiscOptions);
    procedure SetPaintOptions(const Value: TVTPaintOptions);
    procedure SetSelectionOptions(const Value: TVTSelectionOptions);
  protected
    property AnimationOptions: TVTAnimationOptions read FAnimationOptions write SetAnimationOptions
      default DefaultAnimationOptions;
    property AutoOptions: TVTAutoOptions read FAutoOptions write SetAutoOptions default DefaultAutoOptions;
    property MiscOptions: TVTMiscOptions read FMiscOptions write SetMiscOptions default DefaultMiscOptions;
    property PaintOptions: TVTPaintOptions read FPaintOptions write SetPaintOptions default DefaultPaintOptions;
    property SelectionOptions: TVTSelectionOptions read FSelectionOptions write SetSelectionOptions
      default DefaultSelectionOptions;
  public
    constructor Create(AOwner: TBaseVirtualTree); virtual;

    procedure AssignTo(Dest: TPersistent); override;

    property Owner: TBaseVirtualTree read FOwner;
  end;

  TTreeOptionsClass = class of TCustomVirtualTreeOptions;
  
  TVirtualTreeOptions = class(TCustomVirtualTreeOptions)
  published
    property AnimationOptions;
    property AutoOptions;
    property MiscOptions;
    property PaintOptions;
    property SelectionOptions;
  end;

  // Used in the CF_VTREFERENCE clipboard format.
  PVTReference = ^TVTReference;
  TVTReference = record
    Process: Cardinal;
    Tree: TBaseVirtualTree;
  end;
                  
  TVirtualNode = packed record
    Index,                   // index of node with regard to its parent
    ChildCount: Cardinal;    // number of child nodes
    NodeHeight: Word;        // height in pixels
    States: TVirtualNodeStates; // states describing various properties of the node (expanded, initialized etc.)
    Align: Byte;             // line/button alignment
    CheckState: TCheckState; // indicates the current check state (e.g. checked, pressed etc.)
    CheckType: TCheckType;   // indicates which check type shall be used for this node
    Dummy: Byte;             // dummy value to fill DWORD boundary 
    TotalCount,              // sum of this node, all of its child nodes and their child nodes etc.
    TotalHeight: Cardinal;   // height in pixels this node covers on screen including the height of all of its
                             // children
    // Note: Some copy routines require that all pointers (as well as the data area) in a node are
    //       located at the end of the node! Hence if you want to add new member fields (except pointers to internal
    //       data) then put them before field Parent.
    Parent,                  // reference to the node's parent (for the root this contains the treeview)
    PrevSibling,             // link to the node's previous sibling or nil if it is the first node
    NextSibling,             // link to the node's next sibling or nil if it is the last node
    FirstChild,              // link to the node's first child...
    LastChild: PVirtualNode; // link to the node's last child...
    Data: record end;        // this is a placeholder, each node gets extra data determined by NodeDataSize
  end;

  // TVTNodeMemoryManager is a high-performance local memory manager for allocating TVirtualNode structures.
  // It is not thread-safe in itself, because it assumes that the virtual tree is being used within a single
  // thread. The local memory manager supports only fixed-length allocation requests - all requests must be of
  // the same size. The performance improvements are a result of TVTNodeMemoryManager getting 16K blocks
  // of memory from the Delphi memory manager and then managing them in a highly efficient manner.
  // A consequence is that node memory allocations/deallocations are not visible to memory debugging tools.
  //
  // The local memory manager is disabled by default - to enable it {$define UseLocalMemoryManager}. For smaller trees,
  // say less than 10,000 nodes, there is really no major performance benefit in using the local memory manager.
  {$ifdef UseLocalMemoryManager}
    TVTNodeMemoryManager = class
    private
      FAllocSize: Cardinal;       // The memory allocated for each node
      FBlockList: TList;          // List of allocated blocks
      FBytesAvailable: Cardinal;  // Bytes available in current block
      FNext: PVirtualNode;        // Pointer to next available node in current block
      FFreeSpace: PVirtualNode;   // Pointer to free space chain
    public
      constructor Create;
      destructor Destroy; override;

      function AllocNode(const Size: Cardinal): PVirtualNode;
      procedure FreeNode(const Node: PVirtualNode);
      procedure Clear;
    end;
  {$endif UseLocalMemoryManager}

  // structure used when info about a certain position in the tree is needed
  THitInfo = record
    HitNode: PVirtualNode;
    HitPositions: THitPositions;
    HitColumn: TColumnIndex;
  end;

  // auto scroll directions
  TScrollDirections = set of (
    sdLeft,
    sdUp,
    sdRight,
    sdDown
  );

  // OLE drag'n drop support
  TFormatEtcArray = array of TFormatEtc;
  TFormatArray = array of Word;

  // IDataObject.SetData support
  TInternalStgMedium = packed record
    Format: TClipFormat;
    Medium: TStgMedium;
  end;
  TInternalStgMediumArray = array of TInternalStgMedium;

  TEnumFormatEtc = class(TInterfacedObject, IEnumFormatEtc)
  private
    FTree: TBaseVirtualTree;
    FFormatEtcArray: TFormatEtcArray;
    FCurrentIndex: Integer;
  public
    constructor Create(Tree: TBaseVirtualTree; AFormatEtcArray: TFormatEtcArray);

    function Clone(out Enum: IEnumFormatEtc): HResult; stdcall;
    function Next(celt: Integer; out elt; pceltFetched: PLongint): HResult; stdcall;
    function Reset: HResult; stdcall;
    function Skip(celt: Integer): HResult; stdcall;
  end;

  // ----- OLE drag'n drop handling
  IDropTargetHelper = interface(IUnknown)
    [SID_IDropTargetHelper]
    function DragEnter(hwndTarget: HWND; pDataObject: IDataObject; var ppt: TPoint; dwEffect: Integer): HRESULT; stdcall;
    function DragLeave: HRESULT; stdcall;
    function DragOver(var ppt: TPoint; dwEffect: Integer): HRESULT; stdcall;
    function Drop(pDataObject: IDataObject; var ppt: TPoint; dwEffect: Integer): HRESULT; stdcall;
    function Show(fShow: Boolean): HRESULT; stdcall;
  end;

  PSHDragImage = ^TSHDragImage;
  TSHDragImage = packed record
    sizeDragImage: TSize;
    ptOffset: TPoint;
    hbmpDragImage: HBITMAP;
    ColorRef: TColorRef;
  end;

  IDragSourceHelper = interface(IUnknown)
    [SID_IDragSourceHelper]
    function InitializeFromBitmap(var SHDragImage: TSHDragImage; pDataObject: IDataObject): HRESULT; stdcall;
    function InitializeFromWindow(Window: HWND; var ppt: TPoint; pDataObject: IDataObject): HRESULT; stdcall;
  end;

  IVTDragManager = interface(IUnknown)
    ['{C4B25559-14DA-446B-8901-0C879000EB16}']
    procedure ForceDragLeave; stdcall;
    function GetDataObject: IDataObject; stdcall;
    function GetDragSource: TBaseVirtualTree; stdcall;
    function GetDropTargetHelperSupported: Boolean; stdcall;
    function GetIsDropTarget: Boolean; stdcall;

    property DataObject: IDataObject read GetDataObject;
    property DragSource: TBaseVirtualTree read GetDragSource;
    property DropTargetHelperSupported: Boolean read GetDropTargetHelperSupported;
    property IsDropTarget: Boolean read GetIsDropTarget;
  end;

  // This data object is used in two different places. One is for clipboard operations and the other while dragging.
  TVTDataObject = class(TInterfacedObject, IDataObject)
  private
    FOwner: TBaseVirtualTree;          // The tree which provides clipboard or drag data.
    FForClipboard: Boolean;            // Determines which data to render with GetData.
    FFormatEtcArray: TFormatEtcArray;
    FInternalStgMediumArray: TInternalStgMediumArray;  // The available formats in the DataObject
    FAdviseHolder: IDataAdviseHolder;  // Reference to an OLE supplied implementation for advising.
  protected
    function CanonicalIUnknown(TestUnknown: IUnknown): IUnknown;
    function EqualFormatEtc(FormatEtc1, FormatEtc2: TFormatEtc): Boolean;
    function FindFormatEtc(TestFormatEtc: TFormatEtc; const FormatEtcArray: TFormatEtcArray): integer;
    function FindInternalStgMedium(Format: TClipFormat): PStgMedium;
    function HGlobalClone(HGlobal: THandle): THandle;
    function RenderInternalOLEData(const FormatEtcIn: TFormatEtc; var Medium: TStgMedium; var OLEResult: HResult): Boolean;
    function StgMediumIncRef(const InStgMedium: TStgMedium; var OutStgMedium: TStgMedium;
      CopyInMedium: Boolean; DataObject: IDataObject): HRESULT;

    property ForClipboard: Boolean read FForClipboard;
    property FormatEtcArray: TFormatEtcArray read FFormatEtcArray write FFormatEtcArray;
    property InternalStgMediumArray: TInternalStgMediumArray read FInternalStgMediumArray write FInternalStgMediumArray;
    property Owner: TBaseVirtualTree read FOwner;
  public
    constructor Create(AOwner: TBaseVirtualTree; ForClipboard: Boolean); virtual;
    destructor Destroy; override;

    function DAdvise(const FormatEtc: TFormatEtc; advf: Integer; const advSink: IAdviseSink; out dwConnection: Integer):
      HResult; virtual; stdcall;
    function DUnadvise(dwConnection: Integer): HResult; virtual; stdcall;
    function EnumDAdvise(out enumAdvise: IEnumStatData): HResult; virtual; stdcall;
    function EnumFormatEtc(Direction: Integer; out EnumFormatEtc: IEnumFormatEtc): HResult; virtual; stdcall;
    function GetCanonicalFormatEtc(const FormatEtc: TFormatEtc; out FormatEtcOut: TFormatEtc): HResult; virtual; stdcall;
    function GetData(const FormatEtcIn: TFormatEtc; out Medium: TStgMedium): HResult; virtual; stdcall;
    function GetDataHere(const FormatEtc: TFormatEtc; out Medium: TStgMedium): HResult; virtual; stdcall;
    function QueryGetData(const FormatEtc: TFormatEtc): HResult; virtual; stdcall;
    function SetData(const FormatEtc: TFormatEtc; var Medium: TStgMedium; DoRelease: BOOL): HResult; virtual; stdcall;
  end;

  // TVTDragManager is a class to manage drag and drop in a Virtual Treeview.
  TVTDragManager = class(TInterfacedObject, IVTDragManager, IDropSource, IDropTarget)
  private
    FOwner,                            // The tree which is responsible for drag management.
    FDragSource: TBaseVirtualTree;     // Reference to the source tree if the source was a VT, might be different than
                                       // the owner tree.
    FIsDropTarget: Boolean;            // True if the owner is currently the drop target.
    FDataObject: IDataObject;          // A reference to the data object passed in by DragEnter (only used when the owner
                                       // tree is the current drop target).
    FDropTargetHelper: IDropTargetHelper; // Win2k > Drag image support
    FFullDragging: BOOL;               // True, if full dragging is currently enabled in the system.

    function GetDataObject: IDataObject; stdcall;
    function GetDragSource: TBaseVirtualTree; stdcall;
    function GetDropTargetHelperSupported: Boolean; stdcall;
    function GetIsDropTarget: Boolean; stdcall;
  public
    constructor Create(AOwner: TBaseVirtualTree); virtual;
    destructor Destroy; override;

    function DragEnter(const DataObject: IDataObject; KeyState: Integer; Pt: TPoint;
      var Effect: Integer): HResult; stdcall;
    function DragLeave: HResult; stdcall;
    function DragOver(KeyState: Integer; Pt: TPoint; var Effect: Integer): HResult; stdcall;
    function Drop(const DataObject: IDataObject; KeyState: Integer; Pt: TPoint; var Effect: Integer): HResult; stdcall;
    procedure ForceDragLeave; stdcall;
    function GiveFeedback(Effect: Integer): HResult; stdcall;
    function QueryContinueDrag(EscapePressed: BOOL; KeyState: Integer): HResult; stdcall;
  end;

  PVTHintData = ^TVTHintData;
  TVTHintData = record
    Tree: TBaseVirtualTree;
    Node: PVirtualNode;
    Column: TColumnIndex;
    HintRect: TRect;         // used for draw trees only, string trees get the size from the hint string
    DefaultHint: WideString; // used only if there is no node specific hint string available
                             // or a header hint is about to appear
    HintText: WideString;    // set when size of the hint window is calculated
    BidiMode: TBidiMode;
    Alignment: TAlignment;
    LineBreakStyle: TVTToolTipLineBreakStyle;
  end;

  // Determines the kind of animation when a hint is activated.
  THintAnimationType = (
    hatNone,                 // no animation at all, just display hint/tooltip
    hatFade,                 // fade in the hint/tooltip, like in Windows 2000
    hatSlide,                // slide in the hint/tooltip, like in Windows 98