Archive

Archive for May 25, 2015

Lazy params, why not?

May 25, 2015 11 comments

Lazy management of child objects is something we normally dont tolerate in object pascal, and pupils caught writing code like this under my supervision would be promptly court marshaled and shot after a damn good thrashing. Ok maybe not thrashing, and probably not shooting either. Come to think of it, a faint tickle or determined gaze should do the trick.

Silly jokes aside, “Lazy management” is my take on creating objects which are explicitly designed to live for short periods of time. Typically just enough for you to extract some value, format something or just check a state. For values of a more permanent state – especially values you would check regularly, lazy management would be a waste.

Practical example

Sometimes its good to let the stack sort itself

Sometimes its good to let the stack sort itself

In my QTX research and development IDE, I have something called “file sources”. In short it’s a class system for completely abstracting you from the filesystem. Any filesystem to be exact. It’s very clever and it allows the entire IDE to be utterly agnostic regarding where files originate, because the closest you get to files are through reference identifiers.

Another side of this system is support for packages, namely zip based storage containers. The cool part is that the IDE doesnt distinguish between a folder on disk and files coming from inside a package. Why should it? It pertains completely to the global file repository, handling files through references and as such — the files can come from your cloud account (spoiler alert), an FTP account or anywhere else for all the IDE knows.

Naturally parameters to initialize a filesource cant be easily streamlined, so I have opted for a string based parameter function. The Open() method takes a semi-colon delimited name/value pair string, creates a TStringList to break the string down, then I stuff the name/value pairs into a dictionary for quick access later.

So initializing the parameter parser is super easy, like this:

FParams:=TSourceParameters.Create(‘name=testing;color=12;number=94.5;gone=true’);

Since the string is parsed and everything placed in a dictionary, it allows me to extract values quickly by name. But — I really dont want to clutter my code with datatype checks for each and every one! I want a clean interface, a bit like TCustomDataset’s TParams. But at the same time, I dont want to cache any value objects because the values will only exist for a short period of time.

I want access which is simple, like this:

caption:=FParams.Get(‘name’).AsString;

TInterfacedObject makes sense

I must admit, I rarely use TInterfacedObject out of the box. And when I do, I tend to disable the default reference counting because I may need interfaces – but I rarely need reference counting (happily the COM days are almost behind us). But in this particular case, the default behavior is excellent.

In the above one-liner snippet, the Get() method returns an object, but you may notice that I have no “free” statement involved. So at first glance you will probably think that the TSourceParameters object cache’s the objects in a TObjectList or something like that. Well I dont, we just create an object on the fly and forget about it.

So here goes:

type

  TSourceParameters = Class(TObject)
  private
    FLUT: TDictionary<string,string>;
  public
    type
    TSourceParameter = Class(TInterfacedObject)
    private
      FData:      String;
    public
      function    Empty:Boolean;
      function    AsString:String;
      function    AsInteger:Integer;
      function    AsBool:Boolean;
      function    AsFloat:Double;
      Constructor Create(Data:String);virtual;
    end;

    function    Get(Name:String):TSourceParameter;
    Constructor Create(CommandText:String);virtual;
  end;

//#############################################################################
// TSourceParameters.TSourceParameter
//#############################################################################

Constructor TSourceParameters.TSourceParameter.Create(Data:String);
begin
  inherited Create;
  FData:=trim(Data);
end;      

function TSourceParameters.TSourceParameter.Empty:Boolean;
begin
  result:=length(FData)<1;
end;      

function TSourceParameters.TSourceParameter.AsString:String;
begin
  result:=FData;
end;

function TSourceParameters.TSourceParameter.AsInteger:Integer;
begin
  TryStrToInt(FData,Result);
end;

function TSourceParameters.TSourceParameter.AsBool:Boolean;
begin
  TryStrToBool(FData,Result);
end;

function TSourceParameters.TSourceParameter.AsFloat:Double;
begin
  TryStrToFloat(FData,Result);
end;

//#############################################################################
// TSourceParameters
//#############################################################################

Constructor TSourceParameters.Create(CommandText:String);
var
  mList:  TStringlist;
  x:      Integer;
  mId:    String;
