Question

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

我曾尝试过使用Gesture，在TabletOptions中选中了toPressAndHold并在InteractiveGestureOptions中选中了所有内容，但是长按会导致没有OnGesture调用。

我能想到的另一个实现是添加一个计时器，在MouseDown中启动它并在Timer Fired，StartDrag，MouseUp或MouseLeave中结束它。但是，由于我想将此行为添加到几个不同的按钮和面板组件中，我将不得不在每个类中覆盖过程的早午餐并为每个组件复制代码。

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

编辑：

致NGLN

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

您的代码与常用控件完美配合，但我的案例中有2个问题

长时间无法检测到表单上的原因我不是自己的父母）我将Find FChild代码移到了单独的位置从WMParentNotify和FormMouseDown调用的过程和调用解决这个问题。
我有一些自定义按钮，它有一些禁用的HTML 标签（标题，标题，页脚）覆盖标签原件表面，使用你的代码，FChild将是其中一个标签，但它不要得到MouseCapture。我添加以下行来克服它：

虽然不是TControlAccess（FChild）。启用了 FChild：= FChild.Parent;

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

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

Edit2：

致NGLN

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

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

TCustomForm vs TWinControl：由于我的大多数应用程序只有1个主窗体，所有其他可视单元都是我自己创建的框架（不是来自TFrame，而是TScrollingWinControl和ccpack支持），假设TCustomForm对我不起作用。所以我删除了属性表单（但保留了ActiveControl的FForm）并创建了一个已发布的属性Host：TWinControl作为父主机。这样，我也可以将检测限制在一些有限的面板上。分配主机时，我使用GetParentForm（FHost）检查并找到FForm。
禁用控制：正如我之前所说，我有一些禁用的TJvHTLabel覆盖我的按钮，你的组件在标签上工作。我可以通过标签找回按钮，但我认为如果它被新组件处理会更方便。所以我添加了一个SkipDisabled属性，如果设置为turn，则在其父行中循环以找到第一个启用的控件。
我添加了一个PreserveFocus属性，让组件用户选择是否保留最后一个activecontrol。
控制项目。我更改了TLongPressEvent，将ClickPos添加为第二个参数。所以，我现在可以使用ClickPos查找列表框中的哪个项目等等。
在我看来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;

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

1 个答案: