Source Code My easy way to How to Simulating a PopUp menu using TForm and Show method

[emailx45]

My easy way to How to Simulating a PopUp menu using TForm and Show method

• All controls in Form (behind) still working as expected

Spoiler: Content

[SHOWTOGROUPS=4,20]
View attachment 2751

Spoiler: uFormMain

unit uFormMain;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.Menus,
  Vcl.StdCtrls,
  Vcl.ExtCtrls;

type
  TfrmFormMain = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    ListBox1: TListBox;
    ComboBox1: TComboBox;
    Memo1: TMemo;
    pnlMyPanelStatus: TPanel;
    Timer1: TTimer;
    lbMyTimerNOW: TLabel;
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmFormMain: TfrmFormMain;

implementation

{$R *.dfm}

uses
  uMyFormPOPUP;

var
  frmForm2MyPopMenu: TfrmForm2MyPopMenu;

procedure TfrmFormMain.Button1Click(Sender: TObject);
begin
  ShowMessage(Edit1.Text);
end;

procedure TfrmFormMain.Button2Click(Sender: TObject);
begin
  ShowMessage(Edit2.Text);
end;

procedure TfrmFormMain.Button3Click(Sender: TObject);
begin
  if (ComboBox1.ItemIndex > -1) then
    ShowMessage(ComboBox1.Items[ComboBox1.ItemIndex]);
end;

procedure TfrmFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Timer1.Enabled := false;
end;

procedure TfrmFormMain.FormCreate(Sender: TObject);
begin
  frmForm2MyPopMenu        := TfrmForm2MyPopMenu.Create(nil);
  frmForm2MyPopMenu.Parent := self;
  //
  if not(frmForm2MyPopMenu.Parent = nil) then
    Caption := frmForm2MyPopMenu.Parent.ClassName
  else
    Caption := 'frmForm2MyPopMenu.Parent.ClassName = nil';
  //
  Timer1.Enabled := true;
end;

procedure TfrmFormMain.FormDestroy(Sender: TObject);
begin
  if not(frmForm2MyPopMenu = nil) then
    frmForm2MyPopMenu.Free;
end;

procedure TfrmFormMain.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (Button = TMouseButton.mbRight) then
  begin
    if not(frmForm2MyPopMenu = nil) then // and (not frmForm2MyPopMenu.Showing)) then
    begin
      frmForm2MyPopMenu.Left := X;
      frmForm2MyPopMenu.Top  := Y;
      frmForm2MyPopMenu.Show;
    end;
  end;
end;

procedure TfrmFormMain.ListBox1Click(Sender: TObject);
begin
  if ((Sender as TListBox).ItemIndex > -1) then
    ShowMessage((Sender as TListBox).Items[(Sender as TListBox).ItemIndex]);
end;

procedure TfrmFormMain.Timer1Timer(Sender: TObject);
begin
  lbMyTimerNOW.Caption := Format('Now is %s', [TimeToStr(Now)]);
end;

end.

Spoiler: uMyFormPOPUP

unit uMyFormPOPUP;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.ButtonGroup;

type
  TfrmForm2MyPopMenu = class(TForm)
    ButtonGroup1: TButtonGroup;
    procedure FormMouseEnter(Sender: TObject);
    procedure FormMouseLeave(Sender: TObject);
    procedure ButtonGroup1ButtonClicked(Sender: TObject; Index: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmForm2MyPopMenu: TfrmForm2MyPopMenu;

implementation

{$R *.dfm}

uses
  uFormMain;

// Define:  ButtonGroup1.ButtonOptions := [gboFullSize, gboShowCaptions];
//

procedure TfrmForm2MyPopMenu.ButtonGroup1ButtonClicked(Sender: TObject; Index: Integer);
begin
  if not(Self.Parent = nil) then                                    // my frmFormMain
    TfrmFormMain(Self.Parent).pnlMyPanelStatus.Caption :=           { }
      Format('GrpButton = %s, from MyPOPForm = %s', [               { }
        (Sender as TButtonGroup).Items[index].Caption,              { }
        TfrmForm2MyPopMenu((Sender as TButtonGroup).Parent).Caption { }
      ]);
end;

procedure TfrmForm2MyPopMenu.FormMouseEnter(Sender: TObject);
begin
  Self.SetFocus;
end;

procedure TfrmForm2MyPopMenu.FormMouseLeave(Sender: TObject);
begin
  if not(Self.Parent = nil) then // my frmFormMain
    Self.Parent.SetFocus;
end;

end.

[/SHOWTOGROUPS]

 

[vvsektor]

"Dude, have you tried using the TPopupMenu component instead of TForm? It's way easier to work with, and you can attach it to any control you want. Saves you from messing with TForm's Show method, tbh."

 

[aneta74]

"Hey OP, I think you might want to check out the TForm methods 'popupmenu' and 'popupmenuitems' instead of using the Show method. That way you can create a more native GUI experience. Also, consider using the TPopupMenu component for more flexibility."