The Google+ Delphi Developers Community has reached 3300 members, as well as 800+ members in the Delphi iOS & Android Community. The Delphi Component Directory  also carries posts about component updates. FYI, there is a C++Builder Developers group as well, where Brett Wilton is primus motor

In case you have withdrawal symptoms from the EMBT official forums, you know where to find us ;)

Please note that the Delphi groups are strictly for development related discussions, and that if you have a need to vent about prices, EMBT, policies, or other non-technical issues, you should post in this group instead.

Welcome to the Delphi iOS & Android Developers Community on Google+!

The Google+ Delphi Developers Community sprung another sibling!
Feel free to join up with the Delphi iOS & Android Developers Community.

The Delphi Developers Community is a relatively whine free place to discuss our programming challenges, and has just passed 2200 members, and our new iOS and Android offspring focuses on the finer details of getting the most out of the FireMonkey mobile platform - already have 125 people participating.

Then there is the growing Delphi Component Directory, where a steady flow of posts are highlighting the good stuff we may need to solve our challenges.

There even is a place to vent your anger with Delphi and Embarcadero without detracting focus from solving programming issues. If you need to rant and rage - people are all ears in Unit Number 5.

Android Application Events

There are a few differences between a Windows App and an Android App that puzzled me initially. Why doesn't my application get FocusChanged Activate/Deactivate or Close when switching between or terminating apps on Android?

In this post I also test out Google+'s new support for embedding G+ posts in blogs and web pages.

Delphi Developers on G+ has passed 1500 members

With Blogger's ability to +mention people, and now also sharing the blog comments on Google+, I'd say that you would have a hard time finding something that can beat it the Google+/Blogger combo for impact. Perhaps this can reignite the Delphi blogosphere, as it has never been so easy to create content and reach a targeted audience.

So, why don't you put on your writer's hat, write about your Delphi experience, and share it with us at the Delphi Developers Community?

Compile time ordered vectors

I would like to have support for ordering content of a constant array at compile time.

I would like to have optimized lookup function for such an ordered constant array (binary search, hash index, etc, - whatever fits the purpose) to check if a variable has a match in the ordered constant array. The code generator could inline the lookup function if so was desired.

I guess you can say that I am looking for something like the "in" keyword for sets, but extended to work with any constant array (string, array of enumerable, array of number, or array of other constants such as class type references).

A specification syntax could look something like:
  <arraytype> = {ordered {ascending | descending}} Vector<T>

Implicit methods associated with the type:
  Vector<T>.Contains(const element: T):Boolean;
  Vector<T>.ContainsAny(const array of T):Boolean;
  Vector<T>.ContainsAll(const array of T):Boolean;
  Vector<T>.Include(const element: T);
  Vector<T>.Exclude(const element: T);

Example declaration:
type
  TMyType = ordered ascending Vector<Char>;
