FireMonkey下类似手机QQ侧滑菜单的实现

侧滑菜单效果图：

{*------------------------------------------------------------------------------
   侧滑菜单实现

  @author  清幽傲竹(fjfzcsm@qq.com)
  @version 2016/04/09 1.0 Initial revision.
  @todo    侧滑菜单实现
  @comment  侧滑实现参考：http://blog.csdn.net/guolin_blog/article/details/8714621


//侧滑实现参考：http://blog.csdn.net/guolin_blog/article/details/8714621
使用方法(举例往FmainForm上增加侧滑菜单面板)：
  1、放置左侧菜单面板TRectangle,命名为menu_rect,设置属性:menu_rect.Align=MostLeft;
  2、放置内容面板TRectangle,命名为content_rect,设置属性:content_rect.Align=Left;
  3、FmainForm.Touch.InteractiveGestures.pan需设置为true
  4、procedure TFMain.FormCreate(Sender: TObject);
    begin
      FEglSlideMenu := TEglSlideMenu.Create(self,menu_rect,content_rect);
    end;

    procedure TFMain.FormGesture(Sender: TObject;
      const EventInfo: TGestureEventInfo; var Handled: Boolean);
    begin
      FEglSlideMenu.OnGestureDo(sender,EventInfo,Handled);
    end;

    procedure TFMain.ScrollToMenuImgClick(Sender: TObject);
    begin
      FEglSlideMenu.scrollToMenu;
    end;
  5、如果在某个控件上滑动没有效果,请把该控件的Touch.InteractiveGestures.pan设置为true，然后OnGesture事件实现指向到FMain.FormGesture事件实现
  6、在设计时如要隐藏menu_rect，请把 menu_rect.Margin.left设置为0-menu_rect.width,如menu_rect宽度为257，则把 menu_rect.Margin.left设置为-257，即可
     达到隐藏效果,切记不要把 menu_rect.visible设置为false;
-------------------------------------------------------------------------------}
unit UEglSlideMenu;

interface
uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,FMX.Controls.Presentation, FMX.Objects, FMX.Layouts,
  FMX.Ani, FMX.Gestures,System.Generics.Collections;

