И по поводу вызова процедур и функций

← →
olookin (2002-03-02 13:21) [0]

Уважаемые господа!

Как вызвать процедуру по ее идентификатору? Иными словами, вызвать процедуру не по ее имени.

Заранее спасибо.

← →
[NIKEL] © (2002-03-02 13:45) [1]

по указателю на эту процедуру?

← →
olookin (2002-03-02 13:54) [2]

Да

← →
Deus (2002-03-02 14:01) [3]

А имя - не идентификатор?
Если просто в программе - зачем?
Если в DLL - экспортировать из DLL вот так:
exports AddOne index 0 name "AddOne" ...
И соответствено к ней обращаться.
Но Microsoft не советует так делать - лучше по имени...

← →
olookin (2002-03-02 14:26) [4]

Я задал вопрос не совсем корректно. Более правильно задать его так:
Есть совокупность процедур, которые могут быть запущены в результате действия пользователя. Необходимо запомнить их последовательность и воспроизвести по необходимости при следующем запуске программы. Как это сделать без участия case и пр.?

Заранее благодарен.

← →
Фэ © (2002-03-02 15:16) [5]

Попробуй так

// Объявляешь процедурный тип (все процедуры должны ему соответствовать или прячешь несоответсвующее в таком типе)
TMy = procedure stdcall;

PList: array[0..10] of TMy; // будет хранить указатели на процедуры

procedure MyProc_1 stdcall;
procedure MyProc_2 stdcall;

.......

procedure MyProc_1 stdcall;
begin
...
end;

........

Везде, где пользователь вызывает процедуру пишешь
PList[i] := @MyProc_i;

...........
Для вызова запомненной процедуры
Plist[i] //или в цикле

Я тут набросал примитивный примерчик

{------------------------ main.pas ----------------------------}

unit main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Macros,
StdCtrls, Buttons;

type
TMainForm = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject);
public
end;

var
MainForm: TMainForm;
Macro: TMacro;
Offset: TPoint = (X:0; Y:100);

procedure MyMoveTo(X, Y: Integer);
procedure MyLineTo(X, Y: Integer);

implementation

{$R *.DFM}

procedure MyMoveTo(X, Y: Integer);
begin
WriteMacro("MyMoveTo", X, Y);
MainForm.Canvas.MoveTo(X + Offset.X, Y + Offset.Y);
end;

procedure MyLineTo(X, Y: Integer);
begin
//WriteMacro("MyLineTo", X, Y);
WriteMacro(@MyLineTo, X, Y);
MainForm.Canvas.LineTo(X + Offset.X, Y + Offset.Y);
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
RegisterProc("MyMoveTo", @MyMoveTo);
RegisterProc("MyLineTo", @MyLineTo);

Macro := TMacro.Create;

if not FileExists("test.mcr") then
begin
Macro.BeginRecord;
MyMoveTo(20, 40);
MyLineTo(120, 70);
MyLineTo(70, 80);
MyLineTo(20, 40);
Macro.EndRecord;
Macro.SaveToFile("test.mcr");
end;

Macro.LoadFromFile("test.mcr");
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
Macro.Free;
end;

procedure TMainForm.FormPaint(Sender: TObject);
begin
Offset := Point(0, 0);
Macro.Play;
Offset := Point(100, 0);
Macro.Play;
end;

end.

{-------------------------- macros.pas ---------------------}

unit Macros;

interface

uses
Classes, SysUtils;

type
TMyProc = procedure(X, Y: Integer);

TProcCall = class
private
FProc: TMyProc;
FX, FY: Integer;
function GetAsString: string;
procedure SetAsString(const Value: string);
public
property Notation: string read GetAsString write SetAsString;

constructor Create(Proc: TMyProc; X, Y: Integer);
constructor CreateByNotation(const ANotation: string);

procedure Execute;
end;

TMacro = class
private
FCalls: TList;
public
constructor Create;
destructor Destroy; override;

procedure Play;
procedure Clear;

procedure BeginRecord;
procedure EndRecord;
procedure AddCall(Proc: TMyProc; X, Y: Integer);

procedure SaveToFile(const FileName: string);
procedure LoadFromFile(const FileName: string);
end;

procedure RegisterProc(Name: string; Proc: TMyProc);
function ProcByName(Name: string): TMyProc;
function ProcName(Proc: TMyProc): string;

procedure WriteMacro(ProcName: string; X, Y: Integer); overload;
procedure WriteMacro(Proc: TMyProc; X, Y: Integer); overload;

implementation