const
  InvalidChars : TMyType = ['\', ':', '.', '(', ')']; // I don't want to worry about order here

Example of use:
  if InvalidChars.Contains(SomeCharacter) then ...

Today, I can create singleton objects that are ordered as part of the initialization code, but it becomes a lot of micro management code which isn't optimized for call performance, instead of easy to use code like "element in set" style code.

A Windows 8 / Win RT Application in Delphi!

Thom Gerdes @ Embarcadero just posted about his first Delphi / XAML application for Windows 8 and WinRT on Google+. https://plus.google.com/101466385048851863100/posts/26z7Pk9Hipo Blatant plug: If you have not signed up for Google+ yet, you should!

Forms and Data Entry Validation - Part 1

This is not an article about LiveBinding. I was once hoping it was going to be, but instead it has become an alternative to LiveBinding. If anything, it is about compile-time binding and quality assuring the data input from of your users.

Forms, forms, forms...

How many forms have you created?  Chance is - quite a few - and what do they have in common?   If people type rubbish, your data becomes rubbish.  So - what do you do?  You validate the input to prevent rubbish getting into the system.  You do... don't you? Sure you do!

When do you validate it?  When someone clicks Submit or OK?  Right - then you have to go through the input, field by field, and first ensure that what the user typed in actually is understandable in the current context - such as no funny characters in an integer - and sometimes you have to check  the values against each other for logical states. If someone said they took three melons, their combined weight should at least be bigger than zero, and blue shirts don't go well with pink pants, and what else not.

If the user typed in rubbish - you have to inform him or her so that it can be corrected.

Been there, done that

There is a certain amount of logic in this scene that we keep recreating scaffolding for.  Stuffing things into listboxes, formatting and filling in the values, validation of numbers and dates, converting enumerated types into strings (and back again). If you want the dialog to be slick - you might even want to validate as you go, which means eventhandlers for focus changes, keys pressed, UI items clicked, dropped down and selected, also adding to all the scaffolding code.

Some time ago, I had to create yet another dialog.  Lines and lines of housekeeping code that surround the real validation logic.  And naturally I don't have to be clearvoyant to foresee numerous more such dialogs, as it is a major part of writing applications that deal with configuration, input and control.

So - I thought to myself - can I spend a little time now, and save a lot of time later?  Dangerous, innit, thinking like that...  suddenly you could find yourself writing a framework, and we all know what happens to frameworks, right?  They turn to endless amounts of code written with good intentions of handling the unexpected, covering functionality you won't ever need, and at some point collapse on themselves to become a black hole of sketchily documented (since noone updated the docs as new features got added) , and hastily changed (since you always are in a hurry for that extra functionality) code.  And when someone else misread your framework intentions and applied it like a hammer to a screw - it just doesn't end well.

Narrowing down the scope

Hence - Sticking with the KISS principle, I have decided to try to make it independent of other libraries, and limit what I implement to basic functionality while attempting to allow for future expansion.

I am going to create a TInput<T> that wraps a GUI control.  To put it simply - a TInput that points to a specific TEdit, and takes care of stuffing values from the variable and into the GUI control, and vice versa.  The job of that TInput<T> is the present the value correctly, and to ensure that what ever is written into that TEdit, can be converted into an integer.

I will also create a TInputList that is a collection of TInput<T>s, that will have the job of going through the list to fill the controls, to validate the contents, and finally - if all input is syntactically correct - semantically validate the input for logical correctness.

Some of the code that I will present here, is probably centric to the type of data that I work on.  For me, an input form will  typically wrap an object with a set of properties that reflect a row or set of related rows in a database.  Why am I not using data aware controls?  Mostly because the applications we create actually can't write to the database themselves, except through calling stored procedures that perform more magic before, during, or after the data has been written.  For that reason, the TInputList will be a TInputList<T>, and the TInputList<T> will have a property Current:T that I can populate, and each TInput<T> will know that it is member of a TInputList<T>, so that it can kick of the necessary actions for stuff to get validated.

[kom-pli-kei-tid]

By now you have probably thought to yourself: TEdit?  What about the other controls?

Because there are a number of input types, and a number of controls, and these make a number of combinations. TEdit/Double, TEdit/Integer, TEdit/String, and TEdit/Enum is already a list, and I haven't even mentioned TComboBox yet,- so it is obvious that TInputList<T> has to be polymorphic.

This brings us to the first part of complicated - creating a set of generic and polymorphic classes.  Generics in Delphi XE still don't to well with forward declarations, and to create polymorphic parent/children lists, it really helps to be able to forward declare.

After some consideration, I have chosen to use an abstract class without generics as my inner base class.  TAbstractInput will know nothing about the data type we want to work with, nor will it know anything about the control type.  All TAbstractInput will do, is define the virtual abstract methods that will be our type agnostic operators or verbs and queries, if you like.  Hence, our TInputList will use TAbstractInput as its element type.

/// <summary> TAbstractInput defines the bare minimum base class for our list of inputs <summary>
  TAbstractInput = class abstract
  private
  protected
    function GetEdited: Boolean; virtual; abstract;
    procedure SetEdited(const Value: Boolean); virtual; abstract;
    function GetEnabled: Boolean; virtual; abstract;
    procedure SetEnabled(const Value: Boolean); virtual; abstract;
    function ControlValueIsValid:Boolean; virtual; abstract;
    function VariableValueIsValid:Boolean; virtual; abstract;
    procedure FillControl; virtual; abstract;
    procedure FillVariable; virtual; abstract;
    procedure SetDisabledState; virtual; abstract;
    procedure SetErrorState; virtual; abstract;
    procedure SetNormalState; virtual; abstract;
    procedure SaveNormalState; virtual; abstract;
    procedure Setup; virtual; abstract;
  public
    procedure Clear; virtual; abstract;
    procedure Update; virtual; abstract;
    function Validate: Boolean; virtual; abstract;
    property Edited: Boolean read GetEdited write SetEdited;
    property Enabled: Boolean read GetEnabled write SetEnabled;
  end;

From the outside of the list, we need TInput<T> that expose the correct type that we want to access, so that will be our outer base class type - which knows how to set and get the value, and hence the class that we use to reference an input field.

/// <summary> TInput<T> defines the input wrapper as we want it to be
  /// visible from the outside of our list of controls</summary>
  TInput<T> = class abstract(TAbstractInput)
  private
    FOnCanGetValue: TGetValue<Boolean>;
    procedure SetOnCanGetValue(const Value: TGetValue<Boolean>);
  protected
    function GetValue:T; virtual; abstract;
    procedure SetValue(const Value:T); virtual; abstract;
    function CanGetValue:Boolean; virtual; abstract;
  public
    property Value:T read GetValue write SetValue;
    property OnCanGetValue: TGetValue<Boolean> read FOnCanGetValue write SetOnCanGetValue;
  end;

Please note that this is a simplified view of TInput<T> class.

Inside TInputList, I will subclass TInput<T> again, and add knowledge of the controls.  In fact, I will create several subclasses that handle type conversions for each data type and control type, but instead of having the user instantiate all these different class types - I will add factory methods to the TInputList instead.

Here are some excerpts from the declaration of TInputList and the basic control wrapper.

/// <summary> TInputList is a wrapper for all our input controls. </summary>
  TInputList<IT:class, constructor> = class(TList<TAbstractInput>)
  ... 
  public
    type
      /// <summary> This is our core input control wrapper on which we base wrappers for specific controls </summary>
      TInputControl<TCtrl:class; SVT, CVT> = class(TInput<SVT>)
      private
        FController: TInputList<IT>;
        FControl: TCtrl;
        FValue: SVT;
        ...  
      end;
  end;

Properties and Binding

This is the second part of complicated. Will I be using the XE2 LiveBinding? No. IMO, LiveBinding uses the least desirable method to bind a property for setting and getting. I lamented this in my previous article, Finding yourself in a property bind. In my opinion, LiveBinding is a good idea that is implemented in the wrong way, and in it's current form will be vulnerable to property and variable name changes during refactoring. In addition, it appears that LiveBinding is not quite mature yet. Then there is the fact that XE and older, doesn't have LiveBinding.

After some experimentation, I came to the conclusion that even if it appears to be more elegant to use visitors or observers and RTTI binding, I will get more flexibility, readability, and maintainability by using anonymous methods.

Anonymous methods allow me to do manipulation of the value before it is set/get, and allow the setter/getter events to have side effects. It also ensures that all references are validated compile-time. It will not guarantee protection from referencing the wrong properties and variables, but they will at least be of the right type, and actually exist.

Since my primary development platform is Windows, I am a VCL developer - and when I started this little project, I had only VCL in mind. However, as the code matured, I found that I might want to be able to use this for FireMonkey as well. That still remains to be seen as FireMonkey still smell of Baboon.

Still, the core logic is platform agnostic, and the VCL bits are separated into a unit of their own.

Here is an excerpt from the VCL implementation with complete declarations.

TInputListVCL<IT:class, constructor> = class(TInputList<IT>)
  public
    type
      TInputControlVCL<TCtrl:TWinControl; SVT, CVT> = class(TInputList<IT>.TInputControl<TCtrl, SVT, CVT>)
      protected
        procedure ControlEnable(const aState:Boolean); override;
        function ControlEnabled:Boolean; override;
        procedure ControlSetFocus(const aFocused:Boolean); override;
      end;

      /// <summary> Basic wrapper for a TEdit </summary>
      TEditTemplate<SVT> = class abstract(TInputControlVCL<TEdit, SVT, String>)
      private
        FNormalColor: TColor;
      protected
        procedure SetControlValue(const Control:TEdit; const v:String); override;
        function GetControlValue(const Control:TEdit): String; override;
        function ControlValueAsString:String; override;
        procedure SetErrorState; override;
        procedure SetNormalState; override;
        procedure SaveNormalState; override;
        procedure SetDisabledState; override;
      public
        procedure Clear; override;
        procedure Setup; override;
      end;

      /// <summary> TEdit wrapper for editing a string </summary>
      TEditString = class(TEditTemplate<String>)
      protected
        function ConvertControlToVariable(const cv: String; var v:String; var ErrMsg:String):Boolean; override;
        function ConvertVariableToControl(const v:String; var cv:String):Boolean; override;
      end;

      /// <summary> TEdit wrapper for editing a float </summary>
      TEditDouble = class(TEditTemplate<Double>)
      private
        FDecimals: Integer;
      protected
        procedure SetDecimals(const Value: Integer); override;
        function GetDecimals:Integer; override;
        function ConvertControlToVariable(const cv: String; var v:Double; var ErrMsg:String):Boolean; override;
        function ConvertVariableToControl(const v:Double; var cv:String):Boolean; override;
      end;

      ...

  end;

Putting it to use

This will be covered in part 2. Until then, don't forget to try out RAD Studio XE2 and join the RAD Studio World Tour presentations!

RAD Studio XE2 is RTM

The wait is over. If you have bought XE with Software Assurance, your SA Upgrade notice will be arriving shortly. If you want to try it out NOW, you can already download the 30-day trial editions.

Delphi XE2 Architect 30-day trial:
https://downloads.embarcadero.com/free/delphi

RAD Studio XE2 Architect 30-day trial:
https://downloads.embarcadero.com/free/rad_studio

Please note that the trial editions does not contain the command line compiler and VCL source code, as well as some third party offerings. You may want to install the trial editions in a VM, just as a precaution.

Until you got it installed, you might find pleasure in reading about the new release here: http://docs.embarcadero.com/products/rad_studio/, and perhaps in particular this section: What's new in Delphi and C++Builder XE2.

This is a major release, with a lot of new features, so should you stumble upon a problem during your trial - please report any issues you find at http://qc.embarcadero.com

While you are at it, you should also sign up for the RAD Studio XE2 World Tour event near you.

In the Nordic countries:

• Göteborg, 20. September
• Stockholm, 21. September
• København, 21. September
• Oslo, 22. September
• Kolding, 4. Oktober

Edit: Just had to add Andreano Lanusse's XE2 ad image:

RAD Studio XE2 - VCL and FireMonkey (FMX) first glance comparison

Published with permission from Embarcadero.

When you start out a new simplistic GUI project in VCL or FireMonkey (FMX) in XE2, you will notice a few differences from older Delphi versions. XE2 introduce consistent use of unit scope prefixes. The Windows related units are grouped under the Winapi prefix, and the VCL units under VCL. FireMonkey has been given the short prefix FMX.

As you can see - the basic generated skeleton code is quite similar between the two frameworks.
Apart from referring different framework units, the resource include statement is also different: "*.dfm" vs "*.fmx".

The skeleton code

unit MainUnitVCL;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs;

type
  TFormVCL = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormVCL: TFormVCL;

implementation

{$R *.dfm}

end.

This is a FireMonkey HD project.

unit MainUnitFM;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs;

type
  TFormFM = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormFM: TFormFM;

implementation

{$R *.fmx}

end.

The designer

The designers are fairly similar between the frameworks, but there are differences.
The good old VCL

The new FireMonkey designer:

If you are wondering what's up with the drab grey look, you can relax. This is the designer look, not the run time look. FMX adopts to the theme of the OS it is running on - so it will look like a Windows app on Windows, and as a OSX app on OSX.

The form properties

Let's take a quick look at the properties of the standard form.

We are clearly not in Kansas anymore. FMX is a completely different framework, and it has been designed with cross platform in mind, unlike VCL which was designed to wrap Windows controls. This means we can look forward to learning new tricks, which some of us will view as a plus, while others will sigh and mutter something about things being better before.

Porting a project from VCL to FMX is more work than recreating the form in the FMX designer, hooking up the new event handlers, and pasting in code from the VCL project.

I added some standard controls to both forms.

Design time

VCL

FMX

Run time

VCL

FMX

Source code

VCL

unit MainUnitVCL;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TFormVCL = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Label1: TLabel;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormVCL: TFormVCL;

implementation

{$R *.dfm}

procedure TFormVCL.Button1Click(Sender: TObject);
begin
  Memo1.Lines.Add(Edit1.Text);
  Label1.Caption := IntToStr(Memo1.Lines.Count);
end;

end.

FMX

unit MainUnitFM;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Edit, FMX.Layouts,
  FMX.Memo;

type
  TFormFM = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Label1: TLabel;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormFM: TFormFM;

implementation

{$R *.fmx}

procedure TFormFM.Button1Click(Sender: TObject);
begin
  Memo1.Lines.Add(Edit1.Text);
  Label1.Text := IntToStr(Memo1.Lines.Count);
end;

end.

As you can see - although similar in many ways - there are many differences between VCL and FMX. One example: TLabel.Caption is no more. TLabel.Text is the correct property under FMX.

Then there is the glaring fact that FMX HD will build for OSX as well as both 32 and 64-bit Windows :) Alas - since I don't have a Mac, I can't show you the OSX version.

