Delphi - dynamically calling different functions

Question

I have a treeview (VirtualTree) which has nodes. When a user clicks on a node, I need to run a specific function, passing the text name of the node. This function is one of the attributes of the node. For example, assume two nodes.

Node 1, Name = MyHouse, Function=BuildHouse
Node 2, Name = MyCar, function = RunCar

When I click on Node 1, I need to call the function BuildHouse('MyHouse');
When I click on Node 2, I need to call RunCar('MyCar');

Arguments are always strings. It should be noted that these are true functions, NOT members of a class.

There are too many nodes to have a CASE or IF/THEN type of code structure. I need a way to call the various functions dynamically, i.e. without hardcoding the behavior. How do I do this? How do I call a function when I have to lookup the name of the function at runtime, not compile time?

Thanks, GS

Answer 1

Larry has written a nice example on how to use function pointers, but there's still the problem of storing them in such way that VirtualTree can access them. There are at least two approaches you could use here.

1. Store function pointers with the data

If the name and function belong together in your whole application, you would typically want to put them together into one structure.

type
  TStringProc = procedure (const s: string);

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

var
  FNodeData: array of TNodeData;

If you have two string functions ...

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

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

... you can put them into this structure with the following code.

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

VirtualTree would then only need to store an index into this array as an additional data belonging to each node.

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

OnGetText reads this integer from the node data, looks into the FNodeData and displays the name.

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

On click (I used OnFocusChanged for this example) you would again fetch the index from the node data and call the appropriate function.

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. Store function pointers directly into VirtualTree

If your string functions are only used when you are displaying the tree, it makes sense to manage the data structure (node names) independently and store function pointers directly into the node data. To do that, you have to expand NodeDataSize to 8 (4 bytes for the pointer into name structure, 4 bytes for the function pointer).

As the VirtualTree doesn't offer any nice way of processing user data, I like to use following helpers to access individual pointer-sized "slots" in the user data. (Imagine user data being an array with the first index 0 - those functions access this pseudo-array.)

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 stores names of individual nodes):

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

Helper function AddNode stores node name into FNodeNames, creates a new node, sets node index into the first user data "slot" and string procedure into the second "slot".

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;

Text display is identical to the previous case (except that I'm now using the helper function to access user data).

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

OnFocusChanged fetches name index from the first user data "slot", function pointer from the second "slot" and calls the appropriate function.

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. Object-oriented approach

There's also an option of doing it in an object-oriented manner. (I know I said "at least two approaches" at the beginning. That's because this third approach doesn't fully comply with your definition (string functions as pure functions, not methods).)

Set up class hierarchy with one class for each possible string function.

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;

Nodes (instances of the class) can be stored directly in the VirtualTree.

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

To get the node text, you simply cast the user data back to TNode and access the Name property ...

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

... and to call the appropriate function, do the same but call the Process virtual method.

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

The problem with this approach is that you must manually destroy all those objects before the VirtualTree is destroyed. The best place to do it is in the OnFreeNode event.

procedure vtTreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
begin
  TNode(VTGetNodeData(vtTree, node, 0)).Free;
end;

Answer 2

Delphi allows to create variables that point to functions and then call the function through the variable. So, you can create your functions and assign a function to a properly typed attribute of the node (or you can assign functions to, for example, the handy data property of many collection items classes).

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;