Einzelnen Beitrag anzeigen

hanvas

Registriert seit: 28. Okt 2010
168 Beiträge
 
Delphi 11 Alexandria
 
#32

AW: Routine mit Namen aufrufen

  Alt 23. Feb 2015, 16:57

Ich würd ja gern den Ansatz von Ha-Jö testen, aber ich kann das
nicht ausprogrammieren ..., das ist für mich zu weit im Eingemachten.
Ich hatte Dir doch schon fast alles geliefert. Hier nochmal die Komfortvariante.

Delphi-Quellcode:

unit jRegister;
interface
uses classes;

type TJobRegister = class(TComponent)
     private
      FRegister : TStringList;
     public
      Constructor Create(aOwner : TComponent); override;
      Destructor Destroy; override;

      procedure RegisterObjectMethods
       (Instance : TObject; const methods : TStrings); virtual;

      procedure RegisterObjectMethodByName
       (const registeredName : String; Instance : TObject; const method : String);
                                                                                virtual;
      procedure RegisterObjectMethod
        (const registeredName : String; instance : TObject; addr : Pointer); virtual;
      procedure RegisterCall (const registeredName : String; m : pMethod); virtual;
      procedure UnRegisterCall (const registeredName : String); virtual;
      procedure Call(const aFunctionToCall : String); virtual;
     end;

     TExecute = procedure of object;

function jobRegister : TJobRegister;

implementation
uses sysUtils;

var reg : TJobRegister = nil;

function jobRegister : TJobRegister;
begin
 if not Assigned(reg) then
    reg := TJobRegister.Create(Application);
 result := reg;
end;

Constructor TJobRegister.Create(aOwner : TComponent);
begin
 inherited Create(aOwner);
 FRegister := TStringList.Create;
 FRegister.Sorted := True;
end;

Destructor TJobRegister.Destroy;
var i : Integer;
    p : pMethod;
begin
 for i := 0 to FRegister.Count-1 do
  begin
    p := pMethod(FRegister.Objects[i]);
    FreeMem(p);
  end;
end;

procedure TJobRegister.RegisterObjectMethods
       (Instance : TObject; const methods : TStrings);
var i : Integer;
  n,v : String;
begin
 for i := 0 to methods.count-1 do
  begin
    n := methods.Names[i];
    v := methods.Values[n];
    if (n<>'') and
       (v<>'') then
         RegisterObjectMethodByName(n,instance,v);
  end;
end;

procedure TJobRegister.RegisterObjectMethodByName
       (const registeredName : String; Instance : TObject; const method : String);
var p : Pointer;
begin
 if Assigned(instance) then
  begin
   p := Instance.MethodAddress(method);
   if (Assigned(p)) then
       RegisterObjectMethod(registeredName,Instance,p);
  end;
end;


procedure TJobRegister.RegisterObjectMethod
        (const registeredName : String; instance : TObject; addr : Pointer);
var p : pMethod;
begin
 GetMem(p,SizeOf(TMethod));
 p.Data := instance;
 p.Code := addr;
 RegisterCall(registeredName,p);
end;

procedure TJobRegister.RegisterCall (const registeredName : String; m : pMethod);
begin
    if (FRegister.IndexOf(registeredName)<0) then
        FRegister.AddObject(registeredName,Pointer(m))
    else raise Exception.Create('Funktion [' + registeredName + '] bereits registriert');
end;

procedure TJobRegister.UnRegisterCall (const registeredName : String);
var idx : Integer;
    p : pMethod;
begin
 idx := FRegister.IndexOf(registeredName);
 if (idx >= 0 ) then begin
                       p := pMethod(FRegister.Objects[idx]);
                       FreeMem(p);
                     end
                else raise Exception.Create('Ungültiger Versuch [' + registeredName + '] freizugeben');
end;

procedure TJobRegister.Call(const aFunctionToCall : String);
var idx : Integer;
    p : pMethod;
    e : TExecute;
begin
 idx := FRegister.IndexOf(aFunctionToCall);
 if (idx >= 0 ) then begin
                         p := Pointer(FRegister.Objects[idx]);
                         e := TExecute(p^);
                         e();
                     end
                else begin
                       raise Exception.Create('Funtkion [' + aFunctionToCall + '] nicht vorhanden');
                     end;
end;
Die aufzurufenden Routinen musst Du aber selbst verpacken. Das geht aber ziemlich einfach. Das nachfolgende Beispiel zeigt wie.


Delphi-Quellcode:

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
  public
    { Public-Deklarationen }
  published
    procedure execute1;
    procedure execute2;
    procedure execute3;
    procedure execute4;
  end;

var
  Form1: TForm1;

implementation
uses jRegister;

{$R *.dfm}

procedure TForm1.execute1;
begin
 MessageDlg('Test', mtWarning, [mbOK], 0);
end;

procedure TForm1.execute2;
begin
 MessageDlg('Test 2', mtWarning, [mbOK], 0);
end;

procedure TForm1.execute3;
begin
 MessageDlg('Test 3', mtWarning, [mbOK], 0);
end;

procedure TForm1.execute4;
begin
 MessageDlg('Test 4', mtWarning, [mbOK], 0);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 reg := TJobRegister.Create(self);
end;

procedure TForm1.Button1Click(Sender: TObject);
var s : TStringList;
begin
  s := TStringList.Create;
  s.Add('Test=execute1');
  s.Add('Test2=execute2');
 { methoden müssen published sein, Instance muss von TPersistent
   oder TComponent abgeleitet sein }

  jobRegister.RegisterObjectMethods(self,s);
  s.free;

  jobRegister.Call('Test');
  jobRegister.Call('Test2');

 { Instanzen können beliebige Objekte sein, Methoden müssen nicht published sein }
  jobRegister.RegisterObjectMethod('Test 3', self, @TForm1.execute3);
  jobRegister.Call('Test 3');

  { methoden müssen published sein, Instance muss von TPersistent
   oder TComponent abgeleitet sein }

  jobRegister.RegisterObjectMethodByName('Test 4', self, 'execute4' );
  jobRegister.Call('Test 4');
end;

end.
Die Funktion jobregister ist zentral definiert und sollte nur einmal vorhanden. Die Methoden die verpackt werden sollen dürfen in beliebigen anderen Objekten sein, die nicht zwingend von TComponent oder TPersistent abgeleitet sein müssen. Das Registrieren und Deregistrieren von Methoden wäre am besten im Constructor bzw. Destrukter der Objekte untergebracht die diese Methoden aufrufen - das Beispiel ist aber so das Du es verstehen solltest und ähnlich wie das bis jetzt von Dir verwendete.

Schön ist aber trotzdem anders.
  Mit Zitat antworten Zitat