In this tutorial we will learn how to add and use the TPopupMenu component in SCAR forms.
We begin with a basic script that shows a form:
SCAR Code:
program PopupMenuTest;
var
frmDesign: TForm;
procedure InitForm;
begin
frmDesign := CreateForm;
frmDesign.Left := 259;
frmDesign.Top := 132;
frmDesign.Width := 354;
frmDesign.Height := 254;
frmDesign.Caption := 'Menu Testing Form';
frmDesign.Color := clBtnFace;
frmDesign.Font.Color := clWindowText;
frmDesign.Font.Height := -11;
frmDesign.Font.Name := 'MS Sans Serif';
frmDesign.Font.Style := [];
frmDesign.Visible := False;
frmDesign.PixelsPerInch := 96;
end;
procedure SafeInitForm;
var
v: TVariantArray;
begin
SetArrayLength(v, 0);
ThreadSafeCall('InitForm', v);
end;
procedure ShowFormModal;
begin
frmDesign.ShowModal;
end;
procedure SafeShowFormModal;
var
v: TVariantArray;
begin
SetArrayLength(v, 0);
ThreadSafeCall('ShowFormModal', v);
end;
begin
SafeInitForm;
SafeShowFormModal;
end.
In the example that we're making we're going to make the popupmenu appear when you press a button.
So we add a button first:
Variable declaration:
Code for the initform procedure:
SCAR Code:
btn := TButton.Create(frmDesign);
btn.Parent := frmDesign;
btn.Caption := 'Open menu';
btn.Left := 128;
btn.Top := 41;
btn.Width := 75;
btn.Height := 25;
btn.TabOrder := 8;
This results in the script:
SCAR Code:
program PopupMenuTest;
var
frmDesign: TForm;
btn: TButton;
procedure InitForm;
begin
frmDesign := CreateForm;
frmDesign.Left := 259;
frmDesign.Top := 132;
frmDesign.Width := 354;
frmDesign.Height := 254;
frmDesign.Caption := 'Menu Testing Form';
frmDesign.Color := clBtnFace;
frmDesign.Font.Color := clWindowText;
frmDesign.Font.Height := -11;
frmDesign.Font.Name := 'MS Sans Serif';
frmDesign.Font.Style := [];
frmDesign.Visible := False;
frmDesign.PixelsPerInch := 96;
btn := TButton.Create(frmDesign);
btn.Parent := frmDesign;
btn.Caption := 'Open menu';
btn.Left := 128;
btn.Top := 41;
btn.Width := 75;
btn.Height := 25;
btn.TabOrder := 8;
end;
procedure SafeInitForm;
var
v: TVariantArray;
begin
SetArrayLength(v, 0);
ThreadSafeCall('InitForm', v);
end;
procedure ShowFormModal;
begin
frmDesign.ShowModal;
end;
procedure SafeShowFormModal;
var
v: TVariantArray;
begin
SetArrayLength(v, 0);
ThreadSafeCall('ShowFormModal', v);
end;
begin
SafeInitForm;
SafeShowFormModal;
end.
Now we add the popupmenu, first we declare the variable:
Next we also add the variable declarations for the 3 menuitems we're going to add to the menu:
SCAR Code:
mnuMenu1, mnuMenu2, mnuMenu3: TMenuItem;
First we add the code to create the menu in the form to the initform procedure:
SCAR Code:
mnu := TPopupMenu.Create(frmDesign);
Now we do the same for all three menu items:
[scar]mnuMenu1 := TMenuItem.Create(frmDesign);
mnuMenu2 := TMenuItem.Create(frmDesign);
mnuMenu3 := TMenuItem.Create(frmDesign);[scar]
Of course we need to give our menuitems some text so we add the following code to the initform procedure to add text to the items caption property:
SCAR Code:
mnuMenu1.Caption := 'MenuItem1';
mnuMenu2.Caption := 'MenuItem2';
mnuMenu3.Caption := 'MenuItem3';
Now we need to add them to the menu, so we put them in the menu's item list:
SCAR Code:
mnu.Items.Add(mnuMenu1);
mnu.Items.Add(mnuMenu2);
mnu.Items.Add(mnuMenu3);
So now we've got a menu, but... where is it? We can't see it yet, it's a popupmenu, so we need to make it pop up, thats why we made the button, we're going add an onclick event to the button with a small procedure that will open our menu.
To make the menu pop up we use the popup command BUT this requires an x and y coordinate, this is the coordinate where it has to pop up, so we're going to keep it simple and make it pop up at the cursor position.
First we add x and y to store our mouse coordinates to the variable declarations:
We will simply name our procedure ButtonClick, we add a getmousepos procedure to get our mouse position and then the popup command to make our menu pop up when the procedure is ran.
SCAR Code:
procedure ButtonClick(sender: TObject);
begin
GetMousePos(x, y);
mnu.Popup(x, y);
end;
Now we add an onlick event to our button in initform to make our menu show:
SCAR Code:
btn.OnClick := @ButtonClick;
So now we have the following script:
SCAR Code:
program PopupMenuTest;
var
frmDesign: TForm;
mnu: TPopupMenu;
btn: TButton;
mnuMenu1, mnuMenu2, mnuMenu3: TMenuItem;
x, y: Integer;
procedure ButtonClick(sender: TObject);
begin
GetMousePos(x, y);
mnu.Popup(x, y);
end;
procedure InitForm;
begin
frmDesign := CreateForm;
frmDesign.Left := 259;
frmDesign.Top := 132;
frmDesign.Width := 354;
frmDesign.Height := 254;
frmDesign.Caption := 'Menu Testing Form';
frmDesign.Color := clBtnFace;
frmDesign.Font.Color := clWindowText;
frmDesign.Font.Height := -11;
frmDesign.Font.Name := 'MS Sans Serif';
frmDesign.Font.Style := [];
frmDesign.Visible := False;
frmDesign.PixelsPerInch := 96;
btn := TButton.Create(frmDesign);
btn.Parent := frmDesign;
btn.Caption := 'Open menu';
btn.Left := 128;
btn.Top := 41;
btn.Width := 75;
btn.Height := 25;
btn.TabOrder := 8;
btn.OnClick := @ButtonClick;
mnu := TPopupMenu.Create(frmDesign);
mnuMenu1 := TMenuItem.Create(frmDesign);
mnuMenu1.Caption := 'MenuItem1';
mnu.Items.Add(mnuMenu1);
mnuMenu2 := TMenuItem.Create(frmDesign);
mnuMenu2.Caption := 'MenuItem2';
mnu.Items.Add(mnuMenu2);
mnuMenu3 := TMenuItem.Create(frmDesign);
mnuMenu3.Caption := 'MenuItem3';
mnu.Items.Add(mnuMenu3);
end;
procedure SafeInitForm;
var
v: TVariantArray;
begin
setarraylength(v, 0);
ThreadSafeCall('InitForm', v);
end;
procedure ShowFormModal;
begin
frmDesign.ShowModal;
end;
procedure SafeShowFormModal;
var
v: TVariantArray;
begin
setarraylength(v, 0);
ThreadSafeCall('ShowFormModal', v);
end;
begin
SafeInitForm;
SafeShowFormModal;
FreeForm(frmDesign);
end.
We now see our menu pop up when we press the button!
Finally we're going to add fomr procedures for adding to the onclick events of the menu items to test our menu:
SCAR Code:
procedure Mnu1Click(sender: TObject);
begin
WriteLn('You clicked mnuMenu1.');
end;
procedure Mnu2Click(sender: TObject);
begin
WriteLn('You clicked mnuMenu2.');
end;
procedure Mnu3Click(sender: TObject);
begin
WriteLn('You clicked mnuMenu3.');
end;
SCAR Code:
mnuMenu1.OnClick := @Mnu1Click;
mnuMenu2.OnClick := @Mnu2Click;
mnuMenu3.OnClick := @Mnu3Click;
This leaves us with the following script:
SCAR Code:
program PopupMenuTest;
var
frmDesign: TForm;
mnu: TPopupMenu;
btn: TButton;
mnuMenu1, mnuMenu2, mnuMenu3: TMenuItem;
x, y: Integer;
procedure ButtonClick(sender: TObject);
begin
GetMousePos(x, y);
mnu.Popup(x, y);
end;
procedure Mnu1Click(sender: TObject);
begin
WriteLn('You clicked mnuMenu1.');
end;
procedure Mnu2Click(sender: TObject);
begin
WriteLn('You clicked mnuMenu2.');
end;
procedure Mnu3Click(sender: TObject);
begin
WriteLn('You clicked mnuMenu3.');
end;
procedure InitForm;
begin
frmDesign := CreateForm;
frmDesign.Left := 259;
frmDesign.Top := 132;
frmDesign.Width := 354;
frmDesign.Height := 254;
frmDesign.Caption := 'Menu Testing Form';
frmDesign.Color := clBtnFace;
frmDesign.Font.Color := clWindowText;
frmDesign.Font.Height := -11;
frmDesign.Font.Name := 'MS Sans Serif';
frmDesign.Font.Style := [];
frmDesign.Visible := False;
frmDesign.PixelsPerInch := 96;
btn := TButton.Create(frmDesign);
btn.Parent := frmDesign;
btn.Caption := 'Open menu';
btn.Left := 128;
btn.Top := 41;
btn.Width := 75;
btn.Height := 25;
btn.TabOrder := 8;
btn.OnClick := @ButtonClick;
mnu := TPopupMenu.Create(frmDesign);
mnuMenu1 := TMenuItem.Create(frmDesign);
mnuMenu1.Caption := 'MenuItem1';
mnuMenu1.OnClick := @Mnu1Click;
mnu.Items.Add(mnuMenu1);
mnuMenu2 := TMenuItem.Create(frmDesign);
mnuMenu2.Caption := 'MenuItem2';
mnuMenu2.OnClick := @Mnu2Click;
mnu.Items.Add(mnuMenu2);
mnuMenu3 := TMenuItem.Create(frmDesign);
mnuMenu3.Caption := 'MenuItem3';
mnuMenu3.OnClick := @Mnu3Click;
mnu.Items.Add(mnuMenu3);
end;
procedure SafeInitForm;
var
v: TVariantArray;
begin
setarraylength(v, 0);
ThreadSafeCall('InitForm', v);
end;
procedure ShowFormModal;
begin
frmDesign.ShowModal;
end;
procedure SafeShowFormModal;
var
v: TVariantArray;
begin
setarraylength(v, 0);
ThreadSafeCall('ShowFormModal', v);
end;
begin
SafeInitForm;
SafeShowFormModal;
FreeForm(frmDesign);
end.
You can also add submenus to these menus, this works with the same concept as with the TMainMenu component, so please refer to my tutorial for those components top learn how to add submenus.
And that concludes this tutorial, have fun.