DBR Delphi-Ecke

// Hier eine Möglichkeit Popup-Menüs dynamisch zu erzeugen. Im Beispiel
// sind es zwei. Sie werden in FormCreate zunächst erzeugt, danach werden
// die (frei ausgedachten) Items angelegt, dann den Items die entsprechenden
// OnClick-Events beigegeben und zum Schluss der Form und einem Panel die
// Popups zugewiesen.

// Getestet mit D4 unter WinME

unit Unit1; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  ExtCtrls, Menus; 
 
type 
  TForm1 = class(TForm) 
    Panel1: TPanel; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
  private 
{ Private-Deklarationen } 
  public 
    procedure minimieren(Sender: TObject); 
    procedure rot(Sender: TObject); 
    procedure schliessen(Sender: TObject); 
    procedure oeffnen(Sender: TObject); 
    procedure speichern(Sender: TObject); 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
const 
  PopMenuAnzahl = 2; 
  itms1: array[0..3] of string = ('Mi&nimieren', '&Rot färben', '-', '&Schließen'); 
  itms2: array[0..1] of string = ('Ö&ffnen', '&Speichern'); 
 
var 
  tp: array[0..PopMenuAnzahl - 1] of TPopupmenu; 
  tm: array[0..PopMenuAnzahl - 1] of array of TMenuItem; 
 
procedure makeItems(welches: integer; its: array of string); 
var 
  x: integer; 
begin 
  setlength(tm[welches], length(its)); 
  for x := 0 to length(its) - 1 do begin 
    tm[welches][x] := TMenuItem.Create(Form1); 
    tm[welches][x].caption := its[x]; 
    tp[welches].items.add(tm[welches][x]); 
  end; 
end; 
 
procedure TForm1.minimieren(Sender: TObject); 
begin 
  application.minimize; 
end; 
 
procedure TForm1.rot(Sender: TObject); 
begin 
  Form1.color := clred; 
end; 
 
procedure TForm1.schliessen(Sender: TObject); 
begin 
  application.terminate; 
end; 
 
procedure TForm1.oeffnen(Sender: TObject); 
begin 
// enstsprechende Routine 
// z.B: 
  showmessage(TMenuItem(Sender).caption); 
end; 
 
procedure TForm1.speichern(Sender: TObject); 
begin 
// enstsprechende Routine 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
var x: integer; 
begin 
  for x := 0 to PopMenuAnzahl - 1 do 
    tp[x] := NewPopupMenu(Form1, 'PopMenu' + inttostr(x + 1), paLeft, true, tm[x]); 
  makeItems(0, itms1); 
  makeItems(1, itms2); 
  tm[0][0].onclick := minimieren; 
  tm[0][1].onclick := rot; 
  tm[0][3].onclick := schliessen; 
  tm[1][0].onclick := oeffnen; 
  tm[1][1].onclick := speichern; 
  Form1.popupmenu := tp[0]; 
  Panel1.popupmenu := tp[1]; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
var x, y: integer; 
begin 
  for x := 0 to PopMenuAnzahl - 1 do begin 
    for y := 0 to length(tm[x]) - 1 do tm[x][y].free; 
    tm[x] := nil; 
    tp[x].free; 
  end; 
end; 
 
end.