将长按事件添加到按钮类的最佳方法是什么？

Question

通过长按,我的意思是按下按钮/面板并保持一段时间(比如2秒)而不释放或拖动.它在手机和触摸设备中很常见.

我曾尝试使用Gesture,在TabletOptions中检查了PressAndHold并在InteractiveGestureOptions中检查了所有内容,但是长时间按下不会导致OnGesture调用.

我能想到的另一种实现增加一个计时器,在开始的MouseDown,并结束它在任何计时器所触发,的startDrag,的MouseUp或鼠标离开.然而,正如我希望这个行为添加到几个不同的按键和面板组件,我将不得不重写程序的早午餐​​每个类和各地复制代码为每个组件.

有没有更好的方法来实现这一目标？

---

编辑:

致NGLN

哇,伟大的工作!结合您对这些滚动效果的回答,VCL几乎可以实现移动操作系统的外观和感觉!

您的代码与常用控件完美配合,但在我的案例中我遇到了2个问题

1. 长时间无法检测表单(原因,因为表单不是其自身的父级)我将查找FChild代码转移到单独的过程并从WMParentNotify和FormMouseDown调用来解决它.

2. 我有一些自定义按钮,它有一些禁用的HTML标签(标题,标题,页脚)覆盖标签原始表面,使用你的代码,FChild将是其中一个标签,但它不会得到MouseCapture.我添加以下行来克服它:

   而不是TControlAccess(FChild).Enabled做FChild:= FChild.Parent;

最后,对于一些更复杂的控件,如TCategoryButtons或TListBox,事件的用户可能需要检查不是针对整个控件而是检查控件中的指定项.所以我认为我们需要保存原来的CursorPos并在定时器触发时触发另一个事件,以便手动确定它是否符合长按条件.如果是或未分配事件,则使用您的默认代码进行确定.

总而言之,我们可以创建一个支持LongPress的表单/面板来托管所有其他控件.这比使用Component by Component实现LongPress功能要容易得多!十分感谢!

---

编辑2:

致NGLN

再次感谢您的组件版本,这是一种很好的方法,不需要对现有组件进行任何修改,并且可以检测到长按!

为了您的信息,我做了一些修改,以满足自己的需要.

1. TCustomForm与TWinControl:由于我的大部分应用程序只有1个主窗体,所有其他可视单元都是我自己创建的框架(不是来自TFrame,而是TScrollingWinControl和ccpack支持),假设TCustomForm对我不起作用.所以我删除了属性表单(但保留了ActiveControl的FForm)并创建了一个已发布的属性Host:TWinControl作为父主机.这样,我也可以将检测限制在一些有限的面板上.分配主机时,我使用GetParentForm(FHost)检查并找到FForm.
2. 禁用控制:正如我之前所说,我有一些禁用的TJvHTLabel覆盖我的按钮,你的组件在标签上工作.我可以通过标签找回按钮,但我认为如果它被新组件处理会更方便.所以我添加了一个SkipDisabled属性,如果设置为turn,则在其父行中循环以找到第一个启用的控件.
3. 我添加了一个PreserveFocus属性,让组件用户选择是否保留最后一个activecontrol.
4. 控制项目.我更改了TLongPressEvent,将ClickPos添加为第二个参数.所以,我现在可以使用ClickPos来查找列表框中的哪个项目或者长期持有的项目.
5. 在我看来,FindVCLWindow与您的FindControlAtPos具有相同的效果？

再次感谢您的出色工作.

Answer 1

在每个鼠标左键单击,WM_PARENTNOTIFY发送到所点击控件的所有(大)父母.因此,这可以用于跟踪长按的起始点,并且可以使用计时器来定时按压的持续时间.剩下的就是决定何时应将印刷机称为长按.当然,将这一切包装在一个很好的组件中.

在下面编写的组件中,OnLongPress满足以下条件时会触发事件处理程序:

• 间隔后,控件仍然有鼠标捕获,或仍然有焦点,或被禁用,
• 在间隔之后,鼠标没有移动更多Mouse.DragThreshold.

关于代码的一些解释:

• 它会暂时替换控件的OnMouseUp事件处理程序,否则连续点击也可能导致长按.中间事件处理程序禁用跟踪计时器,调用原始事件处理程序并将其替换回来.
• 长按后,主动控制被重置,因为我认为长按不是为了聚焦控制.但这只是我的猜测,它可能是一个房产的候选人.
• 还可以跟踪表单本身的长按(而不仅仅是其子节点).
• 有一个定制的FindControlAtPos例程,可以在任意窗口上执行深度搜索.替代方案是(1)TWinControl.ControlAtPos,但它只搜索一个深度,和(2)Controls.FindDragTarget,但尽管AllowDisabled参数,它无法找到禁用的控件.

unit LongPressEvent;

interface

uses
  Classes, Controls, Messages, Windows, Forms, ExtCtrls;

type
  TLongPressEvent = procedure(Control: TControl) of object;

  TLongPressTracker = class(TComponent)
  private
    FChild: TControl;
    FClickPos: TPoint;
    FForm: TCustomForm;
    FOldChildOnMouseUp: TMouseEvent;
    FOldFormWndProc: TFarProc;
    FOnLongPress: TLongPressEvent;
    FPrevActiveControl: TWinControl;
    FTimer: TTimer;
    procedure AttachForm;
    procedure DetachForm;
    function GetDuration: Cardinal;
    procedure LongPressed(Sender: TObject);
    procedure NewChildMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure NewFormWndProc(var Message: TMessage);
    procedure SetDuration(Value: Cardinal);
    procedure SetForm(Value: TCustomForm);
    procedure StartTracking;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation);
      override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Form: TCustomForm read FForm write SetForm;
  published
    property Duration: Cardinal read GetDuration write SetDuration
      default 1000;
    property OnLongPress: TLongPressEvent read FOnLongPress
      write FOnLongPress;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TLongPressTracker]);