How do the form resources look?

VCL

object FormVCL: TFormVCL
  Left = 0
  Top = 0
  Caption = 'FormVCL'
  ClientHeight = 337
  ClientWidth = 635
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 8
    Top = 8
    Width = 31
    Height = 13
    Caption = 'Label1'
  end
  object Button1: TButton
    Left = 536
    Top = 294
    Width = 75
    Height = 25
    Caption = 'Button1'
    Default = True
    TabOrder = 0
    OnClick = Button1Click
  end
  object Memo1: TMemo
    Left = 8
    Top = 24
    Width = 498
    Height = 265
    Lines.Strings = (
      'Memo1')
    TabOrder = 1
  end
  object Edit1: TEdit
    Left = 8
    Top = 296
    Width = 498
    Height = 21
    TabOrder = 2
    Text = 'Edit1'
  end
end

FMX

object FormFM: TFormFM
  BiDiMode = bdLeftToRight
  Caption = 'FormFM'
  ClientHeight = 400
  ClientWidth = 600
  Left = 0
  Top = 0
  Transparency = False
  Visible = False
  StyleLookup = 'backgroundstyle'
  object Button1: TButton
    Position.Point = '(496,363)'
    Width = 80.000000000000000000
    Height = 22.000000000000000000
    OnClick = Button1Click
    TabOrder = 1
    StaysPressed = False
    IsPressed = False
    Text = 'Button1'
    Default = True
  end
  object Memo1: TMemo
    Position.Point = '(8,24)'
    Width = 473.000000000000000000
    Height = 321.000000000000000000
    TabOrder = 10
    WordWrap = False
  end
  object Label1: TLabel
    Position.Point = '(8,8)'
    Width = 120.000000000000000000
    Height = 15.000000000000000000
    TabOrder = 11
    Text = 'Label1'
  end
  object Edit1: TEdit
    Position.Point = '(8,360)'
    Width = 473.000000000000000000
    Height = 22.000000000000000000
    TabOrder = 12
    ReadOnly = False
    Password = False
  end
end

FMX is made for scaling, and it also have numerous other nifty features such as rotation.

Summary

This was just a very shallow outline of some of the differences between VCL and FMX, but it is perhaps enough food for thought to make you realize that you most likely will have to put some effort into moving from VCL to FMX. In some cases, you can get away with minor adjustments, but when it comes to sophisticated GUI - or stuff that is based on Windows functions - you will need to rewrite parts of your code.

Don't forget to visit http://www.embarcadero.com/world-tour to register for the RAD Studio XE2 World Tour event near you!

RAD Studio XE2 - Breaking out of 32-bit Windows

Published with permission from Embarcadero.

The Embarcadero RAD Studio XE2 World Tour is upon us.

The features are shiny! The reviews will be rave! As a Delphi developer, your favorite toolbox is about to get a massive upgrade that you don't want to miss!

Click on the banner up top or down at the bottom of the blog to sign up for an event near you.

One of the new features is cross platform support.

On the long awaited end - your new Delphi will be able to do your old Windows 32-bit platform, and now also will compile your VCL applications to native 64-bit. Note that VCL will still be Windows Only. You may have to do a little fixing to your code, as Integer still is 32-bit but Pointer is 64-bit - so those old Pointer(Integer) casts will have to be reworked.

The most exiting feature of XE2 is that you can create GUIs for other platforms as well!
To enable this - Embarcadero nabbed the guy behind VGScene and DXScene and created FireMonkey - a whole new GUI framework that supports Windows, OSX and iOS in Delphi XE2, and that will (warning - speculation) very likely add support for other OS platforms in future versions of RAD Studio.

FireMonkey apps are cross platform - but they come in various flavors - so you still have to make a conscious choice about where to start...

Over the coming days I predict heavy blog activity with a lot to read about the new RAD Studio XE2 release, but in the mean time - make sure to sign up for the RAD Studio XE2 World Tour events!

Weird code snippet #2: Generic Double Linked List

They say Generics and pointers don't mix.

type
  PMyThing<T> = ^TMyThing<T> // [DCC Error] E2508 type parameters not allowed on this type
  TMyThing<T> = record
     Thing: T;
  end;

Ok, they don't. But there is a loophole!

type
  TMyThing<T> = record
    Thing: T;
    NextThing: ^TMyThing<T>;
  end;

Why this is allowed, I don't know. Just like I don't really understand why the first one is forbidden. There is probably some good explanation for it.

Still - it can be fun breaking the rules!

unit GenericDoubleLinkedList;

interface
uses
  Classes, Generics.Defaults;

