Tag: Delphi

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

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

Remember that 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 , December 5, 2010

interface
uses
  SysUtils, Generics.Collections;

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

  TCache = class(TObjectDictionary<KeyT, TCacheEntry>)
  private
    FCache: TCache;
    FDefaultValue: ValT;
    function AddValue(const Id: KeyT; const Value: ValT): TCache;
  protected
    function ValidateId(Id: KeyT): KeyT; virtual;
  public
    class function Define(var Cache; const aDefaultValue:ValT): TCache;
    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 read AddValue; default;
  end;

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

implementation

{ TCache }

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

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

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

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

function TCache.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;
begin
  TCache
   .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;
begin
  TCache.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;
begin
  TCache.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;
begin
  TCache.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 , December 1, 2010

interface
uses
  SysUtils, Generics.Collections;

type
  TSwitchProc = reference to procedure;
  TGenericSwitch = class(TObjectDictionary)
  private
    FTheElseCase: TSwitchProc;
    FTheTargetKey: KeyType;
    function AddSwitchCase(const name: KeyType; 
                           const value: TSwitchProc): TGenericSwitch;
    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;
    function ElseCase(const Action: TSwitchProc): TGenericSwitch;
    procedure EndCase;
    property Cases[const name:KeyType; const value:TSwitchProc]: TGenericSwitch
                  read AddSwitchCase; default;
  end;

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

implementation

{ TGenericSwitch }

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

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

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

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

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

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

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

{ TStringSwitch }

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


end.

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.

FDCLib – Wizards – On hold for now

The promised FDCLib wizards are still work-in-progress, and it looks like it will take a some weeks before I can find some time to complete the work. I recently got a chance to work with something really interesting which probably will be taking most of my spare time in the coming month or so. It is funny how life sneaks up on you sometimes, and naturally, it is your pet projects that get to suffer.

Swindell: Native code remains the core foundation of application development

Michael Swindell writes: “… Native code remains the core foundation for desktop, client/server, and workstation application development. ISVs and Micro ISVs rely on native code to deliver high-performance packaged software, and the ubiquity of multicore architectures enables programmers with abilities in native languages like C++ and Delphi to drive application development in high-growth industries like healthcare, financial markets, and services and telecommunications. …”

Full article here: http://www.ddj.com/architect/210604499

It’s good to be a Delphi developer.

Edit: I guess this is an infomercial 😛 – Well, I bought it 🙂

Snippet: Convert Java time to TDateTime

I am currently working on an application that need to extract content from a Java Web Service using a SOAP interface. The interface delivers all timestamps as Java timestamps (64-bit integer – UTC time in milliseconds before or after the start of January 1, 1970), so I need to convert them to TDateTime for further processing in the Delphi code.

First, I convert it to a Windows filesystem time – which is similar to the Javatime, except from the start time offset and the time resolution. Next, I convert the filetime to Windows UTC time, and adjust for the timezone – simplified to just use the default – ie current local timezone. The final step is to convert the system time constant to a TDateTime.

The whole thing is done with blatant disregard of the tradition of checking return values from the two system calls. The less optimistic of you may choose to check for return values equaling zero to indicate an error.


uses
  Windows, SysUtils;  // Time functions

function JavaTimeToDateTime(javatime:Int64):TDateTime;
// java time -> Win32 file time -> UTC time
// adjust to active time zone -> TDateTime
var
  UTCTime, LocalTime: TSystemTime;
begin
  FileTimeToSystemTime(TFileTime(Int64(javatime + 11644473600000) * 10000), UTCTime);
  SystemTimeToTzSpecificLocalTime(nil, UTCTime, LocalTime);
  Result := SystemTimeToDateTime(LocalTime);
end;

FYI: 11644473600000 * 10000 = 1 Jan 1970 in Windows File Time

Importing Delphi from UK to Norway

After checking with a UK based software reseller, they confirmed that they can sell licenses to Norway. Since Norway is not a member of EU, they will not charge the EU VAT rate.

After checking with the Customs Authorities in Norway, they confirmed that there is no Norwegian import tax on software.

If the software delivered on physical media,you have to pay 25% VAT to the Customs Authorities with the import declaration.

If the software is digitally delivered, the Customs Authorities don’t require you to pay them the 25% VAT, although if you are required to register the cost in your balance sheets, you will need to clarify with your accountant/auditor and/or the regional tax office on how it should be registered.

For a hobbyist, that means you effectively get the software at net cost from the reseller and at the same rate as the rest of the world.

Although this solves the problem with the inflated price of Delphi on the Nordic CodeGear web shop for the consumer – I can’t help but to ponder what kind of problem this pose for the local resellers. They would have to be able to offer some seriously good support to compensate for the inflated price they are required to charge.