Title: How to create a dynamic PopUpMenu
Question: Have you ever wanted to Create a PopupMenu at a Position you wanted.
e.g. from a button going up:
_______
|_Item1_|
|_Item2_|__
|Button___|
Here is an approach with TrackPopupMenuEx.
Hint: Use if you are stuck to StandardControls, otherwise you could use a clever component, if you find it
Answer:
So here is the commented sorce:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, ExtCtrls, Menus;
const
//our Message ID's
WM_1TEST = WM_USER + 101;
WM_2TEST = WM_USER + 102;
WM_3TEST = WM_USER + 103;
type
TForm1 = class(TForm)
Panel1: TPanel;
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
protected
procedure WMCommand(var Msg: TWMCommand); message WM_COMMAND;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WMCommand(var Msg: TWMCommand);
begin
case Msg.ItemID of //- Msg.ItemID contains the WM_USER + x
WM_1TEST : Memo1.Lines.Add('Command 1');
WM_2TEST : Memo1.Lines.Add('Command 2');
WM_3TEST : Memo1.Lines.Add('Command 3');
end;
inherited; //- important for not disturbing Windows-MessageHandling
end;
procedure TForm1.Button1Click(Sender: TObject);
var
MyPopUpMenu : TPopUpMenu;
MyMsg : LongBool;
begin
MyPopUpMenu := TPopUpMenu.Create(Self);
MyPopUpMenu.AutoPopup := FALSE;
MyPopUpMenu.AutoHotkeys := maManual;
//Create the Items
//AppendMenu here sufficient, just want to handle a simple OnClickEvent
//could also be used with if or case if you don't want all the Items
//everytime
AppendMenu(MyPopUpMenu.Handle
, MF_POPUP //- each Item in single Line
//otherwise use
// MF_MENUBREAK for a Column for each Item (all in one Line)
// MF_MENUBARBREAK for a Column each Item with separator
or MF_STRING or MF_UNCHECKED
, WM_1TEST //- important the WM_USER+x identifies the Msg in WMCommand
, 'Test1'); //Caption of the MenuItem
AppendMenu(MyPopUpMenu.Handle
, MF_POPUP or MF_STRING or MF_UNCHECKED
, WM_2TEST //- important the WM_USER+x identifies the Msg in WMCommand
, 'Test2');
AppendMenu(MyPopUpMenu.Handle
, MF_POPUP or MF_STRING or MF_UNCHECKED
, WM_3TEST //- important the WM_USER+x identifies the Msg in WMCommand
, 'Test3');
MyMsg := TrackPopupMenuEx(MyPopUpMenu.Handle //the PopUpMenu to be shown
// Alignment to the point specified!
// horizontal vertical
, TPM_LEFTALIGN or TPM_BOTTOMALIGN
//in this case to the left and up
//, TPM_LEFTALIGN or TPM_TOPALIGN
//, TPM_LEFTALIGN or TPM_VCENTERALIGN
//, TPM_RIGHTALIGN or TPM_BOTTOMALIGN
//, TPM_RIGHTALIGN or TPM_TOPALIGN
//, TPM_RIGHTALIGN or TPM_VCENTERALIGN
//, TPM_CENTERALIGN or TPM_BOTTOMALIGN
//, TPM_CENTERALIGN or TPM_TOPALIGN
//, TPM_CENTERALIGN or TPM_VCENTERALIGN
//or TPM_VERTICAL or TPM_HORIZONTAL
//you could specify a region the PopUpMenu should'nt overlap
//but you have to specify a TPMPARAMS(~TRect) structure (last Param)
or TPM_RETURNCMD //Return the Identifier of the Item clicked
//or TPM_NONOTIFY //no Message send back
or TPM_LEFTBUTTON //the Left Button selects
//or TPM_RIGHTBUTTON //the Right Button selects
//or TPM_LEFTBUTTON or TPM_RIGHTBUTTON// or both
or TPM_HORPOSANIMATION or TPM_VERNEGANIMATION
//^these Settings look best with TPM_LEFTALIGN and TPM_BOTTOMALIGN
//could also be:
//TPM_NOANIMATION
//or TPM_HORNEGANIMATION or TPM_VERPOSANIMATION
, TControl(Sender).ClientOrigin.x //Origin of Menu X
//+TControl(Sender).Width //use TPM_RIGHTALIGN and TPM_BOTTOMALIGN
, TControl(Sender).ClientOrigin.y //Origin of Menu Y
//the TopLeft Point of the Control which should have the Menu
//used TControl here, so it could be used with most Control's
//for Example if you want a TLabel to have a PoPUpMenu
, Self.Handle //- Handle to the Window/Application
, nil); //- TPMPARAMS structure, nil cause, i forced the PopUp Menu to go Left and Up
if MyMsg then //- TrackPopUpMenuEx returns TRUE if everything worked out ok
SendMessage(Self.Handle //- sending a message to the window
, WM_COMMAND //- Type of Message
, Integer(MyMsg) //- Param, i.e. ReturnValue of TrackPopUpMenuEx
, 0);
MyPopUpMenu.Free; //- destroy created PopUpMenu
MyPopUpMenu := nil;
end;
end.
//Reference:
//Delphi Help: TrackPopUpMenu, AddMenu, DestroyMenu, Sendmessage
//don't forget to check overview, Group, etc. in the Help Entrys
Please give comments
Chr.