ICS updated for Delphi XE6

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

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


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

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

End of Windows XP. Modernize your applications.

You've probably seen the news that Microsoft is ending support for Windows XP on April 8^th of this year. It is time to update your old applications to work with the new generation of modern operating systems.

There is an upcoming webminar by Marco Cantù on Mernizing Delphi and C++Builder Windows applications: http://forms.embarcadero.com/ModernWindowsApps3-19






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

Persistent form with F11 to fullscreen

This article shows how to create a persistent form having the ability to go real full screen. A persistent form is one which remember his size and position. Real full screen means the form use all the available screen area without having border nor title bar.

The form goes to full screen using the F11 key, just like Internet Explorer does. Of course a menu item or other UI gadget may be used for that purpose as well.

All in all, it is not much difficult to do. The code I will show you below make use of the followings items:

1. Form position and size: each form has Top, Left, Width and Height properties. BoundsRect property is a TRect with those values.
2. Form state: each form can be maximized, minimized or in normal state.
3. Form full screen: The form simply has the size of the desktop work area and no border nor title bar. My code use the kind of border as a flag for full screen.
4. Monitor: A form can be completely on a monitor or partially on one monitor or another monitor.
5. Screen: a screen is made of all available monitors. There are some TScreen methods helping located the monitor where a given window (ie. a form) is located.
6. Desktop area: the desktop area is made of all monitors areas. The main monitor also has the task bar on one of its size, reducing the available work area.
7. IniFile: My code use a classic INI file to store data when the application quits so that it can be reloaded with it is restarted.
8. Special shell folder: Windows Explorer has a number of well known folders. My code use "Local AppData" folder to store the INI file. This way each user has a private INI file.
9. Key preview: the keyboard actions are directed to the control having the focus. A form has a property KeyPreview which make the keyboard events (KeyDown and the likes) to be triggered on behalf of the form before being triggered on behalf of the control having focus. This way a form can override the action associated with any key. My code trap F11 to toggle full screen mode.

I won't explain all the details of the demo application because it is quite simple. Don't hesitate to use the comment section of this article to ask for your question regarding my code.

The application is a simple VCL form application having a single form. The form source code is in FullScreenMain.pas, the project is FullScreen.dpr. I used Delphi XE5 but the code should works with most Delphi versions.

FullScreenMain.pas

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

Author:       François PIETTE
              http://francois-piette@blogspot.be
Creation:     Mar 01, 2014
Description:  Persitent position and size form having the ability to go
              full screen using F11 (Like IE) or popup menu.
Version:      1.00
History:


 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit FullScreenMain;

interface

uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics,
    Controls, Forms, Dialogs, ShlObj, IniFiles, Menus, ComCtrls, StdCtrls;

const
    CompanyFolder        = 'OverByte';

type
    TFullScreenMainForm = class(TForm)
        MainMenu1: TMainMenu;
        FileMainMenu: TMenuItem;
        QuitMainMenu: TMenuItem;
        ViewMainMenu: TMenuItem;
        FullScreenMainMenu: TMenuItem;
        StatusBar1: TStatusBar;
        Button1: TButton;
        procedure FullScreenMainMenuClick(Sender: TObject);
        procedure QuitMainMenuClick(Sender: TObject);
        procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    private
    protected
        FLocalAppData           : String;
        FAppName                : String;
        FIniFileName            : String;
        FInitialized            : Boolean;
        FIniSection             : String;
        FIniSectionData         : String;
        FNormalBounds           : TRect;
        procedure DoShow; override;
        procedure DoClose(var Action: TCloseAction); override;
        procedure SetFullScreen(Value : Boolean);
    public
        constructor Create(AOwner : TComponent); override;
        property IniFileName            : String     read  FIniFileName
                                                     write FIniFileName;
        property IniSection             : String     read  FIniSection
                                                     write FIniSection;
        property IniSectionData         : String     read  FIniSectionData
                                                     write FIniSectionData;
        property LocalAppData           : String     read  FLocalAppData
                                                     write FLocalAppData;
        property AppName                : String     read  FAppName
                                                     write FAppName;
    end;

var
    FullScreenMainForm : TFullScreenMainForm;

implementation

{$R *.dfm}

const
    SectionWindow      = 'WindowMain';   // Must be unique for each window
    SectionData        = 'Data';
    KeyFullScreen      = 'FullScreen';
    KeyWindowState     = 'WindowState';
    KeyTop             = 'Top';
    KeyLeft            = 'Left';
    KeyWidth           = 'Width';
    KeyHeight          = 'Height';

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

{ TFullScreenMainForm }

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor TFullScreenMainForm.Create(AOwner: TComponent);
var
    Path : array [0..MAX_PATH] of Char;
