Showing posts with label programming. Show all posts
Showing posts with label programming. Show all posts

September 29, 2021

ICS V8.67 adds Delphi 11 and OpenSSL 3 support

ICS V8.67 has been released at: http://wiki.overbyte.eu/wiki/index.php/ICS_Download

ICS is a free internet component library for Delphi 7, 2006 to 2010, XE to XE8, 10 Seattle, 10.1 Berlin, 10.2 Tokyo, 10.3 Rio, 10.4 Sydney and 11.0 and C++ Builder 2006 to XE3, 10.2 Tokyo, 10.3 Rio, 10.4 Sydney and 11.0. ICS supports VCL and FMX, Win32, Win64 and MacOS 32-bit targets. The distribution zip includes the latest OpenSSL 1.1.1i win32, with OpenSSL 3.0 and Win64 versions of OpenSSL being available from the download page.

Changes in ICS V8.67 include:

1 - Added support and packages for RAD Studio 11.0.  Updated SSL/TLS root certificate bundles, old certificates gone, new ones added, nothing major.

2 - Added support for OpenSSL 3.0 which is a major new release, primarily a lot of internal changes to ease long term support. There is an optional FIPS module with 3.0 but not available here since our DLLs are not built to the standards required for certification. The old engines for special extensions are replaced by new more versatile providers of which the FIPS module is one, a provider legacy.dll has obsolete ciphers and hash digests, including MD2, MD4, Blowfish, DES, IDEA, RC2, RC4, SEED, that most applications no longer need and which needs to loaded by the application by setting global variable GSSLEAY_LOAD_LEGACY to true before loading OpenSSL.

3 - OpenSSL 3.0 does not offer any specific new features of benefit to ICS at present, although HTTP/3 support is planned for 3.1 or later, so the main ICS distribution retains OpenSSL 1.1.1i which is fully supported until September 2023. OpenSSL 3.0 may be downloaded from the download page. There are two global variables to restrict which OpenSSL version is loaded, GSSLEAY_DLL_IgnoreNew set true will ignore 3.0, while GSSLEAY_DLL_IgnoreOld will ignore 1.1.1, if both sets of DLLs are available in the same directory. The main SSL samples all set these globals, which can be changed for  testing one version or the other, or set by the application, but must be before OpenSSL is initialised.

4 - The main implication for ICS with OpenSSL 3.0 is for SSL/TLS certificate private keys saved with password protection, which is required for PKCS12 certificates for importing into the Windows certificate store. The new PKCS12 default password encryption AES256 is not recognised until Windows Server 2016 v1709  and Windows 10 v1709, so Server 2012, Windows 10 RTM and earlier won't load AES passworded keys, only 3DES, for which the legacy.dll must be loaded.

5 - The TX509Base class has various improvements. The ValidateCertChain method reports CA roots for multiple certificate verification paths with two or more intermediate certificates, rather than only the last. The CertMainInfo method provides a single line with the main certificate information.

6 - There are two new classes to write and read SSL/TLS certificates to and from the Windows Certificate Store, including private keys. This is primarily so Let's Encrypt certificates can be installed automatically for use with the IIS web server.  TMsX509List descends from TX509List adding a method LoadFromStore to load the list from a Windows certificate store by store name TMsCertStore and location MsCertLocation. For My/Personal store, attempts to load private keys if they are allowed to be exported unencrypted. TMsCertTools descends from TSslCertTools adding methods SaveToStorePfx and LoadFromMyStore to access Windows certificate stores. Note access to the Local Machine Store for web server certificates requires administrator rights.

7 - Various improvements for the OverbyteIcsPemTool sample.  It includes new buttons to list the  contents of Windows certificate and private key stores and allow old items to be deleted.  This may be useful for cleaning up old certificates and private keys from the Windows stores. Added ResavePrivateKey and Resave Private Key menu option which prompt for a PFX or PEM file containing an encrypted  private key with a new cipher, renaming old file to .oldpem/pfx.  Specifically for files saved with old ciphers than OpenSSL 3.0 does not support as standard if required for older versions of Windows.  Displaying certificates and bundles is no longer a new modal window, but updates the existing log window. Improved import certificates from Windows certificate store to use TMsX509List instead of Windows API calls, and to access all Windows store locations instead of just user, specifically the Local Machine store where server certificates are located.

8 - For the TX509Certs component, the default cipher for encrypting PFX/P12 files is now PrivKeyEncAES256 with 3.0 unless the legacy DLL is loaded when still PrivKeyEncTripleDES so older versions of Windows can load them. Changed extraction of download PEM bundle so that main certificate does not need to be first in file, log them all, and ignore any self signed root certificates. If testing dns-01 challenge fails, rotate to next public server and three retries (previously only happened on timeout). When saving files with private keys, log encryption type used. Added more certificate output formats, OutFmtPwPem and OutFmtPwP12 specify whether to password PEM and P12/PFX private keys. Note Windows always needs passworded P12/PRX files, while Apache web server only accepts PEM files without a password. Allow automatic installation of new certificates to the Windows Certificate Store so they can be used by IIS web sites, by setting output format to OutFmtWinStore.  Note application must have administrator rights to do this.

9 - Fixed two problems in the FTP client, support option ftpFixPasvLanIP for PUT/APPE uploads as well as  downloads, and support IPv6 for PUT/APPE uploads as well as downloads.

10 - Fixed a problem in TIcsMailQueue with sequential number generation to avoid file locking errors and unicode BOM corrupting file, generate large random number for errors instead of reverting to 1.  Don't save BOM withunicode compilers.

11 - In the Application Web Server TSslHttpAppSrv, added an optional LastModified parameter to the AnswerStream, AnswerPage, and AnswerString methods to avoid adding a custom header line with the date.  Added NO_CACHE_EX and NO_STORE_EX literals. Added PUT and DELETE verb handlers, similar to GET and POST.

12 - For the HTTP client TSslHttpCli, fixed a relocation problem where the Location: header included a path with a space, encode the space. Fixed another relocation problem where HEAD sometimes stalled. Remove # fragment or anchor from URL in relocation, only used by browsers and not by servers.

13 - In the TIcsBlackList component, Internally use BlockedFlag instead of setting attempts to 9999 once the actual maximum failed attempts is reached, so we can keep counting attempts.

14 - Added a new SSL sample, OverbyteIcsDDWebService.dpr which is very similar to OverbyteIcsSslMultiWebServ.dpr, but designed as a Windows service, although it will also run as a GUI for debugging.  It requires DDService service framework to be installed from https://www.magsys.co.uk/delphi/ddservice. asp. It also includes a REST server with simple lookup responses from a SQL
database, which optionally requires DISQLite3 5.36.5 or later to be installed from http://www.yunqa.de. Note this sample in not in the project groups due to these pre-requisites.

15 - Moved TRestParams from the OverbyteIcsSslHttpRest unit to OverbyteIcsUrl to ease circular references. Added a new method AddItemNULL to add a null, in Json this will be unquoted. Added a new TRestParamsSrv component which provides methods for creating REST server Json responses from a SQL database resultset, one or more rows, also error responses. Note this is only compiled if DATABASE is defined in OverbyteIcsDefs.inc to avoid bringing in database units that are not available on all Delphi editions.  There is a REST server sample OverbyteIcsDDWebService.dpr that illustrates SQL lookups.

16 - In the proxy component TIcsHttpProxy, don't send an HTTP request header until after HTTP body has been processed in case the body length changes. HTTP Forward Proxy using HTTP works again, broken in V8.65. Using HTTP Forward Proxy, convert absolute URL to path only since some servers can not process an absolute URL and sulk.

17 - In the Jose unit, rewrote the functions converting private keys to and from Json Web Keys with new OpenSSL 3.0 provider functions. Use AnsiStrings and functions when dealing with binary data to avoid possible issues with string conversions and nulls.  Json now created with TRestParams.

18 - Added two new sample project groups, OtherDemos64 and SslDemos64 which include Win64 versions of all the main active samples with 64 added to the project name, so they can be regularly built alongside the Win32 versions without changing platforms and overwriting executables.

 

August 29, 2020

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




March 18, 2014

On the fly form

This article explain how to create a form on the fly. Such a form is created by code, without using the designer.

You will surely ask why you would do that! Granted the Delphi form designer is very easy to use. But in some cases it is not practical because it creates several files and makes more difficult, for example, to hide the form in a component.

This is exactly the case I had: in a component I needed a small helper form. I wanted the code to be in the component source itself. You may already use an "on the fly" form without knowing: InputQuery and InputBox are already such a form. Their code is located in the Dialogs unit.

Actually, there is not much magic to use to create an "on the fly" form. After all a form is just an object as any other object. The only special thing is related to the constructor. The form constructor insist on loading a form from a resource as it had been created with the designer and his DFM file. If there is no DFM and you call Create, you get an exception EResNotFound with a resource name equal to your form class name.

Instead of Create, you have to call CreateNew. This is easy but somewhat misleading. This is why the code I present below override the standard constructor named Create and call CreateNew. This way you can use the standard constructor without worrying.

The sample code I use to demonstrate the "on the fly" form is very easy. The form is a simple form named TComboBoxInputForm with a combobox and a pair of buttons for OK/Cancel. I created an Execute method which calls ShowModal after having initialized the combobox with an array of const values passed as argument.

Here is the code showing the use:

procedure TForm1.Button1Click(Sender: TObject);
var
    Form    : TComboBoxInputForm;
    AResult : String;
begin
    Form := TComboBoxInputForm.Create(Self);
    try
        if Form.Execute(['Delphi', 123, 2.3, TRUE],
                        Edit1.Text, AResult,
                        'Select value') then
            Edit1.Text := AResult;
    finally
        FreeAndNil(Form);
    end;
end;

This code uses TComboBoxInputForm to ask the user to select a value in a list.

The source code is very simple and looks like any other form, except since there is no DFM file, all used components are created and initialized from the constructor.

type
    TComboBoxInputForm = class(TCustomForm)
        ComboBox     : TComboBox;
        OKButton     : TButton;
        CancelButton : TButton;
    protected
        procedure OKButtonClick(Sender: TObject);
        procedure CancelButtonClick(Sender: TObject);
    public
        constructor Create(AOwner : TComponent); override;
        function Execute(const Values   : array of const;
                         const ADefault : String;
                         out   AResult  : String;
                         const ACaption : String = '') : Boolean;
    end;

    TForm1 = class(TForm)
        Button1: TButton;
        Edit1: TEdit;
        procedure Button1Click(Sender: TObject);
    end;

var
    Form1: TForm1;

