Delphi 6 items

Comment on this article

Objects
  Converting procedure types
  Invisible interface pointer trick and critical sections 

Widestrings
  Empty strings

Exceptions
  Catching exceptions in threads

COM
  ForEach

Misc
 
MouseCoord/MouseToCell
  Exception in coreide60.bpl


Objects

Converting procedure types

The thing is, that when you design a procedure that takes procedure pointers as parameters to be used as callbacks, you have to decide beforehand if you’re going to take global procedures or member procedures as parameter. Ideally, you’d always use member procedures, but you’re not ideal, are you? In any case, I always succeed in guessing wrong, so I decided to always take pointers to member procedures if in doubt and convert global procedures to member procedures if it turns out I was wrong. So, I created a wrapper class that takes a pointer to a global procedure and calls it from a member function. Then I hand out the member function instead. Sounds about right, yes? Ideal for cast operators and should be trivial to write as a template. Eh… that was in that other language… oops. Ok, Delphi should be able to do it, maybe forcing it a little bit. First iteration:

TGProc = procedure;
TMProc = procedure of object;
class TWGP = class
  fgp : TGProc;
  constructor Create(gp: TGProc);
  procedure ptr;
end;

constructor TWGP.Create(gp: TGProc);
begin
  fgp := gp;
end;

procedure TWGP.ptr;
begin
  fgp();
end;

Then this could be used as:

CallMe(TWGP.Create(GlobalThing).ptr);

…if GlobalThing is a global procedure. The problem here is of course that there’ll be a TWGP instance hanging around forever afterwards. So, let’s do:

var
  wgp: TWGP;
begin
  wgp := TWGP.Create(GlobalThing);
  try
    CallMe(wgp.ptr);
  finally
    wgp.Free;
  end;
end;

Yeah, right. I’ll wear out my typing fingers real quick this way. Frickin’ ridiculous. Maybe use the “invisible interface pointer” trick, then:

IWGP = interface
  function ptr: TMProc;
end;

TWGP = class(TInterfacedObject, IWGP)
  fgp : TGProc;
  constructor Create(gp: TGProc);
  procedure ptr;
end;

function WGP(gp: TGProc): IWGP;
begin
  Result := TWGP.Create(gp);
end;

Then, we could expect to be able to use it like:

CallMe(WGP(GlobalThing).ptr);

Ah, yes, and pigs can fly, right? Now Delphi complains that this isn’t a member function… And why the f… not? Because it’s a member of an interface, probably. But if Delphi can be a bitch, so can I. Next try:

IWGP = interface
  function fptr: TMProc;
end;

TWGP = class(TInterfacedObject, IWGP)
  fgp : TGProc;
  constructor Create(gp: TGProc);
  procedure ptr;
  function fptr: TMProc;
end;

The only new function is the fptr() function:

function TWGP.fptr: TMProc;
begin
  Result := ptr;
end;

Using it becomes:

CallMe(WGP(GlobalThing).fptr);

So, the only thing we’re doing here is explicitly returning the pointer to our member function instead of implicitly[1]. Now Delphi doesn’t complain no more. Sometimes it takes a few rounds around the block to make it shut up.

Getting rid of the member function name would have been even better, so you could use it like:

CallMe(WGP(GlobalThing));

>…but that turned out to be out of reach. Having a default property in the interface do it seems ideal, except that default properties must be arrays. And cast operators and such are totally unknown in the Delphi universe. So Delphi wasn’t entirely defeated this time.

You could justly wonder when the destructor for the TWGP object will be called in the above code. You could argue that the scope for the invisible returned interface pointer is limited to the scope of the function parameters, and that the destructor would then be called right after the CallMe() call ends. But then you'd be C++ish. Some experimenting shows that the TWGP object disappears as the surrounding scope ends:

begin
  ..dododo
  ..tetete
  ..CallMe(WGP(GlobalThing).fptr);
  ..gugugu
  ..pipipi
end;  <-- here the TWGP hidden object will be freed

So I guess Delphi doesn't create a scope during parameter resolution. I doubt that's a useful thing to remember, though.



[1] I didn’t want to lower myself to casting, that would be showing weakness in the face of the enemy. Maybe it wouldn’t even work, but that’s just a detail.

 

Invisible interface pointer trick and critical sections

I’m really and truly grieving that Delphi doesn’t allow objects on the stack and the automatic destructors. It’s a tragedy. The only thing that can, sometimes, replace it is the destruction of reference counted objects as they go out of scope. In other words, if you do the following, the object is exception safe and destroys itself as the procedure exits, even if it goes feet first:

type
  IMyObj = interface
  end;
  
  TMyObj = class(TInterfacedObject, IMyObj)
  end;

procedure MyProc;
var
  myobj : IMyObj;
begin
  myobj := TMyObj.Create;
  .. dadada
  .. dididi
  .. dododo
end;  <= here myobj will go out of scope and the object be freed

