Добавление методов объекта в список строк, чтобы их можно было вызывать по имени

Question

У меня есть серверный код, который принимает команды от клиентов и выполняет методы объекта в соответствии с полученной командой. Я хочу создать список строк, используя AddObject, чтобы связать команду с желаемой процедурой. Это прекрасно работает с автономными процедурами, но я получаю ошибки «переменная требуется» при попытке добавить методы объекта в мой список строк. Вот пример кода:

type
  TExample = class
  public
    var Commands: TStringList;
    constructor Create;
    destructor Destroy; override;
    procedure ExecCommand(Cmd, Msg: string);
    procedure Alpha(Msg: string);
    procedure Beta(Msg: string);
    procedure Gamma(Msg: string);
  end;

constructor TExample.Create;
begin
  inherited Create;
  Commands := TStringList.Create;
  Commands.AddObject('Alpha', @Alpha); // fails to compile: "variable required"
  Commands.AddObject('Beta', @Beta);
  Commands.AddObject('Gamma', @Gamma);
end;

destructor TExample.Destroy;
begin
  Commands.Free;
  inherited Destroy;
end;

procedure TExample.ExecCommand(Cmd, Msg: string);
type
  TProcType = procedure(Msg: string);
var
  i: integer;
  P: TProcType;
begin
  i := Commands.IndexOf(Cmd);
  if i >= 0 then
  begin
    P := TProcType(Commands.Objects[i]);
    P(Msg);
  end;
end;

procedure TExample.Alpha(Msg: string);
begin
  ShowMessage('Alpha: ' + Msg);
end;

procedure TExample.Beta(Msg: string);
begin
  ShowMessage('Beta: ' + Msg);
end;

procedure TExample.Gamma(Msg: string);
begin
  ShowMessage('Gamma: ' + Msg);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Example: TExample;
  Cmd, Msg: string;
begin
  Cmd := Edit1.Text;
  Msg := Edit2.Text;
  Example := TExample.Create;
  Example.ExecCommand(Cmd, Msg);
  Example.Free;
end;

Answer 1

Вы пытаетесь вызвать не * stati c методы класса для TExample объектов, поэтому вам нужно добавить of object к объявлению TPropType для обработки параметра Self:

type
  TProcType = procedure(Msg: string) of object;

Тем не менее, нестатические c указатели на методы объекта больше, чем обычные ванильные указатели, поскольку они несут две части информации - указатель на объект и указатель на метод для вызова объекта - так что вы не может напрямую сохранить указатель метода не-stati c в списке TStringList.Objects[]. Однако вы можете сохранить его косвенно .

Одним из способов является динамическое распределение указателей метода, например:

type
  TExample = class
  public
    var Commands: TStringList;
    constructor Create;
    destructor Destroy; override;
    procedure ExecCommand(Cmd, Msg: string);
    procedure Alpha(Msg: string);
    procedure Beta(Msg: string);
    procedure Gamma(Msg: string);
  end;

type
  TProcType = procedure(Msg: string) of object;
  PProcType = ^TProcType;

constructor TExample.Create;
var
  P: PProcType;
begin
  inherited Create;
  Commands := TStringList.Create;

  New(P);
  P^ := @Alpha;
  Commands.AddObject('Alpha', TObject(P));

  New(P);
  P^ := @Beta;
  Commands.AddObject('Beta', TObject(P));

  New(P);
  P^ := @Gamma;
  Commands.AddObject('Gamma', TObject(P));
end;

destructor TExample.Destroy;
var
  I: Integer;
begin
  for I := 0 to Commands.Count-1 do
    Dispose(PProcType(Commands.Objects[I]));
  Commands.Free;
  inherited Destroy;
end;

procedure TExample.ExecCommand(Cmd, Msg: string);
var
  i: integer;
  P: PProcType;
begin
  i := Commands.IndexOf(Cmd);
  if i >= 0 then
  begin
    P := PProcType(Commands.Objects[i]);
    P^(Msg);
  end;
end;

procedure TExample.Alpha(Msg: string);
begin
  ShowMessage('Alpha: ' + Msg);
end;

procedure TExample.Beta(Msg: string);
begin
  ShowMessage('Beta: ' + Msg);
end;

procedure TExample.Gamma(Msg: string);
begin
  ShowMessage('Gamma: ' + Msg);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Example: TExample;
  Cmd, Msg: string;
begin
  Cmd := Edit1.Text;
  Msg := Edit2.Text;
  Example := TExample.Create;
  Example.ExecCommand(Cmd, Msg);
  Example.Free;
