Блог

У меня есть treeview (виртуальное дерево), в котором есть узлы. Когда пользователь нажимает на узел, мне нужно запустить определенную функцию, передавая текстовое имя узла. Эта функция является одним из атрибутов узла. Например, предположим, что существует два узла.

Узел 1, Имя = myHouse, Функция =BuildHouse
Узел 2, Имя = myCar, функция = RunCar

Когда я нажимаю на узел 1, мне нужно вызвать функцию BuildHouse (‘myHouse’);
Когда я нажимаю на узел 2, мне нужно вызвать RunCar (‘myCar’);

Аргументы всегда являются строками. Следует отметить, что это настоящие функции, А НЕ члены класса.

Узлов слишком много, чтобы иметь структуру кода типа CASE или IF / THEN. Мне нужен способ вызывать различные функции динамически, т. е. без жесткого кодирования поведения. Как мне это сделать? Как мне вызвать функцию, когда мне нужно выполнить поиск по имени функции во время выполнения, а не во время компиляции?

Спасибо, GS

Ларри написал хороший пример того, как использовать указатели на функции, но все еще существует проблема их хранения таким образом, чтобы 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;
  

Delphi позволяет создавать переменные, которые указывают на функции, а затем вызывать функцию через переменную. Итак, вы можете создавать свои функции и назначать функцию правильно введенному атрибуту узла (или вы можете назначать функции, например, удобному data свойству многих классов элементов коллекции).

 interface

type
  TNodeFunction = function(AInput: String): String;

implementation

function Func1(AInput: String): String;
begin
   result := AInput;
end;

function Func2(AInput: String): String;
begin
   result := 'Fooled You';
end;

function Func3(AInput: String): String;
begin
   result := UpperCase(AInput);
end;

procedure Demonstration;
var
  SomeFunc, SomeOtherFunc: TNodeFunction;
begin

     SomeOtherFunc = Func3;

     SomeFunc := Func1;
     SomeFunc('Hello');   // returns 'Hello'
     SomeFunc := Func2;
     SomeFunc('Hello');   // returns 'Fooled You'

     SomeOtherFunc('lower case'); // returns 'LOWER CASE'

end;
  

Я никогда не использую VirtualTree, но могу подсказать вам 2 способа для этого.

Первый способ:

если вы используете Delphi 2009 или более позднюю версию, попробуйте использовать rtti для динамического вызова метода

это пример для rtti

 uses rtti;

function TVLCVideo.Invoke(method: string; p: array of TValue): TValue;
var
  ctx     : TRttiContext;
  lType   : TRttiType;
  lMethod : TRttiMethod;

begin
  ctx := TRttiContext.Create;
  lType:=ctx.GetType(Self.ClassInfo); // where is the your functions list ? if TFunctions replace the Self with TFunctions class
  Result := nil;
  try
    if Assigned(lType) then
      begin
       lMethod:=lType.GetMethod(method);

       if Assigned(lMethod) then
        Result := lMethod.Invoke(Self, p);  // and here is same replace with your functions class
      end;
  finally
    lMethod.Free;
    lType.Free;
    ctx.Free;
  end;
end;
  

Второй способ — если вы знаете тип параметров и количество функций, вы можете поместить указатель на свою функцию в каждый узел!

Но вы должны определить процедуру или тип функции, такой как as Tproc = procedure (var p1: string; p2: integer) of object;