type
  TLinkVisitor<T> = reference to procedure(const Item: T);

  TDoubleLinked<T> = record
    Value: T;
    PrevLink: ^TDoubleLinked<T>; // Hey, it compiles!
    NextLink: ^TDoubleLinked<T>;
    constructor Create(aValue:T);
    function Add(aValue:T): TDoubleLinked<T>;
    function HasNext:Boolean;
    function Next: TDoubleLinked<T>;
    function HasPrev:Boolean;
    function Prev: TDoubleLinked<T>;
    function First: TDoubleLinked<T>;
    function Last: TDoubleLinked<T>;
    procedure ForEach(const Proc: TLinkVisitor<T>);
  end;

  procedure Test(const Log:TStrings);

implementation

{ TDoubleLinked<T> }

constructor TDoubleLinked<T>.Create(aValue: T);
begin
  Value := aValue;
  NextLink := nil;
  PrevLink := nil;
end;

function TDoubleLinked<T>.Add(aValue: T): TDoubleLinked<T>;
var
  p: ^TDoubleLinked<T>; // But this one is not assignment compatible
begin
  p := AllocMem(SizeOf(TDoubleLinked<T>)); // Make space
  p^ := Self;      // Copy current value to allocated block
  Value := aValue; // Set self to new value
  p.NextLink := @Self;
  if Assigned(p.PrevLink) // Fix up previous nextlink
   then Pointer(p.PrevLink.NextLink) := Pointer(p);
  Pointer(PrevLink) := Pointer(p);  // Point back to old value
  Result := Self;
end;

function TDoubleLinked<T>.HasPrev: Boolean;
begin
  Result := PrevLink <> nil;
end;

function TDoubleLinked<T>.Prev: TDoubleLinked<T>;
begin
  Result := TDoubleLinked<T>(PrevLink^)
end;

function TDoubleLinked<T>.HasNext: Boolean;
begin
  Result := NextLink <> nil;
end;

function TDoubleLinked<T>.Next: TDoubleLinked<T>;
begin
  Result := TDoubleLinked<T>(NextLink^)
end;

function TDoubleLinked<T>.First: TDoubleLinked<T>;
begin
  Result := Self;
  while Result.HasPrev
   do Result := Result.Prev;
end;

function TDoubleLinked<T>.Last: TDoubleLinked<T>;
begin
  Result := Self;
  while Result.HasNext
   do Result := Result.Next;
end;

procedure TDoubleLinked<T>.ForEach(const Proc: TLinkVisitor<T>);
var
  Node: TDoubleLinked<T>;
begin
  Node := First;
  Proc(Node.Value);
  while Node.HasNext
  do begin
    Node := Node.Next;
    Proc(Node.Value);
  end;
end;

procedure Test(const Log:TStrings);
var
  List, Node : TDoubleLinked<String>;
begin
  List.Create('One');
  List.Add('Two');
  List.Add('Three');
  Node := List;  // Bad idea
  List.Add('Four');
  Node.Add('ThreeAndAHalf');

  List.ForEach(
    procedure(const Value:String)
    begin
      Log.Add('List: ' + Value)
    end);

  Node.ForEach(
    procedure(const Value:String)
    begin
      Log.Add('Node: ' + Value)
    end);
end;

end.

The problem is that "List" is not a pointer, but the tail item of the list. Hence, a Delete procedure needs to take this into consideration.

Even worse, if you add a second Node variable to point to something in the list, that reference will not be fixed up after adding 'Four', and hence it will take the tail place of the list - for both references, effectively forgetting the 'Four' item.

So, although this was somewhat entertaining, a mix of Generics and pointers probably isn't something we should make use of.

Exercise for the reader: Implement the TDoubleLinked<T>.Delete; procedure.

End question: Why are we not allowed to declare pointers to generic types?

Weird code snippet #1: Pseudobinary case statement

Curt Carpenter suggested a language addition for handing binary case logic.

That gave me this idea. Chalk it up as another weird code snippet from yours truly.

///<summary>> Convert array of booleans to a pseudobinary integer. 
///Good for up to 12 bits.</summary>
function BoolToInt(B: Array of Boolean):Integer;
var
  x : Boolean;
begin
  Result := 0;
  for x in B
  do begin
    Result := Result * 10;
    if x then Inc(Result);
  end;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  ch : Char;
begin
  ch := Lowercase(Char(Key));
  case BoolToInt([ssShift in Shift, ssCtrl in Shift, ch='a', ch='x', ch='c', ch='v']) of
    011000: SelectAll;
    010100: Cut;
    010010: Copy;
    110010: Clone;
    010001: Paste;
  end;
end;

A slightly more tongue in cheek example:

procedure SexistTestLogic(const Cute, Funny, Smart: boolean);
begin
  case BoolToInt([Cute, Funny, Smart]) of
     000: Avoid;
     001: Admire;
     010,
     011: Befriend;
     100: Tolerate;
     101: HandleWithCare;
     110: Adore;
     111: Marry;
  end;
end;

Finding yourself in a property bind

From the wishful thinking department, I would love to be able to

var  
  Src: TSomeClass;
  MyObject : TBoundObject<Boolean>;
begin
  MyObject.Bind(Src, CompilerMagic(TSomeClass.SomeBooleanProperty));
end;

instead of

var  
  Src: TSomeClass;
  MyObject : TBoundObject<TSomeClass, Boolean>;
begin
  MyObject.Bind(Src, 'SomeBooleanProperty');
end;

Why? Because the first one is resilient to property renaming.
Until I can, I am stuck with using something similar to

var
  Src: TSomeClass;
  MyObject : TBoundObject<TSomeClass, Boolean>;
begin
  MyObject.Bind(Src,
    function (const Ref:TSomeClass):Boolean // reads the bound prop
    begin
      Result = Ref.SomeBooleanProperty;
    end,
    procedure (const Ref: TSomeClass; const Value:Boolean)  // writes the bound prop
    begin
      Ref.SomeBooleanProperty := Value;
    end);
end;

which actually has some benefits - such as being able to sanitize assigned values - but is way too verbose.

I wish...

Generics, Enumerated types and ordinal values

I wish this was a solution post, but it is a frustration post. I trying to figure out how I can use Ord() to convert an enumerated type to integer or cast an integer to an enumerated type using generics type arguments?

uses
  SysUtils,
  TypInfo;

type
  TSomeEnumType = (TheFirst, TheSecond, TheThird, TheFourth);

type
  TEnumGen<TEnumType> = class
    class function Name(const Enum:TEnumType):String;
    class function Value(const Ordinal:Integer):TEnumType;
  end;

class function TEnumGen<TEnumType>.Name(const Enum: TEnumType): String;
begin
  Result := Format('%s.%s', 
    [GetTypeName(TypeInfo(TEnumType)), 
     GetEnumName(TypeInfo(TEnumType), Ord(Enum)) // <-- Bombs
    ]);
end;

class function TEnumGen<TEnumType>.Value(const Ordinal:Integer):TEnumType;
begin
  Result := TEnumType(Ordinal); // <- Bombs
end;

Unfortunately there is no "enum" delimiter that can be used to tell the compiler that Ord() and casting of integers should be allowed for generic enumerated type arguments.

Dataists: Ranking the popularity of programming languages - YALPC

Yet Another Language Popularity Contest - Web site dataists had an article in december about the popularity of programming languages, using data from StackOverflow and GitHub to measure popularity. Delphi scored high on StackOverflow, but low on GitHub - which probably reflect on the SVN support in Delphi, making SVN more popular than Git for Delphi users. Note that the scales are by rank, and not by relative number of entries.

A generic cache

Update: Eric Grange suggested a change to TStringList that speeds it up significantly and place it well in front of TCache. I will update the article to reflect this in the end of the week. See the article comments for the details.

