DBR Delphi-Ecke

// Wenn man dynamisch erzeugten Komponenten ein Ereignis (Event) zuweisen möchte
// und benutzt dazu eine einfache Prozedur (Funktion), erhält man die Fehlermeldung
// "Inkompatible Typen: Methodenzeiger und reguläre Prozedur". Man benötigt also
// einen Methodenzeiger. Das ist so etwas wie ein doppelter Zeiger, besser gesagt
// ein Record mit zwei Pointern.

// Getestet mit D4 unter XP

// Variante 1:
// Am einfachsten erlangt man das, in dem man in ein bestehendes Objekt (class)
// eine Prozedur (Funktion) einlagert.

 ... 
  private 
    { Private-Deklarationen } 
  public 
    procedure MyClick(Sender: TObject); 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.dfm} 
 
var 
  L: TLabel; 
 
procedure TForm1.MyClick(Sender: TObject); 
begin 
  Caption := 'He, mein Freund, klickst du überall drauf ??'; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  L := TLabel.create(self); 
  L.parent := self; 
  L.caption := 'Klick hier drauf'; 
  L.left := 20; 
  L.top := 100; 
  L.OnClick := MyClick; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  L.free; 
end;

//---------------------------------------------------------

// Variante 2:
// Bei einfachen Events kann man Delphi austricksen und einen Methodenzeiger
// vorgaukeln. Allerdings kann man keine Parameter übergeben, da diese wegen
// des fehlenden zweiten Zeigers völlig falsch zugewiesen werden würden.

var 
  F: TNotifyEvent; 
  L: TLabel; 
 
procedure MyClick; 
begin 
  Form1.Caption := 'Hörst du vielleicht mal mit der Klickerei auf ?!'; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  L := TLabel.create(self); 
  L.parent := self; 
  L.caption := 'Klick mich'; 
  L.left := 20; 
  L.top := 100; 
  @F := @MyClick; 
  L.OnClick := F; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  L.free; 
end;

//---------------------------------------------------------

// Variante 3:
// Besser ist es, den Methodenzeiger mittels "TMethod" und "procedure of object"
// nachzubilden, dann können auch alle entsprechenden Parameter übergeben werden.

var 
  F: procedure(Sender: TObject; Button: TMouseButton; 
    Shift: TShiftState; X, Y: Integer) of object; 
  L: TLabel; 
 
procedure MyMouseUp(Form: TForm; Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
begin 
  if Sender is TLabel then 
    Form.Caption := TLabel(Sender).Caption; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  L := TLabel.create(self); 
  L.parent := self; 
  L.caption := 'Schaun mer mal was passiert, wennste draufklickst'; 
  L.left := 20; 
  L.top := 100; 
  TMethod(F).Code := @MyMouseUp; 
  TMethod(F).Data := self; 
  L.OnMouseUP := F; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  L.free; 
end;