pokretanje procedure iz programa?

[ salvaric @ 07.05.2014. 19:41 ] @

Pozdrav,

interesuje me dal je moguće pretvoriti neki string u naziv procedure i pokrenuti je,
tj. dal je moguće pokenuti neku već definisanu proceduru upisom njenog naziva u neko edit polje tipa:

Code:

private
   procedure PrikaziPoruku();

...

procedure TForm1.PrikaziPoruku();
begin
        ShowMessages('poruka');
        ....
end;

i posle pokretanja programa koji sadrzi edit polje uneti naziv i pokrenuti je pritiskom na neko dugme ili bilo koji drugi dogadjaj.

[ reiser @ 07.05.2014. 19:55 ] @

Mozes pomocu RTTI-ja

Code:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
  public
    procedure NekaMetoda(const AMessage: String);
  end;

var
  Form1: TForm1;

implementation

uses
  System.Rtti;

{$R *.dfm}

function ExecMethod(const AClass: TClass; const AMethod: String; const AArgs: array of TValue): Boolean;
var
  r: TRttiContext;
  t: TRttiType;
  m: TRttiMethod;
begin
  t := R.GetType(AClass);
  m := t.GetMethod(AMethod);
  if Assigned(m) then
  begin
    m.Invoke(AClass.Create, AArgs);
    Exit(TRUE);
  end;
  Exit(FALSE);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ExecMethod(TForm1, 'NekaMetoda', ['neka poruka']);
end;

procedure TForm1.NekaMetoda(const AMessage: String);
begin
  ShowMessage(AMessage);
end;

end.

[ salvaric @ 07.05.2014. 20:19 ] @

Hvala drugar,

radim u Lazarusu, zaboravio sam napomenuti, tako da mi ova procedure ne fercera, rtti biblioteka nepostoji za njega.

[ reiser @ 07.05.2014. 20:26 ] @

Probaj MethodAddress(), s' tim sto onda moras da znas unapred deklaraciju funkcije. Koliko vidim, Lazarus ima ovo. Pisano iz glave, ali ce ti dati ideju:

Code:

TNekaFunkcija = procedure(const AParametar: String) of object;
PNekaFunkcija = ^TNekaFunkcija;

TNekaKlasa = class
private
  function IzvrsiMetodu(const AMetoda, AParametar: String): Boolean;
public
published
  procedure NekaMetoda(const AParametar: String);
end;

function TNekaKlasa.IzvrsiMetodu(const AMetoda, AParametar: String): Boolean;
var
  method_addr: PNekaFunkcija;
begin
  method_addr := self.MethodAddress(AMetoda);
  if not Assigned(method_addr) then
    Exit(FALSE);

  method_addr^(AParametar);
  Exit(TRUE);
end;

procedure TNekaKlasa.NekaMetoda(const AParametar: String);
begin
  ShowMessage(AParametar);
end;

[ Milan Milosevic @ 08.05.2014. 16:06 ] @

Sto jednostavno ne probas
If Edit.text = nazivprocedure then pozoviprocedru

[ salvaric @ 10.05.2014. 21:17 ] @

Hteo sam da smestim nazive procedura i funkcija u jednu tabelu (.mdb), i da se pokreću po potrebi, hteo sam da izbegnem if varijantu svake procedure, pošto planiram da stalno nadograđujem iste, pa da nemoram pravim kilometarski kod ako to nije potrebno.

Pokušao sam pomoću prethodnog predloga, al neradi.

U svakom slučaju hvala!

[ savkic @ 10.05.2014. 21:35 ] @

> Hteo sam da smestim nazive procedura i funkcija u jednu tabelu (.mdb), i da se pokreću po potrebi, hteo sam da izbegnem if varijantu svake procedure, pošto planiram da stalno
> nadograđujem iste, pa da nemoram pravim kilometarski kod ako to nije potrebno.

Ako pozivaš metode po nazivu tu je problem kako proslediti argumente...
Pogledaj da iskoristiš neki od postoječih skriptova za pascal (npr. www.remobjects.com/ps.aspx), dobićeš daleko veću fleksibilnost.

[ salvaric @ 10.05.2014. 21:49 ] @

Dal se može izvršiti neka procedura upisana u nekom stringlist-u il tako nešto, tj. nemora imati naziv već sadržaj koda?

Čak procedure mogu imati samo naziv bez argumenata tipa "Ispis()", samo da je mogu izvrsiti na neki način.

[ reiser @ 10.05.2014. 22:13 ] @

"Pokušao sam pomoću prethodnog predloga, al neradi."

Mozda kada bi nam dao vise informacije zasto "ne radi", neko bi ti pomogao. Ako metoda postoji u Lazarusu, onda sigurno ima neku svrhu, i sigurno radi, samo treba da se napise kod ispravno. Sta si pokusao, sta ne radi, zasto ne radi, kakvu gresku javlja?

[ salvaric @ 10.05.2014. 22:29 ] @

Code:
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;

type
  TNekaFunkcija = procedure(const AParametar: String) of object;
  PNekaFunkcija = ^TNekaFunkcija;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    function IzvrsiMetodu(const AMetoda, AParametar: String): Boolean;
    { private declarations }
  public

  published
  procedure NekaMetoda(const AParametar: String);

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  IzvrsiMetodu('NekaMetoda','poruka');
end;

function TForm1.IzvrsiMetodu(const AMetoda, AParametar: String): Boolean;
var
  method_addr: PNekaFunkcija;
begin
  method_addr := self.MethodAddress(AMetoda);
  if not Assigned(method_addr) then
    Exit(FALSE);

  method_addr^(AParametar);
  Exit(TRUE);
end;

procedure TForm1.NekaMetoda(const AParametar: String);
begin
      ShowMessage(AParametar);
end;

end.

izbaci poruku: poruka

[ savkic @ 11.05.2014. 00:25 ] @

Code:

type
  TNekaFunkcija = procedure(const AParametar: string) of object;

type
  TForm1 = class(TForm)
    btn1: TButton;
    procedure btn1Click(Sender: TObject);
  private
    function IzvrsiMetodu(const AMetoda, AParametar: String): Boolean;
  public

  published
    procedure NekaMetoda(const AParametar: String);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.NekaMetoda(const AParametar: String);
begin
  ShowMessage(AParametar);
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
  IzvrsiMetodu('NekaMetoda','poruka');
end;

function TForm1.IzvrsiMetodu(const AMetoda, AParametar: String): Boolean;
var
  Method: TMethod;
  Exec: TNekaFunkcija;
begin
  Method.Code := MethodAddress(AMetoda);
  if Assigned(Method.Code) then
  begin
    Method.Data := Self;
    Exec := TNekaFunkcija(Method);
    Exec(AParametar);
  end;
end;

end.

[ salvaric @ 11.05.2014. 13:26 ] @

Hvala Savkiću, to je to!

Zahvaljujem se i ostalima na pomoći i sugestijama, možete zaključati temu.

_{[Ovu poruku je menjao salvaric dana 11.05.2014. u 22:07 GMT+1]}