CODEWITHSUNDEEP
androiddelphifiremonkey
StanE
StanE

Reputation: 2774

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).

Upvotes: 3

Views: 1588

Answers (2)

user3437976
user3437976

Reputation: 111

On mobile devices you don't use OnClick but OnTap!

If you use OnTap then there won't be any misfiring while scrolling.

To still be able to test my app as a win32 application, I use this:

procedure TForm1Rectangle.Click;
begin
  inherited;
  {$IFDEF MSWINDOWS}
  // Screen.MousePos ist in reference to the current screen:
  Tapped(Self.ScreenToLocal(Screen.MousePos));
  {$ENDIF}
end;

procedure TForm1Rectangle.Tap(const Point:TPointF);
begin
  inherited;
  // 'Point' is in reference to the current window:
  Tapped(Self.AbsoluteToLocal(Point));
end;

procedure TForm1Rectangle.Tapped(const Point:TPointF);
begin
  // Here 'Point' is in reference to TopLeft of the rectangle
end;

Upvotes: 4

Dave Nottage
Dave Nottage

Reputation: 3602

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

Upvotes: 6

Related Questions