滚动 TVertScrollBox 时防止触发事件

Question

通常，在滚动 "scroll box" 的内容时，不会从滚动框的子组件触发任何事件函数，例如。 G。在本机应用程序中。但在 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 中的错误/未实现的功能吗？我很欣赏解决这个滚动问题的所有想法。如果可能，没有第三方组件。

我正在使用 Delphi 社区版 10.3.2 (26.0.34749.6593)。

Answer 1

Is this a bug / not implemented feature in FireMonkey?

对这个问题的两个部分都否，尽管作为一项功能会很好。这是一种可能的解决方案：

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.

在这里，我使用了通常被称为 "interposer" class 的东西，它继承自 TButton，以覆盖检测鼠标是否移动所需的方法，以便仅调用 Click当鼠标没有移动（非常多）时。当一个按钮接收到 MouseDown 时，Down 标志和位置被设置，然后当接收到 MouseMove 时，它计算它移动了多远。如果太远，当最终调用 Click 时，不会调用继承的方法，因此不会触发 OnClick 事件。

您可以对 TRectangle 或任何可以接收点击的内容使用相同的技术

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;

滚动 TVertScrollBox 时防止触发事件

Prevent firing events while scrolling TVertScrollBox

delphi

android

firemonkey