Not bad. Not really good, either. The first improvement is to get rid of the class create call, since it allows the caller (me! and I know myself!) to do stupid things. For instance:

procedure MyProc;
var
  myobj : TMyObj;  <= class type by mistake, instead of interface type!
begin
  myobj := TMyObj.Create;
  .. dadada
  .. dididi
  .. dododo
end;  <= here myobj will hide itself in memory and giggle at you forever

To stop myself from doing this, I declare the object like:

interface
type
  IMyObj = interface
  end;

  function makeMyObj(): IMyObj;

implementation
  TMyObj = class(TInterfacedObject, IMyObj)
  end;

  function makeMyObj(): IMyObj;
  begin
    Result := TMyObj.Create();
  end;

So now there’s no way to declare that bad object type, since the class itself is hidden from outside modules. So, this is how far in useability we’ve gotten now:

procedure MyProc;
var
  myobj : IMyObj; <= using TMyObj here will cause syntax error
begin
  myobj := makeMyObj();
  .. dadada
  .. dididi
  .. dododo
end; <= here myobj will go away and die

The reason this works is that it turns out that Delphi has a funny way of handling return values from functions. As you know, you don’t have to assign return values, but it seems Delphi absolutely insists on returning them anyway. To be able to do that, Delphi creates an invisible variable to receive the unused return value. It makes the following code entirely equivalent to the preceding code:

procedure MyProc;
begin
  makeMyObj();
  .. dadada
  .. dididi
  .. dododo
end; <= here myobj will go away and die

The “myObj” variable is now created by the compiler and doesn’t have a name. But that’s ok. The LockCS() function in LockCritSec.pas (see below) works exactly this way, so you can very elegantly lock critical sections and have them released in an exception safe way:

..
  fCS := TCriticalSection.Create;
..
procedure MyProc;
begin
  LockCS(fCS);  <= calls fCS.Acquire
	try
		.. dududu
		.. dedede
	except
		.. hihihi
	end;
end;  <= fCS.Release will be called here whatever happens

The LockCS() function and its companion class are in the LockCritSec.pas unit file that looks like this:

unit LockCritSec;

interface

uses SyncObjs;

type
	ILockCS = interface
	end;

function LockCS(cs: TCriticalSection): ILockCS;

implementation

type
	TLockCS = class(TInterfacedObject, ILockCS)
		fCS : TCriticalSection;
		constructor Create(cs: TCriticalSection);
		destructor Destroy; override;
	end;

function LockCS(cs: TCriticalSection): ILockCS;
begin
	Result := TLockCS.Create(cs);
end;

constructor TLockCS.Create(cs: TCriticalSection);
begin
	fCS := cs;
	fCS.Acquire;
end;

destructor TLockCS.Destroy;
begin
	fCS.Release;
	inherited;
end;

end.

There’s just one thing: Borland does not document this “hidden return value” effect, so it may go away in later versions. If it does, the first thing you’ll notice is massive amounts of corrupt data through thread contention if you're using critical sections like above.


Widestrings

Empty strings

An empty string in Pascal normally gets replaced by a nil pointer. This can cause problems when talking to other apps through com. For example, trying to talk to xTrade, there's a method you call with an empty string if you want "all contracts". The COM stub then crashes on "null reference". It obviously expects a pointer to an empty string, not a null pointer. So while this won't work:

  em2 := is2.CreateNextRxEnumMsg('');

...this will:

  const
    nothing: WideString = #0#0;
  begin
    em2 := is2.CreateNextRxEnumMsg(nothing);
  end;

Other useful trivia:

NullWideStr is a PWideChar that points to an empty string. New in Delphi6. Did not work in the above scenario:

  em2 := is2.CreateNextRxEnumMsg(NullWideStr^);  // same old kaka

Exceptions

Catching exceptions in threads

If exceptions are raised in a thread that is not the primary thread, and that exception is not handled in code, no dialog box appears to tell the user what happened. The program happily continues while the thread that raised the exception dies. Not always what you want. The trick to avoid this is to get the exception shown from the context of the primary thread and that's exactly what the synchronize keyword is meant to do. So, instead of deriving your thread classes from TThread, derive them from TThreadGT. Then in your very own Execute method, make sure TThreadGT's HandleException method is called:

procedure TMyClass.Execute;
begin
  inherited;
  try
    while not Terminated do begin
    ...working my dick off
    end;
  except
    HandleException();
  end;
end;

TMyClass is derived from TThreadGT, which looks like this:

type
  TThreadGT = class(TThread)
  private
    fException : Exception;
    procedure PrimaryHandleException;
  protected
    procedure HandleException;
  end;
	
procedure TThreadGT.PrimaryHandleException;
begin
  if GetCapture() <> 0 then
    SendMessage(GetCapture(), WM_CANCELMODE, 0, 0);
  if fException is Exception then begin
    if Assigned(ApplicationShowException) then
      ApplicationShowException(fException);
  end else
    SysUtils.ShowException(fException, nil);
end;

