Direct2D canvas for Delphi forms

In this blog post, I will show you how easy it is the have a Direct2D canvas for your Delphi form.

What is a canvas? 

In Delphi VCL technology, a canvas is an abstraction encapsulating Windows API to render content on screen. In VCL, the standard canvas is implemented using GDI. It allows the developer to draw anything on screen. The class that encapsulate a canvas is names TCanvas. Every form has a TCanvas instance. You use it from the form’s OnPaint event handler. Similarly, all VCL component which are able to render something on screen has a TCanvas instance and a Paint method you can override to draw your own content.

TCanvas has method and properties to render many graphic primitives such as lines, rectangles, ellipses, polygons, bitmaps and text. There are properties such as Brush and Pen to select how you want something to be rendered. For example, a Pen is used to select the color, width and style of the rectangle outline while a Brush is use to select the color used to paint the rectangle’s interior.

Why would you like a Direct2D canvas?

Direct2D is a Microsoft DirectX technology especially designed for high performance 2D drawing. This is an API that provides Win32 / Win64 developers with the ability to perform 2D graphics rendering tasks with superior performance and visual quality.

Delphi is exactly a development platform for Win32 / Win64 application and has everything required to use almost any Windows API.

Delphi VCL has a TCanvas based on Direct2D API. It is not created by default but you can easily create it if you need it. But why would you need it?

I see two reasons:
    1. Speed
    2. More rendering features

The aim of this blog post is not to explain all the details of Direct2D. No, it is to show you how easy it is to start using it. Actually, my previous blog post already made use od it to display images. Now, I will show you how to benefit from powerful new Direct2D API: apply transformations to your drawings.

Direct2D transformation are geometric computation inserted between you call of a drawing primitive (For example a rectangle) and the actual rendering (The rectangle appears on screen).

 

The demo

The demo will show a simple transformation: a rotation. The demo has a for-loop which draw the same rectangle 24 times after applying a rotation transformation with an incrementing angle. The result visible on screen is 24 rectangles rotated 15°, drawing a nice picture.

How does it works?

Instead of showing the full code as is, I will explain the steps required to build the application from scratch. You’ll then be able to apply the steps to your own application.

1. Create a VCL form application

2. Add the units Vcl.Direct2D and Winapi.D2D1 to the uses clause.

3. Add the following code to the form’s declaration:

    private
        FD2DCanvas : TDirect2DCanvas;
        function CreateD2DCanvas: Boolean;
    protected
        procedure CreateWnd; override;
 

 4. Implement CreateD2DCanvas method:

    function TMainForm.CreateD2DCanvas: Boolean;
    begin
        try
            FD2DCanvas.Free;
            FD2DCanvas    := TDirect2DCanvas.Create(Handle);
            Result        := TRUE;
        except
            Result        := FALSE;
        end;
    end;

5. Implement CreateWnd method:

    procedure TMainForm.CreateWnd;
    begin
        inherited;
        CreateD2DCanvas;
    end;

6. Add an OnResize event handler to your form:

    procedure TMainForm.FormResize(Sender: TObject);
    var
        Size: D2D1_SIZE_U;
    begin
        // When the windows is resized, we needs to resize RenderTarget as well
        Size := D2D1SizeU(ClientWidth, ClientHeight);
        ID2D1HwndRenderTarget(FD2DCanvas.RenderTarget).Resize(Size);
        Invalidate;
    end;

