Delphi - appel dynamique de différentes fonctions

J'ai un arbre (VirtualTree) qui a des nœuds. Lorsqu'un utilisateur clique sur un nœud, je dois exécuter une fonction spécifique en transmettant le nom textuel du nœud. Cette fonction est l'un des attributs du noeud. Par exemple, supposons deux nœuds.

Nœud 1, Nom = MyHouse, Fonction = BuildHouse
Noeud 2, Nom = MyCar, fonction = RunCar

Lorsque je clique sur le nœud 1, je dois appeler la fonction BuildHouse ('MyHouse');
Lorsque je clique sur le nœud 2, je dois appeler RunCar ('MyCar');

Les arguments sont toujours des chaînes. Il convient de noter que ce sont des fonctions vraies, PAS membres d'une classe.

Il y a trop de nœuds pour avoir un type de structure de code de type CASE ou IF/THEN. J'ai besoin d'un moyen d'appeler les différentes fonctions de manière dynamique, c'est-à-dire sans coder en dur le comportement. Comment puis-je faire cela? Comment appeler une fonction lorsque je dois rechercher le nom de la fonction au moment de l'exécution, pas au moment de la compilation?

Merci, GS

9
Désolé pour le offtopic mais j'ai vu ce virtualtree est très populaire où puis-je obtenir ce composant?
ajouté l'auteur opc0de, source
Les sous-classes et les méthodes virtuelles constituent la meilleure approche, si possible. Sinon, les pointeurs de fonction Pascal/Delphi conviennent. Larry Lustig donne un excellent exemple ci-dessous.
ajouté l'auteur paulsm4, source
Je déteste nécromancer mon propre message ... mais une autre alternative (selon le scénario) consiste simplement à déclarer votre pointeur de méthode AS un pointeur de méthode. EXEMPLE: type TNodeFunction = procédure (AInput: String) de l’objet; . Plus de détails ici: docwiki.embarcadero.com/RADStudio/XE3/en/…
ajouté l'auteur paulsm4, source
ajouté l'auteur gabr, source

3 Réponses

Larry a écrit un bel exemple d'utilisation des pointeurs de fonction, mais le problème est de les stocker de manière à ce que VirtualTree puisse y accéder. Il y a au moins deux approches que vous pouvez utiliser ici.

1. Stocker les pointeurs de fonction avec les données

Si le nom et la fonction appartiennent à l'ensemble de votre application, vous souhaiterez généralement les regrouper dans une seule structure.

type
  TStringProc = procedure (const s: string);

  TNodeData = record
    Name: string;
    Proc: TStringProc;
  end;

var
  FNodeData: array of TNodeData;

Si vous avez deux fonctions de chaîne ...

procedure RunCar(const s: string);
begin
  ShowMessage('RunCar: ' + s);
end;

procedure BuildHouse(const s: string);
begin
  ShowMessage('BuildHouse: ' + s);
end;

... vous pouvez les mettre dans cette structure avec le code suivant.

procedure InitNodeData;
begin
  SetLength(FNodeData, 2);
  FNodeData[0].Name := 'Car';   FNodeData[0].Proc := @RunCar;
  FNodeData[1].Name := 'House'; FNodeData[1].Proc := @BuildHouse;
end;

VirtualTree n'aurait alors besoin que de stocker un index dans ce tableau en tant que données supplémentaires appartenant à chaque nœud.

InitNodeData;
vtTree.NodeDataSize := 4;
vtTree.AddChild(nil, pointer(0));
vtTree.AddChild(nil, pointer(1));

OnGetText lit cet entier à partir des données du nœud, examine le FNodeData et affiche le nom.

procedure vtTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column:
  TColumnIndex; TextType: TVSTTextType; var CellText: string);
begin
  CellText := FNodeData[integer(vtTree.GetNodeData(Node)^)].Name;
end;

