delphi - What is the best way to add long press event to button class?

Question

By Long Press, I mean pressing a button / panel and hold for a period (say 2 seconds) without releasing or dragging around. It is common in mobile phone and touch device.

I had tried using Gesture, checked toPressAndHold in TabletOptions and Checked all in InteractiveGestureOptions but long pressing cause no OnGesture Call.

Another implementation I can think of is adding a timer, start it in MouseDown and end it in either Timer Fired, StartDrag, MouseUp or MouseLeave. However, as I want to add this behavior to several different buttons and panel component, I would have to override a brunch of procedure in each class and copy the code around for each component.

Is there a better way of achieving that?

---

Edit :

To NGLN

Woo, great piece of work! Together with your answer to those scrolling effects, VCL can almost achieve mobile OS look and feel!

Your code work perfectly with common controls but I got 2 issues in my case

1. Long Clicking on the form cannot be detected (of cause as the form is not parent of itself) I shift the Find FChild Code to separate procedure and call from both WMParentNotify and FormMouseDown to solve it.

2. I got some custom button which has some disabled HTML labels (Header, Caption, Footer) covering up the label original surface, Using your code, FChild will be one of those label but it do not get MouseCapture. I add the below line to overcome it :

   while not TControlAccess(FChild).Enabled do FChild := FChild.Parent;

Finally, for some more complicated controls like TCategoryButtons or TListBox, the user of the event might need to check not against the whole control but a specify item in the control. So I think we need to save the original CursorPos and fire another event when the timer triggered to let manual determination of whether it meet the long press condition or not. If yes or event not assigned, then use your default code for determination.

All in all, we can just create a LongPress supported form / panel to host all other controls. This is much more easier then implementing the LongPress feature Component by Component! Great Thanks!

---

Edit2 :

To NGLN

Thanks again for your component version, which is excellent approach, not needing to do any modification to existing components and can detect long press everywhere!

For your information, I had do several modification to suit my own need.

1. TCustomForm vs TWinControl : As most of my application has only 1 main form and all other visual units are my own created frame (not from TFrame but TScrollingWinControl with ccpack support), assuming TCustomForm do not work for me. So I had deleted property form (but retain FForm for ActiveControl) and create a published property Host : TWinControl to act as the parent host. In that way, I can also limit the detection to some limited panel. When Assigning Host, I check and find the FForm using GetParentForm(FHost).
2. Disabled Controls : As I said previously, I got some disabled TJvHTLabel covering my buttons and your component work on the labels. I can of cause find back the button by the label, but I think it would be more convenient if it had been handled by the new component. So I add a property SkipDisabled and if set to turn, loop in its parent line to find first enabled control.
3. I add a PreserveFocus property to let component user choose to keep last activecontrol or not.
4. Controls with items. I changed your TLongPressEvent, adding the ClickPos as the 2nd parameter. So, I can now use the ClickPos to find which item in a list box or the like had been long held.
5. It seems to me that FindVCLWindow is having same effect with your FindControlAtPos?

Thank you again for your great work.

Answer 1

At every left mouse button click, WM_PARENTNOTIFY is send to all (grand) parents of the clicked control. So this can be used for tracking the starting point of a long press, and the duration of a press can be timed with a timer. What is left is to decide when a press should be called a long press. And to wrap this all up in a nice component of course.

In the component written below, the OnLongPress event handler is fired when the following conditions are met:

• after the interval, the control still has mouse capture, or still has focus, or is disabled,
• after the interval, the mouse has not moved more then Mouse.DragThreshold.

Some explanation on the code:

• It temporarily replaces the control's OnMouseUp event handler, otherwise consecutive clicks might also result in a long press. The intermediate event handler disables the tracking timer, calls the original event handler and replaces it back.
• After the long press, the active control is reset, because I thought a long press is not done with the intention to focus the control. But that's just my guess, and it might be candidate for a property.
• Also tracks for long presses on the form itself (rather then only its childs).
• Has a customized FindControlAtPos routine which performs a deep search on an arbitrary window. Alternatives were (1) TWinControl.ControlAtPos, but it searches just one level deep, and (2) Controls.FindDragTarget, but despite the AllowDisabled parameter, it is not able of finding disabled controls.

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.

To get this component working, add it to a package, or use this runtime code:

  ...
  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;