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

emailx45

Местный
Регистрация
5 Май 2008
Сообщения
3,571
Реакции
2,438
Credits
573
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]
1593832372139.png

Код:
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.
Код:
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]