end;

Другим способом является сохранение данных c. указатели на методы класса, а затем используйте запись TMethod, чтобы помочь вам, когда вам нужно вызвать методы, как @OndrejKelle, описанный в комментариях, например:

type
  TExample = class
  public
    var Commands: TStringList;
    constructor Create;
    destructor Destroy; override;
    procedure ExecCommand(Cmd, Msg: string);
    procedure Alpha(Msg: string);
    procedure Beta(Msg: string);
    procedure Gamma(Msg: string);
  end;

type
  TProcType = procedure(Msg: string) of object;

constructor TExample.Create;
begin
  inherited Create;
  Commands := TStringList.Create;
  Commands.AddObject('Alpha', TObject(@TExample.Alpha));
  Commands.AddObject('Beta', TObject(@TExample.Beta));
  Commands.AddObject('Gamma', TObject(@TExample.Gamma));
end;

destructor TExample.Destroy;
begin
  Commands.Free;
  inherited Destroy;
end;

procedure TExample.ExecCommand(Cmd, Msg: string);
var
  i: integer;
  P: TProcType;
begin
  i := Commands.IndexOf(Cmd);
  if i >= 0 then
  begin
    TMethod(P).Data := Self;
    TMethod(P).Code := Pointer(Commands.Objects[i]);
    P(Msg);
  end;
end;

procedure TExample.Alpha(Msg: string);
begin
  ShowMessage('Alpha: ' + Msg);
end;

procedure TExample.Beta(Msg: string);
begin
  ShowMessage('Beta: ' + Msg);
end;

procedure TExample.Gamma(Msg: string);
begin
  ShowMessage('Gamma: ' + Msg);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Example: TExample;
  Cmd, Msg: string;
begin
  Cmd := Edit1.Text;
  Msg := Edit2.Text;
  Example := TExample.Create;
  Example.ExecCommand(Cmd, Msg);
  Example.Free;
end;

Но в любом случае TStringList действительно не лучший инструмент для этой работы. Вы действительно должны использовать TDictionary вместо этого, тогда вам не нужно прыгать через ненужные обручи, например:

uses
  ..., System.Generics.Collections;

type
  TProcType = procedure(Msg: string) of object;

  TExample = class
  public
    var Commands: TDictionary<String, TProcType>;
    constructor Create;
    destructor Destroy; override;
    procedure ExecCommand(Cmd, Msg: string);
    procedure Alpha(Msg: string);
    procedure Beta(Msg: string);
    procedure Gamma(Msg: string);
  end;

constructor TExample.Create;
begin
  inherited Create;
  Commands := TDictionary<String, TProcType>.Create;
  Commands.Add('Alpha', @Alpha);
  Commands.Add('Beta', @Beta);
  Commands.Add('Gamma', @Gamma);
end;

destructor TExample.Destroy;
begin
  Commands.Free;
  inherited Destroy;
end;

procedure TExample.ExecCommand(Cmd, Msg: string);
var
  P: TProcType;
begin
  if Commands.TryGetValue(Cmd, P) then
    P(Msg);
end;

procedure TExample.Alpha(Msg: string);
begin
  ShowMessage('Alpha: ' + Msg);
end;

procedure TExample.Beta(Msg: string);
begin
  ShowMessage('Beta: ' + Msg);
end;

procedure TExample.Gamma(Msg: string);
begin
  ShowMessage('Gamma: ' + Msg);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Example: TExample;
  Cmd, Msg: string;
begin
  Cmd := Edit1.Text;
  Msg := Edit2.Text;
  Example := TExample.Create;
  Example.ExecCommand(Cmd, Msg);
  Example.Free;
end;

Answer 2

Спасибо за размещенные решения. Я решил использовать опцию TMethod и упростить ее. Так как я могу сделать так, чтобы переданные команды точно совпадали с именами моих методов объекта, я могу пропустить список ha sh и сделать вызовы напрямую так:

type
  TExample = class
  published
    procedure Alpha(Msg: string);
    procedure Beta(Msg: string);
    procedure Gamma(Msg: string);
  public
    procedure ExecCommand(Cmd, Msg: string);
  end;

procedure TExample.ExecCommand(Cmd, Msg: string);
type
  TProcType = procedure(Msg: string) of object;
var
  M: TMethod;
  P: TProcType;
begin
  M.Code := Self.MethodAddress(Cmd);
  if M.Code = Nil then ShowMessage('Unknown command: ' + Cmd) else
  begin
    M.Data := Pointer(Self);
    P := TProcType(M);
    P(Msg);
  end;
end;