如何使用虚拟树视图实现TStringGrid？

时间：2011-01-18 03:28:35

标签： delphi

如何使用虚拟树视图实现TStringGrid？有人有例子吗？

2 个答案:

答案 0 :(得分：3)

虽然它确实适合树结构，但可以在这里找到一个例子：

http://www.bjmsoftware.com/delphistuff/virtualstringtreeexample.zip

这是我一直在玩的东西，以开始一些新的基础框架，因此可能有你不需要的东西。 BaseTree_fr单元包含来自旧项目的VirtualStringTree内容。 Tree_fm.pas单元包含我的新工作。 Tree_fm.pas尚未包含动态添加新节点和删除现有节点，但您可以在BaseTree_fr单元中找到它。

为了保持StackOverflow站在自己的两只脚的精神，我在这里包括两个单位。

新的努力 

unit Tree_fm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, VirtualTrees, StdCtrls, DomainObject, DogBreed, ImgList;

type
  RTreeData = record
    CDO: TCustomDomainObject;
  end;
  PTreeData = ^RTreeData;

  TForm1 = class(TForm)
    VirtualStringTree1: TVirtualStringTree;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    HeaderImages: TImageList;
    TreeImages: TImageList;
    StateImages: TImageList;
    procedure VirtualStringTree1Checked(Sender: TBaseVirtualTree; Node:
        PVirtualNode);
    procedure VirtualStringTree1CompareNodes(Sender: TBaseVirtualTree; Node1,
        Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
    procedure VirtualStringTree1DblClick(Sender: TObject);
    procedure VirtualStringTree1FocusChanged(Sender: TBaseVirtualTree; Node:
        PVirtualNode; Column: TColumnIndex);
    procedure VirtualStringTree1GetImageIndex(Sender: TBaseVirtualTree; Node:
        PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted:
        Boolean; var ImageIndex: Integer);
    procedure VirtualStringTree1GetText(Sender: TBaseVirtualTree; Node:
        PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText:
        string);
    procedure VirtualStringTree1InitChildren(Sender: TBaseVirtualTree; Node:
        PVirtualNode; var ChildCount: Cardinal);
    procedure VirtualStringTree1InitNode(Sender: TBaseVirtualTree; ParentNode,
        Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
  private
    FIsLoading: Boolean;
    FCDO: TCustomDomainObject;
  protected
    procedure BeginLoad;
    procedure EndLoad;
    procedure ClearFrame;
    procedure ClearHeaders;
    procedure ShowColumnHeaders;
    procedure ShowDomainObject(aCDO, aParent: TCustomDomainObject);
    procedure ShowDomainObjects(aCDO, aParent: TCustomDomainObject);

    procedure AddColumnHeaders(aColumns: TVirtualTreeColumns); virtual;
    function GetColumnText(aCDO: TCustomDomainObject; aColumn: TColumnIndex;
      var aCellText: string): Boolean; virtual;
  protected
    property CDO: TCustomDomainObject read FCDO write FCDO;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Load(aCDO: TCustomDomainObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.AddColumnHeaders(aColumns: TVirtualTreeColumns);
var
  Col: TVirtualTreeColumn;
begin
  Col := aColumns.Add;
  Col.Text := 'Breed(Group)';
  Col.Width := 200;

  Col := aColumns.Add;
  Col.Text := 'Average Age';
  Col.Width := 100;
  Col.Alignment := taRightJustify;

  Col := aColumns.Add;
  Col.Text := 'CDO.Count';
  Col.Width := 100;
  Col.Alignment := taRightJustify;
end;

procedure TForm1.BeginLoad;
begin
  FIsLoading := True;
  VirtualStringTree1.BeginUpdate;
end;

procedure TForm1.ClearFrame;
begin
  VirtualStringTree1.Clear;
//  FNodeList.Clear;
//  DoSelectionChanged(nil);
end;

procedure TForm1.ClearHeaders;
begin
  VirtualStringTree1.Header.Columns.Clear;
end;

constructor TForm1.Create(AOwner: TComponent);
begin
  inherited;

  VirtualStringTree1.DefaultText := '';
  VirtualStringTree1.NodeDataSize := SizeOf(RTreeData);

  VirtualStringTree1.Header.Options := VirtualStringTree1.Header.Options
    //- []
    + [hoDblClickResize, hoHotTrack, hoShowImages]
  ;
  VirtualStringTree1.Header.Style := hsXPStyle;

  VirtualStringTree1.TreeOptions.AnimationOptions := VirtualStringTree1.TreeOptions.AnimationOptions
    //- []
    //+ []
  ;
  VirtualStringTree1.TreeOptions.AutoOptions := VirtualStringTree1.TreeOptions.AutoOptions
    //- []
    // toAutoSort is (was once?) causing heavy recursions and InitNode executions!!!
    // It isn't now, but it does cause the entire tree to be loaded!
    + [{toAutoSort,}{ toAutoHideButtons}]
  ;
  //VirtualStringTree1.TreeOptions.ExportMode := emChecked;
  VirtualStringTree1.TreeOptions.MiscOptions := VirtualStringTree1.TreeOptions.MiscOptions
    - [toInitOnSave]
    + [toCheckSupport]
  ;
  VirtualStringTree1.TreeOptions.PaintOptions := VirtualStringTree1.TreeOptions.PaintOptions
    - [toShowTreeLines]
    + [toHotTrack, toGhostedIfUnfocused, toUseExplorerTheme]
  ;
  VirtualStringTree1.TreeOptions.SelectionOptions := VirtualStringTree1.TreeOptions.SelectionOptions
    //- []
    + [toExtendedFocus, toFullRowSelect, toMultiSelect]
  ;
  VirtualStringTree1.TreeOptions.StringOptions := VirtualStringTree1.TreeOptions.StringOptions
    //- []
    //+ []
  ;

  VirtualStringTree1.Header.Images := HeaderImages;
  VirtualStringTree1.CheckImageKind := ckXP;
  VirtualStringTree1.CustomCheckImages := nil;
  VirtualStringTree1.Images := TreeImages;
  VirtualStringTree1.StateImages := StateImages;

  //VirtualStringTree1.ClipboardFormats := ;
  //VirtualStringTree1.DragMode := dmAutomatic;
  VirtualStringTree1.DragOperations := [];
end;

procedure TForm1.EndLoad;
begin
  VirtualStringTree1.EndUpdate;
  FIsLoading := False;
end;

function TForm1.GetColumnText(aCDO: TCustomDomainObject; aColumn: TColumnIndex;
  var aCellText: string): Boolean;
begin
  if Assigned(aCDO) then begin
    case aColumn of
      -1, 0: begin
        aCellText := aCDO.DisplayString;
      end;
      1: begin
        if aCDO.InheritsFrom(TDogBreed) then begin
          aCellText := IntToStr(TDogBreed(aCDO).AverageAge);
        end;
      end;
      2: begin
        aCellText := IntToStr(aCDO.Count);
      end;
    else
//      aCellText := '';
    end;
    Result := True;
  end else begin
    Result := False;
  end;
end;

procedure TForm1.Load(aCDO: TCustomDomainObject);
begin
// This would be in a more generic ancestor.
  BeginLoad;
  try
    if Assigned(CDO) then begin
      ClearHeaders;
      ClearFrame;
    end;
    CDO := aCDO;
    if Assigned(CDO) then begin
      ShowColumnHeaders;
      ShowDomainObjects(CDO, nil);
    end;
  finally
    EndLoad;
  end;
end;

procedure TForm1.ShowColumnHeaders;
begin
  AddColumnHeaders(VirtualStringTree1.Header.Columns);
  if VirtualStringTree1.Header.Columns.Count > 0 then begin
    VirtualStringTree1.Header.Options := VirtualStringTree1.Header.Options
      + [hoVisible];
  end;
end;

procedure TForm1.ShowDomainObject(aCDO, aParent: TCustomDomainObject);
begin
// We are dealing with a virtual tree that asks for its data, and so we don't
// need to do anything here.
end;

procedure TForm1.ShowDomainObjects(aCDO, aParent: TCustomDomainObject);
begin
// We are dealing with a virtual tree that asks for its data, and so we only need
// to set the number of nodes under the root.

  if Assigned(aCDO) then begin
    VirtualStringTree1.RootNodeCount := aCDO.Count;
  end else begin
    VirtualStringTree1.RootNodeCount := 0;
  end;
end;

procedure TForm1.VirtualStringTree1Checked(Sender: TBaseVirtualTree; Node:
    PVirtualNode);
begin
(*
procedure TBaseTreeFrame.Frame_VstChecked(Sender: TBaseVirtualTree;
  Node: PVirtualNode);
var
  ACDO: TCustomDomainObject;
  NodeData: ^RTreeData;
begin
  inherited;
  NodeData := Sender.GetNodeData(Node);
  ACDO := NodeData.CDO;
  if ACDO <> nil then begin
    ACDO.Checked := (Node.CheckState in [csCheckedNormal, csCheckedPressed]);
  end;
end;
*)
end;

procedure TForm1.VirtualStringTree1CompareNodes(Sender: TBaseVirtualTree;
    Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
begin
  beep;
(*
procedure TBaseTreeFrame.Frame_VstCompareNodes(Sender: TBaseVirtualTree;
  Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var
  Node1Data: ^RTreeData;
  Node2Data: ^RTreeData;
  Node1CDO: TCustomDomainObject;
  Node2CDO: TCustomDomainObject;
begin
  inherited;
  Node1Data := Frame_Vst.GetNodeData(Node1);
  Node2Data := Frame_Vst.GetNodeData(Node2);
  Node1CDO := Node1Data.CDO;
  Node2CDO := Node2Data.CDO;
//
  if (Node1CDO = nil) or (Node2CDO = nil) then begin
    Result := 0;
  end else if (Node1CDO is TDomainObjectList) <> (Node2CDO is TDomainObjectList) then begin
    if Node1CDO is TDomainObjectList then begin
      Result := -1;
    end else begin
      Result := 1;
    end;
  end else begin
    Result := AnsiCompareText(Node1CDO.SortString, Node2CDO.SortString);
  end;
end;
*)
end;

procedure TForm1.VirtualStringTree1DblClick(Sender: TObject);
begin
(*
procedure TBaseTreeFrame.Frame_VstDblClick(Sender: TObject);
var
  ACDO: TCustomDomainObject;
  NodeData: ^RTreeData;
  Tree: TBaseVirtualTree;
begin
  inherited;
  if Sender is TBaseVirtualTree then begin
    Tree := TBaseVirtualTree(Sender);
    if Tree.FocusedNode <> nil then begin
      NodeData := Tree.GetNodeData(Tree.FocusedNode);
      ACDO := NodeData.CDO;
      HandleDoubleClicked(ACDO);
    end;
  end;
end;

procedure TBaseTreeFrame.HandleDoubleClicked(ACDO: TCustomDomainObject);
begin
  DoDoubleClicked(ACDO);
end;

procedure TBaseTreeFrame.DoDoubleClicked(ACDO: TCustomDomainObject);
begin
  if assigned(FOnDoubleClicked) then begin
    FOnDoubleClicked(ACDO);
  end;
end;
*)
end;

procedure TForm1.VirtualStringTree1FocusChanged(Sender: TBaseVirtualTree; Node:
    PVirtualNode; Column: TColumnIndex);
begin
(*
procedure TBaseTreeFrame.Frame_VstFocusChanged(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex);
var
  ACDO: TCustomDomainObject;
  NodeData: ^RTreeData;
begin
  inherited;
  NodeData := Sender.GetNodeData(Node);
  ACDO := NodeData.CDO;
  HandleSelectionChanged(ACDO);
end;

procedure TBaseTreeFrame.HandleSelectionChanged(ACDO: TCustomDomainObject);
begin
  DoSelectionChanged(ACDO);
end;

procedure TBaseTreeFrame.DoSelectionChanged(ACDO: TCustomDomainObject);
begin
  if assigned(FOnSelectionChanged) then begin
    FOnSelectionChanged(ACDO);
  end;
end;
*)
end;

procedure TForm1.VirtualStringTree1GetImageIndex(Sender: TBaseVirtualTree;
    Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted:
    Boolean; var ImageIndex: Integer);
begin
(*
procedure TBaseTreeFrame.Frame_VstGetImageIndex(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
  var Ghosted: Boolean; var ImageIndex: Integer);
var
  ACDO: TCustomDomainObject;
  NodeData: ^RTreeData;
begin
  inherited;
  Case Column of
    -1, 0 : begin
      NodeData := Sender.GetNodeData(Node);
      ACDO := NodeData.CDO;
      case Kind of
        ikState: ImageIndex := -1;
        ikNormal: ImageIndex := GetImageIndexFor(ACDO, false);
        ikSelected: ImageIndex := GetImageIndexFor(ACDO, true);
        ikOverlay: ImageIndex := -1;
      else
        ImageIndex := -1;
      end;
    end;
  else
  end;
*)
end;

procedure TForm1.VirtualStringTree1GetText(Sender: TBaseVirtualTree; Node:
    PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText:
    string);
var
  NodeData: ^RTreeData;
begin
  NodeData := Sender.GetNodeData(Node);
  if GetColumnText(NodeData.CDO, Column, {var}CellText) then
  else begin
    if Assigned(NodeData.CDO) then begin
      case Column of
        -1, 0: CellText := NodeData.CDO.DisplayString;
      end;
    end;
  end;
end;

procedure TForm1.VirtualStringTree1InitChildren(Sender: TBaseVirtualTree; Node:
    PVirtualNode; var ChildCount: Cardinal);
var
  NodeData: ^RTreeData;
begin
// This is called when user has clicked on a plus sign.
// We only need to tell the tree for how many children to prepare.

  ChildCount := 0;

  NodeData := Sender.GetNodeData(Node);
  if Assigned(NodeData.CDO) then begin
    ChildCount := NodeData.CDO.Count;
  end;
end;

procedure TForm1.VirtualStringTree1InitNode(Sender: TBaseVirtualTree;
    ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
var
  ParentNodeData: ^RTreeData;
  ParentNodeCDO: TCustomDomainObject;
  NodeData: ^RTreeData;
begin
  if Assigned(ParentNode) then begin
    ParentNodeData := VirtualStringTree1.GetNodeData(ParentNode);
    ParentNodeCDO := ParentNodeData.CDO;
  end else begin
    ParentNodeCDO := CDO;
  end;

  NodeData := VirtualStringTree1.GetNodeData(Node);
  if Assigned(NodeData.CDO) then begin
    // CDO was already set, for example when added through AddDomainObject.
  end else begin
    if Assigned(ParentNodeCDO) then begin
      if ParentNodeCDO.Count > Node.Index then begin
        NodeData.CDO := ParentNodeCDO.CDO[Node.Index];
        if NodeData.CDO.Count > 0 then begin
          InitialStates := InitialStates + [ivsHasChildren];
        end;
//        FNodeList.Add(NodeData.CDO, Node);
      end;
    end;
  end;
  Sender.CheckState[Node] := csUncheckedNormal;
end;

end.

旧的

签入第二个答案，我超出了文本字符限制...

答案 1 :(得分：3)

我用这个单位超出了我原来答案的字符数限制，所以这是一个单独的答案。

{===============================================================================
  Copyright © BJM Software
  http://www.bjmsoftware.com
===============================================================================}
unit BaseTree_fr;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ImgList, VirtualTrees, Contnrs
  , DomainObject_intf, Base_fr
  ;

type
  RTreeData = record
    CDO: TCustomDomainObject;
  end;
  PTreeData = ^RTreeData;

  TBaseTreeEvent = procedure of object;

  TCDONodeList = class(TObject)
  private
    FCDOs: TObjectList;
    FNodes: TList;
  protected
  public
    constructor Create;
    destructor Destroy; override;
    procedure Add(ACDO: TCustomDomainObject; ANode: PVirtualNode);
    procedure Clear;
    function IndexOfCDO(ACDO: TCustomDomainObject): Integer;
    function NodeOf(ACDO: TCustomDomainObject): PVirtualNode;
    procedure Remove(ACDO: TCustomDomainObject);
    procedure InvalidateNodeFor(ACDO: TCustomDomainObject; AEvent: TCDOEvent);
    function IndexOfNode(ANode: PVirtualNode): Integer;
    function CDOOf(ANode: PVirtualNode): TCustomDomainObject;
    procedure InvalidateNode(ANode: PVirtualNode);
  end;

  TBaseTreeFrame = class(TBaseFrame, ICDOObserver)
    Frame_Vst: TVirtualStringTree;
    procedure Frame_VstGetImageIndex(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
      var Ghosted: Boolean; var ImageIndex: Integer);
    procedure Frame_VstGetText(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
      var CellText: WideString);
    procedure Frame_VstFocusChanged(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Column: TColumnIndex);
    procedure Frame_VstDblClick(Sender: TObject);
    procedure Frame_VstInitNode(Sender: TBaseVirtualTree; ParentNode,
      Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
    procedure Frame_VstInitChildren(Sender: TBaseVirtualTree;
      Node: PVirtualNode; var ChildCount: Cardinal);
    procedure Frame_VstCompareNodes(Sender: TBaseVirtualTree; Node1,
      Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
    procedure Frame_VstChecked(Sender: TBaseVirtualTree;
      Node: PVirtualNode);
  private
    FNodeCheckType: TCheckType;
    FOnCDOChanged: TCDONotifyEvent;
    FOnDoubleClicked: TCDONotifyEvent;
    FOnSelectionChanged: TCDONotifyEvent;
    FOnShowColumnHeaders: TBaseTreeEvent;
  protected
    FNodeList: TCDONodeList;
    procedure ClearFrame; override;
    procedure ClearHeaders; override;
    function FindParentNode(ACDO: TCustomDomainObject; AParent:
        TCustomDomainObject): PVirtualNode;
    function GetImageIndexFor(ACDO: TCustomDomainObject; Selected: boolean):
        Integer; virtual;
    procedure ShowDobs(ACDO: TCustomDomainObject; AParent: TCustomDomainObject); override;
    procedure ShowDomainObject(ACDO: TCustomDomainObject; AParent:
        TCustomDomainObject); override;
    procedure RemoveDomainObject(ACDO: TCustomDomainObject; AParent:
        TCustomDomainObject);
    procedure SetCDO(const Value: TCustomDomainObject); override;
    function ShowChildrenOfList(AFromCDO: TCustomDomainObject): TCustomDomainObject;
        virtual;
    procedure UpdateCDO(ACDO: TCustomDomainObject; AEvent: TCDOEvent);
    procedure HandleDoubleClicked(ACDO: TCustomDomainObject); virtual;
    procedure HandleSelectionChanged(ACDO: TCustomDomainObject); virtual;
    procedure DoCDOChanged(ACDO: TCustomDomainObject);
    procedure DoDoubleClicked(ACDO: TCustomDomainObject);
    procedure DoSelectionChanged(ACDO: TCustomDomainObject);
    procedure DoShowColumnHeaders;
    procedure BeginLoad; override;
    procedure EndLoad; override;
    procedure ShowColumnHeaders; override;
    procedure AddDomainObject(ACDO: TCustomDomainObject; AParent:
        TCustomDomainObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CheckAll;
    function CheckedCount: integer;
    procedure FocusOn(ACDO: TCustomDomainObject);
    function GetTree: TCustomDomainObject;
    function GetSelection: TCustomDomainObject;
    procedure UncheckAll;
    property NodeCheckType: TCheckType read FNodeCheckType write FNodeCheckType;
    property OnCDOChanged: TCDONotifyEvent read FOnCDOChanged write FOnCDOChanged;
    property OnDoubleClicked: TCDONotifyEvent read FOnDoubleClicked write
        FOnDoubleClicked;
    property OnSelectionChanged: TCDONotifyEvent read FOnSelectionChanged
        write FOnSelectionChanged;
    property OnShowColumnHeaders: TBaseTreeEvent read FOnShowColumnHeaders
        write FOnShowColumnHeaders;
  end;

implementation

{$R *.dfm}

uses
  BaseGUIApp_fm
  , DomainObject_cls
  , GUIApplication_cls
  ;

constructor TCDONodeList.Create;
begin
  FCDOs := TObjectList.Create( false );
  FNodes := TList.Create;
end;

destructor TCDONodeList.Destroy;
begin
  FCDOs.Free;
  FNodes.Free;
  inherited;
end;

procedure TCDONodeList.Add(ACDO: TCustomDomainObject; ANode: PVirtualNode);
begin
  FCDOs.Add( ACDO );
  FNodes.Add( ANode );
end;

function TCDONodeList.CDOOf(ANode: PVirtualNode): TCustomDomainObject;
var
  Idx: integer;
begin
  Idx := FNodes.IndexOf( ANode );
  if Idx = -1 then begin
    Result := nil;
  end else begin
    Result := TCustomDomainObject( FCDOs[Idx] );
  end;
end;

function TCDONodeList.IndexOfCDO(ACDO: TCustomDomainObject): Integer;
begin
  Result := FCDOs.IndexOf( ACDO );
end;

function TCDONodeList.IndexOfNode(ANode: PVirtualNode): Integer;
begin
  Result := FNodes.IndexOf( ANode );
end;

procedure TCDONodeList.InvalidateNode(ANode: PVirtualNode);
var
  Tree: TBaseVirtualTree;
begin
  Tree := TreeFromNode( ANode );
  Tree.InvalidateNode( ANode );
end;

procedure TCDONodeList.InvalidateNodeFor(ACDO: TCustomDomainObject; AEvent:
  TCDOEvent);
var
  Idx: integer;
  Node: PVirtualNode;
  Tree: TBaseVirtualTree;
begin
  Idx := FCDOs.IndexOf( ACDO );
  if Idx > -1 then begin  // Just in case
    Node := PVirtualNode( FNodes[Idx] );
    Tree := TreeFromNode( Node );
    Tree.InvalidateNode( Node );
  end;
end;

function TCDONodeList.NodeOf(ACDO: TCustomDomainObject): PVirtualNode;
var
  Idx: integer;
begin
  Idx := FCDOs.IndexOf( ACDO );
  if Idx = -1 then begin
    Result := nil;
  end else begin
    Result := PVirtualNode( FNodes[Idx] );
  end;
end;

procedure TCDONodeList.Remove(ACDO: TCustomDomainObject);
begin
  FNodes.Delete( FCDOs.Remove( ACDO ) );
end;

procedure TBaseTreeFrame.ClearFrame;
begin
  inherited;
  Frame_Vst.Clear;
  FNodeList.Clear;  
  DoSelectionChanged( nil );
end;

constructor TBaseTreeFrame.Create(AOwner: TComponent);
begin
  FNodeList := TCDONodeList.Create;
  inherited;

  Frame_Vst.DefaultText := '';
  Frame_Vst.DragOperations := [];
  Frame_Vst.NodeDataSize := SizeOf( RTreeData );
//  // This is causing heavy recursions and InitNode executions!!!
//  Frame_Vst.TreeOptions.AutoOptions := Frame_Vst.TreeOptions.AutoOptions
//      + [toAutoSort];
  Frame_Vst.TreeOptions.MiscOptions := Frame_Vst.TreeOptions.MiscOptions
      - [toEditable]
      + [toCheckSupport{, toReadOnly}]
      ;
  Frame_Vst.TreeOptions.PaintOptions := Frame_Vst.TreeOptions.PaintOptions
      - [toHideFocusRect, toHideSelection];
  Frame_Vst.TreeOptions.SelectionOptions := Frame_Vst.TreeOptions.SelectionOptions
      // - []
      + [toFullRowSelect]
      ;
  Frame_Vst.Images := TBaseGUIAppForm( GUIApp.MainForm ).Images;
  Frame_Vst.Header.Images := TBaseGUIAppForm( GUIApp.MainForm ).HeaderImages;
  Frame_Vst.NodeDataSize := sizeof( RTreeData );
end;

destructor TBaseTreeFrame.Destroy;
begin
  FNodeList.Free;
  inherited;
end;

procedure TBaseTreeFrame.RemoveDomainObject(ACDO: TCustomDomainObject; AParent:
    TCustomDomainObject);
var
  Node: PVirtualNode;
begin
  Node := FNodeList.NodeOf( ACDO );
  if Node <> nil then begin
    FNodeList.Remove( ACDO );
    Frame_Vst.DeleteNode( Node );
  end;
end;

procedure TBaseTreeFrame.SetCDO(const Value: TCustomDomainObject);
begin
  if Value <> FCDO then begin
    if FCDO <> nil then begin
      FCDO.DetachObserver( self );
    end;
    inherited;
    if FCDO <> nil then begin
      FCDO.AttachObserver( self );
    end;
  end;
end;

procedure TBaseTreeFrame.ShowDomainObject(ACDO: TCustomDomainObject; AParent:
    TCustomDomainObject);
begin
// We are dealing with a virtual tree that asks for its data, and so we don't
// need to do anything here.
end;

procedure TBaseTreeFrame.UpdateCDO(ACDO: TCustomDomainObject; AEvent:
    TCDOEvent);
//var
//  Node: PVirtualNode;
begin
  if ACDO = CDO then begin // Root that isn't shown.
  end else begin
    case AEvent of
      ceAddedToList: begin
        AddDomainObject( ACDO, ACDO.Container );
        FocusOn( ACDO );
      end;
      ceSaved: begin
        FNodeList.InvalidateNodeFor( ACDO, AEvent );
        DoCDOChanged( ACDO );
      end;
      ceRemovedFromList: begin
        RemoveDomainObject( ACDO, ACDO.Container );
      end;
//      ceCheckStateChanged: begin
//        FNodeList.InvalidateNodeFor( ACDO, AEvent );
//      end;
(*
      ceListReloaded: begin
        Node := FNodeList.NodeOf( ACDO );
        Frame_Vst.ReInitNode( Node, true );
//        FNodeList.InvalidateNodeFor( ACDO, AEvent );
      end;
*)
    end;
  end;
end;

procedure TBaseTreeFrame.Frame_VstGetImageIndex(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
  var Ghosted: Boolean; var ImageIndex: Integer);
var
  ACDO: TCustomDomainObject;
  NodeData: ^RTreeData;
begin
  inherited;
  Case Column of
    -1, 0 : begin
      NodeData := Sender.GetNodeData( Node );
      ACDO := NodeData.CDO;
      case Kind of
        ikState: ImageIndex := -1;
        ikNormal: ImageIndex := GetImageIndexFor( ACDO, false );
        ikSelected: ImageIndex := GetImageIndexFor( ACDO, true );
        ikOverlay: ImageIndex := -1;
      else
        ImageIndex := -1;
      end;
    end;
  else
  end;
end;

procedure TBaseTreeFrame.Frame_VstGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: WideString);
begin
  inherited;
// Should be abstract.
end;

procedure TBaseTreeFrame.Frame_VstFocusChanged(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex);
var
  ACDO: TCustomDomainObject;
  NodeData: ^RTreeData;
begin
  inherited;
  NodeData := Sender.GetNodeData( Node );
  ACDO := NodeData.CDO;
  HandleSelectionChanged( ACDO );
end;

procedure TBaseTreeFrame.HandleSelectionChanged(ACDO: TCustomDomainObject);
begin
  DoSelectionChanged( ACDO );
end;

function TBaseTreeFrame.GetSelection: TCustomDomainObject;
var
  Node: PVirtualNode;
  NodeData: ^RTreeData;
begin
  Node := Frame_Vst.FocusedNode;
  if Node = nil then begin
    Result := nil;
  end else begin
    NodeData := Frame_Vst.GetNodeData( Node );
    Result := NodeData.CDO;
  end;
end;

procedure TBaseTreeFrame.DoSelectionChanged(ACDO: TCustomDomainObject);
begin
  if assigned( FOnSelectionChanged ) then begin
    FOnSelectionChanged( ACDO );
  end;
end;

procedure TBaseTreeFrame.DoCDOChanged(ACDO: TCustomDomainObject);
begin
  if assigned( FOnCDOChanged ) then begin
    FOnCDOChanged( ACDO );
  end;
end;

procedure TBaseTreeFrame.Frame_VstDblClick(Sender: TObject);
var
  ACDO: TCustomDomainObject;
  NodeData: ^RTreeData;
  Tree: TBaseVirtualTree;
begin
  inherited;
  if Sender is TBaseVirtualTree then begin
    Tree := TBaseVirtualTree( Sender );
    if Tree.FocusedNode <> nil then begin
      NodeData := Tree.GetNodeData( Tree.FocusedNode );
      ACDO := NodeData.CDO;
      HandleDoubleClicked( ACDO );
    end;
  end;
end;

procedure TBaseTreeFrame.HandleDoubleClicked(ACDO: TCustomDomainObject);
begin
  DoDoubleClicked( ACDO );
end;

procedure TBaseTreeFrame.DoDoubleClicked(ACDO: TCustomDomainObject);
begin
  if assigned( FOnDoubleClicked ) then begin
    FOnDoubleClicked( ACDO );
  end;
end;

procedure TBaseTreeFrame.BeginLoad;
begin
  inherited;
  Frame_Vst.BeginUpdate;
end;

procedure TBaseTreeFrame.EndLoad;
begin
  Frame_Vst.EndUpdate;
  inherited;
end;

procedure TBaseTreeFrame.DoShowColumnHeaders;
begin
  if assigned( FOnShowColumnHeaders ) then begin
    FOnShowColumnHeaders;
  end;
end;

procedure TBaseTreeFrame.ShowColumnHeaders;
begin
  inherited;
  DoShowColumnHeaders;
end;

procedure TBaseTreeFrame.ClearHeaders;
begin
  inherited;
  Frame_Vst.Header.Columns.Clear;
end;

procedure TCDONodeList.Clear;
begin
  FCDOs.Clear;
  FNodes.Clear;
end;

function TBaseTreeFrame.GetImageIndexFor(ACDO: TCustomDomainObject;
  Selected: boolean): Integer;
begin
// Should be abstract.
  Result := -1;
end;

procedure TBaseTreeFrame.ShowDobs(ACDO, AParent: TCustomDomainObject);
begin
// We are dealing with a virtual tree that asks for its data, so we don't
// need to do anything here.
  inherited;
  if CDO <> nil then begin
    Frame_Vst.RootNodeCount := CDO.CDOCount;
  end else begin
    Frame_Vst.RootNodeCount := 0;
  end;
end;

procedure TBaseTreeFrame.Frame_VstInitNode(Sender: TBaseVirtualTree;
  ParentNode, Node: PVirtualNode;
  var InitialStates: TVirtualNodeInitStates);
var
  ParentNodeData: ^RTreeData;
  ParentNodeCDO: TCustomDomainObject;
  NodeData: ^RTreeData;
  ChildCDO: TCustomDomainObject;
  ChildCDOCount: Cardinal;
begin
// Attach CDO to Node, but wich CDO???
// And tell Node whether it can have children. We don't care yet how many.

  inherited;
  if ParentNode = nil then begin
    ParentNodeCDO := CDO;
  end else begin
    ParentNodeData := Frame_Vst.GetNodeData( ParentNode );
    ParentNodeCDO := ParentNodeData.CDO;
  end;

  NodeData := Frame_Vst.GetNodeData( Node );
  if NodeData.CDO = nil then begin
    ChildCDO := ShowChildrenOfList( ParentNodeCDO );
    if ( ChildCDO <> nil ) then begin
      // Prevent warning on comparing signed/unsiged types.
      ChildCDOCount := ChildCDO.CDOCount;
      if ( ChildCDOCount > Node.Index ) then begin
//      if ChildCDO is TDomainObject then begin
//        NodeData.CDO := ParentNodeCDO.CDO[Node.Index];
//      end else if NodeData.CDO is TDomainObjectList then begin
          NodeData.CDO := ChildCDO.CDO[Node.Index];
//      end;
        FNodeList.Add( NodeData.CDO, Node );
      end;
    end;
  end else begin
    // CDO is already set when node was added through AddDomainObject.
  end;

  Node.CheckType := NodeCheckType;
  Sender.CheckState[Node] := csUncheckedNormal;

end;

procedure TBaseTreeFrame.Frame_VstInitChildren(Sender: TBaseVirtualTree;
  Node: PVirtualNode; var ChildCount: Cardinal);
begin
  inherited;
// This is called when user has clicked on a plus sign.
// We only need to tell the tree for how many children to prepare.

{ TODO -cWishList : This could be defaulted to something like
var
  NodeData: ^RTreeData;
begin
  inherited;
  NodeData := Sender.GetNodeData( Node );
  ChildCount := 0;
  if NodeData.CDO is TCustomDomainObjectList then begin
    ChildCount := NodeData.CDO.CDOCount;
  end;
}
end;

procedure TBaseTreeFrame.AddDomainObject(ACDO: TCustomDomainObject; AParent:
    TCustomDomainObject);
var
  Node: PVirtualNode;
  NodeData: ^RTreeData;
  ParentNode: PVirtualNode;
begin
  inherited;
  Node := FNodeList.NodeOf( ACDO );
  ParentNode := FindParentNode( ACDO, AParent );

  if Node = nil then begin
    Frame_Vst.BeginUpdate;  // Prevent auto sorting
    try
      if ParentNode = nil then begin  // we need the tree's root
        ParentNode := Frame_Vst.RootNode;
        Frame_Vst.RootNodeCount := Frame_Vst.RootNodeCount + 1;
      end else begin
        Frame_Vst.ChildCount[ParentNode] := Frame_Vst.ChildCount[ParentNode] + 1;
      end;
      Node := Frame_Vst.GetLastChild( ParentNode );
    finally
      Frame_Vst.EndUpdate;
    end;
    NodeData := Frame_Vst.GetNodeData( Node );
    NodeData.CDO := ACDO;
    FNodeList.Add( ACDO, Node );
  end else begin
    // it exists, so nothing to do.
  end;
end;

procedure TBaseTreeFrame.Frame_VstCompareNodes(Sender: TBaseVirtualTree;
  Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var
  Node1Data: ^RTreeData;
  Node2Data: ^RTreeData;
  Node1CDO: TCustomDomainObject;
  Node2CDO: TCustomDomainObject;
begin
  inherited;
  Node1Data := Frame_Vst.GetNodeData( Node1 );
  Node2Data := Frame_Vst.GetNodeData( Node2 );
  Node1CDO := Node1Data.CDO;
  Node2CDO := Node2Data.CDO;
//
  if ( Node1CDO = nil ) or ( Node2CDO = nil ) then begin
    Result := 0;
  end else if ( Node1CDO is TDomainObjectList ) <> ( Node2CDO is TDomainObjectList ) then begin
    if Node1CDO is TDomainObjectList then begin
      Result := -1;
    end else begin
      Result := 1;
    end;
  end else begin
    Result := AnsiCompareText( Node1CDO.SortString, Node2CDO.SortString );
  end;
end;

function TBaseTreeFrame.ShowChildrenOfList(AFromCDO: TCustomDomainObject): 
    TCustomDomainObject;
begin
// Should be abstract?
  Result := AFromCDO;
end;

procedure TBaseTreeFrame.FocusOn(ACDO: TCustomDomainObject);
var
  FocusOnNode: PVirtualNode;
begin
  FocusOnNode := FNodeList.NodeOf( ACDO );
  if FocusOnNode <> nil then begin
    Frame_Vst.FocusedNode := FocusOnNode;
    Frame_Vst.ClearSelection;
    Frame_Vst.Selected[FocusOnNode] := true;
  end;
end;

function TBaseTreeFrame.FindParentNode(ACDO,
  AParent: TCustomDomainObject): PVirtualNode;
begin
  Result := FNodeList.NodeOf( AParent );
  if Result = nil then begin
    if AParent.Container <> nil then begin
      Result := FindParentNode( AParent, AParent.Container );
    end;
  end;
end;

function TBaseTreeFrame.GetTree: TCustomDomainObject;
begin
  Result := CDO;
end;

procedure TBaseTreeFrame.CheckAll;
var
  Run: PVirtualNode;
begin
  Frame_Vst.BeginUpdate;
  try
    Run := Frame_Vst.GetFirstVisible;
    while Assigned( Run ) do begin
      Run.CheckState := csCheckedNormal;
      Run := Frame_Vst.GetNextVisible( Run );
    end;
    GetTree.CheckAll;
  finally
    Frame_Vst.EndUpdate;
  end;
end;

procedure TBaseTreeFrame.UncheckAll;
var
  Run: PVirtualNode;
begin
  Frame_Vst.BeginUpdate;
  try
    Run := Frame_Vst.GetFirstVisible;
    while Assigned( Run ) do begin
      Run.CheckState := csUncheckedNormal;
      Run := Frame_Vst.GetNextVisible( Run );
    end;
    GetTree.UncheckAll;
  finally
    Frame_Vst.EndUpdate;
  end;
end;

function TBaseTreeFrame.CheckedCount: integer;
var
  Run: PVirtualNode;
begin
  Result := 0;
  Run := Frame_Vst.GetFirstVisible;
  while Assigned( Run ) do begin
    if Run.CheckState in [csCheckedNormal, csCheckedPressed] then begin
      inc( Result );
    end;
    Run := Frame_Vst.GetNextVisible( Run );
  end;
end;

procedure TBaseTreeFrame.Frame_VstChecked(Sender: TBaseVirtualTree;
  Node: PVirtualNode);
var
  ACDO: TCustomDomainObject;
  NodeData: ^RTreeData;
begin
  inherited;
  NodeData := Sender.GetNodeData( Node );
  ACDO := NodeData.CDO;
  if ACDO <> nil then begin
    ACDO.Checked := ( Node.CheckState in [csCheckedNormal, csCheckedPressed] );
  end;
end;

end.
相关问题
最新问题