In my previous article about a generics based case statement for strings, I commited many sins towards the Church Of Pure Pascal :)

One of them was to not check for prior art. Sergey Antonov aka 0xffff did something similar back in April 2010 (Note: two links!).

So, to make penance for my lack of purity (and have a chance to sin some more), I have tried to take the good parts of the concept and create something less ugly, and more comfortable to use.

I rewrote the generic class and named it TCache. I kept the configurable key type, and I made the lookup value configurable as well. Basically, it all ends up as a thin wrapper around a dictionary, but I quite like the simple declaration you can achieve with this approach.

Example declaration

var
  Cache : TCache<String, Integer>;
  i : Integer;
begin
  if not Assigned(Cache)
  then TCache<String, Integer>
   .Define(Cache, 0)
   ['alpha',   11]
   ['bravo',   22]
   ['charlie', 33]
   ['delta',   44]
   ['echo',    55]
   ['foxtrot', 66];

  i := Cache.Lookup('charlie');

Remember that <String, Integer> can be almost any type you like, including code (for the value part, at least).

Here is the class. Note that I also keep track of the index of the order each key/value was added. This could be removed. Also note that I still do dirty deeds, such as a dangerous cast. I guess I just suck at writing clean code ;).

unit GenericsCache;

/// Written by Lars Fosdal <lars@fosdal.com>, December 5, 2010

interface
uses
  SysUtils, Generics.Collections;

type
  TCacheEntry<T> = record
    Value: T;
    Index: Integer;
  end;

  TCache<KeyT, ValT> = class(TObjectDictionary<KeyT, TCacheEntry<ValT>>)
  private
    FCache: TCache<KeyT, ValT>;
    FDefaultValue: ValT;
    function AddValue(const Id: KeyT; const Value: ValT): TCache<KeyT, ValT>;
  protected
    function ValidateId(Id: KeyT): KeyT; virtual;
  public
    class function Define(var Cache; const aDefaultValue:ValT): TCache<KeyT, ValT>;
    function Lookup(const Id: KeyT):ValT;
    function Index(const Id: KeyT):Integer;
    property DefaultValue: ValT read FDefaultValue write FDefaultValue;
    property Values[const Id: KeyT; const Value: ValT]: TCache<KeyT, ValT> read AddValue; default;
  end;

  TCaseStringCache = class(TCache<String, String>)
    function ValidateId(Id: String): String; override;
  end;

implementation

{ TCache<KeyT, ValT> }

function TCache<KeyT, ValT>.AddValue(const Id: KeyT; const Value: ValT): TCache<KeyT, ValT>;
var
  Rec : TCacheEntry<ValT>;
begin
  Result := Self;
  Rec.Value := Value;
  Rec.Index := Count;
  Add(ValidateId(Id), Rec);
end;

class function TCache<KeyT, ValT>.Define(var Cache; const aDefaultValue: ValT): TCache<KeyT, ValT>;
begin
  Result := Create;
  Result.FCache := Result;
  Result.DefaultValue := aDefaultValue;
  TCache<KeyT, ValT>(Cache) := Result;
end;

function TCache<KeyT, ValT>.Index(const Id: KeyT): Integer;
var
  Rec : TCacheEntry<ValT>;
begin
  if TryGetValue(ValidateId(Id), Rec)
   then Result := Rec.Index
    else Result := -1;
end;

function TCache<KeyT, ValT>.Lookup(const Id: KeyT): ValT;
var
  Rec : TCacheEntry<ValT>;
begin
  if FCache.TryGetValue(ValidateId(Id), Rec)
   then Result := Rec.Value
    else Result := DefaultValue;
end;

function TCache<KeyT, ValT>.ValidateId(Id: KeyT): KeyT;
begin
  Result := Id;
end;

{ TCaseStringCache }

function TCaseStringCache.ValidateId(Id: String): String;
begin
  Result := LowerCase(Id);
end;

end.

I wrote a simple benchmark, testing different ways to use this, and also comparing it to do String2Index / Case -type lookup mechanisms as well as if/then/else, and the ugly method from my previous article. Several people suggested using a string to index / case approach. I have also used that many times. The painful part of strings to index, is that if you change the order of the strings, you also have to change the indices. TCache makes the index entirely optional, since the string is the index - if you see what I mean.

See below for the test code.

The Good, The Bad, and the Ugly.

The test uses GetTickCount and 5.000.000 iterations, for each method, repeated 10 times, with 12 strings (the numbers are consistant at 6 strings as well - except that string to index will be slightly faster) and the process priority was set to High to avoid other parts of the PC affecting the numbers. I weighted the results towards the results for the if/then/else. So Perf tells you how many times slower than if/then/else each test was.

Method	Perf	AvgRun	Comment
TStringSwitch	52.94	35340.7	The ugly was really ugly performance-wise as well.
AnsiIndexTextFunc	12.40	8277.3	String to Index, then case/anon.method is no speed demon either.
StringIndex	12.05	8041.7	Jolyon's variant is around the same speed.
AnsiIndexText	12.03	8032.6	If you remove anon.methods, the impact is not huge.
TStringList	6.94	4631.6	Using a pre-created sorted string list is nearly twice the speed of AnsiIndexText.
TCacheProc	3.70	2471.1	Cool, TCache and anon.methods are nearly twice the speed of a string list.
TCacheFunc	3.71	2475.8	No signficant difference between a procedure and function.
TCacheFuncStack	3.72	2480.5	Passing the anon.method by stack doesn't cost much either.
TCaseStringCache	3.12	2085.6	Case insensitive string to string saves some time over using anon.methods.
TCacheString	2.93	1957.9	So does eliminating the LowerCase function. TCache with string/string is 3 times slower than if/then/else, but it is 4 times faster than AnsiIndexText, and more than twice as fast as a string list.
If/then/else	1	667.6	You can't beat this. You also can't enjoy maintaining it.
LastKey	0.39	260.4	No surprise that indexed array lookups are fast. Yes, I know I am not looking up the same strings, but the cost is the same.

If you need to repeatedly do lookup by strings, you can benefit from using something like TCache. Also - for the AnsiIndexText - it does a sequential search for the match, hence if the list is long, or the later entries are more commonly used - it will degrade performancewise. Without having dissected TDictionary in detail, I would believe that it's hash table will allow TCache to remain relativly constant in performance, even if you add thousands of entries.

You could also shave off some more by eliminating the ValidateId methods.

Here is the test program (which also use the unit from my previous article).

program TestGenericsSwitch;
{$apptype Console}
uses
  ExceptionLog,
  Windows,
  Classes,
  SysUtils,
  StrUtils,
  GenericsCache in 'GenericsCache.pas',
  GenericsSwitch in 'GenericsSwitch.pas';

{$define Twelve}  // remove this to run with 6 strings

const
  {$ifndef Twelve}
  Elements = 6;
  {$else}
  Elements = 12;
  {$endif}
  TestCount = 5000000;
  Keys : Array[0..Elements] of String
   = ('alpha','bravo', 'charlie', 'delta', 'echo', 'foxtrot',
  {$ifdef Twelve}
      'golf', 'hotel', 'india', 'juliet', 'kilo', 'lima',
  {$endif}
      'what');

type
  TFunc = reference to function:String;
  TProc = reference to procedure;

function RandomKey:String;
begin
  Result := Keys[Random(Elements + 1)];
end;

function AssignTest:String;
var
  ix : Integer;
  s: String;
