Popup - como criar um menu popup em runtime

Top  Previous  Next

Question/Problem/Abstract:

 

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

 

 

--------------------------------------------------------------------------------

Generated by PasToWeb, a tool by Marco Cantù. 

 

 

 

Please give comments 

 

Christoph Otto 

otto.c@gmx.net