implementation

{$R *.dfm}

{ TComboBoxInputForm }

constructor TComboBoxInputForm.Create(AOwner: TComponent);
begin
    // We need the following lines to avoid the EResNotFound exception
    // because we have no DFM resource for our form
    GlobalNameSpace.BeginWrite;
    try
        CreateNew(AOwner);
    finally
        GlobalNameSpace.EndWrite;
    end;
    BorderStyle          := bsToolWindow;
    ComboBox             := TComboBox.Create(Self);
    ComboBox.Parent      := Self;
    ComboBox.Top         := 16;
    ComboBox.Left        := 32;
    ComboBox.Style       := csDropDownList;
    OKButton             := TButton.Create(Self);
    OKButton.Parent      := Self;
    OKButton.Top         := ComboBox.Top + ComboBox.Height + 8;
    OKButton.Left        := ComboBox.Left;
    OKButton.Width       := 50;
    OKButton.Caption     := '&OK';
    OKButton.Default     := TRUE;
    OKButton.OnClick     := OKButtonClick;
    CancelButton         := TButton.Create(Self);
    CancelButton.Parent  := Self;
    CancelButton.Top     := OKButton.Top;
    CancelButton.Left    := OkButton.Left + OKButton.Width + 16;
    CancelButton.Width   := OKButton.Width;
    CancelButton.Caption := '&Cancel';
    CancelButton.Cancel  := TRUE;
    CancelButton.OnClick := CancelButtonClick;
    ComboBox.Width       := OKButton.Width + CancelButton.Width + 16;
    ClientWidth          := ComboBox.Left + ComboBox.Width + ComboBox.Left;
    ClientHeight         := ComboBox.Top + OKButton.Top + OKButton.Height;
end;

procedure TComboBoxInputForm.OKButtonClick(
    Sender : TObject);
begin
    Close;
    ModalResult := mrOK;
end;

procedure TComboBoxInputForm.CancelButtonClick(
    Sender : TObject);
begin
    Close;
    ModalResult := mrCancel;
end;

function TComboBoxInputForm.Execute(
    const Values   : array of const;
    const ADefault : String;
    out   AResult  : String;
    const ACaption : String) : Boolean;
var
    I    : Integer;
const
    BoolToStr : array [Boolean] of String = ('FALSE', 'TRUE');
begin
    Caption   := ACaption;
    ComboBox.Items.Clear;
    I := Low(Values);
    while I <= High(Values) do begin
        case Values[I].VType of
        vtUnicodeString: ComboBox.Items.Add(Values[I].VPWideChar);
        vtBoolean:       ComboBox.Items.Add(BoolToStr[Values[I].VBoolean]);
        vtInteger:       ComboBox.Items.Add(IntToStr(Values[I].VInteger));
        vtExtended:      ComboBox.Items.Add(FloatToStr(Values[I].VExtended^));
        end;
        Inc(I);
    end;
    // Preselect default item
    I := ComboBox.Items.IndexOf(ADefault);
    if I >= 0 then
        ComboBox.ItemIndex := I;

    Result := ShowModal = mrOK;
    if Result then
        AResult := ComboBox.Text
    else
        AResult := ADefault;
end;






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

February 25, 2014

Automate Word document print using Delphi

Automating Microsoft office Word from Delphi is really easy. I already blogged on the subject. This time, I will show you how to select a specific printer in your Delphi application and instruct Word to use that printer.


Using Delphi, create a new VCL forms application and drop a TComboBox, a TButton and a TWordApplication. Add the unit Printers to the uses clause. In the FormShow event handler, we will fill the combobox with the available printers:
procedure TForm1.FormShow(Sender: TObject);
begin
    ComboBox1.Items     := Printer.Printers;
    ComboBox1.ItemIndex := Printer.PrinterIndex;
end;
In the button's OnClick event handler, add the following code:
procedure TForm1.Button1Click(Sender: TObject);
var
    ADoc : _Document;
begin
    WordApplication1.Connect;
    WordApplication1.Visible := TRUE;
    ADoc := WordApplication1.Documents.Add(emptyParam,
                                        emptyParam, emptyParam, emptyParam);
    WordApplication1.Selection.Text := 'Embarcadero Delphi Rocks !' + #13 +
                                       'http://www.overbyte.be' + #13#10;
    WordApplication1.ActivePrinter := ComboBox1.Text;
    WordApplication1.PrintOut;
    WordApplication1.Disconnect;
end;

This code connect the application to Microsoft Word, launching Word if required. It makes Word visible on screen (by default it is not shown). It then insert some nice text in the document. To select the printer Word must use, it is enough to assign the property ActivePrinter with the name of the printer. We pick the name from the combobox. Finally, the document is printed out and the application disconnect from Word. That's it!


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

February 16, 2014

In memory message logging

Message logging is a common activity used for either keeping track of what happens in an application or for debugging purpose.

Recently, I was developing a real time communication system which experimented strange errors. To find out what was happening, I decided to log all kind of informations that where available during the execution. After an error, I analyzed the message log and I eventually could determine what the error was.

But this was not so simple, actually. On a real time system, many errors come from that fact that concurrency is not handled correctly. When badly coded, an error may occur when two of more parts of the system (threads or asynchronous operation) are doing something simultaneously. When you introduce a message logging system, you also introduce some perturbation to the actual process and maybe your error goes away simply because the system is slowly writing messages to the log.

To solve this issue, instead of using my good old logging class, I have designed a brand new one. This new logging class stores all messages in pre-allocated memory for faster access. Of course the class also offers the feature of saving the recorded messages in a text file.

The class has been made “thread safe”. It means the methods can be called not only from the thread which created the class instance in the first place, but by any worker thread. The class takes care of writing message in the correct order without inserting a message from one thread in the middle of the message from another thread.

I just said that memory was pre-allocated. Actually this is more complex than that. I created a linked list of “buffers” to store messages. Buffers are of arbitrary size (more on this later). A new buffer is added to the linked list automatically when the current one is filled.

Buffers are removed from the list once they have been written to a file. But instead of freeing the buffer, it is moved to a list of available buffers where it is available when a new buffer is required. So before allocating a new buffer, the available buffer list is checked to reuse an existing buffer, avoiding the memory allocation.


Writing to the file is straightforward. It is done by iterating thru the linked list of buffers, writing each one to the file and then moving the buffer to the available buffer list.

Multithreading safety is achieved by using two critical sections. One protects the linked lists of buffers and the other make sure only one write to file take place at a time.

Usage


You create a variable to hold the class instance. This variable can have any scope but it is likely a global variable so that in can be used from anywhere, including initialization and finalization sections of units.

var
    GLog : TInMemoryLogger;

You create the object instance the same way as usual. If you selected a global variable, it is likely you create it from the initialization section of unit. You’ll make sure to put the unit in front of other units in the project source file so that it is initialized the first and makes the logger available for other units.

The code looks like this:

initialization
    CompanyFolder   := 'OverByte';
    GLog            := TInMemoryLogger.Create(nil);
    GLog.BufferSize := 4096;
    GLog.SetDefaultFileName;
    GLog.Options    := GLog.Options +
                       [imloAddCRLF,         // Add a CRLF at end of each Log()
                        imloAddDate,         // Add a date in front of each log()
                        imloAddTime,         // Add a time in front of each log()
                        imloAddTimeMSec,     // Add millisecond to time
                        imloFlushOnDestroy]; // Flush to file when destroyed

TInmemoryLogger is actually a component which could be installed and dropped onto a form. Here I use it as a simple class to the constructor takes a nil argument.

The then buffer size is initialized. This is the size in bytes for one buffer which will be part of the linked list. Any size is OK. Selecting a small size forces more allocations (once). Selecting a larger one uses less allocations but make flushing to disk a little bit heavier.

SetDefautFileName assign the filename for flushing the buffer to disk. It builds the file name from the executable file name and put the file in the user profile in Local\AppData branch, in a folder with your company name. Hence the variable “CompanyFolder” used to specify that name. Of course you may also initialize the FileName property with anything you like to store the file exactly where you like.

Finally, there are a number of options which are self-explanatory. Add or remove the options according to your needs and preferences.

Then to use the logger, you just call his Log() method, passing a string:

    GLog.Log(‘This is my demo message’);

If you use a global variable and plan to use it from anywhere, it is better to encapsulate the Log method into a global Log procedure which will take care of the variable being created or destroyed. You’ll avoid many access violations if you don’t master initialization/finalization unit order.

procedure Log(const Msg : String);
begin
    if Assigned(GLog) then
        GLog.Log(Msg);
end;

When doing that, it is better to move the GLog variable to the unit implementation section so that it is not available from anywhere else.

Likely, you’ll create a wrapper procedure to flush the buffers to disk file and for any other access to the class members.

procedure LogFlush;
begin
    if Assigned(GLog) then
        GLog.FlushToFile;
end;


Implementation


The logger is made of two classes: the first one is TInMemoryLogger we saw the use above, the second is the class used to encapsulate a buffer.

Let’s have a look at TInMemoryChunk, the class encapsulating a buffer. It is quite simple. It is manly build around the memory used for storing data. I use a TBytes data type (Dynamic array of bytes). I also use a variable to store the buffer size, even if this could be derived from the array size because it is faster. Then there is an integer to count how many bytes have already been written to the buffer. Finally there is a reference to the next buffer to make the linked list of buffers.

There is a single method named “Write”. It is used to store a message to the buffer. The message is passed as a string argument. Passed also as a var parameter is the number of bytes actually written to the buffer. The method returns the last buffer used to store the message. A large message could be split into several buffers which are created as needed. The method always returns the last buffer used. The main class uses this returned value to update the linked list head.

As I said in the introduction, buffer are allocated once and not freed when emptied. Instead they are move to a list of available buffers for later reuse. TInMemoryChunk has to acquire a buffer from this available buffer list. The list in maintained by the main class and as such is inaccessible from TInMemoryChunk. The implementation makes use of an event that TInMemoryChunk triggers when a free buffer is required. The main class implements a handler for that event which will get a buffer from the available buffer list, or create a new one if no available buffer exists.