begin
  for ix := 0 to TestCount - 1
  do TStringSwitch.CaseOf(RandomKey)
    ['alpha', procedure begin
            s := 'Definitively any case';
          end]
    ['bravo', procedure begin
            s := 'B all you can B';
          end]
    ['charlie', procedure begin
            s := 'Checkpoint C';
          end]
    ['delta', procedure begin
            s := 'Checkpoint D';
          end]
    ['echo', procedure begin
            s := 'Checkpoint E';
          end]
    ['foxtrot', procedure begin
            s := 'Checkpoint F';
          end]
{$ifdef Twelve}
    ['golf', procedure begin
            s:= 'golf';
          end]
    ['hotel',procedure begin
            s:= 'hotel';
          end]
    ['india',procedure begin
            s:= 'india';
          end]
    ['juliet', procedure begin
            s:= 'juliet';
          end]
    ['kilo', procedure begin
            s:= 'kilo';
          end]
    ['lima', procedure begin
            s:= 'lima';
          end]
{$endif}
    .ElseCase(procedure begin
            s := 'Else what?';
          end)
    .EndCase;
  Result := s;
end;

function AssignTestIf:String;
var
  ix : Integer;
  s, t: String;
begin
  for ix := 0 to TestCount - 1 do
  begin
    t := LowerCase(RandomKey);
    if t = 'alpha' then
      s := 'Definitively any case'
    else if t = 'bravo' then
      s := 'B all you can B'
    else if t = 'charlie' then
      s := 'Checkpoint C'
    else if t = 'delta' then
      s := 'Checkpoint D'
    else if t = 'echo' then
      s := 'Checkpoint E'
    else if t = 'foxtrot' then
      s := 'Checkpoint F'
{$ifdef Twelve}
    else if t = 'golf' then
      s := 'golf'
    else if t = 'hotel' then
      s := 'hotel'
    else if t = 'india' then
      s := 'india'
    else if t = 'juliet' then
      s := 'juliet'
    else if t = 'kilo' then
      s := 'kilo'
    else if t = 'lima' then
      s := 'lima'
{$endif}
    else
      s := 'Else what?';
  end;
  Result := s;
end;

function AssignTestS2I:String;
var
  ix : Integer;
  s: String;
begin
  for ix := 0 to TestCount - 1
  do case AnsiIndexText(RandomKey, ['alpha', 'bravo', 'charlie', 'delta', 'echo', 'foxtrot'
{$ifdef Twelve}
    , 'golf', 'hotel', 'india', 'juliet', 'kilo', 'lima'
{$endif}
  ]) of
    0 : s := 'Definitively any case';
    1 : s := 'B all you can B';
    2 : s := 'Checkpoint C';
    3 : s := 'Checkpoint D';
    4 : s := 'Checkpoint E';
    5 : s := 'Checkpoint F';
{$ifdef Twelve}
    6 : s := 'golf';
    7 : s := 'hotel';
    8 : s := 'india';
    9 : s := 'juliet';
   10 : s := 'kilo';
   11 : s := 'lima';
{$endif}
   else s := 'Else what?';
  end;
  Result := s;
end;

function StringIndex(const aString: string; const aCases: array of string;
  const aCaseSensitive: Boolean): Integer;
begin
  if aCaseSensitive then
  begin
    for Result := 0 to Pred(Length(aCases)) do
      if ANSISameText(aString, aCases[Result]) then
        EXIT;
  end
  else
  begin
    for Result := 0 to Pred(Length(aCases)) do
      if ANSISameStr(aString, aCases[Result]) then
        EXIT;
  end;

  Result := -1;
end;

function AssignStringIndexFunc:String;
var
  ix : Integer;
  func : TFunc;
begin
  for ix := 0 to TestCount - 1
  do case StringIndex(RandomKey, ['alpha', 'bravo', 'charlie', 'delta', 'echo', 'foxtrot'
  {$ifdef Twelve}
    , 'golf', 'hotel', 'india', 'juliet', 'kilo', 'lima'
  {$endif}], false) of
    0 : func := function:String begin
          Result := 'Definitively any case';
        end;
    1 : func := function:String begin
          Result := 'B all you can B';
        end;
    2 : func := function:String begin
          Result := 'Checkpoint C';
        end;
    3 : func := function:String begin
          Result := 'Checkpoint D';
        end;
    4 : func := function:String begin
          Result := 'Checkpoint E';
        end;
    5 : func := function:String begin
          Result := 'Checkpoint F';
        end;
{$ifdef Twelve}
    6 : func := function:String begin
          Result:= 'golf';
        end;
    7 : func := function:String begin
          Result:= 'hotel';
        end;
    8 : func := function:String begin
          Result:= 'india';
        end;
    9 : func := function:String begin
          Result:= 'juliet';
        end;
    10: func := function:String begin
          Result:= 'kilo';
        end;
    11: func := function:String begin
          Result:= 'lima';
        end;
{$endif}
   else func := function:String begin
         Result := 'Else what?';
       end;
  end;
  Result := Func;
end;

function AssignTestS2IFunc:String;
var
  ix : Integer;
  func : TFunc;
begin
  for ix := 0 to TestCount - 1
  do case AnsiIndexText(RandomKey, ['alpha', 'bravo', 'charlie', 'delta', 'echo', 'foxtrot'
  {$ifdef Twelve}
    , 'golf', 'hotel', 'india', 'juliet', 'kilo', 'lima'
  {$endif}]) of
    0 : func := function:String begin
          Result := 'Definitively any case';
        end;
    1 : func := function:String begin
          Result := 'B all you can B';
        end;
    2 : func := function:String begin
          Result := 'Checkpoint C';
        end;
    3 : func := function:String begin
          Result := 'Checkpoint D';
        end;
    4 : func := function:String begin
          Result := 'Checkpoint E';
        end;
    5 : func := function:String begin
          Result := 'Checkpoint F';
        end;
{$ifdef Twelve}
    6 : func := function:String begin
          Result:= 'golf';
        end;
    7 : func := function:String begin
          Result:= 'hotel';
        end;
    8 : func := function:String begin
          Result:= 'india';
        end;
    9 : func := function:String begin
          Result:= 'juliet';
         end;
    10: func := function:String begin
          Result:= 'kilo';
        end;
    11: func := function:String begin
          Result:= 'lima';
        end;
{$endif}
   else func := function:String begin
         Result := 'Else what?';
       end;
  end;
  Result := Func;
end;

function AssignCaseStringCache:String;
var
  ix : Integer;
  s: String;
  Cache : TCaseStringCache;
begin
  TCaseStringCache.Define(Cache,
               'Else what?')
   ['alpha',   'Definitively any case']
   ['bravo',   'B all you can B']
   ['charlie', 'Checkpoint C']
   ['delta',   'Checkpoint D']
   ['echo',    'Checkpoint E']
   ['foxtrot', 'Checkpoint F']
{$ifdef Twelve}
   ['golf', 'golf']
   ['hotel', 'hotel']
   ['india', 'india']
   ['juliet', 'juliet']
   ['kilo', 'kilo']
   ['lima', 'lima']
{$endif};
  for ix := 0 to TestCount - 1
   do s := Cache.Lookup(RandomKey);
  Result := s;
end;

function AssignCacheString:String;
var
  ix : Integer;
  s: String;
  Cache : TCache< String, String>;
