滚动TVertScrollBox时防止触发事件 [英] Prevent firing events while scrolling TVertScrollBox

问题描述

通常，在滚动滚动框"的内容时，不会从滚动框的子组件中触发事件功能. G.在本机应用程序中.但是在FireMonkey中，如果TVertScrollBox包含TRectangle之类的子元素(我想将其用作自定义菜单的菜单项)，则用手指在Android上滚动TVertScrollBox有时会触发子元素的事件功能(如OnClick)这对我和我们的客户来说非常令人困惑-他们不想在滚动时点击特定的元素.

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.

在本机应用程序中，这永远不会发生.我不知道如何防止这种行为.我试图将OnMouseEnter和OnMouseLeave中的所有子元素的HitTest属性设置为FALSE(我也尝试了其他事件)，如下所示:

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;

但这显然是行不通的，因为用户首先点击了位于TVertScrollBox顶部的子元素.

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.

这是FireMonkey中的错误/未实现功能吗?我感谢所有解决此滚动问题的想法.如果可能的话，没有第三方组件.

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

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

I am using Delphi Community Edition 10.3.2 (26.0.34749.6593).

推荐答案

这是FireMonkey中的错误/未实现功能吗?

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.

这里，我使用的是从TButton派生的通常称为插入器"的类，以覆盖检测鼠标是否移动的必要方法，以便仅在鼠标未移动时调用Click(非常很多).当按钮接收到MouseDown时，将设置Down标志并设置位置，然后在接收到MouseMove时计算其已移动了多远.如果距离太远，则最终调用Click时，不会调用继承的方法，因此不会触发OnClick事件.

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.

您可以对TRectangle使用相同的技术，也可以采用其他任何方法来获得点击

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

这篇关于滚动TVertScrollBox时防止触发事件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！