type
 TxDistanceObj = class
   distance: Single;
   timeStamp: Cardinal;
 end;
  TSlideMenuParam = record
    SNAP_VELOCITY: Single;//滚动显示和隐藏menu时，手指滑动需要达到的速度
    screenWidth: Integer;//屏幕宽度值
    leftEdge: Single;//menu最多可以滑动到的左边缘。值由menu布局的宽度来定，marginLeft到达此值之后，不能再减少。
    rightEdge: Single;//menu最多可以滑动到的右边缘。值恒为0，即marginLeft到达0之后，不能增加。
    menuPadding: Single;//menu完全显示时，留给content的宽度值。
    xDown: Single;//记录手指按下时的横坐标。
    xMove: Single;//记录手指移动时的横坐标。
    xUp: Single;//记录手指抬起时的横坐标。
    isMenuVisible: Boolean;//menu当前是显示还是隐藏。只有完全显示或隐藏menu时才会更改此值，滑动过程中此值无效。
    distanceX: Single;
    MenuLeftMargin: Single;//menurect.margin.left
    xDistanceList: TObjectList<TxDistanceObj>;//记录每次x轴移动的距离 ,<移动的距离,时间戮>
  end;
  TEglSlideMenu = class(TObject)
  private
    X1, Y1: Single; // 用来判断是否要执行单击事件（记录onmousedown的坐标）
    form: TForm;
    content_rect: TRectangle;
    content_rect_mask: TRectangle;
    menu_rect: TRectangle;
    FSlideMenuParam: TSlideMenuParam;

    procedure content_rect_maskMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure content_rect_maskMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);

    procedure InitSlideMenuParam;//初始化侧滑菜单参数
    /// <summary>
    /// 判断当前手势的意图是不是想显示content。如果手指移动的距离是负数，且当前menu是可见的，则认为当前手势是想要显示content。
    /// </summary>
    /// <returns>当前手势想显示content返回true，否则返回false</returns>
    function wantToShowContent(): Boolean;
    /// <summary>
    /// 判断当前手势的意图是不是想显示menu。如果手指移动的距离是正数，且当前menu是不可见的，则认为当前手势是想要显示menu。
    /// </summary>
    /// <returns>当前手势想显示menu返回true，否则返回false。 </returns>
    function wantToShowMenu(): Boolean;
    /// <summary>
    /// 判断是否应该滚动将menu展示出来。如果手指移动距离大于屏幕的1/2，或者手指移动速度大于SNAP_VELOCITY，
    ///   就认为应该滚动将menu展示出来。
    /// </summary>
    /// <returns>如果应该滚动将menu展示出来返回true，否则返回false。 </returns>
    function shouldScrollToMenu(): Boolean;
    /// <summary>
    /// 获取手指在content界面滑动的速度。
    /// </summary>
    /// <returns>滑动速度，以每秒钟移动了多少像素值为单位</returns>
    function getScrollVelocity(): Single;
    /// <summary>
    /// 判断是否应该滚动将content展示出来。如果手指移动距离加上menuPadding大于屏幕的1/2，
    ///  或者手指移动速度大于SNAP_VELOCITY， 就认为应该滚动将content展示出来。
    /// </summary>
    /// <returns>如果应该滚动将content展示出来返回true，否则返回false。 </returns>
    function shouldScrollToContent(): Boolean;

    /// <summary>
    /// 将屏幕滚动到content界面，滚动速度设定为-30.
    /// </summary>
    procedure scrollToContent();
  public
    constructor Create(aForm: TForm;aLeftMenuRect,aContentRect: TRectangle);
    destructor Destroy; override;
    procedure OnGestureDo(Sender: TObject; const EventInfo: TGestureEventInfo;
      var Handled: Boolean);
    /// <summary>
    /// 将屏幕滚动到menu界面，滚动速度设定为30.
    /// </summary>
    procedure scrollToMenu();
  end;
implementation

{ TEglSlideMenu }

procedure TEglSlideMenu.content_rect_maskMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  X1 := X; // 记录鼠标按下时的坐标值
  Y1 := Y;
end;

procedure TEglSlideMenu.content_rect_maskMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  if Sqrt(Sqr(abs(X - X1)) + Sqr(abs(Y - Y1))) < 5 then // 防止鼠标单击时与滑动冲突
  begin
     scrollToContent;
  end;
end;

constructor TEglSlideMenu.Create(aForm: TForm;aLeftMenuRect, aContentRect: TRectangle);
begin
  form := aForm;
  menu_rect := aLeftMenuRect;
  if not menu_rect.Visible then menu_rect.Visible := True;
  
  content_rect := aContentRect;

  Assert(menu_rect.Align = TAlignLayout.MostLeft,'menu_rect.Align需设置为MostLeft');
  Assert(content_rect.Align = TAlignLayout.Left,'(content_rect.Align需设置为Left');

  Assert(TInteractiveGesture.Pan in form.Touch.InteractiveGestures,'form.Touch.InteractiveGestures.pan需设置为true');

  content_rect_mask := TRectangle.Create(aForm);
  content_rect_mask.Parent := content_rect;
  content_rect_mask.Fill.Kind := TBrushKind.None;
  content_rect_mask.Stroke.Kind := TBrushKind.None;
  content_rect_mask.Align := TAlignLayout.Contents;
  content_rect_mask.OnMouseDown := content_rect_maskMouseDown;
  content_rect_mask.OnMouseUp := content_rect_maskMouseUp;
  content_rect_mask.Touch.InteractiveGestures := [TInteractiveGesture.Pan];
  content_rect_mask.OnGesture := OnGestureDo;

  InitSlideMenuParam;
end;

destructor TEglSlideMenu.Destroy;
begin

  inherited;
end;