begin
  TCache<String, String>
   .Define(Cache, 'Else what?')
   ['alpha',   'Definitively any case']
   ['bravo',   'B all you can B']
   ['charlie', 'Checkpoint C']
   ['delta',   'Checkpoint D']
   ['echo',    'Checkpoint E']
   ['foxtrot', 'Checkpoint F']
{$ifdef Twelve}
   ['golf', 'golf']
   ['hotel', 'hotel']
   ['india', 'india']
   ['juliet', 'juliet']
   ['kilo', 'kilo']
   ['lima', 'lima']
{$endif};
  for ix := 0 to TestCount - 1
   do s := Cache.Lookup(RandomKey);
  Result := s;
end;

function AssignCacheProc:String;
var
  ix : Integer;
  s: String;
  Cache : TCache<String, TProc>;
begin
  TCache<String, TProc>.Define(Cache,
               procedure begin
                 s := 'Else what?';
               end)
   ['alpha',     procedure begin
                 s := 'Definitively any case';
               end]
   ['bravo',   procedure begin
                 s := 'B all you can B';
               end]
   ['charlie', procedure begin
                 s := 'Checkpoint C';
               end]
   ['delta',   procedure begin
                 s := 'Checkpoint D';
               end]
   ['echo',    procedure begin
                 s := 'Checkpoint E';
               end]
   ['foxtrot', procedure begin
                 s := 'Checkpoint F';
               end]
{$ifdef Twelve}
    ['golf',   procedure begin
                 s:= 'golf';
               end]
    ['hotel',  procedure begin
                 s:= 'hotel';
               end]
    ['india',  procedure begin
                 s:= 'india';
               end]
    ['juliet', procedure begin
                 s:= 'juliet';
               end]
    ['kilo',   procedure begin
                 s:= 'kilo';
               end]
    ['lima',   procedure begin
                 s:= 'lima';
               end]
{$endif};

  for ix := 0 to TestCount - 1
   do Cache.Lookup(RandomKey)();
  Result := s;
end;

function AssignCacheFuncStack:String;
var
  ix : Integer;
  s: String;
  Cache : TCache<String, TFunc>;
begin
  TCache<String, TFunc>.Define(Cache,
               function:String begin
                 Result := 'Else what?';
               end)
   ['alpha',     function:String begin
                 Result := 'Definitively any case';
               end]
   ['bravo',   function:String begin
                 Result := 'B all you can B';
               end]
   ['charlie', function:String begin
                 Result := 'Checkpoint C';
               end]
   ['delta',   function:String begin
                 Result := 'Checkpoint D';
               end]
   ['echo',    function:String begin
                 Result := 'Checkpoint E';
               end]
   ['foxtrot', function:String begin
                 Result := 'Checkpoint F';
               end]
{$ifdef Twelve}
    ['golf', function:String begin
            Result := 'golf';
          end]
    ['hotel',function:String begin
            Result := 'hotel';
                 end]
    ['india',function:String begin
            Result := 'india';
                 end]
    ['juliet', function:String begin
            Result := 'juliet';
          end]
    ['kilo', function:String begin
            Result := 'kilo';
          end]
    ['lima', function:String begin
            Result := 'lima';
          end]
{$endif};

  for ix := 0 to TestCount - 1
   do s := Cache.Lookup(RandomKey)();
  Result := s;
end;

function AssignCacheFunc:String;
var
  ix : Integer;
  s: String;
  func: TFunc;
  Cache : TCache<String, TFunc>;
begin
  TCache<String, TFunc>.Define(Cache,
               function:String begin
                 Result := 'Else what?';
               end)
   ['alpha',     function:String begin
                 Result := 'Definitively any case';
               end]
   ['bravo',   function:String begin
                 Result := 'B all you can B';
               end]
   ['charlie', function:String begin
                 Result := 'Checkpoint C';
               end]
   ['delta',   function:String begin
                 Result := 'Checkpoint D';
               end]
   ['echo',    function:String begin
                 Result := 'Checkpoint E';
               end]
   ['foxtrot', function:String begin
                 Result := 'Checkpoint F';
               end]
{$ifdef Twelve}
    ['golf', function:String begin
            Result := 'golf';
          end]
    ['hotel',function:String begin
            Result := 'hotel';
                 end]
    ['india',function:String begin
            Result := 'india';
                 end]
    ['juliet', function:String begin
            Result := 'juliet';
          end]
    ['kilo', function:String begin
            Result := 'kilo';
          end]
    ['lima', function:String begin
            Result := 'lima';
          end]
{$endif};

  for ix := 0 to TestCount - 1
   do begin
     func := Cache.Lookup(RandomKey);
     s := func;
   end;
  Result := s;
end;

function AssignStringList:String;
var
  ix, fx : Integer;
  s: String;
  func : TFunc;
  obj : TObject absolute func;
  StrList : TStringList;
begin
  StrList := TStringList.Create;

  StrList.AddObject('alpha', TObject(function:String begin
                 Result := 'Definitively any case';
               end));
  StrList.AddObject('bravo', TObject(function:String begin
                 Result := 'B all you can B';
               end));
  StrList.AddObject('charlie', TObject(function:String begin
                 Result := 'Checkpoint C';
               end));
  StrList.AddObject('delta', TObject(function:String begin
                 Result := 'Checkpoint D';
               end));
  StrList.AddObject('echo', TObject(function:String begin
                 Result := 'Checkpoint E';
               end));
  StrList.AddObject('foxtrot', TObject(function:String begin
                 Result := 'Checkpoint F';
               end));
//{$ifdef Twelve}
  StrList.AddObject('golf', TObject(function:String begin
            Result := 'golf';
          end));
  StrList.AddObject('hotel',TObject(function:String begin
            Result := 'hotel';
                 end));
  StrList.AddObject('india',TObject(function:String begin
            Result := 'india';
                 end));
  StrList.AddObject('juliet', TObject(function:String begin
            Result := 'juliet';
          end));
  StrList.AddObject('kilo', TObject(function:String begin
            Result := 'kilo';
          end));
  StrList.AddObject('lima', TObject(function:String begin
            Result := 'lima';
          end));
//{$endif}

  StrList.Sorted := True;

  for ix := 0 to TestCount - 1
   do begin
     fx := StrList.IndexOf(RandomKey);
     if fx >= 0
      then begin
        obj := StrList.Objects[fx];
        s := func;
      end
       else s := 'ElseWhat';
   end;
  Result := s;
end;

function TimeIt(proc: TFunc; name:String):Integer;
var
  start : Cardinal;
  LastLookup : String;
  oldSeed : Integer;
begin
  OldSeed := RandSeed;
  start := GetTickCount;
  LastLookup := Proc;
  Result := GetTickCount - start;
  Writeln(Format('%-18s %6d - %s', [name, Result, LastLookup]));
  RandSeed := OldSeed;
end;

function LastKey:String;
var
  ix : Integer;
  s : String;
  OldSeed : Integer;
begin
  OldSeed := RandSeed;
  for ix := 0 to TestCount - 1
   do s := RandomKey;
  RandSeed := OldSeed;
  Result := s;
end;

procedure Test;
const
  Repeats = 10;
var
  ix : Integer;
begin
  for ix := 0 to Repeats - 1
  do begin
    Randomize;
//    RandSeed := 2003112605;
    Writeln;
    Writeln(Format('strings=%d, repeats=%d, seed=%d', [Elements, TestCount, RandSeed]));
    TimeIt(AssignTest,'TStringSwitch');
    TimeIt(AssignTestS2IFunc, 'AnsiIndexText Func');
    TimeIt(AssignStringIndexFunc, 'StringIndex');
    TimeIt(AssignTestS2I, 'AnsiIndexText');
    TimeIt(AssignStringList,'TStringList');
    TimeIt(AssignCacheProc, 'TCache Proc');
    TimeIt(AssignCacheFunc, 'TCache Func');
    TimeIt(AssignCacheFuncStack, 'TCache Func Stack');
    TimeIt(AssignCaseStringCache, 'TCaseStringCache');
    TimeIt(AssignCacheString, 'TCache String');
    TimeIt(AssignTestIf, 'If/then/else');
    TimeIt(LastKey, 'LastKey');
  end;