All in all, here is the class declaration:

    TInMemoryChunk = class(TObject)
    strict private
        FBuffer         : TBytes;
        FBufferSize     : Integer;
        FBufferNext     : TInMemoryChunk;
        FWriteCount     : Integer;
        FOnAcquireChunk : TInMemoryChunkAcquireEvent;
        function  AcquireChunk : TInMemoryChunk;
    public
        constructor Create(Size : Integer);
        function Write(const Msg       : String;
                       var   ByteCount : Integer) : TInMemoryChunk;
        property Buffer         : TBytes                  read  FBuffer
                                                          write FBuffer;
        property BufferNext     : TInMemoryChunk          read  FBufferNext
                                                          write FBufferNext;
        property BufferSize     : Integer                 read  FBufferSize
                                                          write FBufferSize;
        property WriteCount     : Integer                 read  FWriteCount
                                                          write FWriteCount;
        property OnAcquireChunk : TInMemoryChunkAcquireEvent
                                                          read  FOnAcquireChunk
                                                          write FOnAcquireChunk;
    end;

You will recognize all the member variables I talked above, as well as their corresponding properties declarations. This is quite canonical and opens the door to easy customization.

Actual implementation code is really straightforward:

constructor TInMemoryChunk.Create(Size: Integer);
begin
    if Size < 16 then
        raise EInMemoryRangeException.Create(ERROR_MSG_SIZE_TO_LOW);
    FWriteCount := 0;
    FBufferNext := nil;
    FBufferSize := Size;
    SetLength(FBuffer, FBufferSize);
end;


function TInMemoryChunk.AcquireChunk: TInMemoryChunk;
begin
    Result := nil;
    if Assigned(FOnAcquireChunk) then
        FOnAcquireChunk(Self, Result);
end;


// Write a msg into the buffer, allocating a new one if required
// Returns the last buffer used (The current one or the new allocated)
function TInMemoryChunk.Write(
    const Msg       : String;
    var   ByteCount : Integer) : TInMemoryChunk;
var
    I          : Integer;
    Len        : Integer;
    AvailBytes : Integer;
    NewBuffer  : TInMemoryChunk;
begin
    Result := Self;
    Len := Length(Msg);
    if Len <= 0 then
        Exit;
    AvailBytes := Result.BufferSize - Result.WriteCount;
    I          := Low(Msg);
    while I <= High(Msg) do begin
        // Simple and incorrect unicode to ascii conversion
        Result.Buffer[Result.WriteCount] := Ord(Msg[I]);
        Result.WriteCount := Result.WriteCount + 1;
        Inc(I);
        Inc(ByteCount);
        Dec(AvailBytes);
        if AvailBytes <= 0 then begin
            // No more room in current buffer, allocate new one
            NewBuffer           := AcquireChunk;       // Get a free chunk
            if not Assigned(NewBuffer) then begin
                Result := nil;
                Exit;
            end;
            Result.BufferNext   := NewBuffer;
            Result              := NewBuffer;
            Result.BufferNext   := nil;
            Result.WriteCount   := 0;
            AvailBytes          := Result.BufferSize;
        end;
    end;
end;

As you can see, I’m converting the string (Unicode) to ascii. I do it the rude way for performance reason. Of course you can preserve Unicode instead if you need it. This double the in memory size and write to disk time. For my application, keeping ascii is enough and I preferred better speed and less memory and disk space. Just a choice.
Now let’s see the main class. TInMemoryLogger is responsible for maintening the list of buffers and the list of available buffers. It receives the request to write a message thru the method Log() and the request to flush the buffers to disk thru the method FlushToFile(). Another important responsibility of the class it to manage concurrency so that the Log and FlushToFile methods can be called from different threads. So there are two critical sections: one two serialize access to the buffers and one to serialize access to the file.

The list of available buffers is managed by two protected methods: AcquireChunk and ReleaseChunk. AcquireChunk will check for available buffer and return it, or create a new buffer if no one is available. ReleaseChunk takes an emptied buffer (one which has been flushed to disk) and move it to the available buffer list.

The final code is quite simple. Here after you’ll find it complete.

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Author:       François PIETTE
Creation:     Feb 09, 2014
Description:  Fast multithread safe in memory logging
Version:      1.00
History:


 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit OverbyteInMemoryLogger;

interface

uses
    Windows, ShlObj,
    Types, Classes, SysUtils, SyncObjs,
    Generics.Collections,
    OverbyteInMemoryChunk;

type
    TInMemoryLoggerOption  = (
        imloAddCRLF,        // Add a CRLF at end of each Log()
        imloAddDate,        // Add a date in front of each log()
        imloAddTime,        // Add a time in front of each log()
        imloAddTimeMSec,    // Add millisecond to time
        imloFlushOnDestroy  // Flush to file when destroyed
    );
    TInMemoryLoggerOptions = set of TInMemoryLoggerOption;

    TInMemoryLogger = class(TComponent)
    private
    protected
        FCritSectBuffer : TCriticalSection;  // To protect buffer access
        FCritSectFile   : TCriticalSection;  // To protect file write access
        FBufferHead     : TInMemoryChunk;
        FBufferCurrent  : TInMemoryChunk;
        FBuffe     : Integer;
        FOptions        : TInMemoryLoggerOptions;
        FFileName       : String;
        FBufferAvail    : TInMemoryChunk;
        FByteCount      : Integer;
        function  AcquireChunk: TInMemoryChunk;
        procedure ReleaseChunk(Chunk: TInMemoryChunk);
        procedure AcquireChunkHandler(Sender: TObject; var Chunk: TInMemoryChunk);
        function  GetByteCount: Integer;
    public
        constructor Create(AOwner : TComponent); override;
        destructor  Destroy; override;
        procedure Log(const Msg : String);
        procedure FlushToFile;
        procedure SetDefaultFileName;
    published
        property BufferSize    : Integer                read  FBufferSize
                                                        write FBufferSize;
        property Options       : TInMemoryLoggerOptions read  FOptions
                                                        write FOptions;
        property FileName      : String                 read  FFileName
                                                        write FFileName;
        property ByteCount     : Integer                read  GetByteCount;
    end;

var
    CompanyFolder : String = 'OverByte';


implementation

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

{ TInMemoryLogger }

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor TInMemoryLogger.Create(AOwner: TComponent);
begin
    FCritSectBuffer := TCriticalSection.Create;
    FCritSectFile   := TCriticalSection.Create;
    FBufferSize     := 4096;                      // Default buffer size;
    FOptions        := [imloAddCRLF, imloFlushOnDestroy,
                        imloAddDate, imloAddTime, imloAddTimeMSec];
    inherited Create(AOwner);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor TInMemoryLogger.Destroy;
var
    Chunk1 : TInMemoryChunk;
    Chunk2 : TInMemoryChunk;
begin
    if imloFlushOnDestroy in FOptions then
        FlushToFile;
    if Assigned(FCritSectBuffer) then
        FCritSectBuffer.Acquire;
    try
        // Free currently active buffers
        Chunk1      := FBufferHead;
        FBufferHead := nil;
        while Assigned(Chunk1) do begin
            Chunk2 := Chunk1.BufferNext;
            FreeAndNil(Chunk1);
            Chunk1 := Chunk2;
        end;
        // Free available buffers
        Chunk1       := FBufferAvail;
        FBufferAvail := nil;
        while Assigned(Chunk1) do begin
            Chunk2 := Chunk1.BufferNext;
            FreeAndNil(Chunk1);
            Chunk1 := Chunk2;
        end;
    finally
        if Assigned(FCritSectBuffer) then begin
            FCritSectBuffer.Release;
            FreeAndNil(FCritSectBuffer);
        end;
    end;
    FreeAndNil(FCritSectFile);
    inherited Destroy;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TInMemoryLogger.AcquireChunk : TInMemoryChunk;
begin
    FCritSectBuffer.Acquire;
    try
        // Check if a buffer is available
        if not Assigned(FBufferAvail) then
            Result := nil
        else begin
            // Take one buffer from the buffer available list
            Result            := FBufferAvail;
            FBufferAvail      := FBufferAvail.BufferNext;
            Result.BufferNext := nil;
        end;
    finally
        FCritSectBuffer.Release;
    end;

    // If we got no buffer, then create a new one
    if not Assigned(Result) then begin
        Result                := TInMemoryChunk.Create(FBufferSize);
        Result.OnAcquireChunk := AcquireChunkHandler;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TInMemoryLogger.ReleaseChunk(Chunk : TInMemoryChunk);
begin
    if not Assigned(Chunk) then
        Exit;
    FCritSectBuffer.Acquire;
    try
        // Add the buffer to the available buffer list
        Chunk.BufferNext := FBufferAvail;
        FBufferAvail     := Chunk;
        // Clear data
        Chunk.WriteCount := 0;
{$IFDEF DEBUG}
        // When debugging, clear buffer memory
        if Assigned(Chunk.Buffer) then
            FillChar(PByte(Chunk.Buffer)^, Chunk.BufferSize, 0);
{$ENDIF}
    finally
        FCritSectBuffer.Release;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Build filename with LocalApp data location, company folder and
// same filename es executable with .log extension
procedure TInMemoryLogger.SetDefaultFileName;
var
    ExeName : array [0 .. MAX_PATH] of Char;
    Path    : array [0 .. MAX_PATH] of Char;
    AppName : String;
begin
    // Fetch Windows LocalApp data folder location
    SHGetFolderPath(0, CSIDL_LOCAL_APPDATA, 0, SHGFP_TYPE_CURRENT, @Path[0]);
    // Fetch executable file path
    GetModuleFileName(0, ExeName, High(ExeName));
    AppName := ChangeFileExt(ExtractFileName(ExeName), '');
    // Build complete file name
    FFileName := IncludeTrailingPathDelimiter(Path) + CompanyFolder +
                 '\' + AppName + '\' + AppName + '.Log';
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TInMemoryLogger.AcquireChunkHandler(
    Sender     : TObject;
    var Chunk  : TInMemoryChunk);
begin
    Chunk := AcquireChunk;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TInMemoryLogger.FlushToFile;
var
    Stream : TFileStream;
    Mode   : Integer;
    Next   : TInMemoryChunk;
begin
    // Check if critical section are assigned. The may be not assigned
    // in case of exception raise during contructor execution.
    if not Assigned(FCritSectFile) then
        Exit;
    if not Assigned(FCritSectBuffer) then
        Exit;

    FCritSectFile.Acquire;
    try
        if (not Assigned(FBufferHead)) or (FBufferHead.WriteCount <= 0) then
            Exit;
        if FFileName = '' then
            Exit;
        if FileExists(FFileName) then
            Mode := fmOpenWrite
        else
            Mode := fmCreate;
        Stream := TFileStream.Create(FFileName, Mode);
        try
            Stream.Seek(0, TSeekOrigin.soEnd);
            FCritSectBuffer.Acquire;
            try
                while Assigned(FBufferHead) do begin
                    Stream.Write(FBufferHead.Buffer[0], FBufferHead.WriteCount);
                    Dec(FByteCount, FBufferHead.WriteCount);
                    FBufferHead.WriteCount := 0;
                    Next := FBufferHead.BufferNext;
                    ReleaseChunk(FBufferHead);
                    FBufferHead := Next;
                    // Release/Acquire the critical section to enhance concurrency
                    FCritSectBuffer.Release;
                    Sleep(0);           // Let other thread take hand
                    FCritSectBuffer.Acquire;
                end;
            finally
                FCritSectBuffer.Release;
            end;
        finally
            FreeAndNil(Stream);
        end;
    finally
        FCritSectFile.Release;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TInMemoryLogger.GetByteCount: Integer;