end;

function FindControlAtPos(Window: TWinControl;
  const ScreenPos: TPoint): TControl;
var
  I: Integer;
  C: TControl;
begin
  for I := Window.ControlCount - 1 downto 0 do
  begin
    C := Window.Controls[I];
    if C.Visible and PtInRect(C.ClientRect, C.ScreenToClient(ScreenPos)) then
    begin
      if C is TWinControl then
        Result := FindControlAtPos(TWinControl(C), ScreenPos)
      else
        Result := C;
      Exit;
    end;
  end;
  Result := Window;
end;

{ TLongPressTracker }

type
  TControlAccess = class(TControl);

procedure TLongPressTracker.AttachForm;
begin
  if FForm <> nil then
  begin
    FForm.HandleNeeded;
    FOldFormWndProc := Pointer(GetWindowLong(FForm.Handle, GWL_WNDPROC));
    SetWindowLong(FForm.Handle, GWL_WNDPROC,
      Integer(MakeObjectInstance(NewFormWndProc)));
  end;
end;

constructor TLongPressTracker.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FTimer := TTimer.Create(Self);
  FTimer.Enabled := False;
  FTimer.Interval := 1000;
  FTimer.OnTimer := LongPressed;
  if AOwner is TCustomForm then
    SetForm(TCustomForm(AOwner));
end;

destructor TLongPressTracker.Destroy;
begin
  if FTimer.Enabled then
  begin
    FTimer.Enabled := False;
    TControlAccess(FChild).OnMouseUp := FOldChildOnMouseUp;
  end;
  DetachForm;
  inherited Destroy;
end;

procedure TLongPressTracker.DetachForm;
begin
  if FForm <> nil then
  begin
    if FForm.HandleAllocated then
      SetWindowLong(FForm.Handle, GWL_WNDPROC, Integer(FOldFormWndProc));
    FForm := nil;
  end;
end;

function TLongPressTracker.GetDuration: Cardinal;
begin
  Result := FTimer.Interval;
end;

procedure TLongPressTracker.LongPressed(Sender: TObject);
begin
  FTimer.Enabled := False;
  if (Abs(FClickPos.X - Mouse.CursorPos.X) < Mouse.DragThreshold) and
    (Abs(FClickPos.Y - Mouse.CursorPos.Y) < Mouse.DragThreshold) and
    (((FChild is TWinControl) and TWinControl(FChild).Focused) or
      (TControlAccess(FChild).MouseCapture or (not FChild.Enabled))) then
  begin
    FForm.ActiveControl := FPrevActiveControl;
    if Assigned(FOnLongPress) then
      FOnLongPress(FChild);
  end;
  TControlAccess(FChild).OnMouseUp := FOldChildOnMouseUp;
end;

procedure TLongPressTracker.NewChildMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FTimer.Enabled := False;
  if Assigned(FOldChildOnMouseUp) then
    FOldChildOnMouseUp(Sender, Button, Shift, X, Y);
  TControlAccess(FChild).OnMouseUp := FOldChildOnMouseUp;
end;

procedure TLongPressTracker.NewFormWndProc(var Message: TMessage);
begin
  case Message.Msg of
    WM_PARENTNOTIFY:
      if TWMParentNotify(Message).Event = WM_LBUTTONDOWN then
        StartTracking;
    WM_LBUTTONDOWN:
      StartTracking;
  end;
  with Message do
    Result := CallWindowProc(FOldFormWndProc, FForm.Handle, Msg, WParam,
      LParam);
end;

procedure TLongPressTracker.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FForm) and (Operation = opRemove) then
    DetachForm;
  if (AComponent = FChild) and (Operation = opRemove) then
  begin
    FTimer.Enabled := False;
    FChild := nil;
  end;
end;

procedure TLongPressTracker.SetDuration(Value: Cardinal);
begin
  FTimer.Interval := Value;
end;

procedure TLongPressTracker.SetForm(Value: TCustomForm);
begin
  if FForm <> Value then
  begin
    DetachForm;
    FForm := Value;
    FForm.FreeNotification(Self);
    AttachForm;
  end;
end;

procedure TLongPressTracker.StartTracking;
begin
  FClickPos := Mouse.CursorPos;
  FChild := FindControlAtPos(FForm, FClickPos);
  FChild.FreeNotification(Self);
  FPrevActiveControl := FForm.ActiveControl;
  FOldChildOnMouseUp := TControlAccess(FChild).OnMouseUp;
  TControlAccess(FChild).OnMouseUp := NewChildMouseUp;
  FTimer.Enabled := True;
end;

end.

要使此组件正常工作,请将其添加到包中,或使用此运行时代码:

  ...
  private
    procedure LongPress(Control: TControl);
  end;

...

procedure TForm1.FormCreate(Sender: TObject);
begin
  with TLongPressTracker.Create(Self) do
    OnLongPress := LongPress;
end;

procedure TForm1.LongPress(Control: TControl);
begin
  Caption := 'Long press occurred on: ' + Sender.ClassName;
end;