Touch Demo Part II

Last week I posted Touch Demo Part I. This is the continuation to that series.

In Part I I demonstrated how to add the Direct2D Canvas to a form. This step is another foundation step that will add frames to your application by adding a timer.

At the moment the form looks like this:

type
  TTouchForm = class(TForm)
  private
    FCanvas: TDirect2DCanvas;
  protected
    procedure Paint; override;
    procedure Resize; override;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property Canvas: TDirect2DCanvas read FCanvas
      write FCanvas;
  end;  

Add the following private fields to keep track of the frames:

    FFPS: Integer;
    FFrames: Integer;
    FStartTime: Cardinal;

and initialize them in the FormShow:

procedure TTouchForm.FormShow(Sender: TObject);
begin
  FFPS := 0;
  FFrames := 0;
  FStartTime := GetTickCount;
end;

Next update the Paint function:

procedure TTouchForm.Paint;
begin
  Canvas.BeginDraw;
  try
    // Clear Background
    Canvas.RenderTarget.Clear(D2D1ColorF(clBlack));

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

And then add a protected Update method that updates the frames:

procedure TTouchForm.Update;
begin
  Inc(FFrames);

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

Last, drop a TTimer on your form and set the interval to 10. Also set the form's Align to alClient and the BorderStyle to bsNone.

Next create the OnTimer event and simply call two functions, Update and Paint:

procedure TTouchForm.Timer1Timer(Sender: TObject);
begin
  Update;
  Paint;
end;

At this point your form should look like this:

type
  TTouchForm = class(TForm)
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    FCanvas: TDirect2DCanvas;
    FFPS: Integer;
    FFrames: Integer;
    FStartTime: Cardinal;
  protected
    procedure Update;
    procedure Paint; override;
    procedure Resize; override;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property Canvas: TDirect2DCanvas read FCanvas
      write FCanvas;
  end;