防止在滚动TVertScrollBox时触发事件

Question

通常，在滚动“滚动框”的内容时，不会从滚动框的子组件中触发任何事件函数，例如在原生应用程序中。但是在FireMonkey中，如果TVertScrollBox包含像TRectangle这样的子元素（我想将其用作自定义菜单的菜单项），在Android上用手指滚动TVertScrollBox有时会触发子元素的事件函数（如OnClick），这对我和我们的客户非常困惑-他们不想在滚动时点击特定的元素。

在原生应用程序中，这种情况永远不会发生。我找不出如何防止这种行为的方法。我尝试在OnMouseEnter和OnMouseLeave（我还尝试了其他事件）中为所有子元素设置HitTest属性为FALSE，类似于以下内容：

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;

但显然这种方法行不通（也无法实现），因为用户先点击了位于 TVertScrollBox 上方的子元素。

这是 FireMonkey 中一个bug/未实现的功能吗？我欢迎所有解决此滚动问题的想法，如果可能的话，不使用第三方组件。

我正在使用 Delphi Community Edition 10.3.2 (26.0.34749.6593)。

- StanE

Answer 1

这是FireMonkey中未实现的功能吗或者是一个bug吗？都不是，尽管作为功能它会很好。这里有一个可能的解决方案：

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.

在这里，我使用了一个经常被称为“插入器”类的东西，它继承自TButton，覆盖了必要的方法以检测鼠标是否移动，因此只有当鼠标没有（非常）移动时才调用Click。当一个按钮接收到MouseDown时，Down标志和位置被设置，然后当接收到MouseMove时，它计算了移动的距离。如果太远，当最终调用Click时，继承的方法不会被调用，因此没有OnClick事件触发。

您可以使用相同的技术来处理您的TRectangle或任何其他可以接收点击的对象。

- Dave Nottage

---

这是一个好的解决方案，我可以使用它。非常感谢！希望有一天所有组件都能引入这样的“功能”，因为它可以正常处理触摸屏幕上的滚动。 - StanE

Answer 2

在移动设备上，不使用OnClick而应该使用OnTap！

使用OnTap可以避免在滚动时误操作。

为了仍能够将我的应用程序测试为Win32应用程序，我使用以下内容：

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;

- user3437976