LazProfiler/vtvObject.pas at master · PascalRiekenberg/LazProfiler · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
{
    Copyright (c) 2017-18 Pascal Riekenberg

    VirtualTreeView-Helper-Class

    See the file COPYING.modifiedLGPL.txt, included in this distribution,
    for details about the license.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}

unit vtvObject;

{$mode objfpc}{$H+}

interface

uses
  Classes,
  Generics.Collections,
  SysUtils,
  Laz.VirtualTrees;

type

  { TvtvObj }

  TvtvObj = class;
  TvtvObjList = specialize TObjectList<TvtvObj>;

  TvtvObj = class
  private
    function GetCheckState: TCheckState; inline;
    procedure SetNode(pValue: PVirtualNode);
  protected
    fLine: Integer;
    fVst: TBaseVirtualTree;
    fNode: PVirtualNode;
    fParent, fRoot: TvtvObj;
    fChilds: TvtvObjList;
    procedure SetCheckState(pCheckState: TCheckState); virtual;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Add(pChild: TvtvObj);
    function CellText(Column: TColumnIndex; TextType: TVSTTextType): String; virtual; abstract;
    function InitialStates: TVirtualNodeInitStates; virtual;
    function InitChildren: Cardinal; virtual;
    function ImageIndex(pColumn: TColumnIndex): Integer; virtual;
    procedure InitNode(pVST: TBaseVirtualTree; pNode: PVirtualNode); virtual;
    procedure UpdateExpanded; virtual;
    property Node: PVirtualNode read fNode write SetNode;
    property Childs: TvtvObjList read fChilds;
    property Parent: TvtvObj read fParent;
    property Root: TvtvObj read fRoot;
    property CheckState: TCheckState read GetCheckState write SetCheckState;
    property Line: Integer read fLine write fLine;
  end;
  PvtvObj = ^TvtvObj;

implementation

{ TvtvObj }

function TvtvObj.GetCheckState: TCheckState;
begin
  Result := fNode^.CheckState;
end;

procedure TvtvObj.SetCheckState(pCheckState: TCheckState);
var
  i: Integer;
begin
  fNode^.CheckState := pCheckState;
  for i := 0 to fChilds.Count - 1 do
    fChilds[i].CheckState := pCheckState;
end;

procedure TvtvObj.SetNode(pValue: PVirtualNode);
begin
  if fNode = pValue then Exit;
  fNode := pValue;
end;

constructor TvtvObj.Create;
begin
  fChilds := TvtvObjList.Create(True);
  fParent := nil;
  fRoot := nil;
  fNode := nil;
end;

destructor TvtvObj.Destroy;
begin
  FreeAndNil(fChilds);
  inherited Destroy;
end;

procedure TvtvObj.Add(pChild: TvtvObj);
begin
  pChild.fParent := Self;
  fChilds.Add(pChild);
  pChild.fRoot := Self;
  while Assigned(pChild.fRoot.fParent) do pChild.fRoot := pChild.fRoot.fParent;
end;

function TvtvObj.InitialStates: TVirtualNodeInitStates;
begin
  Result := [];
  if fChilds.Count > 0 then
    Result := Result + [ivsHasChildren];
end;

function TvtvObj.InitChildren: Cardinal;
begin
  Result := fChilds.Count;
end;

function TvtvObj.ImageIndex(pColumn: TColumnIndex): Integer;
begin
  Result := -1;
end;

procedure TvtvObj.InitNode(pVST: TBaseVirtualTree; pNode: PVirtualNode);
begin
  fVst := pVST;
  fNode := pNode;
end;

procedure TvtvObj.UpdateExpanded;
begin
  // do nothing
end;

end.