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.
