Ларри написал хороший пример того, как использовать указатели на функции, но все еще существует проблема их хранения таким образом, чтобы VirtualTree мог получить к ним доступ. Здесь можно использовать как минимум два подхода.
1. Хранить указатели функций с данными
Если имя и функция принадлежат всему вашему приложению, вы обычно хотите объединить их в одну структуру.
type
TStringProc = procedure (const s: string);
TNodeData = record
Name: string;
Proc: TStringProc;
end;
var
FNodeData: array of TNodeData;
Если у вас есть две строковые функции ...
procedure RunCar(const s: string);
begin
ShowMessage('RunCar: ' + s);
end;
procedure BuildHouse(const s: string);
begin
ShowMessage('BuildHouse: ' + s);
end;
... вы можете поместить их в эту структуру с помощью следующего кода.
procedure InitNodeData;
begin
SetLength(FNodeData, 2);
FNodeData[0].Name := 'Car'; FNodeData[0].Proc := @RunCar;
FNodeData[1].Name := 'House'; FNodeData[1].Proc := @BuildHouse;
end;
В этом случае VirtualTree потребуется только сохранить индекс в этом массиве в качестве дополнительных данных, принадлежащих каждому узлу.
InitNodeData;
vtTree.NodeDataSize := 4;
vtTree.AddChild(nil, pointer(0));
vtTree.AddChild(nil, pointer(1));
OnGetText считывает это целое число из данных узла, просматривает FNodeData и отображает имя.
procedure vtTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column:
TColumnIndex; TextType: TVSTTextType; var CellText: string);
begin
CellText := FNodeData[integer(vtTree.GetNodeData(Node)^)].Name;
end;
При щелчке (я использовал OnFocusChanged для этого примера) вы снова извлекаете индекс из данных узла и вызываете соответствующую функцию.
procedure vtTreeFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex);
var
nodeIndex: integer;
begin
if assigned(Node) then begin
nodeIndex := integer(vtTree.GetNodeData(Node)^);
FNodeData[nodeIndex].Proc(FNodeData[nodeIndex].Name);
end;
end;
2. Хранить указатели функций непосредственно в VirtualTree
Если ваши строковые функции используются только при отображении дерева, имеет смысл независимо управлять структурой данных (именами узлов) и сохранять указатели функций непосредственно в данных узла. Для этого вам нужно расширить NodeDataSize до 8 (4 байта для указателя на структуру имени, 4 байта для указателя функции).
Поскольку VirtualTree не предлагает какого-либо приятного способа обработки пользовательских данных, я хотел бы использовать следующие помощники для доступа к отдельным "слотам" размером с указатель в пользовательских данных. (Представьте, что пользовательские данные - это массив с первым индексом 0 - эти функции обращаются к этому псевдомассиву.)
function VTGetNodeData(vt: TBaseVirtualTree; node: PVirtualNode; ptrOffset: integer): pointer;
begin
Result := nil;
if not assigned(node) then
node := vt.FocusedNode;
if assigned(node) then
Result := pointer(pointer(int64(vt.GetNodeData(node)) + ptrOffset * SizeOf(pointer))^);
end;
function VTGetNodeDataInt(vt: TBaseVirtualTree; node: PVirtualNode; ptrOffset: integer): integer;
begin
Result := integer(VTGetNodeData(vt, node, ptrOffset));
end;
procedure VTSetNodeData(vt: TBaseVirtualTree; value: pointer; node: PVirtualNode;
ptrOffset: integer);
begin
if not assigned(node) then
node := vt.FocusedNode;
pointer(pointer(int64(vt.GetNodeData(node)) + ptrOffset * SizeOf(pointer))^) := value;
end;
procedure VTSetNodeDataInt(vt: TBaseVirtualTree; value: integer; node: PVirtualNode;
ptrOffset: integer);
begin
VTSetNodeData(vt, pointer(value), node, ptrOffset);
end;
Построитель дерева (FNodeNames хранит имена отдельных узлов):
Assert(SizeOf(TStringProc) = 4);
FNodeNames := TStringList.Create;
vtTree.NodeDataSize := 8;
AddNode('Car', @RunCar);
AddNode('House', @BuildHouse);
Вспомогательная функция AddNode сохраняет имя узла в FNodeNames, создает новый узел, устанавливает индекс узла в первый «слот» пользовательских данных, а строковую процедуру во второй «слот».
procedure AddNode(const name: string; proc: TStringProc);
var
node: PVirtualNode;
begin
FNodeNames.Add(name);
node := vtTree.AddChild(nil);
VTSetNodeDataInt(vtTree, FNodeNames.Count - 1, node, 0);
VTSetNodeData(vtTree, pointer(@proc), node, 1);
end;
Отображение текста идентично предыдущему случаю (за исключением того, что сейчас я использую вспомогательную функцию для доступа к пользовательским данным).
procedure vtTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column:
TColumnIndex; TextType: TVSTTextType; var CellText: string);
begin
CellText := FNodeNames[VTGetNodeDataInt(vtTree, node, 0)];
end;
OnFocusChanged извлекает индекс имени из первого «слота» пользовательских данных, указатель функции из второго «слота» и вызывает соответствующую функцию.
procedure vtTreeFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex);
var
nameIndex: integer;
proc: TStringProc;
begin
if assigned(Node) then begin
nameIndex := VTGetNodeDataInt(vtTree, node, 0);
proc := TStringProc(VTGetNodeData(vtTree, node, 1));
proc(FNodeNames[nameIndex]);
end;
end;
3. Объектно-ориентированный подход
Также есть возможность сделать это объектно-ориентированным способом. (Я знаю, что сказал «по крайней мере два подхода» в начале. Это потому, что этот третий подход не полностью соответствует вашему определению (строковые функции как чистые функции, а не методы).)
Настройка иерархии классов с одним классом для каждой возможной строковой функции.
type
TNode = class
strict private
FName: string;
public
constructor Create(const name: string);
procedure Process; virtual; abstract;
property Name: string read FName;
end;
TVehicle = class(TNode)
public
procedure Process; override;
end;
TBuilding = class(TNode)
public
procedure Process; override;
end;
{ TNode }
constructor TNode.Create(const name: string);
begin
inherited Create;
FName := name;
end;
{ TVehicle }
procedure TVehicle.Process;
begin
ShowMessage('Run: ' + Name);
end;
{ TBuilding }
procedure TBuilding.Process;
begin
ShowMessage('Build: ' + Name);
end;
Узлы (экземпляры класса) могут храниться непосредственно в VirtualTree.
Assert(SizeOf(TNode) = 4);
vtTree.NodeDataSize := 4;
vtTree.AddChild(nil, TVehicle.Create('Car'));
vtTree.AddChild(nil, TBuilding.Create('House'));
Чтобы получить текст узла, вы просто приводите пользовательские данные обратно в TNode и получаете доступ к свойству Name ...
procedure vtTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column:
TColumnIndex; TextType: TVSTTextType; var CellText: string);
begin
CellText := TNode(VTGetNodeData(vtTree, node, 0)).Name;
end;
... и для вызова соответствующей функции сделайте то же самое, но вызовите виртуальный метод Process.
procedure vtTreeFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex);
begin
TNode(VTGetNodeData(vtTree, node, 0)).Process;
end;
Проблема этого подхода заключается в том, что вы должны вручную уничтожить все эти объекты, прежде чем VirtualTree будет уничтожен. Лучшее место для этого - событие OnFreeNode.
procedure vtTreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
begin
TNode(VTGetNodeData(vtTree, node, 0)).Free;
end;