begin
    FCritSectBuffer.Acquire;
    try
        Result := FByteCount;
    finally
        FCritSectBuffer.Release;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TInMemoryLogger.Log(const Msg: String);
var
    NewBuffer : TInMemoryChunk;
    Buf       : String;
begin
    FCritSectBuffer.Acquire;
    try
        if not Assigned(FBufferHead) then begin
            NewBuffer      := AcquireChunk;
            FBufferHead    := NewBuffer;
            FBufferCurrent := NewBuffer;
        end;
        if not Assigned(FBufferCurrent) then
            raise EInMemoryNoBufferException.Create(ERROR_MSG_NO_BUFFER);
        if (imloAddTime in FOptions) and (imloAddDate in FOptions) then begin
            // Add both date and time
            if imloAddTimeMSec in FOptions then
                Buf := FormatDateTime('YYYYMMDD HHNNSS.ZZZ ', Now)
            else
                Buf := FormatDateTime('YYYYMMDD HHNNSS ', Now);
            FBufferCurrent := FBufferCurrent.Write(Buf, FByteCount);
        end
        else if imloAddDate in FOptions then begin
            // Add date only
            Buf := FormatDateTime('YYYYMMDD ', Now);
            FBufferCurrent := FBufferCurrent.Write(Buf, FByteCount);
        end
        else if imloAddTime in FOptions then begin
            // Add time only
            if imloAddTimeMSec in FOptions then
                Buf := FormatDateTime('HHNNSS.ZZZ ', Now)
            else
                Buf := FormatDateTime('HHNNSS ', Now);
            FBufferCurrent := FBufferCurrent.Write(Buf, FByteCount);
        end;
        if not Assigned(FBufferCurrent) then
            raise EInMemoryNoBufferException.Create(ERROR_MSG_NO_BUFFER);
        FBufferCurrent := FBufferCurrent.Write(Msg, FByteCount);
        if imloAddCRLF in FOptions then
            FBufferCurrent := FBufferCurrent.Write(#13#10, FByteCount);
    finally
        FCritSectBuffer.Release;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

end.
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Author:       François PIETTE
Creation:     Feb 09, 2014
Description:  Class to represent a buffer for TInMemoryLogger. Buffers
              are organized as a simply linked list.
Version:      1.00
History:


 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit OverbyteInMemoryChunk;

interface

uses
    SysUtils;

type
    EInMemoryException         = class(Exception);
    EInMemoryRangeException    = class(EInMemoryException);
    EInMemoryNoBufferException = class(EInMemoryException);

    TInMemoryChunk = class;
    TInMemoryChunkAcquireEvent = procedure (Sender    : TObject;
                                            var Chunk : TInMemoryChunk)
                                            of object;

    // Store data in ASCII
    TInMemoryChunk = class(TObject)
    strict private
        FBuffer         : TBytes;
        FBufferSize     : Integer;
        FBufferNext     : TInMemoryChunk;
        FWriteCount     : Integer;
        FOnAcquireChunk : TInMemoryChunkAcquireEvent;
        function  AcquireChunk : TInMemoryChunk;
    public
        constructor Create(Size : Integer);
        destructor Destroy; override;
        function Write(const Msg       : String;
                       var   ByteCount : Integer) : TInMemoryChunk;
        property Buffer         : TBytes                  read  FBuffer
                                                          write FBuffer;
        property BufferNext     : TInMemoryChunk          read  FBufferNext
                                                          write FBufferNext;
        property BufferSize     : Integer                 read  FBufferSize
                                                          write FBufferSize;
        property WriteCount     : Integer                 read  FWriteCount
                                                          write FWriteCount;
        property OnAcquireChunk : TInMemoryChunkAcquireEvent
                                                          read  FOnAcquireChunk
                                                          write FOnAcquireChunk;
    end;

const
    ERROR_MSG_NO_BUFFER   = 'Log failed. No buffer available';
    ERROR_MSG_SIZE_TO_LOW = 'Create buffer failed. Min size is 16';


implementation

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

{ TInMemoryChunk }

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor TInMemoryChunk.Create(Size: Integer);
begin
    if Size < 16 then
        raise EInMemoryRangeException.Create(ERROR_MSG_SIZE_TO_LOW);
    FWriteCount := 0;
    FBufferNext := nil;
    FBufferSize := Size;
    SetLength(FBuffer, FBufferSize);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor TInMemoryChunk.Destroy;
begin
    inherited Destroy;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TInMemoryChunk.AcquireChunk: TInMemoryChunk;
begin
    Result := nil;
    if Assigned(FOnAcquireChunk) then
        FOnAcquireChunk(Self, Result);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// Write a msg into the buffer, allocating a new one if required
// Returns the last buffer used (The current one or the new allocated)
function TInMemoryChunk.Write(
    const Msg       : String;
    var   ByteCount : Integer) : TInMemoryChunk;
var
    I          : Integer;
    Len        : Integer;
    AvailBytes : Integer;
    NewBuffer  : TInMemoryChunk;
begin
    Result := Self;
    Len := Length(Msg);
    if Len <= 0 then
        Exit;
    AvailBytes := Result.BufferSize - Result.WriteCount;
    I          := Low(Msg);
    while I <= High(Msg) do begin
        // Simple and incorrect unicode to ascii conversion
        Result.Buffer[Result.WriteCount] := Ord(Msg[I]);
        Result.WriteCount := Result.WriteCount + 1;
        Inc(I);
        Inc(ByteCount);
        Dec(AvailBytes);
        if AvailBytes <= 0 then begin
            // No more room in current buffer, allocate new one
            NewBuffer           := AcquireChunk;       // Get a free chunk
            if not Assigned(NewBuffer) then begin
                Result := nil;
                Exit;
            end;
            Result.BufferNext   := NewBuffer;
            Result              := NewBuffer;
            Result.BufferNext   := nil;
            Result.WriteCount   := 0;
            AvailBytes          := Result.BufferSize;
        end;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

end.




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

February 13, 2014

The most interesting topics...

Maybe you'll be interested by the topics mostly read on my blog.
The number in front of the titles are the number of hits:

9007 Delphi XE5 to develop Android applications
5509 Automate Microsoft Office from Delphi
2612 Delphi XE4 and AnsiString
2528 Multithreading and PostMessage performance
2498 Inter Process Communication Using Pipes

Of course some articles are older than other so the counts do not exactly reflect interest.



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

January 26, 2014

Coding style matters

Coding Style, AKA Programming Style refers to the way you layout your source code. In many languages, source code layout is simply ignored by the compiler. You can write as you like.

It is very important for code readability and understanding to use the same coding style across all files of an application. It is even important to have the same coding style in all your source code.

Having the same coding style helps reading the code. And if you carefully select your coding style, you can even pinpoint coding errors simply because something look strange in the layout.

Of course, if you share your code among a team, like I do, it is very important that everyone in the team uses the same coding style. it is even important that in a company, all development teams use the same coding style so that code can be easily read and shared across teams and developers.

What coding style to use? I would say that this is mostly a matter of personal preferences as long as the style is constant and emphasizes the code structure.

I wrote my personal preferences in a document titled "ICS Coding Style". The name comes from the fact that I wrote it long time ago when a lot of peoples started to make changes to ICS. I wanted everyone to use the same coding style as me. Not an easy task because every developer think his coding style is the best.

The following image gives an idea of my coding style.


You can download my coding style document from here.

There are many "code formatter" on the market. The IDE is use (Delphi) has a fairly powerful code formatter. But this is not enough. For example, no code formatter will be able to rename the variables, methods and other identifiers according to a naming convention. Nad properly naming identifiers is an essential part of the coding sytle.

Code formatter also doesn't handle all aligments. For example, when the code must be broken into several lines, the code formatter will mostly go to the next line with some indentation. i prefer to aligne arguments and this become problematic for the code formatter when arguments are themself function calls.


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

January 5, 2014

TIniFile for Android and Windows

When writing cross platform applications, you are faced with different ways of doing thing depending on the platform. Thanks to the OOP paradigm, we may encapsulate those things in a class and create an implementation specific to each platform. This class hides all the details which are not readily portable.

In this article, I will model a class depending on the operation of the well-known Windows INI files. Of course, Windows own system will be used in the Windows implementation. On Android side, I will use the SharedPreferences API which is very close.

INI file concept


In an INI file, you have Key-Value pairs organized by sections. You can read or write values.

Under Windows, the INI file format is a simple text file with a Key=Value per line. All Key-Value pairs related to the same section are grouped under a header line in the form of the section name between brackets.

Under Android, the file format is not specified. You are not supposed to access the file directly. You use a “Shared Preference Editor” to access it. Android API lacks the “section” concept we have in Windows. This is not a problem. To create the section concept, I will simply prefix each key by his section name surrounded by brackets like this: ‘[‘ + Section + ‘]_’ + Key

Delphi TIniFile revisited


Since the beginning, Delphi has a class encapsulation Windows INI files. It is well named “TIniFile” and sits into “System.IniFiles” unit.

I will use the same class name in my implementation and even the save class signature by inheriting from the existing TCustomIniFile for Android and TIniFile for Windows.

Using the same class name as an existing one will force you to pay some attention to the units used in the uses clause, and/or prefix the class name you intent to use with the unit name.

I made things simples. Under both Windows and Android, in your application, you do not use System.IniFiles but FMX.Overbyte.IniFiles. No other change is required. Your application will compile targeted for Windows as well as Android. The conditional compilation is located in FMX.Overbyte.IniFiles and you can safely ignore it!

Storage location


TIniFile constructor takes a filename as argument. This will be the file where the sections and key-value pairs will be stored. The Windows API store the file exactly where you specify it when using a full path. When you omit the path, Windows tore the file in the Windows directory. Since Windows Vista, normal user cannot write to the Windows directory. So it fails.

I slightly changed the base class so that when a full path is omitted, the INI file is stored in the user profile LoaclAppData special directory (non-roaming version). This is a convenient place most of the time. You may always specify a full path name if you want to store it elsewhere.

Android has a “well known” place to store the preference files. We are not supposed to know where. The actual files are not available directly unless your Android device is rooted.

TIniFile constructor in the Android implementation will simple ignore any path you specify and let Android API store the file where it want it to be stored. This could cause a problem if you want to use the same file name for different files stored in different folders. This will cause trouble since the path is ignored.


Windows implementation


The windows implementation is quite trivial since it already exists in Delphi RTL. As stated above, I derived my class from Delphi existing class and only override the constructor to adjust the path when left empty.

The resulting declaration is trivial:
    TIniFile = class(System.IniFiles.TIniFile)
    public
        constructor Create(const AFileName : String);
    end;

The implementation is simple:

constructor TIniFile.Create(const AFileName: String);
var
    FileName     : String;
    Path         : array [0..1023] of Char;
    AppExeName   : array [0..1023] of Char;
    AppName      : String;
    LocalAppData : String;
begin
    if ExtractFilePath(AFileName) = '' then begin
        GetModuleFileName(0, AppExeName, Sizeof(AppExeName));
        SHGetFolderPath(0, CSIDL_LOCAL_APPDATA, 0, SHGFP_TYPE_CURRENT, @Path[0]);
        AppName        := ChangeFileExt(ExtractFileName(AppExeName), '');
        LocalAppData   := IncludeTrailingPathDelimiter(Path) +
                           CompanyFolder + '\' + AppName + '\';
        FileName       := LocalAppData + AFileName;
        ForceDirectories(LocalAppData);
    end
    else
        FileName := AFileName;

    inherited Create(FileName);
end;

This implementation makes use of SHgetFolderPath API function to get the special directory “LocalAppData” located in each user profile. I used ForceDirectories to create the directory if it does not already exist.

You may want to change the location by changing the constant CSIDL_LOCAL_APPDATA to another one (There is a bunch of such constant, see the API documentation or Delphi source code if you have an edition which includes it).

You may also want to change the string constant “CompanyFolder” to your actual company name instead of OverByte which is my company name.

Using the demo application named “IniFileDemo”, running under Win7, the INI files without path will be stored in “C:\Users\\AppData\Local\OverByte\IniFileDemo”.


Android implementation


Android implementation makes use of SharedPreferences API which is already defined by Delphi runtime library. You handle that API using an interface named “JSharedPreferences” which is located in Androidapi.JNI.GraphicsContentViewText.

We need to implement most of the TIniFile methods. We can skip the read/write for other data types than string because they are all based on the read/write string.

The class declaration looks like this:


    TIniFile = class(System.IniFiles.TCustomIniFile)
    private
        FPrefs : JSharedPreferences;
        function InitPrefs : JSharedPreferences;
        function Key(const Section, Ident : String) : JString;
        procedure ReadSectionKeysValues(const Section : String;
                                        const KeyOnly : Boolean;
                                        Strings       : TStrings);
    public
        constructor Create(const FileName: String);
        function  ReadString(const Section, Ident, Default: String): String; override;
        procedure WriteString(const Section, Ident, Value: String); override;
        procedure ReadSection(const Section: String; Strings: TStrings); override;
        procedure ReadSections(Strings: TStrings); override;
        procedure ReadSectionValues(const Section: String; Strings: TStrings); override;
        procedure DeleteKey(const Section, Ident: String); override;
        procedure EraseSection(const Section: string); override;
        procedure UpdateFile; override;
    end;

The class TIniFile derives from existing TCustomIniFile. I used the fully qualified class name to avoid confusion (Here it is not strictly necessary since we do not redefine TCustomIniFile).

All the public methods are those required to make TIniFile work as it does under Windows. Private members are required as helpers for the implementation. As their visibility implies, you will never directly use them.

All methods need to get hand on a JSharedPreferences interface. That is why I created a member variable FPrefs to store it and an InitPrefs method to initialize it.

Once you get FPrefs, you may use it to fetch a value. look at ReadString implementation:

function TIniFile.ReadString(const Section, Ident, Default: String): String;
begin
    InitPrefs;
    Result := JStringToString(FPrefs.GetString(Key(Section, Ident),
                                               StringToJString(Default)));
end;

FPrefs.GetString is themethod use to retrieve (read) a stored value given his key. Here, as explained above, we implement the concept of section, so the key is really constructed using the section name and the identifier used outside of the class as key.

JStringToString and StringToJString are support functions to marshal back and forth a Delphi string to a Java string (Remember Android API is written in Java).

ReadSection, ReadSections and ReadSectionValues all require to enumerate all keys are save values in a string list for some of the keys if they match a condition. Iterating all the keys is a common process so I moved it to a specialized private method ReadSectionKeysValues.

Here is the implementation:

procedure TIniFile.ReadSectionKeysValues(
    const Section : String;  // Section to read, or empty for keys and values
    const KeyOnly : Boolean;
    Strings       : TStrings);
var
    AMap     : JMap;
    ASet     : JSet;
    AIter    : JIterator;
    AObj     : JObject;
    AString  : JString;
    DString  : String;
    ASection : String;
    AIdent   : String;
    I, J     : Integer;
begin
    if not Assigned(Strings) then
        Exit;
    InitPrefs;
    Strings.Clear;
    AMap  := FPrefs.GetAll;
    if not Assigned(AMap) then
        Exit;
    ASet  := AMap.entrySet;
    if not Assigned(ASet) then
        Exit;
    AIter := ASet.iterator;
    Strings.BeginUpdate;
    while AIter.hasNext do begin
        AObj    := AIter.next;
        AString := AObj.toString;
        DString := JStringToString(AString);
        // We get "[Section]_Ident"
        if (Length(DString) > 3) and (DString[Low(DString)] = '[') then begin
            I := Pos(']', DString);
            if I > 0 then begin
                ASection := Copy(DString, 2, I - 2);
                if Section = '' then begin
                    // We are reading section names
                    if Strings.IndexOf(ASection) < 0 then
                        Strings.Add(ASection);
                end
                else if SameText(Section, ASection) then begin
                    // We are reading the key names (Ident)
                    if KeyOnly then
                        J := PosEx('=', DString)
                    else
                        J := Length(DString) + 1;
                    if J > 0 then begin
                        AIdent := Copy(DString, I + 2, J - I - 2);
                        Strings.Add(AIdent);
                    end;
                end;
            end;
        end;
    end;
    Strings.EndUpdate;
end;

SharedPreferences Android API make use of string collection returned by getAll method to store all the preferences values. It is a generic Java class which can be accessed using a JMap interface which is available to Delphi program. Accessing the individual strings is 4 steps process:
1) Get the JMap interface by calling getAll
2) Get the JSet interface on behalf f the JMap
3) Get the JIterator on behalf og the JSet
4) Iterate with the JIterator to get hand of all object in the collection
The objects are here JStrings we can convert to Delphi string and process them.