7. Add a OnPaint event handler to your form:

    procedure TMainForm.FormPaint(Sender: TObject);
    var
        Rect1 : D2D1_RECT_F;
       Angle : Single;
       I     : Integer;
    const
        RECT_SIZE  = 50;
        ANGLE_STEP = 15.0;
    begin
        FD2DCanvas.BeginDraw;
        try
            // Erase background
            FD2DCanvas.RenderTarget.Clear(D2D1ColorF(clDkGray));

            // Set pen color to draw rectangle outline
            FD2DCanvas.Pen.Color   := clYellow;

            // Clear all transformations

            FD2DCanvas.RenderTarget.SetTransform(TD2DMatrix3x2F.Identity);

            // Define rectangle to be drawn. Top left corner in center of window
            Rect1                  := Rect((ClientWidth  div 2),
                                           (ClientHeight div 2),
                                           (ClientWidth  div 2) + RECT_SIZE,
                                           (ClientHeight div 2) + RECT_SIZE);
            // Loop drawing the same rectangle but rotated step by step
            for I := 0 to Round(360.0 / ANGLE_STEP) do begin
                Angle := ANGLE_STEP * I;
                FD2DCanvas.RenderTarget.SetTransform(
                             TD2DMatrix3x2F.Rotation(Angle,
                                                     Rect1.Left,
                                                     Rect1.Top));
                FD2DCanvas.DrawRectangle(Rect1);
            end;
        finally
            FD2DCanvas.EndDraw;
        end;
    end;

8. Compile and run your application.

TDirect2DCanvas has almost the same methods and properties as the standard TCanvas. Porting code from standard TCanvas  to TDirect2DCanvas is very easy.

But TDirect2DCanvas is far from implementing all the features of Direct2D API. Fortunately, all the new features – such as transformations – are accessible very easily thru the property RenderTarget.
RenderTarget is an interface implemented in Direct2D DLL. When you call a method of RenderTarget, your are actually calling a Microsoft DLL!

In the demo code you see above, there are two calls to SetTransform. This is how we specify Direct2D to apply one or more transformation. Here we apply a simple rotation.

Transformations are described mathematically by a matrix of 3x2 floating point number. I will not enter the math details here. To help us, Microsoft has prebuilt several matrices for common transformations. Rotation is among them. In the call

     TD2DMatrix3x2F.Rotation(Angle, Rect1.Left, Rect1.Top);

We simply invoke a prebuilt matrix to rotate all subsequent drawings by the specified angle. The rotation take place around the point specified by the second and third arguments.

To cancel any transformation, just set a new transformation. If you want to transformation at all, you can use the matrix names “Identity” which is a kind of do-nothing. The code is:

    FD2DCanvas.RenderTarget.SetTransform(TD2DMatrix3x2F.Identity);

I invite your to see the online help for TDirect2DCanvas at http://docwiki.embarcadero.com/Libraries/Sydney/en/Vcl.Direct2D.TDirect2DCanvas

--
François Piette

ICS updated for Delphi XE6

ICS has been updated for Delphi XE6. No new feature, just a simple update for the latest Delphi version. VCL and FMX supported for desktop platforms. Mobile still under way.

Download as usual. See http://wiki.overbyte.be


Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be

HowTo: Create a DCR file for your Delphi component

When you create a component for Delphi, you need a bitmap to represent your component in the component palette. This bitmap must be saved as a DCR file and linked into the component package. DCR stands for Delphi Component Resource. It is a binary resource file (RES) renamed to DCR.

In the old days, Delphi was delivered with a simple image editor which let you draw your bitmap and create the DCR file. The last version which included that tool was Delphi 7 if memory serves me well.

Now, you have to use a "paint" program to build your bitmap. Any will do provided it is able to produce Windows bitmap file (BMP) with a 24x24 pixels image having 16 or 256 colors. Windows "Paint" is enough for that.

Then you must transform that bitmap into a DCR file which is easy using any "resource compiler" program. Delphi is delivered with one named BRCC32. A resource compiler produce a RES file.

A resource compiler takes a resource script as a source file (RC). This is a text file containing commands to describe the resource you want to build. There are many kind of resources that can be included in a resource file. Here we are only interested in a bitmap resource.

Assuming be are building a component whose class name is TDemoComponent and that the source code is in DemoComponent.pas, we need to create a DemoComponent.dcr resource file containing a bitmap resource named TDemoComponent. We thus need to create DemoComponent.bmp bitmap and DemoComponent.rc resource script.

TDemoComponent BITMAP "DemoComponent.bmp"

Then we run BRCC32 with the following command line:

