Home Forum RSS PGP Alerts Links (D) |
|
Delphi 6 items Comment on this articleObjects
Exceptions Misc ObjectsConverting procedure typesThe 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 sectionsI’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. WidestringsEmpty stringsAn 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 ExceptionsCatching exceptions in threadsIf 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; COMForeachDelphi 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. MiscMouseCoord/MouseToCellAccording 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.bplThis 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. |
TOP |