The enumerated strings looks like this: “[Section1]_Key1=Value1”. We can then easily parse the string to extract the parts and do whatever we need with it.

The rest of the class implementation is quite trivial.


Full source code

The source code as well as a demo application is available from my website at
http://www.overbyte.be/frame_index.html?redirTo=/blog_source_code.html

FMX.Overbyte.IniFiles.pas

unit FMX.Overbyte.IniFiles;
{$DEFINE OVERBYTE_INCLUDE_MODE}
{$IFDEF ANDROID}
    {$I FMX.Overbyte.Android.IniFiles.pas}
{$ENDIF}
{$IFDEF MSWINDOWS}
    {$I FMX.Overbyte.Windows.IniFiles.pas}
{$ENDIF}
FMX.Overbyte.Windows.IniFiles.pas
{$IFNDEF OVERBYTE_INCLUDE_MODE}
unit FMX.Overbyte.Windows.IniFiles;
{$ENDIF}

interface

uses
    System.SysUtils, System.Classes, System.IniFiles,
    WinApi.Windows,
    WinApi.ShlObj;

const
    CompanyFolder = 'OverByte';

type
    // We are enhancing Embarcadero implementation
    TIniFile = class(System.IniFiles.TIniFile)
    public
        constructor Create(const AFileName : String);
    end;

implementation

{ TIniFile }

constructor TIniFile.Create(const AFileName: String);
var
    FileName     : String;
    Path         : array [0..1023] of Char;
    AppExeName   : array [0..1023] of Char;
    AppName      : String;
    LocalAppData : String;
begin
    // When the path is empty, Windows use Windows directory (C:\windows). This
    // is bad since Win7 which requires special permission to write to this
    // directory.
    // This implementation redirect the INI file to the user profile, that is
    // \Local Settings\Application Data (non roaming)
    // If you really want to write to Windows directory, then you must
    // specify that path name specifically.
    if ExtractFilePath(AFileName) = '' then begin
        GetModuleFileName(0, AppExeName, Sizeof(AppExeName));
        SHGetFolderPath(0, CSIDL_LOCAL_APPDATA, 0, SHGFP_TYPE_CURRENT, @Path[0]);
        AppName        := ChangeFileExt(ExtractFileName(AppExeName), '');
        LocalAppData   := IncludeTrailingPathDelimiter(Path) +
                           CompanyFolder + '\' + AppName + '\';
        FileName       := LocalAppData + AFileName;
        ForceDirectories(LocalAppData);
    end
    else
        FileName := AFileName;

    inherited Create(FileName);
end;

end.

FMX.Overbyte.Android.IniFiles.pas

{$IFNDEF OVERBYTE_INCLUDE_MODE}
unit FMX.Overbyte.Android.IniFiles;
{$ENDIF}

interface

uses
    System.SysUtils, System.Classes, System.IniFiles, System.StrUtils,
    FMX.Helpers.Android,
    Androidapi.NativeActivity,
    Androidapi.JNI,
    Androidapi.JNI.App,
    Androidapi.JNI.GraphicsContentViewText,
    Androidapi.JNI.JavaTypes;

type
    TIniFile = class(System.IniFiles.TCustomIniFile)
    private
        FPrefs : JSharedPreferences;
        function InitPrefs : JSharedPreferences;
        function Key(const Section, Ident : String) : JString;
        procedure ReadSectionKeysValues(const Section : String;
                                        const KeyOnly : Boolean;
                                        Strings       : TStrings);
    public
        constructor Create(const FileName: String);
        function  ReadString(const Section, Ident, Default: String): String; override;
        procedure WriteString(const Section, Ident, Value: String); override;
        procedure ReadSection(const Section: String; Strings: TStrings); override;
        procedure ReadSections(Strings: TStrings); override;
        procedure ReadSectionValues(const Section: String; Strings: TStrings); override;
        procedure DeleteKey(const Section, Ident: String); override;
        procedure EraseSection(const Section: string); override;
        procedure UpdateFile; override;
    end;

