(The code coloring is made thanks to DELPHI CODE CONVERTER by Angus Johnson)
unit MethodAddrDemoUMain;

    { ****************************************************************** }
    {                                                                    }
    {   Delphi (6) unit  --   Illustrates how to access an object's      }
    {   published methods, using their name (as string).                 }
    {   It illustrates too how to store pointers in variants.            }
    {                                                                    }
    {   Part I : The place from where we'll call our published           }
    {            procedures and functions.                               }
    {                                                                    }
    {                  ----------------------------                      }
    {                                                                    }
    {   Copyright © 2005 by Olivier Touzot                               }
    {   (http://mapage.noos.fr/qnno/delphi_en.htm  -  qnno@noos.fr)      }
    {                                                                    }
    {   This code is provided "as is" without any guarantee. It can be   }
    {   freely used.                                                     }
    {                                                                    }
    { ****************************************************************** }

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, Menus, shellapi, ExtCtrls,
  MethodAddrDemoUParser;  // the one where our published methods are declared

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    StringGrid1: TStringGrid;
    Memo1: TMemo;
    Button4: TButton;
    Bevel1: TBevel;
    Bevel2: TBevel;
    Bevel3: TBevel;
    PopupMenu1: TPopupMenu;
    LineSummary1: TMenuItem;
    Duration1: TMenuItem;
    TotalDuration1: TMenuItem;
    AverageDuration1: TMenuItem;
    TotalAccess1: TMenuItem;
    AverageAccess1: TMenuItem;
    Memo2: TMemo;
    Memo3: TMemo;
    Memo4: TMemo;
    Bevel4: TBevel;
    Label1: TLabel;
    Label2: TLabel;
    Button5: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Label2Click(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

// TMenuManager will just store the variant array which will be passed to
// the methods called by a click on a menu item, together with the
// click event handler.
TMenuManager = Class
Private
  fData : Variant;
  Procedure ClickHandler(Sender: TObject);
Public
  Constructor Create;
  Destructor  Destroy; override;
End;

var
  Form1: TForm1;
  appelCount : integer = 0;
  aMenuManager : TMenuManager;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var i : integer;
begin
  // Grid contents
  With Form1.StringGrid1 Do
  Begin
    // headers
    Cells[0,0] := 'Event observed';
    Cells[1,0] := 'First time observed';
    Cells[2,0] := 'Last time observed';
    Cells[3,0] := 'Number of occurences';
    // values
    Cells[0,1] := 'A certain event';
    Cells[0,2] := 'An other one';
    Cells[0,3] := 'One more';
    Cells[0,4] := 'The last one';
    For i:= 1 To 4 Do
      Cells[1,i] := DateTimeToStr(Now + (i/19.5));
    For i:= 1 To 4 Do
      Cells[2,i] := DateTimeToStr(Now + 2*(i/19.5));
    For i:= 1 To 4 Do
    Randomize;
    For i:= 1 To 4 Do
      Cells[3,i] := IntToStr(Random(1000));
  End;
  // The memo
  Memo1.Lines.Add('//  Comment or uncomment lines using "//"');
  Memo1.Lines.Add('AddStrings(1,2,3,4)');
  Memo1.Lines.Add('AddIntegers(1,2,3,4)');
  Memo1.Lines.Add('UserShowMessage(Here is a message)');
  // The popUpMenu
  aMenuManager := TMenuManager.create();
  PopUpMenu1.AutoPopup := False;
  For i := 0 To popUpMenu1.Items.Count -1 Do
    PopUpMenu1.Items[i].OnClick := aMenuManager.ClickHandler;
end;


// -----------------------------------------------------------------------------
// --- The Memo
// -----------------------------------------------------------------------------

procedure TForm1.Button1Click(Sender: TObject);
// 'Execute Memo lines' button
// Will first split each uncommented line between a method name and an array of
// args, then call the function in charge of launching the wanted method
// ( 'parser.ExecFuncByName('aFuncName', [arguments]) ).
var aParsedLine: TParsedLine;                      // declared in the other unit
    v: Variant;
    i: Integer;
    aPArserInstance: TLittleParser;
begin
  aParserInstance := TLittleParser.Create;
  For i:= 0 To Memo1.Lines.Count -1 Do
  Begin
    aPArsedLine := aParserInstance.GetParsedLine(Memo1.Lines[i]);
    If aParsedLine.lnIsValide then 
    Begin
      v := aParserInstance.ExecFuncByName(aParsedLine.lnMethodName,
                                          aParsedLine.lnArguments);
      If varIsStr(v) Then If v = '' Then exit;
      If Not(VarIsNull(v))
         Then Memo1.Lines[i] := Memo1.Lines[i] + '     : ' + varToStr(v)
         Else Memo1.Lines[i] := Memo1.Lines[i] + '     : (Unknown method :'
                                               + aParsedLine.lnMethodName + ')';
    End;
  End;
  aParserInstance.Free;
end;


// -----------------------------------------------------------------------------
// --- Using the buttons caption
// -----------------------------------------------------------------------------

procedure TForm1.Button2Click(Sender: TObject);
// Click handler for both 'AddStrings' and 'AddIntegers' button.
// The method to execute is the first part of the button's caption, the
// argument to use is the second part (enclosed within parenthesis).
// The 'GetParsedLine()' methode will return the string name to be executed,
// and a variant containing the argument.
// This variant may hold anything from integers to arrays of variant.
var aParsedLine: TParsedLine;
    v: Variant;
    aParserInstance: TLittleParser;
begin
  aPArserInstance := TLittleParser.Create;
  aPArsedLine := aParserInstance.GetParsedLine( TButton(Sender).Caption );
  v := aPArserInstance.ExecFuncByName(aParsedLine.lnMethodName,
                                      aParsedLine.lnArguments);
  showMessage( varToStr( v ) );
  aParserInstance.Free;
end;


// -----------------------------------------------------------------------------
// --- Storing pointers in variants
// -----------------------------------------------------------------------------

// Step one : We need a pointer (!)
// It is declared in one place only, at the top of the other unit.
// type PPointedRec = ^TPointedRec;

procedure TForm1.Button3Click(Sender: TObject);
// Step two : Declare a variable of the pointer type we're about
// to use : aPointedRec: PPointedRec;
var aPointedRec: PPointedRec;
    v: Variant;
    aPArserInstance: TLittleParser;
begin
  inc(appelCount);
  
  // Let's declare a new instance of a TPointedRec record
  new(aPointedRec);
  aPointedRec.anInteger := appelCount;
  aPointedRec.aSender   := Sender;

  // To store a pointer in a variant, just cast it to a legal type :
  // (integers and pointers are both stored on 4 bytes.)
  v := Integer(aPointedRec);

  // call the wanted function, and use it's return
  aParserInstance := TLittleParser.Create;
  showMessage( aPArserInstance.ExecFuncByName('HandlePointerValues', v) );

  // be kind, free memory
  Dispose(aPointedRec);
end;


// -----------------------------------------------------------------------------
// --- Dealing with the grid's menu
// -----------------------------------------------------------------------------

Constructor TMenuManager.Create;
Begin
  Inherited;
  self.fData := VarArrayCreate([0,2],varInteger);
End;

Destructor TMenuManager.Destroy;
Begin
  VarArrayRedim(fData,0);
  Inherited Destroy;
End;

Procedure TMenuManager.ClickHandler(Sender: TObject);
var aParser: TLittleParser;
    s:String;
Begin
   TRY
     If Sender Is TMenuItem Then
     Begin
       s := StringReplace( TMenuItem(Sender).Caption, '&', '', [rfReplaceAll] );
       aParser := TLittleParser.Create;
       // fData stores a "pointer" to the grid, the column and the row number.
       aParser.ExecProcByName( s, self.fData );
       aParser.Free;
     End;
   EXCEPT; END;
End;

// To pass a pointer to our grid to one of the methods, we need a pointer type
// to grids :
Type PStringGrid = ^TStringGrid;

procedure TForm1.StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
                                      Shift: TShiftState; X, Y: Integer);
var aCol, aRow: Integer;
    i: Integer;
Begin
  // let's handle rightClick only
  If not( button = mbRight ) Then Exit;

  // Find the col and row which have just been "clicked";
  // Exit if we clicked outside the cells.
  StringGrid1.MouseToCell(X, Y, aCol, aRow);
  If (aCol = -1) Or (aRow = -1) Then exit;

  // Pointers in variant again : Variants can't hold pointers. But variants can
  // hold integers. So let's cast the pointer to an integer...
  i := Integer( PStringGrid( StringGrid1 ) );
  aMenuManager.fData[0] := VarAsType (i, varInteger);       // pointer to the stringGrid
  aMenuManager.fData[1] := VarAsType (aCol, varInteger);    // col number the mouse is above
  aMenuManager.fData[2] := VarAsType (aRow, varInteger);    // row number the mouse is above

  // The menu contents depends on the col we've just click upon,
  // and sometimes on the row too.
  For i := 0 To PopUpMenu1.Items.Count -1 Do
      PopUpMenu1.Items.Items[i].Visible := False;

  Case aCol of
    0 :   Begin                                             // "event name" column
            // Objective = Display all elements of this line as a formatted string
            // (If we're on row zero, we do nothing and exit.)
            If aRow = 0 Then exit
            Else PopUpMenu1.Items.Items[0].Visible := True;
          End;
    1,2 : Begin                                             // "TimeStamps" columns
            // Objective = either compute the elapsed time between start and
            // stop for this line or compute the total elapsed time for these
            // two columns. If aRow = 0, we can only compute the total time
            // (<=> no particular line is selected).
            If aRow <> 0 Then PopUpMenu1.Items.Items[1].Visible := True;
            PopUpMenu1.Items.Items[2].Visible := True;
            PopUpMenu1.Items.Items[3].Visible := True;
          End;
    3 :   Begin                                             // number of observations column
            // Objective = either compute the total number of access (sum this
            // column) or compute the average number of acces.
            PopUpMenu1.Items.Items[4].Visible := True;
            PopUpMenu1.Items.Items[5].Visible := True;
          End;
    Else  exit;                                             // clicks outside the grid itself are just ignored.
  End; //case
  // affichage du menu
  PopUpMenu1.PopUp(StringGrid1.ClientOrigin.X + X,
                   StringGrid1.ClientOrigin.Y + Y);
End;


procedure TForm1.Label2Click(Sender: TObject);
begin
  ShellExecute(Form1.Handle,'open',
               PChar('http://mapage.noos.fr/qnno/pages/delphi_en.htm'),
               nil,nil, SW_SHOWNORMAL);
end;

end.