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

emailx45

Staff member
Premium
Joined
May 5, 2008
Messages
2,477
Reaction score
2,211
Location
here and there
My easy way to How to Simulating a PopUp menu using TForm and Show method
  • All controls in Form (behind) still working as expected
[SHOWTOGROUPS=4,20]
View attachment 2751

Code:
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.
Code:
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]
 
Top