implementation

{ TIniFile }

constructor TIniFile.Create(const FileName: String);
begin
    // Under Android, just ignore the path part because Android has a well
    // known place to store preferences files
    inherited Create(ExtractFileName(FileName));
end;

procedure TIniFile.DeleteKey(const Section, Ident: String);
var
    Edit  : JSharedPreferences_Editor;
begin
    InitPrefs;
    Edit := FPrefs.Edit;
    Edit.Remove(Key(Section, Ident));
    Edit.Apply;
end;

procedure TIniFile.EraseSection(const Section: String);
var
    Idents : TStringList;
    Edit  : JSharedPreferences_Editor;
    I     : Integer;
begin
    Idents := TStringList.Create;
    ReadSectionKeysValues(Section, TRUE, Idents);
    InitPrefs;
    Edit := FPrefs.Edit;
    for I := 0 to Idents.Count - 1 do
        Edit.Remove(Key(Section, Idents[I]));
    Edit.Apply;
end;

function TIniFile.InitPrefs : JSharedPreferences;
begin
    if not Assigned(FPrefs) then
        FPrefs := SharedActivityContext.getSharedPreferences(
                      StringToJString(FileName),
                      TJActivity.JavaClass.MODE_PRIVATE);
    Result := FPrefs;
end;

function TIniFile.Key(const Section, Ident: String): JString;
begin
    Result := StringToJString('[' + Section + ']_' + Ident);
end;

procedure TIniFile.ReadSection(const Section: String; Strings: TStrings);
begin
    if Section = '' then begin
        if Assigned(Strings) then
            Strings.Clear;
    end
    else
        ReadSectionKeysValues(Section, TRUE, Strings);
end;

procedure TIniFile.ReadSections(Strings: TStrings);
begin
    ReadSectionKeysValues('', FALSE, Strings);
end;

procedure TIniFile.ReadSectionKeysValues(
    const Section : String;  // Section to read, or empty for keys and values
    const KeyOnly : Boolean;
    Strings       : TStrings);
var
    AMap     : JMap;
    ASet     : JSet;
    AIter    : JIterator;
    AObj     : JObject;
    AString  : JString;
    DString  : String;
    ASection : String;
    AIdent   : String;
    I, J     : Integer;
begin
    if not Assigned(Strings) then
        Exit;
    InitPrefs;
    Strings.Clear;
    AMap  := FPrefs.GetAll;
    if not Assigned(AMap) then
        Exit;
    ASet  := AMap.entrySet;
    if not Assigned(ASet) then
        Exit;
    AIter := ASet.iterator;
    Strings.BeginUpdate;
    while AIter.hasNext do begin
        AObj    := AIter.next;
        AString := AObj.toString;
        DString := JStringToString(AString);
        // We get "[Section]_Ident"
        if (Length(DString) > 3) and (DString[Low(DString)] = '[') then begin
            I := Pos(']', DString);
            if I > 0 then begin
                ASection := Copy(DString, 2, I - 2);
                if Section = '' then begin
                    // We are reading section names
                    if Strings.IndexOf(ASection) < 0 then
                        Strings.Add(ASection);
                end
                else if SameText(Section, ASection) then begin
                    // We are reading the key names (Ident)
                    if KeyOnly then
                        J := PosEx('=', DString)
                    else
                        J := Length(DString) + 1;
                    if J > 0 then begin
                        AIdent := Copy(DString, I + 2, J - I - 2);
                        Strings.Add(AIdent);
                    end;
                end;
            end;
        end;
    end;
    Strings.EndUpdate;
end;

procedure TIniFile.ReadSectionValues(const Section: String; Strings: TStrings);
begin
    if Section = '' then
        Strings.Clear
    else
        ReadSectionKeysValues(Section, FALSE, Strings);
end;

function TIniFile.ReadString(const Section, Ident, Default: String): String;
begin
    InitPrefs;
    Result := JStringToString(FPrefs.GetString(Key(Section, Ident),
                                               StringToJString(Default)));
end;

procedure TIniFile.UpdateFile;
begin
    // Nothing to do
end;

procedure TIniFile.WriteString(const Section, Ident, Value: String);
var
    Edit  : JSharedPreferences_Editor;
begin
    InitPrefs;
    Edit := FPrefs.Edit;
    Edit.PutString(Key(Section, Ident), StringToJString(Value));
    Edit.Apply;
end;

end.


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

December 18, 2013

Mandelbrot Explorer for Android and Windows

Using Delphi XE5, I rewrote my Mandelbrot fractal explorer with the FireMonkey component framework. The result is a working application for Android and Windows. To generate Windows or Android version, it is enough to just change the target operating system. Nice cross-platform application!
 
On the picture below, you see the Windows version running on my desktop and the Android version running on my Nexus 7 device.
 

The source code is making use of what I described in two previous articles:
http://francois-piette.blogspot.be/2013/12/firemonkey-android-windows-and.html
http://francois-piette.blogspot.be/2013/12/mandelbrot-fractal-explorer.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

December 17, 2013

Coding in Delphi ebook

Coding in Delphi ebook by Nick Hodges.

Available to registered users of Delphi XE5, RAD Studio XE5, and Embarcadero All-Access XE. This promotional item is available as a special promotion through December 31, 2013.

There is also a Google+ community: https://plus.google.com/communities/110978417023349293804

You can download it from http://cc.embarcadero.com/Item/29670

December 9, 2013

Practical Parallel Computing

Parallel computing is a form of computation in which many calculations are carried out simultaneously. This is almost the only way of taking full power of today’s computers.

CPU have reached the point where it is not possible to increase the frequency of operation. The only way to increase computation power is to multiply the CPU. Either fully using multi-CPU computer, or partially using multi-core and hyper threading.

Most of today’s PC are equipped with 4 cores CPU. High end workstations have multiple CPU each with multiple cores and even hyper threading. For example, my own computer is a HP Z600 workstation having two Intel Xeon processors each one having 4 cores and hyper threading. Using Windows task manager, you actually see 16 processors.

Not an easy task


To benefit from multi cores computers, you must write programs so that the problem is divided into smaller ones which are then executed in parallel.

Not all problems can be divided in smaller ones for parallel execution. Numerical computation is one domain where parallelism is often possible. In this article, I will show the programming for a heavy computing problem: exploring the Mandelbrot set. Mandelbrot set is well known. It is mostly shown as a beautiful colorful picture which may take a very long time to compute. Using parallel computing will result in a high performance gain provided you run on a modern computer.

Parallel computer programs are more difficult to write than sequential ones, because concurrency introduces several new classes of potential software bugs.

The most common concurrency problem is when one task writes some shared data which is read by another task. If nothing special is done, then the reader may read partial data! The writer starts writing following data while the reader has not finished reading previous data. This kind of bug is difficult to find because it does not always occur. It depends on how one task runs compared to other task. This is referred as a race condition. Most of the time, it works because the reading and writing are occurring at different times. Sometimes it does not work because reading and writing overlaps.

Multithreading


Multithreading is the way you write parallel programs using traditional languages such as C/C++, Delphi or C# running on traditional (PC) computers. Other languages or other hardware architecture exists, but this is beyond of this article which is related to PC programming.

A thread is an execution path managed by an operating system. Multiple threads are executed simultaneously by a processor when the processor has multiple cores. With a single core processor, you still have multithreading, but they are executed one after the other. Execution switches quickly between each thread, making the human eye see all executing in parallel. They are really executed in parallel with multi core CPU or when multiple CPU are available.

It is the operating system and the language run time that take care of the required housekeeping. As seen from the programming language, a thread looks mostly like a simple function call (or an object’s method call when using an object oriented language). The difference with a normal function call is that when using multithreading, the function returns immediately while the function’s code is executed in parallel with the caller’s code.

Synchronization


To avoid messing everything, the work accomplished by different threads has to be synchronized.

For example, data cannot be read while it is being written by another thread. Several threads can simultaneously read the same data, but when one is writing data, it must be the only one accessing the data.

Another example is computing. Adding a value to a variable must be executed by a thread having exclusive access to that data. This is, at another level, the same issue as we find in multiple user database application. In such application, we use a “record lock” so that a record can be read, some computation done and then written back in an atomic operation. That is, no other user can have access to the data while the first reads-computes-writes.

The very same problem exists with multithreading. Simply the data is not in a database but in memory. Every single variable has to be protected from simultaneous reading and writing. And some operations, such as adding a variable to another one must be done atomically. And by the way, if multiple threads are doing database access, we have to use the exact same “record lock” as we do for a multiple user application.

A last example: frequently, when a problem is divided in multiple parts for parallel execution, something must be done at one point in time to be sure that all parts are done before continuing. Imagine you use parallel processing to create a dataset in memory. You must wait until all threads are done before writing the result to the file.

Operating system and language runtime provide many synchronization mechanisms. For example: critical section, semaphore, mutex, queues and others.

Introduction to Mandelbrot set


Benoît Mandelbrot, who died on 10/14/2010, was a famous mathematician. He studied fractal geometry. He found that chaos can emerge from a very simple equation:

This equation is iteration where c is a constant. We start from a first value X0 and compute X1 using the formula. Using X1 we then compute X2 and so on. This is no fun but easy. Where it becomes interesting is when we do this calculation using complex numbers and when we look what happens after a lot of iterations. Depending on the constant c, we can see that the Xn value increases quickly or not. Sometimes, the value change but never become very large. Even if computing a lot of iterations, we cannot decide whether the value will become very large.

Complex numbers can be represented by two numbers forming the coordinates X and Y on a plane. This is exactly what we use to draw a colorful representation of the Mandelbrot set. Each pixel on the image is one value of the constant c in the iteration above. The color of each pixel is given by the number of iterations computed so that the Xn value becomes large. The number of iterations is limited to a maximum. If the maximum is reached, the pixel is colored in a specific color, usually black or white. The result looks like this:



Using Delphi, the code to compute the value of a given point is as follow:

function ComputeMandelPoint(P, Q : Extended; MaxIter : Integer) : Integer;
var
    X0, Y0, X, Y : Extended;
    R, M         : Extended;
    K            : Integer;
