Delphi XE7实现的任意位置弹出菜单

Posted 2020-08-20

Delphi XE7中目前还没有弹出菜单组件，这个弹出菜单应用很普遍，在Java开发的安卓程序中很简单就可以用上了，应该说是一个标准控件。看了一些例子，但是都不能满足我想在任意位置弹出菜单需求，于是自己在网上找了一个例子，修改后实现了我的在任意位置弹出菜单需求！全部代码如下：

{
  功能：DelphiXE7里面实现的弹出菜单
  ------------------------------------------------------------------------------
  说明：实现在任意位置显示弹出菜单功能。
  ------------------------------------------------------------------------------
  注意：
  1，rcPopup为弹出菜单最外层的容器，在正式使用时候，"visiable"属性建议设置为false。
  在设计菜单时候，把这个属性改为true，那样可以可视化设计菜单。


  2，"main_old.pas"为原作者写的代码，对原作者辛苦工作表示感谢。


  ------------------------------------------------------------------------------
  原作者：不详，从大富翁论坛下载到此代码
  修改者： Email：[email protected]  修改时间：2014/11/20 00:47
  ------------------------------------------------------------------------------
  开发工具：Delphi XE7
  测试手机：华为荣耀X1
}


unit main;


interface


uses
  System.SysUtils, System.Types, System.UITypes, System.Classes,
  System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Effects,
  FMX.Objects, FMX.StdCtrls, FMX.Filter.Effects, FMX.Ani;


type
  TForm7 = class(TForm)
    ToolBar1: TToolBar;
    sbDropDown: TSpeedButton;
    rcPopup: TRectangle;
    ShadowEffect1: TShadowEffect;
    lbHome: TLabel;
    imHome: TImage;
    FillRGBEffect1: TFillRGBEffect;
    imSeparator: TImage;
    Image1: TImage;
    lbOption2: TLabel;
    Image2: TImage;
    FillRGBEffect2: TFillRGBEffect;
    Image3: TImage;
    lbOption1: TLabel;
    Image4: TImage;
    FillRGBEffect3: TFillRGBEffect;
    lbOption3: TLabel;
    Image5: TImage;
    FillRGBEffect4: TFillRGBEffect;
    PopupAnimation: TFloatAnimation;
    procedure sbDropDownClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }


    // {
    // 功能： 执行显示弹出菜单操作
    // 参数：
    // menuX：// 菜单显示位置的X值
    // menuX：// 菜单显示位置的Y值
    // isShowMenu：是否显示菜单
    // }
    // procedure DoShowPopMenu(menuX, menuY: Single; var isShowMenu: boolean);


    procedure DoShowPopMenu(menuX, menuY: Single; var popMenu: TRectangle;
      var popAnimation: TFloatAnimation; var isShowMenu: boolean);
  end;


var
  Form7: TForm7;


  isShowPopMenu: boolean; // 是否显示菜单


implementation


{$R *.fmx}


// 演示如何使用
procedure TForm7.sbDropDownClick(Sender: TObject);
var
  menuX, menuY: Single; // 菜单显示位置的X和Y值
begin


  { 测试数据1 }
  // 测试默认菜单X值
  menuX := 1;
  // 测试默认菜单Y值
  menuY := ToolBar1.Height;


  { 测试数据2 }
  menuX := menuX + 20; // 菜单显示位置的X值
  menuY := menuY + 20; // 菜单显示位置的Y值


  // 执行显示弹出菜单操作
  self.DoShowPopMenu(menuX, menuY, rcPopup, PopupAnimation, isShowPopMenu);


end;


// 执行显示弹出菜单操作
procedure TForm7.DoShowPopMenu(menuX, menuY: Single; var popMenu: TRectangle;
  var popAnimation: TFloatAnimation; var isShowMenu: boolean);
begin


  // 如果要执行不显示菜单操作
  if isShowMenu = false then
  begin


    // 设置是否显示菜单布尔值为true,为了下次显示菜单判断用
    isShowMenu := True;


    // 设置菜单显示位置X值
    popMenu.Position.X := menuX;
    // 设置菜单显示位置Y值
    popMenu.Position.Y := menuY;


    // 设置菜单可见
    popMenu.Visible := True;


    { 暂时没弄清楚下面这两个参数含义，只是通过测试知道这样设置达到预期效果了 }
    // 设置菜单打开动画起始位置
    popAnimation.StartValue := popMenu.Position.Y;
    // 设置菜单打开动画结束位置
    popAnimation.StopValue := popMenu.Position.Y;


    // 启动动画
    popAnimation.Start;
  end
  else
  begin


    // 设置是否显示菜单布尔值为false,为了下次显示菜单判断用
    isShowMenu := false;


    // 设置菜单显示位置X值
    popMenu.Position.X := menuX;
    // 设置菜单显示位置Y值
    popMenu.Position.Y := menuY;


    { 暂时没弄清楚下面这两个参数含义，只是通过测试知道这样设置达到预期效果了 }
    // 设置菜单打开动画起始位置
    popAnimation.StartValue := popMenu.Position.Y;
    // 设置菜单打开动画结束位置
    popAnimation.StopValue := popMenu.Position.Y;


    // 启动动画
    popAnimation.Start;


    // 设置菜单不可见
    popMenu.Visible := false;
  end;


end;


end.

源代码下载：http://dl5.csdn.net/fd.php?i=878681887197295&s=1031a6c70ac5628e21f978f48da52987