Touch Demo Part IV

Previously I posted Part I, Part II and Part III of the Touch Demo.

This is the final step of the touch demo where I will be adding the inertia processing and mouse support. Mouse support is easy but requires a minor refactoring of the touch message handler so the mouse can piggy back on it. For CodeRage I did add a touch keyboard but I will leave that as an exercise for the user.

And now you can download source code from CodeCentral for all four demos. Update: The download wasn't working but it has now been fixed.

Inertia processing requires the Manipulations unit. Then the object that is to be manipulated, in this case TGlowSpot, should implement the _IManipulationsEvents interface which is a COM event sync. Here is how that class changed:

  TGlowSpot = class(TInterfacedObject, _IManipulationEvents)
  private
    FInertia: IInertiaProcessor;
    FManipulator: IManipulationProcessor;
    FInertiaCookie, FManipulatorCookie: LongInt;
    FCompleted: BOOL;
  public
    X, Y, Radius: Integer;
    Alpha: Extended;
    FadeIn: Boolean;
    Color: TColor;
    ID: Integer;

  protected
    procedure DoTouch(const APoint: TPoint; AID: Integer; ATouchMessage: TTouchMessage);

    { _IManipulationEvents }
    function ManipulationStarted(X: Single; Y: Single): HRESULT; stdcall;
    function ManipulationDelta(X: Single; Y: Single; translationDeltaX: Single;
      translationDeltaY: Single; scaleDelta: Single; expansionDelta: Single;
      rotationDelta: Single; cumulativeTranslationX: Single;
      cumulativeTranslationY: Single; cumulativeScale: Single;
      cumulativeExpansion: Single; cumulativeRotation: Single): HRESULT;
      stdcall;
    function ManipulationCompleted(X: Single; Y: Single;
      cumulativeTranslationX: Single; cumulativeTranslationY: Single;
      cumulativeScale: Single; cumulativeExpansion: Single;
      cumulativeRotation: Single): HRESULT; stdcall;
  public
    constructor Create(AParent: TWinControl);

    procedure Paint(Canvas: TDirect2DCanvas);
    procedure Disconnect;
    procedure ProcessInertia;
  end;
...

Each TGlowSpot needs to hold on to an instance of the inertia processor and the manipulation processor and then connect up to them with the event sync. That is done in the constructor:

constructor TGlowSpot.Create(AParent: TWinControl);
begin
  inherited Create;
  Alpha := 1;
  Radius := 80;
  FadeIn := False;
  Randomize;
  Color := RGB(Random(255), Random(256), Random(256));
  ID := -1;
  FCompleted := True;
  ID := -1;
  FCompleted := True;

  FInertia := CreateComObject(CLSID_IInertiaProcessor) as IInertiaProcessor;
  FManipulator := CreateComObject(CLSID_IManipulationProcessor) as IManipulationProcessor;
  InterfaceConnect(FInertia, _IManipulationEvents, Self, FInertiaCookie);
  InterfaceConnect(FManipulator, _IManipulationEvents, Self, FManipulatorCookie);

  FInertia.put_DesiredDeceleration(0.001);

  FInertia.put_BoundaryLeft(200);
  FInertia.put_BoundaryTop(200);
  FInertia.put_BoundaryRight(AParent.Width - 200);
  FInertia.put_BoundaryBottom(AParent.Height - 200);

  FInertia.put_ElasticMarginLeft(200);
  FInertia.put_ElasticMarginTop(200);
  FInertia.put_ElasticMarginRight(200);
  FInertia.put_ElasticMarginBottom(200);
end;

And then of the disconnect is done like this:

procedure TGlowSpot.Disconnect;
begin
  InterfaceDisconnect(FInertia, _IManipulationEvents, FInertiaCookie);
  InterfaceDisconnect(FManipulator, _IManipulationEvents, FManipulatorCookie);
end;

The inertia processing is handled with each WM_TOUCH message that is fired. It's pretty simple really, if there is a move, call the manipulation COM object's ProcessMove, and do the same with down. Up is a bit different because of the inertia but all you need to do is set the velocity and the location.

procedure TGlowSpot.DoTouch(const APoint: TPoint; AID: Integer;
  ATouchMessage: TTouchMessage);
var
  Vx, Vy: Single;
begin
  case ATouchMessage of
    tmMove:
    begin
      X := APoint.X;
      Y := APoint.Y;
      FManipulator.ProcessMove(AID, APoint.X, APoint.Y);
    end;

    tmDown:
    begin
      X := APoint.X;
      Y := APoint.Y;
      FManipulator.ProcessDown(AID, APoint.X, APoint.Y);
    end;

    tmUp:
    begin
      ID := -1;

      FManipulator.ProcessUp(AID, APoint.X, APoint.Y);

      FManipulator.GetVelocityX(Vx);
      FManipulator.GetVelocityY(Vy);

      FInertia.put_InitialVelocityX(Vx);
      FInertia.put_InitialVelocityY(Vy);

      FInertia.put_InitialOriginX(X);
      FInertia.put_InitialOriginY(Y);

      FCompleted := False;
    end;
  end;
