How to declare a Delphi object method called from a script with a procedure type argument

Question

The Delphi application runs a DWS script. The Delphi application provides an instance of the object, calls it "MyApplication", a script. An open object has a method in which one argument is a procedure.

Essentially, the goal is for the Delphi method to perform some calculations and stop this calculation when the callback procedure says it is done. The callback procedure is inside the script.

I implemented this by passing the name of the callback function as a string. It works well, except that type checking is not performed in the compile-time script. I would like to pass the actual procedure so that the script compiler can catch any error at compile time.

How to do it?

To help the reader understand what I mean, I show some - not working - code:

First a simplified version of the Delphi side:

Interface
type
    TAppCheckProc = procedure (var Done : Boolean);

TMyApplication = class(TPersistent)
published
    procedure Demo(CheckProc : TAppCheckProc);
end;

Implementation

TMyApplication.Demo(CheckProc : TAppCheckProc);
var
    Done : Boolean;
begin
    Done := FALSE;
    while not Done do begin
        // Some more code here...
        CheckProc(Done);
    end;
end;

Secondly, on the script side, I have this (also simplified ):

procedure CheckProc(
    var Done : Boolean);
var
    Value : Integer;
begin
    DigitalIO.DataIn(1, Value);
    Done := (Value and 8) = 0;
end;

procedure Test;
begin
    MyApplication.Demo(CheckProc);
end;

Probably, the argument to the Demo method should be declared differently and should be called differently. This is a question ...

Edit: Removed additional tag argument (error while simplifying code, this is not a question).

Answer 1

I put it together quickly and it works. It gives a compilation error when the parameters for the callback are incorrect. You need to create a delegate and use it as a type.

An example of using a standalone function

dwsUnit - TdwsUnit, Delphi.

procedure TMainForm.FormCreate(Sender: TObject);
var
  delegate: TdwsDelegate;
  func: TdwsFunction;
  parm: TdwsParameter;
begin
  // Create a delegate
  delegate := dwsUnit.Delegates.Add;
  delegate.Name := 'TAppCheckProc';
  parm := delegate.Parameters.Add;
  parm.Name := 'Done';
  parm.DataType := 'Boolean';
  parm.IsVarParam := True;

  // Create our function and link it to the event handler
  func := dwsUnit.Functions.Add;
  func.Name := 'Demo';
  func.OnEval := dwsUnitFunctionsDemoEval;
  parm := func.Parameters.Add;
  parm.Name := 'CheckProc';
  parm.DataType := 'TAppCheckProc';
end;

script, , :

procedure CheckProc(
    var Done : Boolean);
begin
  if Done then
    SayHello('World');
end;

Demo(CheckProc);

, script.

:

procedure TMainForm.dwsUnitFunctionsDemoEval(info: TProgramInfo);
begin
  info.Vars['CheckProc'].Call([True]);
end;

, . , CustomClasses TEarth, .

procedure TMainForm.FormCreate(Sender: TObject);
var
  delegate: TdwsDelegate;
  method: TdwsMethod;
  parm: TdwsParameter;
begin
  // Create a delegate
  delegate := dwsUnit.Delegates.Add;
  delegate.Name := 'TAppCheckProc';
  parm := delegate.Parameters.Add;
  parm.Name := 'Done';
  parm.DataType := 'Boolean';
  parm.IsVarParam := True;

  // Create our method and link it to the event handler
  method := TdwsClass(dwsUnit.Classes.Symbols['TEarth']).Methods.Add;
  method.Name := 'Demo';
  method.OnEval := dwsUnitFunctionsDemoEval;
  parm := method.Parameters.Add;
  parm.Name := 'CheckProc';
  parm.DataType := 'TAppCheckProc';
end;

script, :

procedure CheckProc(
    var Done : Boolean);
begin
  if Done then
    PrintLn('Called with true')
  else
    PrintLn('Called with false');
end;

var earth: TEarth;
earth:=TEarth.Create;
earth.Demo(CheckProc);

:

procedure TMainForm.dwsUnitFunctionsDemoEval(info: TProgramInfo; ExtObject:
    TObject);
begin
  info.Vars['CheckProc'].Call([True]);
end;

, script .

SpeedFreak . IDE, .