var
ProcList: TStrings; // only for non-members procedures (4bytes)
CurrentMacro: TMacro;

{------------------------- General procedures ---------------------------------}

procedure RegisterProc(Name: string; Proc: TMyProc);
begin
ProcList.AddObject(Name, TObject(@Proc));
end;

function ProcByName(Name: string): TMyProc;
var idx: Integer;
begin
Result := nil;
idx := ProcList.IndexOf(Name);
if idx <> -1 then
TObject(Result) := ProcList.Objects[idx]
else
raise Exception.CreateFmt("procedure "%s" is not registered",[Name]);
end;

function ProcName(Proc: TMyProc): string;
var idx: Integer;
begin
Result := "";
idx := ProcList.IndexOfObject(TObject(@Proc));
if idx <> -1 then Result := ProcList[idx];
end;

procedure WriteMacro(ProcName: string; X, Y: Integer);
begin
if Assigned(CurrentMacro) then
CurrentMacro.AddCall(ProcByName(ProcName), X, Y);
end;

procedure WriteMacro(Proc: TMyProc; X, Y: Integer);
begin
if ProcList.IndexOfObject(TObject(@Proc)) = -1 then
raise Exception.CreateFmt("procedure "%p" is not registered",[@Proc]);

if Assigned(CurrentMacro) then
CurrentMacro.AddCall(Proc, X, Y);
end;

{-------------------- TMacro --------------------------------------------------}

constructor TMacro.Create;
begin
FCalls := TList.Create;
end;

destructor TMacro.Destroy;
begin
Clear;
FCalls.Free;
end;

procedure TMacro.Clear;
var i: Integer;
begin
for i := 0 to FCalls.Count-1 do
TProcCall(FCalls[i]).Free;
FCalls.Clear;
end;

procedure TMacro.AddCall(Proc: TMyProc; X, Y: Integer);
begin
FCalls.Add(TProcCall.Create(Proc, X, Y));
end;

procedure TMacro.BeginRecord;
begin
if Assigned(CurrentMacro) then raise Exception.Create("error");
CurrentMacro := Self;
end;

procedure TMacro.EndRecord;
begin
CurrentMacro := nil;
end;

procedure TMacro.Play;
var i: Integer;
begin
for i := 0 to FCalls.Count-1 do
TProcCall(FCalls[i]).Execute;
end;

procedure TMacro.LoadFromFile(const FileName: string);
var
i: Integer;
Str: TStrings;
begin
Clear;
Str := TStringList.Create;
try
Str.LoadFromFile(FileName);
for i := 0 to Str.Count-1 do
FCalls.Add( TProcCall.CreateByNotation(Str[i]) );
finally
Str.Free;
end;
end;

procedure TMacro.SaveToFile(const FileName: string);
var
i: Integer;
Str: TStrings;
begin
Str := TStringList.Create;
try
for i := 0 to FCalls.Count-1 do
Str.Add(TProcCall(FCalls[i]).Notation);
Str.SaveToFile(FileName);
finally
Str.Free;
end;
end;

{------------------------- TProcCall ------------------------------------------}

constructor TProcCall.Create(Proc: TMyProc; X, Y: Integer);
begin
FProc := Proc;
FX := X;
FY := Y;
end;

constructor TProcCall.CreateByNotation(const ANotation: string);
begin
Notation := ANotation;
end;

procedure TProcCall.Execute;
begin
if Assigned(FProc) then FProc(FX, FY);
end;

function TProcCall.GetAsString: string;
begin
Result := Format("%s(%d, %d);",[ProcName(FProc), FX, FY]);
end;

function StrBetween (const str, cfrom, cto: string): string;
var beg, fin, lbeg, L: Integer;
s: string;
begin
Result := "";
L := Length(str);
lbeg := Length(cfrom);
beg := Pos(cfrom, str);

if beg > 0 then
begin
beg := beg + lbeg - 1;
s := Copy(str, beg+1, L-beg);
end
else if cfrom <>"" then Exit else s := str;

if cto = "" then fin := Length(s)+1 else fin := Pos(cto, s);
if (fin<>0) then Result := Copy(s,1,fin-1);
end;

procedure TProcCall.SetAsString(const Value: string);
begin
FProc := ProcByName( StrBetween(Value, "", "(") );
FX := StrToInt ( StrBetween(Value, "(", ",") );
FY := StrToInt ( StrBetween(Value, ",", ")") );
end;

initialization

ProcList := TStringList.Create;

finalization

ProcList.Free;

end.

И по поводу вызова процедур и функций Найти похожие ветки