brcc32 -fo"DemoComponent.dcr" "DemoComponent.rc"

The resulting file has to be included in the package source file (DPK) containing the component. This is done by adding a single line into the dpk:

{$R 'SimpleComponent.dcr'}

Usually you add this line right after the existing line

{$R *.res}

Summary of required files:

Filename	Description	How
DemoComponent.pas	Component source code	You create this with Delphi
DemoComponent.bmp	Component bitmap	You create this with Windows Paint
DemoComponent.rc	Resource script	You create this with NotePad
DemoComponent.dcr	Binary resource file	You use BRCC32 to create it

This works for VCL and FireMonkey components. Visual and non visual components.

It is likely that you want to automate the process. Easy! Just add the BRCC32 command shown above in your package project option. Add it to the "Build Events" for target "All configurations", "Pre-build events". That's it. Doing this way, your DCR file will be recreated at each build. This takes time but BRCC32 is blazing fast at compiling a so simple RC file. Whenever you change the bitmap, just recompile/install the package and the updated bitmap will be shown.


Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be
This article is available from http://francois-piette.blogspot.be

Update 2 for RAD Studio XE5, Delphi XE5 and C++Builder XE5

If you have not noticed yet, Embarcadero published the second update for their latest tools: Delphi XE5 as well as RAD Studio XE5 and C++ Builder XE5.

More than one hundred bugs have been fixed. Thanks for the users having taken the time to write a bug report to Quality Central, the web tool used to keep track of bugs and feature requests.

Most fixed bugs are related to the mobile platforms and FireMonkey component set. Obviously the Windows,  RTL and VCL parts of the product are very stable.

The update is available freely for registered users of the product.
Download from http://cc.embarcadero.com/item/29662

There is also an article with a partial list of fixes: http://dn.embarcadero.com/article/43522

Update 16/12/2013: Hot fixes are available: HF1 and HF2


Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be
This article is available from http://francois-piette.blogspot.be

What is ProcessMessages?

Sometimes, when you browse some application source code, you find loops calling Processmessages. What’s this? Well, it is a “Message pump” which retrieves and process messages from Windows message queues. More exactly from the current thread message queues.

Quick note: At the end of this article, you'll find why you should NOT use ProcessMessages. Before that, let's understand the concept.

The code you see is frequently like this:

FSomeFlag := TRUE;
while FSomeFlag do begin
    Application.ProcessMessages;
    Sleep(100);
end;

When looking at that code, you may think it will loop forever. Actually it will not! The loop variable “FSomeFlag” is for sure set to false in an event handler.

Application.ProcessMessages is implemented in Delphi runtime (Forms unit) as a loop checking Windows message queue for the current thread. The loop removes any message from the queue and dispatch processing, until the queue is emptied.

In the message queue, you have messages from the user interface (for example mouse move, button click, menu actions and much more) and from many activities occurring in the system such as inserting a removable disk, user wanting shutting down the computer, data received from a serial port, data packet received on the network, battery running out of charge and much more.

ProcessMessages will fetch all those events and process them. Translated to more common Delphi speaking, your event handlers will be called from ProcessMessages.

Try this:
Create a new VCL forms application, drop two buttons on the form and a memo. Declare a private Boolean member variable named “FSomeFlag”. Then write and run this code:

procedure TForm1.Button1Click(Sender: TObject);
begin
    FSomeFlag := TRUE;
    Memo1.Lines.Add('First message: Start looping, click on Button2');
    while FSomeFlag do begin
        Application.ProcessMessages;
        Sleep(100);
    end;
    Memo1.Lines.Add('Second message: Loop done');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
    Memo1.Lines.Add('You clicked on Button2');
    FSomeFlag := FALSE;
end;

When running, click on Button1. This will execute Button1Click event handler which contains the loop. It will display the first message and then loop until FSomeFlag becomes FALSE.
After clicking on button1, then click on button2. This will execute Button2Click event handler which sets FSomeFlag to FALSE which in turn will break the loop still running in Button1Click event handler. You’ll see the message display by Button2Click event handler, followed by the second message in Button1Click event handler and you know the loop has ended.