procedure TThreadGT.HandleException;
begin
  fException := Exception(ExceptObject);
  try
    if not (fException is EAbort) then
      Synchronize(PrimaryHandleException);
  finally
    fException := nil;
  end;
end;

COM

Foreach

Delphi doesn't have the keyword 'ForEach' so it has no built-in way of handling enumerators like VB does. To make it easier to handle this situation, use the below class (a rewrite of a similar class by Binh Ly at www.techvanguards.com).

This class will typically be used like this:

var
  foreach : IForEach;
  en      : IEnumSomething;
  item    : ISomething;
  varitem : OleVariant;
begin
  // DoSomething() returns a collection
  en := DoSomething() as IEnumSomething;
  foreach := makeForEach(en);
  while foreach.Next(varitem) do begin
    item := IUnknown(varitem) as ISomething;
    item.GreatFunction();
  end;

The TForEach class implements the IForEach interface and the whole unit looks like this:

interface
type
  IForEach = interface
    function Next(var item: OleVariant): boolean;
    procedure Reset();
  end;

function makeForEach(collection: IDispatch): IForEach;

// ==================================================================

implementation

uses
  Windows,
  SysUtils,
  ActiveX;

type
  TForEach = class(TInterfacedObject, IForEach)
    fEnum : IEnumVARIANT;
    constructor Create(collection: IDispatch);
    function Next(var item: OleVariant): boolean;
    procedure Reset();
  end;

// ==================================================================

function makeForEach(collection: IDispatch): IForEach;
begin
  Result := TForEach.Create(collection);
end;


// ==================================================================
{ TForEach }

constructor TForEach.Create(collection: IDispatch);
var
  invokeResult : OleVariant;
  disppar : DISPPARAMS;
  hr : HRESULT;
begin
  VariantInit(invokeResult);
  zeromemory(@disppar, sizeof(DISPPARAMS));
  hr := collection.Invoke(DISPID_NEWENUM, GUID_NULL,
    LOCALE_SYSTEM_DEFAULT,
    DISPATCH_PROPERTYGET,
    disppar, @invokeResult, nil, nil);
  if SUCCEEDED(hr) then begin
    fEnum := IUnknown(invokeResult) as IEnumVARIANT;
    VariantClear(invokeResult);
    if fEnum = nil then
      raise Exception.Create('Collection does not support IEnumVARIANT');
    Reset();
  end else begin
    raise Exception.Create('Collection does not return an enumerator');
  end;
end;

// ------------------------------------------------------------------

function TForEach.Next(var item: OleVariant): boolean;
var
  nFetched : cardinal;
  newItem : OleVariant;
begin
  Result := False;
  if fEnum <> nil then begin
    VariantInit(newItem);
    if SUCCEEDED(fEnum.Next(1, newItem, nFetched)) then begin
      if nFetched > 0 then begin
        item := newItem;
        VariantClear(newItem);
        Result := True;
      end;
    end;
  end;
end;

// ------------------------------------------------------------------

procedure TForEach.Reset;
begin
  Assert(fEnum <> nil);
  fEnum.Reset();
end;

// ------------------------------------------------------------------

end.

Misc

MouseCoord/MouseToCell

According to the documentation and to a number of messages I've seen in usenet groups, the MouseCoord method is supposed to take a screen relative mouse position and return the grid cell the mouse is positioned over, while the MouseToCell method takes the grid relative position. Well, after losing a lot of time trying to make this work, I looked in the VCL source and found this was all malarkey. I wonder where these other guys got their Delphi from. Another Borland? This is the VCL implementation for MouseToCell right in the Source\Vcl\grids.pas unit, at least in mine:

procedure TCustomDrawGrid.MouseToCell(X, Y: Integer; var ACol, ARow: Longint);
var
  Coord: TGridCoord;
begin
  Coord := MouseCoord(X, Y);
  ACol := Coord.X;
  ARow := Coord.Y;
end;

...which clearly just calls MouseCoord() without not even the slightest hint at subtraction or anything. Sure enough, calling MouseToCell() or MouseCoord() with small X and Y values gives exactly the same results. I finally arrived at the following code to determine over which cell the mouse is hovering in a stringgrid:

...
var
  mpos	: TPoint;
  X, Y	: integer;
  ACol, ARow : integer;
//	sg	: TStringGrid;	// the stringgrid in the form
begin
  mpos := Mouse.CursorPos();
  X := sg.ScreenToClient(mpos).X;
  Y := sg.ScreenToClient(mpos).Y;
  sg.MouseToCell(X, Y, ACol, ARow);
  ...
end;

Note that if you use ScreenToClient() instead of sg.ScreenToClient(), you'll get coordinates relative the form, not the grid, with subtle and annoying errors.

Exception in coreide60.bpl

This happens to me with disturbing regularity at startup of Delphi 6. The remedy is to let the IDE start up anyway, go "Component" | "Install packages...", then click any old checkbox off and back on. Exit the IDE, start it up again and for some reason it now works. I'm not impressed.

Comment on this article

TOP