end;

function TGlowSpot.ManipulationCompleted(X, Y, cumulativeTranslationX,
  cumulativeTranslationY, cumulativeScale, cumulativeExpansion,
  cumulativeRotation: Single): HRESULT;
begin
  Result := S_OK;
end;

function TGlowSpot.ManipulationDelta(X, Y, translationDeltaX, translationDeltaY,
  scaleDelta, expansionDelta, rotationDelta, cumulativeTranslationX,
  cumulativeTranslationY, cumulativeScale, cumulativeExpansion,
  cumulativeRotation: Single): HRESULT;
begin
  Inc(Self.X, Round(translationDeltaX));
  Inc(Self.Y, Round(translationDeltaY));
  Result := S_OK;
end;

function TGlowSpot.ManipulationStarted(X, Y: Single): HRESULT;
begin
  Result := S_OK;
end;

procedure TGlowSpot.ProcessInertia;
begin
  if not FCompleted then
    FInertia.Process(FCompleted);
end;

The last bit of code I want to talk about is the mouse handling. I refactored the handling of the WM_TOUCH message into WMTouch and ProcessTouchMessages. ProcessTouchMessages is the common function that the mouse message can call to get the same inertia behavior.

procedure TTouchForm.WMTouch(var Message: TMessage);

  function TouchPointToPoint(const TouchPoint: TTouchInput): TPoint;
  begin
    Result := Point(TouchPoint.X div 100, TouchPoint.Y div 100);
    PhysicalToLogicalPoint(Handle, Result);
  end;

var
  TouchInputs: array of TTouchInput;
  TouchInput: TTouchInput;
  Handled: Boolean;
  Point: TPoint;
  TouchMessage: TTouchMessage;
begin
  Handled := False;
  SetLength(TouchInputs, Message.WParam);
  GetTouchInputInfo(Message.LParam, Message.WParam, @TouchInputs[0],
    SizeOf(TTouchInput));
  try
    for TouchInput in TouchInputs do
    begin
      Point := TouchPointToPoint(TouchInput);

      if (TouchInput.dwFlags and TOUCHEVENTF_MOVE) <> 0 then
        TouchMessage := tmMove
      else if (TouchInput.dwFlags and TOUCHEVENTF_UP) <> 0 then
        TouchMessage := tmUp
      else if (TouchInput.dwFlags and TOUCHEVENTF_DOWN) <> 0 then
        TouchMessage := tmDown;

      ProcessTouchMessages(Point, TouchInput.dwID, TouchMessage);
    end;

    Handled := True;
  finally
    if Handled then
      CloseTouchInputHandle(Message.LParam)
    else
      inherited;
  end;
end;

function TTouchForm.ProcessTouchMessages(const APoint: TPoint; ID: Integer;
  TouchMessage: TTouchMessage): TGlowSpot;
var
  Spot: TGlowSpot;
begin
  Result := nil;
  Spot := FindSpot(ID);

  if Spot = nil then
  begin
    Spot := FindSpot(APoint);

    if Spot <> nil then
      Spot.ID := ID;
  end;

  if Spot = nil then
  begin
    Spot := TGlowSpot.Create(Self);
    Spot.ID := ID;
    FSpots.Add(Spot);
  end;

  Spot.DoTouch(APoint, ID, TouchMessage);
  Result := Spot;
end;

And last the mouse handling functions with the check for ssTouch in the Shift parameter. If that check wasn't there each message would happen effectively twice because the touch messages also send mouse messages for backwards compatibility with applications that don't support touch.

procedure TTouchForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if ssTouch in Shift then Exit;
  FMouseDown := True;
  ProcessTouchMessages(Point(X, Y), 0, tmDown);
end;

procedure TTouchForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if ssTouch in Shift then Exit;
  if FMouseDown then
    ProcessTouchMessages(Point(X, Y), 0, tmMove);
end;

procedure TTouchForm.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Spot: TGlowSpot;
begin
  if ssTouch in Shift then Exit;
  Spot := ProcessTouchMessages(Point(X, Y), 0, tmUp);
  Spot.ID := -1;
  FMouseDown := False;
end;

I just realized that there is a bug in the program. It will run just fine but crash pretty bad if it runs too long. I guess I never demoed it very long before. So I'll leave debugging this crash as an exercise for the user.