1. ホーム
  2. 質問と答え
  3. 仮想ツリービューを使用してTStringGridを実装する方法は？

仮想ツリービューを使用してTStringGridを実装する方法は？

2011-01-18 8 views

答えて

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.

出典

2011-01-18 07:21:43

+0

コードと+盗難防止ツール1 – Mawg

2

あなたは、Dorin Duminica blog

出典

2011-01-18 03:48:04 kludg

+1

Serg、ありがとうございました:-) – ComputerSaysNo

+1

+1ありがとうございました。私は私が極度のパラノイドであると同時にビデオを見ることができるPCを見つけなければならないでしょう。 -/ – Mawg

+0

これは非常に印象的なソフトウェアのようです。残念なことに、学習曲線を意味し、私は学習に多くの時間がないので、他の多くの重さの下で溺れています。だから私はツリープロパティを持たない単純な文字列グリッドを実装する方法を私に示すコードをいくつか探していました。 X行だけY行だけ。 – Mawg

3

例でそれを見つけることができ、ここで見つけることができます：

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

それは私がいくつかを開始すると遊んでてきた何か新しいベースフレーム、そこにあなたが必要としないものがあるかもしれません。 BaseTree_frユニットには、古いプロジェクトのVirtualStringTreeが含まれています。 Tree_fm.pasユニットには私の新しい努力が含まれています。 Tree_fm.pasには、新しいノードを動的に追加したり既存のノードを削除したりすることはまだありませんが、BaseTree_frユニットで見つけることができます。

StackOverflowの精神を自分の2フィートに保つために、私はここに両方の​​ユニットを含めています。

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.

そして第二に答えで古いもの

チェックは、私は、テキスト文字の制限を超えた新たな取り組み...

出典

2011-01-18 07:13:28

+0

+1 – Mawg

関連する問題

 関連する問題