begin
    SHGetFolderPath(0, CSIDL_LOCAL_APPDATA, 0, SHGFP_TYPE_CURRENT, @Path[0]);
    FIniSection     := SectionWindow;
    FIniSectionData := SectionData;
    FAppName        := ChangeFileExt(ExtractFileName(Application.ExeName), '');
    FLocalAppData   := IncludeTrailingPathDelimiter(Path) +
                       CompanyFolder + '\' + FAppName + '\';
    FIniFileName    := FLocalAppData + FAppName + '.ini';
    KeyPreview      := TRUE;   // We need this to see F11 key whatever the
                               // control having focus
    inherited Create(AOwner);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFullScreenMainForm.DoShow;
var
    IniFile      : TIniFile;
    I            : Integer;
    AFullScreen  : Boolean;
    AWindowState : TWindowState;
begin
    if not FInitialized then begin
        FInitialized := TRUE;

        ForceDirectories(ExtractFilePath(FIniFileName));
        IniFile := TIniFile.Create(FIniFileName);
        try
            AFullScreen  := IniFile.ReadBool(FIniSection, KeyFullScreen, FALSE);
            AWindowState := TWindowState(IniFile.ReadInteger(
                              FIniSection, KeyWindowState, Ord(WindowState)));

            Width  := IniFile.ReadInteger(FIniSection, KeyWidth,  Width);
            Height := IniFile.ReadInteger(FIniSection, KeyHeight, Height);
            Top    := IniFile.ReadInteger(FIniSection, KeyTop,
                                          (Screen.Height - Height) div 2);
            Left   := IniFile.ReadInteger(FIniSection, KeyLeft,
                                          (Screen.Width  - Width)  div 2);
        finally
            IniFile.Destroy;
        end;

        // Check if form is on an existing monitor
        I := 0;
        while I < Screen.MonitorCount do begin
            if (Top >= Screen.Monitors[I].Top) and
               (Top <= (Screen.Monitors[I].Top +
                             Screen.Monitors[I].Height)) and
               (Left >= Screen.Monitors[I].Left) and
               (Left <= (Screen.Monitors[I].Left +
                              Screen.Monitors[I].Width)) then
                break;
            Inc(I);
        end;
        if I >= Screen.MonitorCount then begin
            // Form is outside of any monitor. Move to center of main monitor
            Top  := (Screen.Height - Height) div 2;
            Left := (Screen.Width  - Width)  div 2;
        end;
        // Save form's bounds so that it is restored after full screen
        FNormalBounds := BoundsRect;

        // Restore window state as saved at previous exit time, except if it
        // was minimized (Usually user don't like to have their application
        // to start minimized)
        if (AWindowState <> wsMinimized) and (AWindowState <> WindowState) then
            WindowState := AWindowState;

        // Restore full screen mode as saved at previous exit time
        if AFullScreen then
            SetFullScreen(AFullScreen);
    end;
    inherited DoShow;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFullScreenMainForm.DoClose(var Action: TCloseAction);
var
    IniFile      : TIniFile;
    AFullScreen  : Boolean;
    AWindowState : TWindowState;
begin
    try
        IniFile := TIniFile.Create(FIniFileName);
        try
            // Save full screen mode flag for next startup
            AFullScreen := BorderStyle <> bsSizeable;
            if AFullScreen then
                SetFullScreen(FALSE);
            IniFile.WriteBool(FIniSection,    KeyFullScreen, AFullScreen);

            // Save current windows state for next startup
            AWindowState := WindowState;
            IniFile.WriteInteger(FIniSection, KeyWindowState, Ord(AWindowState));

            // Save current form's position and size
            // We need to set the window to normal mode to get correct position
            // and size
            if WindowState <> wsNormal then
                WindowState := wsNormal;
            IniFile.WriteInteger(FIniSection, KeyTop,    Top);
            IniFile.WriteInteger(FIniSection, KeyLeft,   Left);
            IniFile.WriteInteger(FIniSection, KeyWidth,  Width);
            IniFile.WriteInteger(FIniSection, KeyHeight, Height);
        finally
            IniFile.Destroy;
        end;
    except
        // Ignore any exception when saving window size and position
    end;
    inherited DoClose(Action);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFullScreenMainForm.SetFullScreen(Value : Boolean);
begin
    if Value then begin
        // Save form's bounds so that it is restored after full screen
        FNormalBounds := BoundsRect;
        // Remove form's border
        BorderStyle   := bsNone;
        // Set form's size and position to the entire monitor's workarea
        BoundsRect    := Screen.MonitorFromWindow(Handle).WorkareaRect;
    end
    else begin
        // Select normal border for the form
        BorderStyle   := bsSizeable;
        // Restore form's size and position as it was before full screen
        BoundsRect    := FNormalBounds;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFullScreenMainForm.FormKeyDown(
    Sender  : TObject;
    var Key : Word;
    Shift   : TShiftState);
begin
    if (Key = VK_F11) and (Shift = []) then begin
        Key := 0;                       // Signal we have handled the key
        SetFullScreen(BorderStyle = bsSizeable);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFullScreenMainForm.FullScreenMainMenuClick(Sender: TObject);
begin
    SetFullScreen(BorderStyle = bsSizeable);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFullScreenMainForm.QuitMainMenuClick(Sender: TObject);
begin
    Close;