begin
    M  := 100;
    K  := 0;
    X0 := 0;
    Y0 := 0;

    while TRUE do begin
        X  := X0 * X0 - Y0 * Y0 + p;
        Y  := 2.0 * X0 * Y0 + q;
        K  := K + 1;

        R := X * X + Y * Y;
        if R > M then
            break
        else if K >= MaxIter then begin
            K := MaxIter + 1;
            break;
        end;
        X0 := X;
        Y0 := Y;
    end;
    Result := K;
end;

In this code, P and Q are the coordinates of one point in the complex plane. The image is computed for P in the range [-2.4 … 1.0] and Q in the range [-1.3 … 1.3] and a maximum number of iterations of 1000. Coloring is done using a continuous palette composed of 48 shades of blue like this:


Since the value of each pixel is 0 to the maximum number of iteration, the palette is used cyclically. An offset of 25 is given so that the white limit is positioned nicely.

The code here above implements the formula we saw earlier. The code layout may looks strange. It has been done like that for speed optimization.

Building an image from the Mandelbrot set


The image showed above is quite easy to obtain. Here is the set of operations
1. Create a bitmap of a given resolution (1024 x 768 pixel for example)
2. Associate each bitmap pixel to the couple P, Q according to the area you want to display. In the image above, X on the bitmap (0..1023) is mapped to P = [-2.4 … 1.0] and Y on the bitmap (0..767) is mapped to Q = [-1.3 … 1.3].
3. Iterate all X, Y on the bitmap to compute the value of the pixel as a number of iterations.
4. Map the pixel value in iteration to the color value according to the color palette you like.

Mapping bitmap pixel to Mandelbrot set point


The process of step 2 above is named “mapping”. In math language, it is a simple coordinate transformation from one coordinate system (bitmap) to another one (Mandelbrot set).

Graphically, we can represent a graphic with one system on the abscissa (horizontal axis) and on the ordinate (vertical axis) we have the other system:



We can express the slope of the line as seen from X, X1, Y, Y1 and from X2, X1, Y2, Y1 which are obviously the same:

We can rewrite this equation to have the Y value based on all others:


Let’s say we want to transform the X coordinate on a bitmap to the equivalent Y coordinate in the Mandelbrot set. For example, on the bitmap shown above we go from pixel 0 to pixel 1023 and on the Mandelbrot set we go from -2.4 on the left to 1.0 on the right. This gives:

X1 = 0, X2 = 1023, Y1 = -2.4, Y2 = 1.0

Now applying our equation, given an arbitrary pixel coordinate X, we can compute the equivalent value in the Mandelbrot set:

Mandel := -2.4 + (Bitmap – 0) * (1.0 - -2.4) / (1023 – 0)

Note that (Y2 – Y1) / (X2 – X1) which is the slope of the line in the above diagram is frequently named zoom factor.

We can do similar computation for the pixel coordinate Y, using the same zoom factor so that the image is not distorted.

If we put all this in a simple Delphi program, we will get the following code:

procedure TMandelSimpleForm.FormShow(Sender: TObject);
var
    Bitmap : TBitmap;
    X, Y   : Integer;
    P, Q   : Extended;
    V      : Integer;
    Slope  : Extended;
    Colors : array of TColor;
    T0     : Cardinal;
const
    MandelLeft   = -2.4;
    MandelRight  = 1.0;
    MandelBottom = -1.3;
    MaxIter      = 1000;
begin
    SetLength(Colors, 11);
    Colors[ 0] := RGB( 47,  47, 255);
    Colors[ 1] := RGB( 21,  21, 255);
    Colors[ 2] := RGB(  0,   0, 255);
    Colors[ 3] := RGB(255, 255, 255);
    Colors[ 4] := RGB(229, 229, 255);
    Colors[ 5] := RGB(203, 203, 255);
    Colors[ 6] := RGB(177, 177, 255);
    Colors[ 7] := RGB(151, 151, 255);
    Colors[ 8] := RGB(125, 125, 255);
    Colors[ 9] := RGB( 99,  99, 255);
    Colors[10] := RGB( 73,  73, 255);

    Bitmap             := TBitmap.Create;
    Bitmap.PixelFormat := TPixelFormat.pf24bit;
    Bitmap.Width       := Image1.Width;
    Bitmap.Height      := Image1.Height;

    Slope := (MandelRight - MandelLeft) / (Bitmap.Width - 1);

    T0 := GetTickCount;
    for Y := 0 to Bitmap.Height - 1 do begin
        for X := 0 to Bitmap.Width - 1 do begin
            P := MandelLeft   + X * Slope;
            Q := MandelBottom + Y * Slope;
            V := ComputeMandelPoint(P, Q, MaxIter);
            Bitmap.Canvas.Pixels[X, Y] := Colors[V mod Length(Colors)];
        end;
    end;
    Image1.Picture.Bitmap := Bitmap;
    T0 := GetTickCount - T0;
    Bitmap.Free;
    ShowMessage('Computed in ' + IntToStr(T0) + ' mS');
end;

This code is really complete. We don’t need more to have a nice Mandelbrot set shown on screen. To create the application, use the following steps:
  • Create a new VCL forms application
  • Enlarge the form so that a 1024x768 bitmap will fit
  • Drop a TImage on the form, make it 1024x768
  • Add the code above to the form’s OnShow even.
  • Save, compile and run.
On my computer, it takes 4400 mS to build the bitmap. The parallel computing version will run in 690 mS for the same bitmap. This is a 6 fold improvement. It deserves the effort. Those numbers are for a Win32 application. When rebuilt as a Win64 application, times are divided by 2.

Parallel computing of a Mandelbrot set


Overview of required steps:
  • Create a large bitmap to hold the full final image of the Mandelbrot set
  • Divide the total area into a lot of smaller areas
  • Start a number threads giving each one area to compute
  • When a thread finishes his area, submit the area for “painting” and give a new area, if any remains
  • When there is no more area to give to a thread, terminate the thread
  • When all threads are terminated, all areas are computed.
  • Since painting is incredibly faster than computing, short after the last thread finishes, the last area is painted and the full bit map is ready

Dividing Mandelbrot set computation in smaller chunks is easy: divide the bitmap into areas and delegate the computing for those areas to a number of threads.

In my Mandelbrot Explorer, I divided the bitmap as 128x128 pixel areas. If the image size is not a multiple of 128x128, then some areas are smaller and may even be a single pixel.

The areas are described by a class instance with all required parameters. All areas are kept in an object list.

Then a number of threads are created, for example 10 threads, and kept in an object list. Each thread receives one area to process. When it has finished processing the assigned area, the next available area is given to the thread. If no more area is available, the thread is terminated, removed from the list and freed.

Each thread computes the number of iterations for each pixel. Coloring is done by the main thread after computation is done. This is interesting because you can change color mapping without computing again. Coloring is quite fast: on my machine, it is almost instantaneous.

Submitting an area for coloring is done using a custom message posted to the message queue. We need to use that technique because submission is executed in the thread’s context and we want the main thread to do the coloring. Using custom messages is an easy way of inter-thread communication.

The code


The class describing each area is as follow:

TMandelArea = class
public
    Rect     : TGPRect;           // Area rectangle in full bitmap
    PixValue : array of Integer;  // Computed pixel value
    Zoom     : Extended;          // To compute (P, Q) from bitmap coord
    XOffset  : Extended;          // To compute (P, Q) from bitmap coord
    YOffset  : Extended;          // To compute (P, Q) from bitmap coord
    Colors   : TList;     // The list of colors for coloring
    MaxIter  : Integer;           // Max iterations when computing
    Index    : Integer;           // Index in areas list
    procedure Compute;            // Compte all pixels in area
    // Colorize the pixel in the area and draw the area into full bitmap
    procedure Colorize(FullBitmap  : IGPBitmap;
                       ColorInside : TColor;
                       ColorDiv    : Integer;
                       ColorOff    : Integer);
end;


TMandelArea is a very simple class. It has all the fields with parameters we talked about and two methods. One for computing the pixel values and one for colorize the pixels and transfer the result in the full bitmap.

What I named “FullBitmap” is an interface coming from GDI+. Windows GDI+ is a class-based API that provides two-dimensional vector graphics, imaging, and typography. It is faster than Windows GDI API which is used by Delphi runtime.

TMandelArea.Compute is quite trivial. It looks much like the method we have seen above in the simple Mandelbrot application. Here it is:

procedure TMandelArea.Compute;
var
    X, Y       : Integer;
    P, Q       : Extended;
    Index      : Integer;
begin
    SetLength(PixValue, Rect.Width * Rect.Height);
    Index := 0;
    for Y := 0 to Rect.Height - 1 do begin
        Q := (Y + Rect.Y) / Zoom + YOffset;
        for X := 0 to Rect.Width - 1 do begin
            P := (X + Rect.X) / Zoom + XOffset;
            PixValue[Index] := ComputeMandelPoint(P, Q, MaxIter);
            Inc(Index);
        end;
    end;
end;

Basically, the method just iterates thru all pixels in the area, transforms the coordinates from bitmap system to Mandelbrot set system and calls the function we have seen above to compute the pixel value. That value is stored in an array of integer. PixValue array is dimensioned before computing.

Computation has nothing to do with creating the result bitmap and coloring its pixels. The resulting bitmap, which will be shown on screen and saved to disk as JPEG, is created before anything else. I use a GDI+ bitmap which is handled thru in interface.

The programmer can access the data of a GDI+ bitmap. For that, it has to call “LockBits” which returns a record having among other things the pointer to actual bitmap data. For better performance, the lines of a bitmap data is always aligned to memory locations. See how Row is calculated below to see how to handle that.

Bitmap data is organized as RGB value, that is 3 bytes for red, green and blue components of each pixel color. In Delphi, a TColor is simply an integer value with the 3 bytes. This is why you see code like: Row^ := Byte(ColorValue shr 16) to extract one of the bytes and copy it to the bitmap memory.

procedure TMandelArea.Colorize(
    FullBitmap  : IGPBitmap;
    ColorInside : TColor;
    ColorDiv    : Integer;
    ColorOff    : Integer);
var
    BitmapData : TGPBitmapData;
    X, Y       : Integer;
    Row        : PByte;
    ColorValue : TColor;
    PixIndex   : Integer;
