Delphi and Geocoding

Google has some powerful APIs. One of them is the Maps API which is capable of geocoding an address to longitude and latitude information.

It is pretty easy to use this functionality from Delphi. All you need is TIdHttp and a JSON library. (I'm using the Delphi Web Utils)

TLocationType = (ltRooftop, ltRangeInterpolated, ltGeometricCenter, ltApproximate);
  TAddress = class
  private
    fAddress : string;
    fLatitude: double;
    fLongitude: double;
    fLocationType: TLocationType;
  public
    constructor Create(aAddress : string; aHttp : TIdHttp = nil);
    property Address : string read fAddress write fAddress;
    property Latitude : double read fLatitude;
    property Longitude : double read fLongitude;
    property LocationType : TLocationType read fLocationType;
    procedure Geocode(aHttp : TIdHttp);
  end;

The Google API returns a JSON structure with a couple of fields. However, I just grab the longitude and latitude information as well as the location_type, to determine the quality of the coordinates.

procedure TAddress.GeoCode(aHttp: TIdHttp);
var
  url : string;
  jo, location, geometry : TJSONObject;
  sc : TStringCase;
begin
  url := TIdURI.URLEncode('http://maps.google.com/maps/api/geocode/json?address='+fAddress+'&sensor=false');
  jo := TJSONObject.create(aHttp.Get(url));
  if jo.getString('status') = 'OK' then
  begin
    geometry := jo.getJSONArray('results').getJSONObject(0).getJSONObject('geometry');
    location := geometry.getJSONObject('location');
    fLongitude := location.getDouble('lng');
    fLatitude := location.getDouble('lat');

    sc := TStringCase.Create;
    try
      sc.addEntry('ROOFTOP',procedure
      begin
        fLocationType := ltRooftop;
      end);
      sc.addEntry('RANGE_INTERPOLATED',procedure
      begin
        fLocationType := ltRangeInterpolated;
      end);
      sc.addEntry('GEOMETRIC_CENTER',procedure
      begin
        fLocationType := ltGeometricCenter;
      end);
      sc.addEntry('APPROXIMATE',procedure
      begin
        fLocationType := ltApproximate;
      end);
    finally
      sc.switch(geometry.getString('location_type'));
    end;
    sc.Free;
  end
  else raise Exception.Create(jo.getString('status'));
  jo.Free;
end;

I used this and TGoMaps to create a simple application which takes a list of addresses, geocodes them and displays them on a GoogleMap.

Source and binary are available here.

TAddress uses TStringCase from the previous post.

Delphi and TStringCase

Delphi's Case <X> of statement works with everything that is Ordinal. integer, char, enumerations, it even works with boolean.

case b of
  true : MakeSomething;
  false : DoNotMakeSomething;
end;

However, it does not work with strings. And I've come across some places where it would be very handy to have a Case <String> of.

Luckily, with Delphi 2010 came anonymous methods and with the combination of a Dictionary we can finally have something that works as a Case <String> of.

type
  TProc = reference to procedure;
  TCase<T> = class
  private
    fDict : TDictionary<T,TProc>;
    fElse: TProc;
  public
    constructor Create;
    destructor Destroy; override;
    procedure addEntry(aKey : T; aProc :TProc);
    procedure addEntries(const aKeys : array of T; aProc : TProc);
    procedure switch(aKey : T);
    property ElseCase : TProc read fElse write fElse;
  end;
  TStringCase = TCase<string>;

TStringCase is the type, that will be used the most, but with the generic TCase, (almost) everything can be used for a Case statement.

The implementation is very simple:

procedure TCase<T>.addEntries(const aKeys: array of T; aProc: TProc);
var
  key : T;
begin
  for key in aKeys do
    addEntry(key,aProc);
end;

procedure TCase<T>.addEntry(aKey: T; aProc: TProc);
begin
  fDict.Add(aKey, aProc);
end;

constructor TCase<T>.Create;
begin
  fDict := TDictionary<T,TProc>.Create;
end;

destructor TCase<T>.Destroy;
begin
  fDict.Free;
  inherited;
end;

procedure TCase<T>.switch(aKey: T);
var
  p : TProc;
begin
  if fDict.TryGetValue(aKey, p) then
    p()
  else
    if assigned(fElse) then fElse();
end;

And this is how it's used:

procedure UseStringCase;
var
  sc : TStringCase;
begin
  sc :=TStringCase.Create;
  try
    // setup the case
    sc.addEntry('STRING1',procedure
    begin
      Label1.Caption := 'First Option';
    end);

    sc.addEntry('STRING1',procedure
    begin
      Label1.Caption := 'Second Option';
    end);

    sc.addEntries(['STRING3','STRING4','STRING5'],procedure
    begin
      Label1.Caption := 'one of three options';
    end);

    sc.ElseProc := procedure
    begin
      Label1.Caption := 'Something else';
    end;

    sc.switch(Edit1.Text); // execute the right procedure
  finally
    sc.Free;
  end;

end;

The usage has some overhead compared to the standard case, but I think it is still prettier than a bunch of if-then-else's.

procedure UseIfThenElse;
var
  s : string;
begin
  s := Edit1.Text;
  if s = 'STRING1' then
  begin
    Label1.Caption := 'First Option';
  end
  else if s = 'STRING2' then
  begin
    Label1.Caption := 'Second Option';
  end
  else if (s = 'STRING3') or (s = 'STRING4') or (s = 'STRING5') then
  begin
    Label1.Caption := 'one of three options';
  end
  else
  begin
    Label1.Caption := 'Something else';
  end;
end;

Download is available here.

Delphi and Barcode scanning

Todays example uses a dll to access a Barcode Scanner. The used Barcode Scanner is the CS1504 (SDK available here).

The CS1504 has a buffer where it stores all scanned barcodes and this buffer can be accessed via a COM-Port. Luckily, the SDK has a dll which takes care of the communication. The only problem is, that the header is written in C/C++. I translated it (in parts) to Delphi, you can grab the file here.

Now we could just use it as is, but it would be much nicer if we had a class to wrap it all up.

We need some object to store the data, which is really simple:

TBarcode = class
  private
    fTimestamp : TDateTime;
    fCode : string;
  public
    constructor Create(aTimestamp : TDateTime; aCode : string);
    property TimeStamp : TDateTime read fTimestamp;
    property Code : string read fCode;
  end;

And now the class that does all the work:

TScanner = class
  private
    fPort : integer;
    fReady : boolean;
    fHasData: boolean;
    function TimestampToDateTime(aTimestamp : Ansistring) : TDateTime;
  public
    constructor Create(aPort : integer);
    destructor Destroy; override;
    function getBarcodes : TList<TBarcode>;
    procedure clearBarcodes;
    property IsReady : boolean read fReady;
    property HasData : boolean read fHasData;
    procedure setDateTime(aDateTime : TDateTime);
    function getDateTime : TDateTime;
  end;

The TScanner class returns a generic TList<TBarcode> with all the Barcodes from the device.

The most important function is of course getBarcodes.

function TScanner.getBarcodes: TList<TBarcode>;
var
  bc : TBarcode;
  i, count, pl : integer;
  buffer : array[0..63] of AnsiChar;
  dt : TDateTime;
  s : string;
begin
  result := TList<TBarcode>.Create;
  begin
    count := csp2ReadData;
    for i := 0 to count -1 do
    begin
      FillChar(buffer,64,#0);
      pl := csp2GetPacket(@buffer,i,63);

      // The Last 4 Bytes hold the timestamp
      dt := TimestampToDateTime(copy(buffer,pl-3,4));

      s := copy(buffer,3,pl-6);
      bc := TBarcode.Create(dt,s);
      result.Add(bc);
    end;
  end;
end;

The implementation is pretty much straight forward, the trickiest part was to convert the 4-byte timestamp from each barcode to TDateTime. They crammed the six values for year, month, day, hour, minute and second into 4 bytes. (seriously, a SD Card that has the size of my fingernail can hold easily 4 GB and they worry about 2 bytes per scanned barcode)

function TScanner.TimestampToDateTime(aTimestamp: Ansistring): TDateTime;
var
  i1,i2,i3,i4,i5,i6 : integer;
  qb : T4Bytes;
  y,m,d,h,n,s : word;
begin
  // CharToByte
  qb.Bytes[3] := Ord(aTimestamp[1]);
  qb.Bytes[2] := Ord(aTimestamp[2]);
  qb.Bytes[1] := Ord(aTimestamp[3]);
  qb.Bytes[0] := Ord(aTimestamp[4]);

  // split up the bits
  i1 := qb.Total and $fc000000; // 6 Bit
  i2 := qb.Total and $03f00000; // 6 Bit
  i3 := qb.Total and $000f8000; // 5 Bit
  i4 := qb.Total and $00007c00; // 5 Bit
  i5 := qb.Total and $000003c0; // 4 Bit
  i6 := qb.Total and $0000003f; // 6 Bit

  // Shift right to align the bits
  s := i1 shr 26;
  n := i2 shr 20;
  h := i3 shr 15;
  d := i4 shr 10;
  m := i5 shr 6;
  y := i6;

  result := EncodeDate(y+2000,m,d) + EncodeTime(h,n,s,0);
end;

This uses T4Bytes which is a packed record.

T4Bytes = packed record
   case Integer of
    0: (Bytes: array[0..3] of Byte);
    1: (Total: Cardinal);
  end;

The bytes are accessible indivudually and as the resulting 4-Byte Cardinal.

Full Sourcecode is available here.

Delphi and Generics

In this first developer-themed post, I am going to describe some basic stuff, before I delve into some real-world applications.

Delphi 2009 brought Generics to the Delphi-World. And since then, they are found in all of my Applications. Especially Generics.Collections are heavily used by me.

Before Generics.Collections I had to implement a TList for each Class I would like to store a variable amount of Objects. (Or I could use Contnrs.TObjectList and cast to TAnimal everytime I need one, but I don't find that very desirable)

interface

uses
  Classes;

type
  TAnimal = class
  private
    fName : string;
  public
    property Name : string read fName write fName;
  end;
  
  TAnimalList = class (TList)
  private
  procedure putAnimal(Index : integer; Value : TAnimal);
  function getAnimal(Index : integer) : TAnimal;
  public  
    property Items [Index : integer] : TAnimal read getAnimal write setAnimal;
  end;
  
implementation

procedure TAnimalList.putAnimal(Index : integer; Value : TAnimal);
begin
  inherited put(Index, Value);
end;

function TAnimalList.getAnimal(Index : integer) : TAnimal;
begin
  result := (TAnimal) inherited get(Index);
end;

And this is just for TAnimal, if there are any other classes, I would have to copy&paste the code for the List and replace the data types.

With Generics.Collections the same thing looks like this:

interface

uses
  Generics.Collections;

type
  TAnimal = class
  private
    fName : string;
  public
    property Name : string read fName write fName;
  end;

  TAnimalList = TList<TAnimal>

And I don't even need the alias "TAnimalList", I could use "TList<TAnimal>" instead.

Also, it is not limited to Classes, it can hold every datatype like integer, double, boolean and even records. In my case it is even better to use TObjectList<TAnimal>, which automatically frees its containing objects if it is freed.

Since all the Generics.Collectionshave an Enumerator the following is possible:

var
  fAnimals : TList<TAnimal>

procedure init;
var
  a : TAnimal;
begin
  for a in fAnimals do
  begin
    a.DoSomething;
  end;
end;

Generics.Collections has more then some simple Lists up its sleeve. There are also TQueue, which uses FIFO and TStack which uses LIFO to store its contents.

TDictionary is a little different, because its taking two type parameters. One for the key, one for the Value.
A case that I often stumble upon is to store (and recieve) some object or value for a specific string. And then I always use a TDictionary<String,TValue>

There's also a TObjectDictionary, which takes care of memory of the keys, the values or even both.

procedure init;
var
  ownsKeys, ownsValues, ownsBoth : TObjectDictionary<TKey, TValue>
begin
  ownsKeys := TObjectDictionary<TKey, TValue>.Create([doKeys]);
  ownsValues := TObjectDictionary<TKey, TValue>.Create([doValues]);
  ownsBoth := TObjectDictionary<TKey, TValue>.Create([doKeys, doValues]);
end;

That's it for today.

Level Up

Time for another Level Up. In this week I became a certified Delphi Developer. There is also the Delphi Master Certification, but since this certification deals a lot with DataSnap, which I have not used very much, I don't think I'll take it anytime soon.

I think this is a good opportunity to blog about some techniques I am using in my every day work. Which may help some fellow Delphi Developers, who can learn a thing or two and also give me feedback to improve my work.

For those interested in these kind of posts, you can grab the feed for the "Developer"-Posts right here