Форум: "Основная";
Текущий архив: 2002.03.18;
Скачать: [xml.tar.bz2];
ВнизИ по поводу вызова процедур и функций Найти похожие ветки
← →
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] //или в цикле
← →
reonid (2002-03-03 14:40) [6]Я тут набросал примитивный примерчик
{------------------------ 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.
← →
reonid (2002-03-03 14:41) [7]{-------------------------- 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.
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2002.03.18;
Скачать: [xml.tar.bz2];
Память: 0.49 MB
Время: 0.004 c