begin
    BitmapData := FullBitmap.LockBits(Rect, [ImageLockModeWrite],
                                      FullBitmap.PixelFormat);
    PixIndex := 0;
    for Y := 0 to Rect.Height - 1 do begin
        Row := PByte(BitmapData.Scan0) + (Y * BitmapData.Stride);
        for X := 0 to Rect.Width - 1 do begin
            ColorValue := ColorMandelPoint(PixValue[PixIndex],
                                           MaxIter,
                                           ColorInside,
                                           FALSE, 0,
                                           TRUE,
                                           ColorDiv,
                                           ColorOff,
                                           Colors);
            Row^ := Byte(ColorValue shr 16);
            Inc(Row);
            Row^ := Byte(ColorValue shr 8);
            Inc(Row);
            Row^ := Byte(ColorValue);
            Inc(Row);
            Inc(PixIndex);
        end;
    end;
    FullBitmap.UnlockBits(BitmapData);
end;


The thread class:

TMandelThread = class(TThread)
strict private
    FArea       : TMandelArea;
    FNewArea    : TMandelArea;
    FOnComputed : TComputedEvent;
public
    procedure Execute; override;
    property Area       : TMandelArea    read  FArea
                                         write FArea;
    property OnComputed : TComputedEvent read  FOnComputed
                                         write FOnComputed;
end;

implementation

procedure TMandelThread.Execute;
begin
    while Assigned(FArea) do begin
        FArea.Compute;
        FNewArea := nil;
        if Assigned(FOnComputed) then
            FOnComputed(Self, FArea, FNewArea);
        FArea := FNewArea;
    end;
end;

This thread class is incredibly straightforward. It has a single property “Area” which is the area to be computed, a single event “OnComputed” to be called when computation is done and one method “Execute” which is the thread’s entry point.

Execute method is a loop calling Compute method on behalf of the area to be computed and then trigger the OnComputed event to request the next area to compute. The event passes the current computed area (which will be submitted for coloring) and receives, as a var parameter, the new area to compute. If no new area is available, it receives a nil value and the thread terminates the loop.

The main code


The main code must create all the areas, all the threads, allocate areas to threads, colorize areas when computed by each thread and render the result on screen optionally saving it to a jpeg file.

Of course the main code also handles the user interface. I built a nice user interface to help the user explore the Mandelbrot set. I will not describe it here because it is just simple and easy user interface programming.

I will just show and describe the user interface:



The tool bar has edit fields to select the bitmap size, the maximum number of iteration, the number of threads to use for computation and color divisor and offset for coloring.

The buttons are to start computing, navigate to previous position, navigate to the next position, show the full Mandelbrot set, change the color palette, save the bitmap to disk file, change the inside color, zoom in and zoom out.

Using the mouse, the user may draw a rectangular area which is then computed. A double click anywhere on the bitmap recomputes a new bitmap centered on the double click point.

On the status bar, you see the time required computing the displayed image, the zoom factor, the coordinates of the image center and the cursor position coordinates with number of iterations at that point.

When the window is resized, the bitmap is as well. The screen always shows the complete bitmap, even if you select a very large bitmap.

If you load a new color palette, the bitmap is colored without computing again. This is almost instantaneous, even on large bitmaps.

The most interesting parts of the code are the method “MandelCreateImage” and the two event handlers for the thread.

procedure TMandelbrotExplorerForm.MandelCreateImage;
var
    Graphics  : IGPGraphics;
    Area      : TMandelArea;
    X, Y      : Cardinal;
    I         : Integer;
    NewThread : TMandelThread;
begin
    // Just do nothing if already terminating
    if FTerminate then
        Exit;

    // We cannot create a new image if threads are still computing
    // We set a flag so that no new area are given to thread and
    // defer processing until all threads are done
    if FThread.Count > 0 then begin
        FTerminate := TRUE;
        PostMessage(Handle, WM_TERMINATING, 0, 0);
        Exit;
    end;

    // Get parameters from user interface, use existing if invalid values
    FMaxIter         := StrToIntDef(MaxIterEdit.Text,  FMaxIter);
    FMandelWidth     := StrToIntDef(WidthEdit.Text,    FMandelWidth);
    FMandelHeight    := StrToIntDef(HeightEdit.Text,   FMandelHeight);
    FThreadCount     := StrToIntDef(ThreadsEdit.Text,  FThreadCount);

    // Validate all parameters
    if FMaxIter < 1 then
        FMaxIter := 1;
    if FMandelWidth < 1 then
        FMandelWidth := 1;
    if FMandelHeight < 1 then
        FMandelHeight := 1;
    if FThreadCount < 1 then
        FThreadCount := 1;

    // Send values back to user interface to replace invalid values
    MaxIterEdit.Text  := IntToStr(FMaxIter);
    WidthEdit.Text    := IntToStr(FMandelWidth);
    HeightEdit.Text   := IntToStr(FMandelHeight);
    ThreadsEdit.Text  := IntToStr(FThreadCount);

    FXOffset          := FCenter.X - (FMandelWidth div 2) / FZoom;
    FYOffset          := FCenter.Y - (FMandelHeight div 2) / FZoom;

    FFullBitmap       := TGPBitmap.Create(FMandelWidth, FMandelHeight,
                                          PixelFormat24bppRGB);
    FBackBrush        := TGPSolidBrush.Create(
                                 TGPColor.Create(GetRValue(clSilver),
                                                 GetGValue(clSilver),
                                                 GetBValue(clSilver)));
    Graphics          := TGPGraphics.FromImage(FFullBitmap);
    Graphics.FillRectangle(FBackBrush,
                           0, 0,
                           FFullBitmap.Width, FFullBitmap.Height);
    // Divide the image into AreaSize x AreaSize pixels
    FAreas.Clear;
    Y := 0;
    while Y < FFullBitmap.Height do begin
        X := 0;
        while X < FFullBitmap.Width do begin
            Area             := TMandelArea.Create;
            Area.Index       := FAreas.Add(Area);
            Area.Colors      := FColors;
            Area.MaxIter     := FMaxIter;
            Area.Zoom        := FZoom;
            Area.XOffset     := FXOffset;
            Area.YOffset     := FYOffset;
            Area.Rect.X      := X;
            Area.Rect.Y      := Y;
            Area.Rect.Width  := Min(AREA_SIZE, FFullBitmap.Width - X);
            Area.Rect.Height := Min(AREA_SIZE, FFullBitmap.Height - Y);
            // Make last rectangle on row or column has correct size
            if (Area.Rect.X + Area.Rect.Width) >= Integer(FFullBitmap.Width) then
                 Area.Rect.Width := Integer(FFullBitmap.Width) - Area.Rect.X;
            if (Area.Rect.Y + Area.Rect.Height) >= Integer(FFullBitmap.Height) then
                 Area.Rect.Height := Integer(FFullBitmap.Height) - Area.Rect.Y;
            Inc(X, AREA_SIZE);
        end;
        Inc(Y, AREA_SIZE);
    end;

    // Create all threads, but don't start them
    // Thread cannot be started because it would interfere with area allocation
    FAreaIndex := 0;
    for I := 1 to FThreadCount do begin
        NewThread                 := TMandelThread.Create(TRUE);
        NewThread.Area            := FAreas[FAreaIndex];
        NewThread.OnComputed      := MandelThreadComputed;
        NewThread.OnTerminate     := MandelThreadTerminate;
        NewThread.FreeOnTerminate := TRUE;
        FThread.Add(NewThread);
        Inc(FAreaIndex);
        if FAreaIndex >= FAreas.Count then
            break;
    end;

    // Set the counter pf to be colorized areas
    FColorizeCount := FAreas.Count;

    // Now start all thread, in reverse order. Reverse order is required
    // because threads may terminate and be removed from list, messing the
    // indexing.
    FStartTime := GetTickCount;
    for I := FThread.Count - 1 downto 0 do
        FThread[I].Start;
end;


// Warning: this is called in the context of the threads
procedure TMandelbrotExplorerForm.MandelThreadComputed(
    Sender        : TObject;
    const CurArea : TMandelArea;
    var   NewArea : TMandelArea);
begin
    if FTerminate then
        Exit;
    // We must pass the index instead of the pointer because the message
    // handling can be done much later when the area has been reallocated
    PostMessage(Handle, WM_COLORIZE, 0, CurArea.Index);
    FCritSect.Enter;
    if FAreaIndex < FAreas.Count then begin
        NewArea := FAreas[FAreaIndex];
        Inc(FAreaIndex);
    end;
    FCritSect.Leave;
end;


procedure TMandelbrotExplorerForm.MandelThreadTerminate(Sender : TObject);
begin
    // Simply remove the terminated thread from the thread list.
    FThread.Remove(Sender as TMandelThread);
end;

The FCritSect variable is very important. This is one of the synchronization mechanisms I talked above. A critical section works like this: only one thread at a time can execute the “Enter” method. Once the “Enter” method has been executed by a thread, any other thread calling “Enter” is made sleeping. When the “Leave” method is called, one and only one of the sleeping threads is awaken and continue execution. When this thread executes the “Leave” method, another thread is awaken and so forth.

A critical section MUST be used here because we increment FAreaIndex and use it to get the next area for the thread calling MandeThreadComputed.

Another part of the code requires some explanation. A flag “FTerminate” is used to signal the user wants to terminate the current computing. It is set my MandelCreateImage itself when called before all threads are done.

Since we cannot stop the thread immediately (It takes some time to stop a thread), we use another custom message WM_TERMINATING. The message handler will check if all thread are done. If not, it sleeps 0.25 sec and then post the message again. If all threads are done, it calls MandelCreateImage which will start a new image creation.

Here the message handler code:

procedure TMandelbrotExplorerForm.WMTerminating(var Msg: TMessage);
var
    TmpMsg : TMsg;
begin
    if FThread.Count <= 0 then begin
        // No more threads are computing.
        // Remove any WM_COLORIZE from message queue
        while PeekMessage(TmpMsg, Handle, WM_COLORIZE, WM_COLORIZE, 1) do;
        FTerminate := FALSE;
        MandelCreateImage;
    end
    else begin
        Sleep(250);
        PostMessage(Handle, WM_TERMINATING, 0, 0);
    end;
end;

The final word

I hope you enjoyed reading this article. All in all, the code is fairly simple. Actually the code for the user interface is longer!

If you are interested by the source code (Delphi XE5), just drop me a private email.

References:

Parallel computing: http://en.wikipedia.org/wiki/Parallel_computing
Multithreading: http://en.wikipedia.org/wiki/Multithreading_(software)#Multithreading
Synchronization objects: http://msdn.microsoft.com/en-us/library/windows/desktop/ms686364(v=vs.85).aspx
Mandelbrot set: http://en.wikipedia.org/wiki/Mandelbrot_set
GDI+: http://msdn.microsoft.com/en-us/library/windows/desktop/ms533798(v=vs.85).aspx
GDI+ for Delphi : http://www.bilsen.com/gdiplus


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