end;

begin
  try
    Write('Press Enter to start: ');
    Readln;

    Test;

  finally
    Writeln;
    Write('Press Enter: ');
    Readln;
  end;
end.

A generic case for strings

Do you remember the discussion about a case statement for strings?

I got this flash idea after reading Jolyon Smith's "The case for case[]", and remembering a comment from Francisco Ruiz on Nick Hodges' article on THTMLWriter which suggested using a default array property in a creative fashion.

Honestly, it is not really a true case statement, and it might not be as fast as an if then else, but here is how it looks when used. A bit ugly. but good fun :)

program TestGenericsSwitch;
{$apptype Console}
uses
  GenericsSwitch;
begin
  TStringSwitch.CaseOf('chARLie')
    ['Any', procedure begin
            Writeln('Definitively any case');
          end]
    ['B', procedure begin
            Writeln('B all you can B');
          end]
    ['Charlie', procedure begin
            Writeln('Checkpoint C');
          end]
    .ElseCase(procedure begin
            Writeln('Else what?');
          end)
    .EndCase;
end.

And here is how it is implemented.

unit GenericsSwitch;

/// Written by Lars Fosdal <lars@fosdal.com>, December 1, 2010

interface
uses
  SysUtils, Generics.Collections;

type
  TSwitchProc = reference to procedure;
  TGenericSwitch<KeyType> = class(TObjectDictionary<KeyType, TSwitchProc>)
  private
    FTheElseCase: TSwitchProc;
    FTheTargetKey: KeyType;
    function AddSwitchCase(const name: KeyType; 
                           const value: TSwitchProc): TGenericSwitch<KeyType>;
    procedure SetTheElseCase(const Value: TSwitchProc);
    procedure SetTheTargetKey(const Value: KeyType);
  protected
    function ValidateKey(Key:KeyType):KeyType; virtual;
    property TheTargetKey:KeyType read FTheTargetKey write SetTheTargetKey;
    property TheElseCase:TSwitchProc read FTheElseCase write SetTheElseCase;
  public
    class function CaseOf(const Key: KeyType):TGenericSwitch<KeyType>;
    function ElseCase(const Action: TSwitchProc): TGenericSwitch<KeyType>;
    procedure EndCase;
    property Cases[const name:KeyType; const value:TSwitchProc]: TGenericSwitch<KeyType>
                  read AddSwitchCase; default;
  end;

  TStringSwitch = class(TGenericSwitch<String>)
    function ValidateKey(key:String):String; override;
  end;

implementation

{ TGenericSwitch<KeyType, TSwitchProc> }

function TGenericSwitch<KeyType>.AddSwitchCase(const name: KeyType; const value: TSwitchProc): TGenericSwitch<KeyType>;
begin
  Result := Self;
  Add(ValidateKey(Name), Value);
end;

class function TGenericSwitch<KeyType>.CaseOf(const Key: KeyType): TGenericSwitch<KeyType>;
begin
  Result := Create;
  Result.TheTargetKey := Key;
end;

function TGenericSwitch<KeyType>.ElseCase(const Action: TSwitchProc): TGenericSwitch<KeyType>;
begin
  Result := Self;
  TheElseCase := Action;
end;

procedure TGenericSwitch<KeyType>.EndCase;
var
  DoIt : TSwitchProc;
begin
  if TryGetValue(TheTargetKey, DoIt)
  then DoIt
   else
   if Assigned(TheElseCase)
    then TheElseCase;
  Destroy;
end;

procedure TGenericSwitch<KeyType>.SetTheElseCase(const Value: TSwitchProc);
begin
  FTheElseCase := Value;
end;

procedure TGenericSwitch<KeyType>.SetTheTargetKey(const Value: KeyType);
begin
  FTheTargetKey := ValidateKey(Value);
end;

function TGenericSwitch<KeyType>.ValidateKey(Key: KeyType):KeyType;
begin
  Result := Key;
end;

{ TStringSwitch }

function TStringSwitch.ValidateKey(key: String): String;
begin
  Result := LowerCase(Key);
end;


end.

EurekaLog 6.0.25 RC2 (XE compatible) available for registered users

FYI - EurekaLog offers RC2 of an XE compatible v6.0.25 of EurekaLog to registered users at their website. https://www.eurekalog.com/login.php

It installed smoothly for both D2010 and DXE, and appear to work as expected for both.

How time flies...

It is amazing how time flies when you get engaged to the woman of your dreams, and move to another city! In the midst of moving all the furniture, refurbishing and selling the old apartment, getting to know my new bonus kids, and walking the dog - I also changed jobs :) I am no longer an Oslo citizen, but mainly work from home, about 180km further south on the sunny coastline from Oslo. So... what happened on the Delphi level of things?

Status: D5 -> D2009 port: It never completed. The dependencies between the old TopView grid and the database ORM were too large, and the TopView component turned to be for all practical purposes - non-portable. Not only because of the Unicode change, but also due to the fact that they changed the database TBookmark definition. At that point, it became clear that there was not enough resources/time to complete the work needed to complete port within reasonable cost.

I did plan on writing further posts on the migration process, but the main points about the Unicode change have already been covered elsewhere. All in all, it is quite remarkable how smooth that transition seem to have gone.

In January 2010, I began in a new position at Tine SA. No more porting projects, but writing and maintaining data warehouse, production and logistics related code for the dairy product manufacturing at Tine, using Delphi 2010, and integrating with Lawson's MOVEX M3 AS/400 ERP systems, as well as various robotic systems, using MSSQL Server 2008 as the backend.

The Tine team is a distributed team, working from many different geographical locations, that meet up at the same place physically just a few days every month. I am pleasantly surprised of how enjoyable and effective this way of working is! Naturally, it requires a bit more planning and coordination, but with good project management and regular meetings - it works better than I could have hoped for. The only drawback is that when I am mentally engaged in solving a new software challenge, my lady will complain that I spend too much time by the computer :)

Generics: We recently started refactoring the class hierarchies using Generics, and that has shaved about 7% off the number of lines of code in the projects so far. Hopefully, when we are done - the codebase will be 10-15% smaller than what we started with, and a lot simpler to maintain.

Generics is fun. Generics is also somewhat painful, as there are a lot of flaws in D2010. I can't wait to see which 87 generics issues that have been fixed in Delphi XE!

During the fall, I plan resuming the work on the FDCLib, and focus on getting the most out of Generics, Attributes, and Anonymous Methods. Stay tuned.

D5 - D2009 porting project update

The project has been put on hold for now. We got stuck early in January when we couldn't get past a deeply entrenched component from a third party vendor that had gone belly up. With no access to source code (and we did try to find a way of getting it) - there was no option but looking at replacing the component. Unfortunately, the effort required to migrate to a new component have been estimated to be so comprehensive that a complete refactoring may turn out to be a better alternative.

It just goes to show the importance of ALWAYS, and I do mean ALWAYS getting ALL components with source code. Another repeat observation is the importance of decoupling your GUI from your datamodel and business logic. Keep your GUI stupid.

I'll post some generic observations about code changes at a later point in time - but right now I am sunk in other tasks.