This code has some surprising results. For example, click twice on Button1 before clicking on Button2. You will see the first message shown for each click on Button1. Then the message from Button2 when you click on it. And finally twice the second message from Button1Click event handler. What you see is the Button1Click event handler reentered. This is a king of recursive call. ProcessMessages will trigger all events, including new event of the same kind already executing.

Having you event handler reentered may have adverse effect on your code. You should probably avoid it by rewriting Button1Click like this:

procedure TForm1.Button1Click(Sender: TObject);
begin
    if FSomeFlag then begin
        Memo1.Lines.Add('You already clicked Button1');
        Exit;
    end;

    FSomeFlag := TRUE;
    Memo1.Lines.Add('First message: Start looping, click on Button2');
    while FSomeFlag do begin
        Application.ProcessMessages;
        Sleep(100);
    end;
    Memo1.Lines.Add('Second message: Loop done');
end;

Checking FSomeFlag before the loop let us know that the loop is already looping and just exit instead of beginning a new loop.

There are more surprises: once you clicked on Button1, before clicking Button2, try to stop your application by clicking the close window button. It won’t stop!

The application doesn’t stop because VCL is written in such a way that an application is terminated when the main window closes. And that window cannot close while an event handler is still executing. Which event handler is execution? It is Button1Click which is still looping waiting for FSomeFlag to become FALSE. Click on Button2 and the loop will break, letting the window close and the application terminate.

It is likely that this behavior is unwanted. Easy to change. Rewrite Button1Click event handler like this:

procedure TForm1.Button1Click(Sender: TObject);
begin
    if FSomeFlag then begin
        Memo1.Lines.Add('You already clicked Button1');
        Exit;
    end;

    FSomeFlag := TRUE;
    Memo1.Lines.Add('First message: Start looping, click on Button2');
    while FSomeFlag do begin
        Application.ProcessMessages;
        if Application.Terminated then
            break;
        Sleep(100);
    end;
    Memo1.Lines.Add('Second message: Loop done');
end;

The check for Application.Terminated does exactly what it name implies. Actually “Terminated” is a flag which is set when you click on the form’s close button. This is exactly the same mechanism as the one we implemented with FSomeFlag.

Finally, there is one more glitch: what happens if the user never clicks on Button2? Answer: the application loops forever. This is probably unwanted behavior (Remember that is a real application the flag FSomeFlag is set to FALSE no when a user clicks on a button but when some condition is met, for example when a removable media is inserted).

To fix this behavior, we may add a timeout. There are several possibilities to implement it. You may get the time within the loop and break if too much time elapsed. Or you may use a TTimer for that purpose. The code looks simpler with a timer but is not really visible so I prefer to get the time within the loop like this:

procedure TForm1.Button1Click(Sender: TObject);
var
    Timeout : TDateTime;
begin
    if FSomeFlag then begin
        Memo1.Lines.Add('You already clicked Button1');
        Exit;
    end;

    FSomeFlag := TRUE;
    Memo1.Lines.Add('First message: Start looping, click on Button2');
    Timeout := Now + OneSecond * 10;
    while FSomeFlag do begin
        Application.ProcessMessages;
        if Application.Terminated then
            break;
        if Now > Timeout then begin
            Memo1.Lines.Add('Timeout');
            break;
        end;
        Sleep(100);
    end;
    Memo1.Lines.Add('Second message: Loop done');
end;

I have not explained yet why there is a Sleep(100) within the loop. If you remove it, everything seems to work the same way. Really? Not! use the task manager to see how much CPU is used by your application. Since it does almost nothing, task manager shows 0% of CPU used. If you click on Button1, you still see 0%.

Now remove Sleep(100) and test again. Task manager will show your application consuming a lot of CPU just for doing nothing sensible. Why is this?

The loop in Button1Click event will run at the maximum speed when there is no Sleep call. Depending on your CPU (Number of cores), this means the loop will consume almost all CPU time available using a single core. The loop will loop thousand or million times per second depending on your hardware.

