Search code examples
androiddelphifiremonkey

Prevent firing events while scrolling TVertScrollBox


Normally, while scrolling the contents of a "scroll box", no event functions are fired from the sub-components of a scroll box, e. g. in native apps. But in FireMonkey, if a TVertScrollBox contains sub-elements like TRectangle (which I want to use as menu entries for a custom menu), scrolling the TVertScrollBox on Android with a finger sometimes triggers the event functions (like OnClick) of the sub-elements and this is very confusing for me and our customers - They don't want to tap a specific element while scrolling.

In native apps this never happens. I couldn't figure out how to prevent this behaviour. I tried to set the HitTest property to FALSE for all sub-elements in the OnMouseEnter and OnMouseLeave (I also tried other events) with something like this:

procedure TframeCornerMenu.VertScrollBox1MouseEnter(Sender: TObject);
var
  list: TRectangle;
  i: Integer;
begin
  list := FindComponent('rectMenuList') as TRectangle;
  for i := 0 to list.ChildrenCount - 1 do
  begin
    if list.Children[i] is TRectangle then
      TRectangle(list.Children[i]).HitTest := false;
  end;
end;

But this obviously doesn't (and can't) work, because the user taps the sub-elements first which are lying on top of the TVertScrollBox.

Is this a bug / not implemented feature in FireMonkey? I appreciate all ideas solving this scrolling problem. If possible, without third-party components.

I am using Delphi Community Edition 10.3.2 (26.0.34749.6593).


Solution

  • Is this a bug / not implemented feature in FireMonkey?

    No to both parts of that question, though it'd be nice to have as a feature. Here's one possible solution:

    unit MainFrm;
    
    interface
    
    uses
      System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
      FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Layouts, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo, FMX.StdCtrls;
    
    type
      TMouseInfo = record
        Down: Boolean;
        DownPt: TPointF;
        Moved: Boolean;
        procedure MouseDown(const X, Y: Single);
        procedure MouseMove(const X, Y: Single);
        procedure MouseUp;
      end;
    
      TButton = class(FMX.StdCtrls.TButton)
      private
        FMouseInfo: TMouseInfo;
      protected
        procedure Click; override;
        procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
        procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
        procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
      end;
    
      TfrmMain = class(TForm)
        MessagesMemo: TMemo;
        VertScrollBox: TVertScrollBox;
      private
        procedure ControlClickHandler(Sender: TObject);
      public
        constructor Create(AOwner: TComponent); override;
      end;
    
    var
      frmMain: TfrmMain;
    
    implementation
    
    {$R *.fmx}
    
    { TMouseInfo }
    
    procedure TMouseInfo.MouseDown(const X, Y: Single);
    begin
      Down := True;
      Moved := False;
      DownPt := PointF(X, Y);
    end;
    
    procedure TMouseInfo.MouseMove(const X, Y: Single);
    begin
      if Down and not Moved then
        Moved := (Abs(X - DownPt.X) > 10) or (Abs(Y - DownPt.Y) > 10);
    end;
    
    procedure TMouseInfo.MouseUp;
    begin
      Down := False;
    end;
    
    { TButton }
    
    procedure TButton.Click;
    begin
      if not FMouseInfo.Moved then
        inherited;
    end;
    
    procedure TButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
    begin
      inherited;
      FMouseInfo.MouseDown(X, Y);
    end;
    
    procedure TButton.MouseMove(Shift: TShiftState; X, Y: Single);
    begin
      inherited;
      FMouseInfo.MouseMove(X, Y);
    end;
    
    procedure TButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
    begin
      inherited;
      FMouseInfo.MouseUp;
    end;
    
    { TfrmMain }
    
    constructor TfrmMain.Create(AOwner: TComponent);
    var
      I: Integer;
      LButton: TButton;
    begin
      inherited;
      for I := 0 to 29 do
      begin
        LButton := TButton.Create(Self);
        LButton.Name := 'Button' + (I + 1).ToString;
        LButton.Width := 120;
        LButton.Height := 32;
        LButton.Position.X := (Width - LButton.Width) / 2;
        LButton.Position.Y := I * 80;
        LButton.OnClick := ControlClickHandler;
        LButton.Parent := VertScrollBox;
      end;
    end;
    
    procedure TfrmMain.ControlClickHandler(Sender: TObject);
    begin
      MessagesMemo.Lines.Add(TComponent(Sender).Name + ' was clicked');
    end;
    
    end.
    

    Here I'm using what's often referred to as an "interposer" class that descends from TButton, to override the methods necessary to detect whether the mouse has moved, so that Click is called only when the mouse has not moved (very much). When a button receives a MouseDown the Down flag and location is set, then when a MouseMove is received it calculates how far it has moved. If too far, when Click is finally called, the inherited method is not called and so no OnClick event fires.

    You could use the same technique for your TRectangle or whatever can receive clicks