Delphi - динамическое назначение различных функций

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

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

Когда я нажимаю на Node 1, мне нужно вызвать функцию BuildHouse («MyHouse»),
Когда я нажимаю на узел 2, мне нужно вызвать RunCar («MyCar»);

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

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

Благодаря, GS

9
Извините за оффтоп, но я видел, что virtualtree очень популярен, где я могу получить этот компонент?
добавлено автор opc0de, источник
Подклассы и виртуальные методы - лучший подход, если это практично. В противном случае указатели функций Pascal/Delphi прекрасны. Ларри Лустиг дает отличный пример ниже.
добавлено автор paulsm4, источник
Я ненавижу некромант моего собственного сообщения ... но другая альтернатива (в зависимости от сценария) - просто объявить указатель метода AS указателем метода. ПРИМЕР: type TNodeFunction = procedure (AInput: String) объекта; . Подробнее здесь: docwiki.embarcadero.com/RADStudio/XE3/en/…
добавлено автор paulsm4, источник
добавлено автор gabr, источник

3 ответы

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

Tree builder (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;
19
добавлено
+1 - ОЧЕНЬ хорошо!
добавлено автор paulsm4, источник
+1, отличный ответ
добавлено автор TLama, источник

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

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;
13
добавлено

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

Первый путь:

если вы используете 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;

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

But you have to define a procedure or function type like as Tproc = procedure (var p1: string; p2: integer) of object;

2
добавлено
Сделайте это TProc = procedure (var p1: string; p2: integer); , поскольку user1009073 определенно говорят, что это не методы класса.
добавлено автор Gerry Coll, источник
Delphi & Lazarus
Delphi & Lazarus
274 участник(ов)

Чат про Delphi и Lazarus