procedure TEglSlideMenu.OnGestureDo(Sender: TObject;
  const EventInfo: TGestureEventInfo; var Handled: Boolean);
var
  DetalX: Double;
  DetalY: Double;
  moveX: Double;
  aScale: Double;
  aObj: TxDistanceObj;
begin
  if EventInfo.GestureID = System.UITypes.igiPan then
  begin
    if TInteractiveGestureFlag.gfBegin in EventInfo.Flags then // 点击开始移动
    begin
      // 手指按下时，记录按下时的横坐标
      //xDown = event.getRawX();
      FSlideMenuParam.xDown := EventInfo.Location.X;
      //创建记录x轴每次移动的距离对象
      if FSlideMenuParam.xDistanceList = nil then
      begin
        FSlideMenuParam.xDistanceList := TObjectList<TxDistanceObj>.Create();
      end;
    end
    else if (not(TInteractiveGestureFlag.gfBegin in EventInfo.Flags)) and (not(TInteractiveGestureFlag.gfEnd in EventInfo.Flags)) then // 正在移动
    begin
      //xMove = event.getRawX();
      FSlideMenuParam.xMove := EventInfo.Location.X;
      //int distanceX = (int) (xMove - xDown);
      FSlideMenuParam.distanceX := FSlideMenuParam.xMove - FSlideMenuParam.xDown;
      aObj := TxDistanceObj.Create;
      aObj.distance := Abs(FSlideMenuParam.distanceX);
      aObj.timeStamp := TThread.GetTickCount;
      FSlideMenuParam.xDistanceList.add(aObj);
      //log.d('eagle',Self,Format('distanceX:%f;leftEdge:%f',[FSlideMenuParam.distanceX,FSlideMenuParam.leftEdge]));
      if FSlideMenuParam.isMenuVisible then
      begin
        FSlideMenuParam.MenuLeftMargin := FSlideMenuParam.distanceX;
      end
      else
      begin
        FSlideMenuParam.MenuLeftMargin := FSlideMenuParam.leftEdge + FSlideMenuParam.distanceX;
      end;
      if FSlideMenuParam.MenuLeftMargin < FSlideMenuParam.leftEdge then
      begin
        FSlideMenuParam.MenuLeftMargin := FSlideMenuParam.leftEdge;
      end
      else if FSlideMenuParam.MenuLeftMargin > FSlideMenuParam.rightEdge then
      begin
        FSlideMenuParam.MenuLeftMargin := FSlideMenuParam.rightEdge;
      end;
      //log.d('eagle',Self,Format('MenuLeftMargin:%f',[FSlideMenuParam.MenuLeftMargin]));
      menu_rect.Margins.Left := FSlideMenuParam.MenuLeftMargin;
      content_rect_mask.Visible := FSlideMenuParam.MenuLeftMargin <> FSlideMenuParam.leftEdge;

    end
    else if TInteractiveGestureFlag.gfEnd in EventInfo.Flags then //移动结束
    begin
//      Exit;
      //xUp = event.getRawX();
      FSlideMenuParam.xUp := EventInfo.Location.X;
      if wantToShowMenu then
      begin
        if shouldScrollToMenu then
          scrollToMenu
        else
          scrollToContent;
      end
      else if wantToShowContent then
      begin
        if shouldScrollToContent then
          scrollToContent
        else
          scrollToMenu;
      end;
      if FSlideMenuParam.xDistanceList <> nil then
      begin
        {$IFDEF AUTOREFCOUNT}
        FSlideMenuParam.xDistanceList.DisposeOf;
        {$ELSE}
        FSlideMenuParam.xDistanceList.Free;
        {$ENDIF}
      end;
    end;


  end;

end;

function TEglSlideMenu.getScrollVelocity: Single;
var
  aCurTimeStamp: Cardinal;
  aObj: TxDistanceObj;
  i: Integer;
  aCount: Integer;
