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