begin
  inherited Create;
  FLUT:=TDictionary<string,string>.Create;

  commandText:=trim(commandText);
  if length(commandText)>0 then
  Begin
    (* Populate our lookup table *)
    mlist:=TStringList.Create;
    try
      mList.Text:=StringReplace(CommandText,';',#13,[rfReplaceAll]);
      for x:=0 to mList.Count-1 do
      begin
        mId:=lowercase(trim(mList.Names[x]));
        FLut.AddOrSetValue(mId, trim(mList.ValueFromIndex[x]) );
      end;
    finally
      mList.Free;
    end;
  end;
end;

function TSourceParameters.Get(Name:String):TSourceParameter;
var
  mData:  String;
begin
  FLut.TryGetValue(name,mData);
  result:=TSourceParameter.Create(mData);
end;

Simple, easy to use, straight to the point. And we let Delphi deal with releasing any TSourceParameter instances.
So using this would be a case of:

procedure TForm1.Button1Click(Sender: TObject);
var
  FParams: TSourceParameters;
  mText:  String;
  mFloat: Double;
  mBool:  Boolean;
  mInt:   Integer;
begin
  FParams:=TSourceParameters.Create('name=testing;color=12;number=94.5;gone=true');
  try
    mtext:=FParams.Get('name').AsString;
    mInt:=FParams.Get('color').AsInteger;
    mFloat:=FParams.Get('number').AsFloat;
    mBool:=FParams.Get('gone').AsBool;
  finally
    FParams.Free;
  end;
end;

But again, using this technique is not suitable for objects you intend to read over-and-over. For that kind of data you are better off using a proper TObjectList.

Callbacks for Delphi, updated

May 25, 2015 2 comments

In-place callbacks. Not really something very popular in classical Delphi programming, but wildly efficient and handy! In fact, I use them so much in Smart Mobile Studio that I missed them in Delphi — and as such I decided to implement them.

Oh and this is the second version, with some minor alteration from a previous post I did a while back.

So, what is it?

Setup code to execute later the easy way

Setup code to execute later the easy way

Right. Ever found yourself adding a TTimer to your main form because you want something to happen just after the form is shown and everything is ready? Or perhaps when a user clicks something there should be a small delay and then another thing should happen? I know I have. Especially when I want to setup something without taking to much of the OnFormShow() event. But the full onslaught of TComponent seems like overkill for such a tiny function doesnt it?

Either way, under Smart Mobile Studio I have a function initially called W3_Callback to deals with this. It simply creates a time object and keeps track of a procedure reference, and since it’s a one-liner you can use it to delay code execution and essentially allow for a breath of fresh air between calls. The method(s) takes two parameters: the first is the amount of time you want to wait, and the second a procedure you want to execute. So after calling w3_callback it starts a timer, counts down to zero, and then calls the function you provided.

Well, this unit does the same thing as it’s Smart Mobile counterpart. And it does wonders with anonymous procedures, allowing you to setup code to be executed “just after this”.

Note: This is for WinAPI only. If you port it for OS X please let me know, as I’m sure there are equivalent functions. So it shouldn’t be hard to make it portable (have a peek at TTimer under FMX perhaps?).

unit qtx.utils.callback;

//#############################################################################
//
// Unit:      Windows callback mechanism
// Author:    Jon Lennart Aasenden
// Copyright: Jon Lennart Aasenden [LTD]
// Org. Id:   913494741
//            http://w2.brreg.no/enhet/sok/detalj.jsp?orgnr=913494741
//#############################################################################
//
//  Purpose:
//    This unit provides methods for blocking delay of program execution,
//    and also a non-blocking callback function for anonymous methods.
//
//  The TQTXCallback.Delay() method is blocking, meaning that it will halt
//  program execution for the duration of the MS parameter.
//
//  The TQTXCallback.Callback() method is NON-blocking, meaning that it will
//  create a winAPI time object that, when the duration of MS is expired,
//  will execute the inline anonymous function.
//
//  NOTE: There are two overloaded versions: One for anonymous methods,
//        and another for object methods (when used within a class).
//
//  Example:
//     TQTXCallback.callback(
//        procedure (
//          begin
//            showmessage('2 seconds have gone by');
//          end,
//     2000);
//
//
//     TQTXCallback.delay(nil,4000);
//     showmessage('4 seconds have gone by');
//
//
//#############################################################################

interface

uses  System.SysUtils, System.Classes,
      Winapi.Windows, System.Generics.Collections;

type
TQTXObjectProc = procedure of Object;

TQTXCallback = Class
public
  (* Anonymous method implementation *)
  class procedure Callback(const aCallback:TProc;const ms:Cardinal);overload;
  class procedure Callback(const aCallback:TQTXObjectProc;
        const ms:Cardinal);Overload;

  class function  CallbackEx(const aCallBack:TProc;
        const ms:Cardinal):THandle;
  class procedure AbortCallback(const aHandle:THandle);

  (* Object method implementation *)
  class procedure Delay(const aCallback:TProc;const ms:Cardinal);overload;
  class Procedure Delay(const aCallback:TQTXObjectProc;
        const ms:Cardinal);overload;
end;

implementation

uses Vcl.Forms;

var
_LUT: TDictionary<UINT,TProc>;

{ TQTXCallback }

class procedure TQTXCallback.Callback(const aCallback: TProc;
      const ms: Cardinal);
  procedure w3_invoke(hwnd: HWND; uMsg: UINT;
            idEvent: UINT_PTR;dwTime: DWORD);stdcall;
  var
    mProc:  TProc;
  begin
    KillTimer(0,idEvent);
    try
      if assigned(_LUT) then
      begin
        mproc:=_lut.Items[idEvent];
        _lut.Remove(idEvent);
        if assigned(mProc) then
        mproc;
      end;
    except
      on exception do;
    end;
  end;
begin
  if Assigned(_LUT) then
  _LUT.add(SetTimer(0,0,ms,@w3_invoke),aCallback);
end;

class function TQTXCallback.CallbackEx(const aCallBack: TProc;
  const ms: Cardinal): THandle;

  procedure w3_invoke(hwnd: HWND; uMsg: UINT;
            idEvent: UINT_PTR;dwTime: DWORD);stdcall;
  var
    mProc:  TProc;
  begin
    KillTimer(0,idEvent);
    try
      if assigned(_LUT) then
      begin
        mproc:=_lut.Items[idEvent];
        _lut.Remove(idEvent);
        if assigned(mProc) then
        mproc;
      end;
    except
      on exception do;
    end;
  end;

begin
  result:=0;
  if Assigned(_LUT) then
  Begin
    result:=SetTimer(0,0,ms,@w3_invoke);
    _LUT.Add(result,aCallback);
  end;
end;

class procedure TQTXCallback.AbortCallback(const aHandle: THandle);
begin
  if assigned(_LUT)
  and _LUT.ContainsKey(aHandle) then
  begin
    _lut.Remove(aHandle);
    KillTimer(0,aHandle);
  end;
end;

class procedure TQTXCallback.Callback(const aCallback: TQTXObjectProc;
  const ms: cardinal);
  procedure w3_invoke(hwnd: HWND; uMsg: UINT;
            idEvent: UINT_PTR;dwTime: DWORD);stdcall;
  var
    mProc:  TProc;
  begin
    KillTimer(0,idEvent);
    try
      if assigned(_LUT) then
      begin
        mproc:=_lut.Items[idEvent];
        _lut.Remove(idEvent);
        if assigned(mProc) then
        mproc;
      end;
    except
      on exception do;
    end;
  end;
begin
  if Assigned(_LUT) then
  _LUT.add(SetTimer(0,0,ms,@w3_invoke),aCallback);
end;

class procedure TQTXCallback.Delay(const aCallback: TProc;
      const ms: cardinal);
var
  mThen:  DWord;
begin
  if assigned(application)
  and not application.Terminated
  and (ms>0) then
  Begin
    try
      mThen:=getTickCount + ms;
      repeat
        Sleep(1);
        if assigned(application)
        and application.Terminated then
        break;
      until getTickCount>=mThen;
      if assigned(aCallback)
      and Assigned(Application)
      and not (application.Terminated) then
      aCallback;
    except
      on exception do;
    end;
  end;
end;

class procedure TQTXCallback.Delay(const aCallback: TQTXObjectProc;
      const ms:Cardinal);
var
  mThen:  DWord;
begin
  if assigned(application)
  and not application.Terminated
  and (ms>0) then
  Begin
    try
      mThen:=getTickCount + ms;
      repeat
        Sleep(1);
        if assigned(application)
        and application.Terminated then
        break;
      until getTickCount>=mThen;
      if assigned(aCallback)
      and Assigned(Application)
      and not (application.Terminated) then
      aCallback;
    except
      on exception do;
    end;
  end;
end;

initialization
_LUT:=TDictionary<UINT,TProc>.Create;

finalization
if Assigned(_LUT) then
FreeAndNil(_LUT);

end.