begin
  Result := 0;
  aCurTimeStamp := TThread.GetTickCount;
  for i := FSlideMenuParam.xDistanceList.Count-1 downto 0 do
  begin
    if (aCurTimeStamp - FSlideMenuParam.xDistanceList[i].timeStamp) > 1000 then Break;
    Result := Result + FSlideMenuParam.xDistanceList[i].distance;
  end;

end;

procedure TEglSlideMenu.InitSlideMenuParam;
begin
  menu_rect.Align := TAlignLayout.MostLeft;
  content_rect.Align := TAlignLayout.Left;
  content_rect_mask.Visible := False;

  FSlideMenuParam.SNAP_VELOCITY := 200;
  FSlideMenuParam.screenWidth := Screen.Width;
  FSlideMenuParam.rightEdge := 0;
  FSlideMenuParam.menuPadding := FSlideMenuParam.screenWidth - menu_rect.width;//原为80,现改为左侧菜单宽度恒定
  FSlideMenuParam.xDistanceList := nil;

  //将menu的宽度设置为屏幕宽度减去menuPadding
  menu_rect.Width := FSlideMenuParam.screenWidth - FSlideMenuParam.menuPadding;
  // 左边缘的值赋值为menu宽度的负数
  FSlideMenuParam.leftEdge := 0 - menu_rect.Width;
  // menu的leftMargin设置为左边缘的值，这样初始化时menu就变为不可见
  menu_rect.Margins.Left := FSlideMenuParam.leftEdge;
  FSlideMenuParam.isMenuVisible := False;
  // 将content的宽度设置为屏幕宽度
  content_rect.Width := FSlideMenuParam.screenWidth;
  {$IFDEF MSWINDOWS}
  content_rect.Width:= form.Width;//PC上的效果，方便开发调试
  {$ENDIF}
end;

procedure TEglSlideMenu.scrollToContent;
begin
  menu_rect.AnimateFloat('Margins.Left', FSlideMenuParam.leftEdge, 0.2, TAnimationType.In, TInterpolationType.Linear);
  FSlideMenuParam.isMenuVisible := False;
  content_rect_mask.Visible := False;
end;

procedure TEglSlideMenu.scrollToMenu;
begin
  Assert(menu_rect.Visible,'menu_rect.Visible不可设置为false');
  menu_rect.AnimateFloat('Margins.Left', 0, 0.2, TAnimationType.In, TInterpolationType.Linear);
  FSlideMenuParam.isMenuVisible := True;
  content_rect_mask.Visible := True;
end;

function TEglSlideMenu.shouldScrollToContent: Boolean;
begin
  //return xDown - xUp + menuPadding > screenWidth / 2 || getScrollVelocity() > SNAP_VELOCITY;
  Result := (FSlideMenuParam.xDown - FSlideMenuParam.xUp + FSlideMenuParam.menuPadding) > (FSlideMenuParam.screenWidth / 2.0);
  Result := Result or (getScrollVelocity > FSlideMenuParam.SNAP_VELOCITY);
end;

function TEglSlideMenu.shouldScrollToMenu: Boolean;
begin
  //return xUp - xDown > screenWidth / 2 || getScrollVelocity() > SNAP_VELOCITY;
  Result := (FSlideMenuParam.xUp - FSlideMenuParam.xDown) > FSlideMenuParam.screenWidth / 2.0;
  Result := Result or (getScrollVelocity > FSlideMenuParam.SNAP_VELOCITY);
end;

function TEglSlideMenu.wantToShowContent: Boolean;
begin
//  Result := xUp - xDown < 0 && isMenuVisible
  Result := (FSlideMenuParam.xUp - FSlideMenuParam.xDown) < 0;
  Result := Result and FSlideMenuParam.isMenuVisible;
end;

function TEglSlideMenu.wantToShowMenu: Boolean;
begin
  //return xUp - xDown > 0 && !isMenuVisible;
  Result := (FSlideMenuParam.xUp - FSlideMenuParam.xDown) > 0;
  Result := Result and (not FSlideMenuParam.isMenuVisible);
end;

end.

源码附件：http://download.csdn.net/detail/csm2432/9493901