Debugging Direct2D

When debugging Direct2D the debugger can be really slow, and I've recently discovered the culprit of the poor performance; the Intel graphics driver. The same performance problems happen in Visual Studio so it isn't a C++Builder or Delphi bug. If you are debugging Direct2D just run without debugging or get a system with an NVIDIA or ATI graphics card.

Touch Demo

My Touch Move demo is now complete. Here is a quick list of the four parts:

Part I
Part II
Part III
Part IV

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

After the Thanksgiving Holiday I'll start something new. I was thinking of how to hack the touch keyboard, but if anyone has suggestions regarding things you'd like to know about touch drop me a line either via comments or the contact me link on the right side of this blog and I'll try and make a post out of it.

Unicycling in Africa

My good friend Corbin got married this summer to the lovely Louise (yours truly photographed their wedding) and then they went for their honeymoon in Africa on unicycles! Here's an awesome video that Corbin made:



Here is another video from their tour. My daughter loves this one!

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.

Dell Latitude XT2 XFR Rugged Tablet

Dell just introduced the Latitude XT2 XFR; the rugged version of the XT2 multitouch tablet machine I've mentioned a few times before only with a name that is more of a mouth full. So for those of you waiting for a rugged machine before jumping into multitouch wait no longer. The short spec list is 12 inch multitouch display, 5lbs and 1.5 inches thick and mil spec badassness! It also comes with Vista. I guess Windows 7 isn't rugged certified? Just as well, first thing I do when I get a new machine is format it anyway. For all the awesomeness it'll set you back some serious coin. The base model is $3,600 but I loaded one up for just under $5k! I don't think I can justify one of these to Nick, but damn!

Dell SX2210T - Multitouch Monitors

The first standalone multi-touch monitor is the SX2210T. Looks pretty awesome for those that want to add a multi-touch monitor tho an existing computer.

Updated: Link goes to the product page (which is up now) rather than the shopping cart.

Delphi Tips and Tricks - Additional Files

One of the most useful features in the Delphi IDE is CTRL + F12, or the "Search for units" dialog. One of the problems we encounter is we often want to look at files that are not in any of the opened projects. So a hidden registry key was created to add a list of files to the "Search for units" dialog. You can specify the text file by creating a string value under HKEY_CURRENT_USER\Software\CodeGear\BDS\\Globals named "AdditionalViewFiles". Set the string to the file you want the IDE to load. Note that IDE environment variables can be used here. For Example I have $(TP) set to "c:\source" and the AdditionalViewFiles string value is set to $(TP)\AdditionalViewFiles.txt.

The text file format is name value pairs like any other INI file where the name is the short name you want to see and the value is the full path to the file (and this will expand IDE environment variables as well). For example:

Foo.pas=$(TP)\somedirectory\Foo.pas

Sony Touchscreen Computer/TV

From the specs I think this Sony Vaio L beats pants off the HP Touchsmart. It's got glass, HDMI input, 1080p (I'm not sure if this is the computer resolution as well) Blue-ray, NVIDIA graphics and the monitor can be used as a TV without turning on the computer. I'm not sure what the other computer specs are, but the mouse does look horrible. It also appears that the DVD drive isn't a slot loading drive so that's a bit odd. Check out Sony website for more information.

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

How to Write Applications Useful for Color Blind Users

We Are Color Blind is an online repository of information for anyone involved with creating content for the web and making it accessible to the color blind. This is a great resource that I feel is useful for anyone creating content or building applications, not just for the web.

The Quick Tips is probably a good place to start.

UPDATE: Fixed links.

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;  

HP Touchsmart

If you buy a Touchsmart be sure to spend the extra duckets to get the NVIDIA graphics card. It comes with an NVIDIA GeForce 9300M which is a pretty smokin' card and you'll be much happier.