When there is a call to Sleep, it will instruct the operating system to make the thread sleep for the remaining time slice and for approximately the time in millisecond. Using Sleep(100) will make your loop not run more than 10 times per second which will no use to much CPU.


Better solution?

I explained how ProcessMessages works and how to use it. Now it’s time to ask the good question: Should I really use ProcessMessages?

Most of ProcessMessages calls should and can be avoided. They should be avoided because there is a waste of CPU which slows down your application and the computer in general. They can be avoided by redesigning your application using event driven asynchronous pattern.

Most use of ProcessMessages are used when the developer has not correctly understood or is not even aware of the event driven asynchronous pattern. Such developer has a problem with asynchronous operation where your calls merely start an operation and give control back immediately while the operation itself is executed in the background and triggers an event when done.

In the simple case I used above, it is very easy to change the code so that no wait loop calling ProcessMessages is required. Let’s assume that some processing has to be done when the user has clicked Button3 and Button4 in any order.

The idea is to use a flag per event (Button click here) that must have occurred before the processing can take place. For each event, check all flag to see if processing can take place.

Here is the code:

procedure TForm1.Button3Click(Sender: TObject);
begin
   if FFlag3 then
       Memo1.Lines.Add('You already clicked Button3')
   else begin
       Memo1.Lines.Add('You clicked Button3');
       FFlag3 := TRUE;
   end;
   TryToExecute;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
   if FFlag4 then
       Memo1.Lines.Add('You already clicked Button4')
   else begin
       Memo1.Lines.Add('You clicked Button4');
       FFlag4 := TRUE;
   end;
   TryToExecute;
end;

procedure TForm1.TryToExecute;
begin
    // Check if both buttons have been clicked
    if (not FFlag3) or (not FFlag4) then
        Exit;
    // Both have been clicked
    Memo1.Lines.Add('Processing done');
    // Reset the flags so that the user can start again
    FFlag3 := FALSE;
    FFlag4 := FALSE;
end;

There can be cases where order of event is important or there are a large number of conditions. In those cases, the whole application should make use of a finite state machine. This will probably be the subject of a future article. For now, have a look at what Wikipedia says about it: http://en.wikipedia.org/wiki/Finite-state_machine

Update 16/12/2013: I wrote another article about how to make PostMessage multi-platform for Android and Windows: http://francois-piette.blogspot.be/2013/12/firemonkey-android-windows-and.html


Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be
This article is available from http://francois-piette.blogspot.be

Where is that MenuItem displayed ?

I had the need to display a form when the user clicks on an item in a menu. Easy! But the form, which
is small had to be displayed where the MenuItem was displayed. After Googleling a little bit, I did not
find what I needed. So I wrote it. Here is the result.

In Delphi, a TMenuItem has no property to tell where is has been displayed. I had to find how to get
that information. Among TMenuItem events is OnDrawItem. This event is called when the menu has
the OwnDraw property set to true. The corresponding event handler has a TCanvas property and a
TRect property. That was enough. A TCanvas has a handle which can be used to get hand on the
window where it is drawn. And the rectangle gives the position and size of the menu item in that
window. I had everything I needed.

But wait! When the OwnerDraw property of a menu is set to true, all menu items having an
OnDrawItem event assigned are no more drawn. That was annoying because I want it to be drawn as
usual.

Looking at TMenuItem source code, I found that drawing an item is done by AdvancedDrawItem
method. So I had to call it. There was a problem: this is a protected method and I cannot call it from
my TForm1 class. I can’t? Not really.

A protected class member can only be accessed by the class itself or any derived class, or any class in
the same source code. This feature has been considered as a bug by OOP purist but it is “as
designed”. In recent Delphi version, there is now a new “strict” keyword which restrict the
accessibility like OOP purist want it. This isn’t used for AdvancedDrawItem. To access a protected
method, you just have to declare a class deriving from the target class without changing anything. If
that declaration is located in the same source file as you code that need to call it, it can be called.