end;


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

end.

FullScreenMain.dfm

object FullScreenMainForm: TFullScreenMainForm
  Left = 2111
  Top = 115
  Caption = 'Full Screen Demo'
  ClientHeight = 395
  ClientWidth = 510
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  Menu = MainMenu1
  OldCreateOrder = False
  OnKeyDown = FormKeyDown
  DesignSize = (
    510
    395)
  PixelsPerInch = 96
  TextHeight = 13
  object StatusBar1: TStatusBar
    Left = 0
    Top = 376
    Width = 510
    Height = 19
    Panels = <
      item
        Text = 'Here is the status bar'
        Width = 50
      end>
  end
  object Button1: TButton
    Left = 392
    Top = 345
    Width = 115
    Height = 25
    Anchors = [akRight, akBottom]
    Caption = 'Bottom Right button'
    TabOrder = 1
  end
  object MainMenu1: TMainMenu
    Left = 112
    Top = 64
    object FileMainMenu: TMenuItem
      Caption = '&File'
      object QuitMainMenu: TMenuItem
        Caption = '&Quit'
        OnClick = QuitMainMenuClick
      end
    end
    object ViewMainMenu: TMenuItem
      Caption = '&View'
      object FullScreenMainMenu: TMenuItem
        Caption = '&FullScreen'
        OnClick = FullScreenMainMenuClick
      end
    end
  end
end

FullScreen.dpr

program FullScreen;

uses
  Forms,
  FullScreenMain in 'FullScreenMain.pas' {FullScreenMainForm};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TFullScreenMainForm, FullScreenMainForm);
  Application.Run;
end.

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

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

Coding in Delphi

Coding in Delphi is a new programming book by Nick Hodges that covers a variety of powerful Delphi programming features and techniques including Generics, Interfaces, Exception, Handling, Anonymous Methods, Collections, RTTI, Enumerators, Attributes, Dependency Injection and Unit Testing.

Available on paper from here.



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

HowTo: Create a DCR file for your Delphi component

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

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

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

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

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

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

TDemoComponent BITMAP "DemoComponent.bmp"

Then we run BRCC32 with the following command line:

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

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

{$R 'SimpleComponent.dcr'}

Usually you add this line right after the existing line

{$R *.res}

Summary of required files:

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

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

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


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

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

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

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

3D animation with FireMonkey

Paul Toth, a well known Delphi Developer rewrote his CubeMan3D with FireMonkey, making it a cross platform application. The application shows an animated man made of 3D cubes. The man walk in place and turn on himself.

Actually, each cube is a standard FireMonkey TRoundCude 3D component. They are all linked together to form the body and members. The animation is made with a TFloatAnimation for each cube.

It is amazing how short the code is. The code is just the implementation for the AnimationFinish event for the leg. The event handler simply reverse the direction and restart.

The code source is available from here.

Paul Toth is a freelance Certified Delphi Developer. If you need some help with Delphi, feels free to contact him.



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

New blog about Delphi FireMonkey

There is a new blog talking mostly about Delphi FireMonkey on the mobile platform (iOS and Android). The blog also covers other topics, mostly related to FireMonkey and the various supported platforms.

This new blog is named FMXexpress.

Actually, this blog is collecting blog articles from everywhere, display a short abstract and redirect to the original blog article. This is a place to visit on a regular basis.  Click here to visit the blog. There is also a corresponding FaceBook page.

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

Delphi XE5 hotfix 4: reFInd updated

Embarcadero published hotfix #4 for Delphi XE5 and C++ Builder XE5. This hotfix is an update for the command line tool "reFInd".

If you don't know reFInd, it is a tool to help migrating code to Delphi XE5. It is a kind of search and replace on files using Perl RegEx expressions. For example, you can migrate BDE toFireDAC.

Documentation on reFInd can be found here.
The hotfix is availabe for download here.


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

TIniFile for Windows and Android (Source code)

I made available a zip file with the full source code for my TIniFile class compatible with both Windows and Android. You need Delphi XE5 to compile it for Android and a reasonably recent Delphi to compile it for Windows.

You can read the article on my blog. This article explain how it works.
You can download the source code here.


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

Programming Android and iOS Devices and Gadgets

Our modern world is full of programmable and interactive devices.

Delphi and C++Builder can be used to work with these devices and gadgets in innovative ways and extend your apps in ways you never may have imagined.

Devices are platforms that can load and execute your program directly, such as an iPhone, Android phone, tablet or even Google Glass. A gadget on the other hand is something your program interacts with, like 3D input, a brain-computer interface, or a flying drone.

Embarcadero will show this in a webminar. See details at http://edn.embarcadero.com/article/43573

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

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

What programming languages have you used this year?

There is a website which maintain a voting system about which language has been used in 2013. The presentation is very nice.

Of course, you should vote for your favourite language (I hope it is Delphi).

To vote you need a Tweeter account. Send a tweet using the hashtag #code2013 and then the language you vote for.

You can see the result, updated every 10 minutes at http://code2013.herokuapp.com/



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