Wednesday, October 7, 2009

Touch Demo Part III

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

This time around we will add the glowing spots and the basic handling of the WM_TOUCH message. Add Generics.Collections to your uses and copy the following code to your unit:


type
TGlowSpot = class
public
X, Y, Radius: Integer;
Alpha: Extended;
FadeIn: Boolean;
Color: TColor;

public
constructor Create(AParent: TWinControl);

procedure Paint(Canvas: TDirect2DCanvas);
end;

TGlowSpotList = class(TList<TGlowSpot>);
...
implementation

{$R *.dfm}

procedure PaintGlow(Canvas: TDirect2DCanvas; Alpha: Single;
X, Y, Radius: Integer; Color: TColor);
var
Stops: array[0 .. 1] of TD2D1GradientStop;
Gradient: ID2D1GradientStopCollection;
BrushProperties: TD2D1RadialGradientBrushProperties;
RadialBrush: ID2D1RadialGradientBrush;
Brush: TDirect2DBrush;
begin
Stops[0].position := 0;
Stops[0].Color := D2D1ColorF(Color, Alpha);
Stops[1].position := 1;
Stops[1].Color := D2D1ColorF(Color, 0);
Canvas.RenderTarget.CreateGradientStopCollection
(@Stops[0], Length(Stops), D2D1_GAMMA_2_2, D2D1_EXTEND_MODE_CLAMP,
Gradient);
BrushProperties.center := D2D1PointF(X, Y);
BrushProperties.gradientOriginOffset.X := 0;
BrushProperties.gradientOriginOffset.Y := 0;
BrushProperties.radiusX := Radius;
BrushProperties.radiusY := Radius;
Canvas.RenderTarget.CreateRadialGradientBrush
(BrushProperties, nil, Gradient, RadialBrush);
Brush := TDirect2DBrush.Create(Canvas);
Brush.Handle := RadialBrush;
Canvas.Pen.Color := clNone;
Canvas.Brush := Brush;
Canvas.Ellipse(X - Radius, Y - Radius,
X + Radius, Y + Radius);
end;

{ TGlowButton }

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

procedure TGlowSpot.Paint(Canvas: TDirect2DCanvas);
begin
PaintGlow(Canvas, Alpha, X, Y, Radius, Color);
end;

Add a local to hold a lists of TGlowSpots to your form then create it and free it:

TTouchForm = class(TForm)
...
private
FSpots: TGlowSpotList;
...
constructor TTouchForm.Create(AOwner: TComponent);
begin
inherited;
FCanvas := TDirect2DCanvas.Create(Handle);
FSpots := TGlowSpotList.Create;
end;

destructor TTouchForm.Destroy;
begin
FCanvas.Free;
FSpots.Free;
inherited;
end;

Update the Paint routine to paint the spots:

procedure TTouchForm.Paint;
var
Spot: TGlowSpot;
begin
Canvas.BeginDraw;

try
// Clear Background
Canvas.RenderTarget.Clear(D2D1ColorF(clBlack));

for Spot in FSpots do
Spot.Paint(Canvas);

// FPS
Canvas.Font.Color := clWhite;
Canvas.Brush.Color := clNone;
Canvas.Font.Size := 14;
Canvas.TextOut(10, 10, FloatToStrF(FFPS, ffFixed, 2, 2) + ' FPS');
finally
Canvas.EndDraw;
end;
end;

Modify the Update method to fade the spots:

procedure TTouchForm.Update;
var
Spot: TGlowSpot;
begin
Inc(FFrames);

if GetTickCount - FStartTime >= 1000 then
begin
FFPS := FFrames;
FFrames := 0;
FStartTime := GetTickCount;
end;

for Spot in FSpots do
begin
if Spot.FadeIn then
Spot.Alpha := Spot.Alpha + 0.012
else
Spot.Alpha := Spot.Alpha - 0.012;

if Spot.Alpha < 0.3 then
begin
Spot.FadeIn := True;
Spot.Alpha := 0.4
end
else if Spot.Alpha > 1 then
Spot.FadeIn := False;
end;
end;

And last handle the WM_TOUCH message:

TTouchForm = class(TForm)
...
procedure WMTouch(var Message: TMessage); message WM_TOUCH;
...
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;
Spot: TGlowSpot;
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);
Spot := TGlowSpot.Create(Self);
Spot.X := Point.X;
Spot.Y := Point.Y;
FSpots.Add(Spot);
end;

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

If you ran your app at this point you wouldn't get any touch messages. You need to call RegisterTouchWindow and UnregisterTouchWindow. I find it easiest to call UnregisterTouchWindow in the FormClose:

procedure TTouchForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
UnregisterTouchWindow(Handle);
end;

and to call RegisterTouchWindow in the CreateWnd:

procedure TTouchForm.CreateWnd;
begin
inherited;
RegisterTouchWindow(Handle, 0);
end;

Now when you run your app and press the screen you'll get glowing spots wherever you touch the screen. Depending on your hardware 1, 2 or more at a time.

UPDATE: There is a memory leak in this program because I didn't want to delete any code for the next step.

UPDATE: Fixed HTML to make TGlowSpotList = class(TList) actually read TGlowSpotList(TList<TGlowSpot>);

17 comments:

Anonymous said...

You'll need to do a quick tweak there. HTML has turned

TGlowSpotList = class(TList<TGlowSpot>);

Into

TGlowSpotList = class(TList);

Which is obviously undesirable.

Anonymous said...

Oh, and for those who still want to play, but do not have a touch interface, add a Form OnMouseDown handler:

procedure TTouchForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);

Var
Spot : TGlowSpot;
begin
Spot := TGlowSpot.Create(Self);
Spot.X := X;
Spot.Y := Y;
FSpots.Add(Spot);
end;

Chris Bensen said...

Anonymouse #1,

Thanks. Fixed.

Chris Bensen said...

Anonymouse #2,

I was going to talk about using the mouse in a later post but you bring up a good point which is good to bring it up multiple times to really drive it home.

If your application is going to run on a touch machine and non touch machines it is a good idea to add the condition:

if ssTouch in Shift then Exit

at the beginning of the OnMouseDown event handler. The WM_TOUCH message also sends the corresponding WM_LBUTTONDOWN, WM_MOUSEMOVE and WM_LBUTTONUP messages. Without the condition, unless there are other things going on you'd end up with two spots created at the same point.

Xepol said...

@Chris -> Thanks. I was both anonymous posts (I normally can not be bothered to go through the validation process).

It is interesting to see all this, but I can't help but feel that the real content here is the Direct2DCanvas work - definitely don't leave non multitouch users out of the loop. Chances are, you are the only one reading this blog that has a multitouch display.

(I have strong feelings about why multitouch is going to become the next sideshow. MS has some new mice in the research department that might resurrect it in some form, but that remains to be seen)

Giel said...

"Chances are, you are the only one reading this blog that has a multitouch display"

No, he's not! ;-)

Xepol said...

Giel -> What sort of system are you using? I ask because as much as I believe the whole multi-touch idea is doomed to fail in its current form, it is neat technology and I am hoping it will survive at least partially in the new microsoft research mice (and I hear syntaptics has a multitouch pad that might one day play a role)

What I am really hoping for is a descent display I can just add to my current system instead of having to replace everything.

Giel said...

I have a HP Touchsmart TX2 (that's a notebook).

"a descent display I can just add to my current system". Yeah that would be nice, I guess they will be available shortly. That said, I think a touch monitor behind the keyboard on a desk isn't what touch is all about. The fun really starts when there's no keyboard or mouse in sight ;-)

Xepol said...

Giel -> Thanks, and yes, you just underscored my problem with multi-touch - the new machine usually with a 12" screen.

As for no keyboard or mouse in sight. I believe they call that the failed tablet PC concept.

And people wonder why I think this will end up like Sideshow.

spemiraj said...

Hi,
I just downloaded delphi 2010 trial and can't find any demos on/about multi-touch and gestures.

Do you have any sources available for download ?

Chris Bensen said...

Spemiraj,

No demos made it into the release. The blogs at the moment are your best resource.

spemiraj said...

OK,
I am trying to do some test app based on my intuition and your blogs, but I get access violation when drawing on direct 2D canvas. Must be something in my code, but I tryed to make it the same as yours.

Can't you make your examples downloadable on this blog?

Chris Bensen said...

Spermiraj,

I haven't had time to find a good host for the downloads. Any ideas?

spemiraj said...

Maybe you could use Google Code (Project Hosting): http://code.google.com/projecthosting/
... once loged in you go to http://code.google.com/hosting/createProject

Alex Fekken said...

Thanks Chris.

The link to part II is broken (it says 'park' instead of 'part').

Anonymous said...

After a while all GlowSpots are painted in white.
And it doesn't depend on the count of the spots.

Do you know any reason for this behaviour?

Chris Bensen said...

Anonymous, if you go to part IV and scroll all the way down to the bottom you'll see that I left this as an exercise for the reader :)

Post a Comment