That empty class is declared like this:

  THackMenuItem = class(TMenuItem)
    // Intentionally left empty
  end;

The final code is the following:

procedure TForm1.ServiceMnuClick(Sender: TObject);
begin
    Form2.Top  := FServiceMnuRect.Top;
    Form2.Left := FServiceMnuRect.Left;
    Form2.ShowModal;
end;

procedure TForm1.ServiceMnuDrawItem(
    Sender   : TObject;
    ACanvas  : TCanvas;
    ARect    : TRect;
    Selected : Boolean);
var
    State    : TOwnerDrawState;
    MenuItem : TMenuItem;
    Handler  : TMenuDrawItemEvent;
begin
    MenuItem := Sender as TMenuItem;
    GetWindowRect(WindowFromDc(ACanvas.Handle), FServiceMnuRect);
    FServiceMnuRect.Top := FServiceMnuRect.Top  + ARect.Top;

    Handler := MenuItem.OnDrawItem;
    try
        MenuItem.OnDrawItem := nil;
        if Selected then
            State := [odSelected]
        else
            State := [];
        THackMenuItem(MenuItem).AdvancedDrawItem(ACanvas, ARect, State, FALSE);
    finally
        MenuItem.OnDrawItem := Handler;
    end;
end;

ServiceMnuClick is where the secondary form is displayed by calling ShowModal. His position is first
set from the top-left corner of FServiceMnuRect (A member variable of TForm1).

ServiceMnuDrawItem has the responsibility of initializing FServiceMnuRect. Basically, it make use of
the canvas handle (which is a “HDC” or Handle to Device Context in Windows terminology) to get the
rectangle of the window behind the canvas. I used two Windows API calls: WindowFromDc and
GetWindowRect. WindowFromDc fetch the window handle given an HDC and GetWindowRect fetch
the bounding rectangle of a given window.
The bounding rectangle has to be fixed by the drawing rectangle passed to the OnDrawItem event
handler. This drawing rectangle is where the menu item is really drawn.

To call AdvancedDrawItem which drawn the menu item, I used the trick explained above. But there
was another issue: Normally AdvancedDrawItem will call OnDrawItem event handler, so we end up
with a recursive call and a nice stack overflow. So before calling AdvancedDrawItem, I save and clear
the event handler and restore it after.

Complete source file is as follow:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, Menus, Unit2;

type
  THackMenuItem = class(TMenuItem)
    // Intentionally left empty
  end;

  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    FileMnu: TMenuItem;
    OptionsMnu: TMenuItem;
    BrolMnu: TMenuItem;
    N1: TMenuItem;
    ExitMnu: TMenuItem;
    ServiceMnu: TMenuItem;
    TestMnu: TMenuItem;
    procedure ServiceMnuClick(Sender: TObject);
    procedure ServiceMnuDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
      Selected: Boolean);
  private
    FServiceMnuRect : TRect;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ServiceMnuClick(Sender: TObject);
begin
    Form2.Top  := FServiceMnuRect.Top;
    Form2.Left := FServiceMnuRect.Left;
    Form2.ShowModal;
end;

procedure TForm1.ServiceMnuDrawItem(
    Sender   : TObject;
    ACanvas  : TCanvas;
    ARect    : TRect;
    Selected : Boolean);
var
    State    : TOwnerDrawState;
    MenuItem : TMenuItem;
    Handler  : TMenuDrawItemEvent;
begin
    MenuItem := Sender as TMenuItem;
    GetWindowRect(WindowFromDc(ACanvas.Handle), FServiceMnuRect);
    FServiceMnuRect.Top := FServiceMnuRect.Top  + ARect.Top;

    Handler := MenuItem.OnDrawItem;
    try
        MenuItem.OnDrawItem := nil;
        if Selected then
            State := [odSelected]
        else
            State := [];
        THackMenuItem(MenuItem).AdvancedDrawItem(ACanvas, ARect, State, FALSE);
    finally

        MenuItem.OnDrawItem := Handler;
    end;
end;

end.

Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be