Au clic (j'ai utilisé OnFocusChanged pour cet exemple), vous récupérez à nouveau l'index à partir des données du nœud et appelez la fonction appropriée.

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. Stockez les pointeurs de fonction directement dans VirtualTree

Si vos fonctions de chaîne ne sont utilisées que lorsque vous affichez l'arborescence, il est judicieux de gérer la structure de données (noms de nœuds) de manière indépendante et de stocker les pointeurs de fonction directement dans les données de nœud. Pour ce faire, vous devez développer NodeDataSize à 8 (4 octets pour le pointeur dans la structure de noms, 4 octets pour le pointeur de fonction).

Comme le VirtualTree n'offre aucun moyen intéressant de traiter les données utilisateur, j'aime utiliser les assistants suivants pour accéder aux "emplacements" de la taille d'un pointeur dans les données utilisateur. (Imaginez que les données utilisateur soient un tableau avec le premier index 0 - ces fonctions accèdent à ce pseudo-tableau.)

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;

Constructeur d'arborescence (FNodeNames stocke les noms des nœuds individuels):

Assert(SizeOf(TStringProc) = 4);
FNodeNames := TStringList.Create;
vtTree.NodeDataSize := 8;
AddNode('Car', @RunCar);
AddNode('House', @BuildHouse);

La fonction d'assistance AddNode stocke le nom du nœud dans FNodeNames, crée un nouveau nœud, définit l'index du nœud dans le premier "emplacement" de données utilisateur et la procédure de chaîne dans le deuxième "emplacement".

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;

L'affichage du texte est identique au cas précédent (sauf que j'utilise maintenant la fonction d'assistance pour accéder aux données de l'utilisateur).

procedure vtTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column:
  TColumnIndex; TextType: TVSTTextType; var CellText: string);
begin
  CellText := FNodeNames[VTGetNodeDataInt(vtTree, node, 0)];
end;

OnFocusChanged récupère l'index de nom du premier "emplacement" de données utilisateur, le pointeur de la fonction du deuxième "emplacement" et appelle la fonction appropriée.

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. Approche orientée objet

Il est également possible de le faire de manière orientée objet. (Je sais que j'ai dit «au moins deux approches» au début. C'est parce que cette troisième approche n'est pas totalement conforme à votre définition (les fonctions de chaîne sont des fonctions pures, pas des méthodes).)

Configurez la hiérarchie des classes avec une classe pour chaque fonction de chaîne possible.

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;

Les nœuds (instances de la classe) peuvent être stockés directement dans le VirtualTree.

Assert(SizeOf(TNode) = 4);
vtTree.NodeDataSize := 4;
vtTree.AddChild(nil, TVehicle.Create('Car'));
vtTree.AddChild(nil, TBuilding.Create('House'));

Pour obtenir le texte du nœud, il vous suffit de convertir les données utilisateur en TNode et d'accéder à la propriété Name ...

procedure vtTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column:
  TColumnIndex; TextType: TVSTTextType; var CellText: string);
begin
  CellText := TNode(VTGetNodeData(vtTree, node, 0)).Name;
end;

... et pour appeler la fonction appropriée, procédez de la même manière, mais appelez la méthode virtuelle Process.

procedure vtTreeFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Column: TColumnIndex);
begin
  TNode(VTGetNodeData(vtTree, node, 0)).Process;
end;

Le problème avec cette approche est que vous devez détruire manuellement tous ces objets avant que le VirtualTree ne soit détruit. Le meilleur endroit pour le faire est dans l'événement OnFreeNode.

procedure vtTreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
begin
  TNode(VTGetNodeData(vtTree, node, 0)).Free;
end;
19
ajouté
+1 - TRÈS bien!
ajouté l'auteur paulsm4, source
+1, excellente réponse
ajouté l'auteur TLama, source

Delphi permet de créer des variables qui pointent sur des fonctions, puis d’appeler la fonction par le biais de la variable. Vous pouvez donc créer vos fonctions et affecter une fonction à un attribut correctement typé du nœud (ou attribuer des fonctions à, par exemple, la propriété pratique data </​​code> de nombreuses classes d'éléments de collection).

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
ajouté

Je n’utilise jamais VirtualTree mais je peux vous dire 2 façons de le faire.

Première manière:

Si vous utilisez Delphi 2009 ou une version supérieure, essayez d'utiliser rtti pour appeler la méthode de manière dynamique.

ceci est un exemple pour 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;

Deuxièmement, si vous connaissez le type de paramètres et le nombre de fonctions, vous pouvez placer un pointeur de votre fonction dans chaque nœud!

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

2
ajouté
Assurez-vous que TProc = procédure (var p1: chaîne; p2: entier); comme utilisateur 1009073 disent spécifiquement qu'ils ne sont pas des méthodes d'une classe.
ajouté l'auteur Gerry Coll, source