unit uMain;
{$mode objfpc}{$H+}
interface
uses
Classes, Forms, Controls, Dialogs, Menus, StdCtrls;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
pumMain: TPopupMenu;
pumPresets: TPopupMenu;
mainButton: TButton;
presetButton: TButton;
submenuButton: TButton;
procedure MainButtonClick(Sender: TObject);
procedure PresetButtonClick(Sender: TObject);
procedure PresetOnClick(Sender: TObject);
procedure SubmenuButtonClick(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Caption := 'Menu copying example';
pumMain := TPopupMenu.Create(Self);
pumMain.Items.Add(NewItem('Main 1', 0, False, True, Nil, 0, ''));
pumMain.Items.Add(NewItem('Main 2', 0, False, True, Nil, 0, ''));
pumMain.Items.Add(NewItem('Main 3', 0, False, True, Nil, 0, ''));
pumPresets := TPopupMenu.Create(Self);
pumPresets.Items.Add(NewItem('Presets 1', 0, False, True, @PresetOnClick, 0, ''));
pumPresets.Items.Add(NewItem('Presets 2', 0, False, True, @PresetOnClick, 0, ''));
pumPresets.Items.Add(NewItem('Presets 3', 0, False, True, @PresetOnClick, 0, ''));
mainButton := TButton.Create(Self);
with mainButton do
begin
AutoSize := True;
Caption := 'Popup main';
OnClick := @MainButtonClick;
BorderSpacing.Around := 20;
AnchorSideTop.Control := Self;
AnchorSideLeft.Control := Self;
Parent := Self;
end;
presetButton := TButton.Create(Self);
with presetButton do
begin
AutoSize := True;
Caption := 'Popup preset';
OnClick := @PresetButtonClick;
BorderSpacing.Around := 20;
AnchorSideLeft.Control := Self;
AnchorSideTop.Control := mainButton;
AnchorSideTop.Side := asrBottom;
Parent := Self;
end;
submenuButton := TButton.Create(Self);
with submenuButton do
begin
AutoSize := True;
Caption := 'Add preset to main';
OnClick := @SubmenuButtonClick;
BorderSpacing.Around := 20;
AnchorSideLeft.Control := Self;
AnchorSideTop.Control := presetButton;
AnchorSideTop.Side := asrBottom;
Parent := Self;
end;
end;
procedure TForm1.MainButtonClick(Sender: TObject);
begin
pumMain.PopUp;
end;
procedure TForm1.PresetButtonClick(Sender: TObject);
begin
pumPresets.PopUp;
end;
procedure TForm1.PresetOnClick(Sender: TObject);
begin
if Sender is TMenuItem then
ShowMessage('You clicked menu captioned '+TMenuItem(Sender).Caption);
end;
procedure TForm1.SubmenuButtonClick(Sender: TObject);
var
mi, smi: TMenuItem;
i: Integer;
begin
mi := TMenuItem.Create(pumMain);
pumMain.Items[2].Insert(0, mi);
mi.Caption := 'Added Presets';
for i := 0 to pumPresets.Items.Count-1 do
begin
smi := TMenuItem.Create(pumMain);
smi.Caption := pumPresets.Items[i].Caption;
smi.OnClick := pumPresets.Items[i].OnClick;
mi.Add(smi);
end;
submenuButton.Enabled := False;
end;
end.