I tend to use Delphi's TStringList for text manipulation, so I write a lot of procedures/functions like:
var
TempList: TStringList;
begin
TempList:= TStringList.Create;
try
// blah blah blah do stuff with TempList
finally
TempList.Free;
end;
end;
It would be nice to cut out the creation and freeing for such a common utility class.
Since we now have records with methods, is it possible to wrap a Class like TStringList in a
Record so I could just have:
var
TempList: TRecordStringList;
begin
// blah blah blah do stuff with TempList
end;
It's possible. Create an interface that exposes the methods / objects you want:
type
IStringList = interface
procedure Add(const s: string); // etc.
property StringList: TStringList read GetStringList; // etc.
end;
Implement the interface, and have it wrap a real TStringList:
type
TStringListImpl = class(TInterfacedObject, IStringList)
private
FStringList: TStringList; // create in constructor, destroy in destructor
// implementation etc.
end;
Then implement the record:
type
TStringListRecord = record
private
FImpl: IStringList;
function GetImpl: IStringList; // creates TStringListImpl if FImpl is nil
// returns value of FImpl otherwise
public
procedure Add(const s: string); // forward to GetImpl.Add
property StringList: TStringList read GetStringList; // forward to
// GetImpl.StringList
// etc.
end;
The fact that there's an interface inside the record means the compiler will handle reference counting automatically, calling _AddRef and _Release as copies get created and destroyed, so lifetime management is automatic. This works for objects that will never contain a reference to themselves (creating a cycle) - reference counting needs various tricks to get over cycles in the reference graph.
If you are lucky enough to have upgraded to Delphi 2009 then check out Barry's work with smart pointers.
TSmartPointer<T: class> = record
strict private
FValue: T;
FLifetime: IInterface;
public
constructor Create(const AValue: T); overload;
class operator Implicit(const AValue: T): TSmartPointer<T>;
property Value: T read FValue;
end;
They are really cool, but require Generics and Anonymous methods. If you haven't upgraded to Delphi 2009, then do it now! Especially while they are offering their BOGO special. You also get Marco's Delphi Developer Handbook free just for downloading the trial. I already purchased a copy of it too.
There is another example already implemented in CC.
StringList is the same as TStringList except that it is a value
type. It does not have to be created, destroyed or put within
try/finally. This is done by the compiler for you. There are
virtually no special performance penalties for these to work:
var
strings: StringList;
astr: string;
begin
strings.Add('test1');
strings.Add('test2');
aStr := string(strings);
RichEdit.Lines.AddStrings(strings);
end;
The code can be used as a template to wrap any TObject as a value class type.
It already has everything for a TStringList exposed for you.
Related
In Delphi 10 Seattle I could use the following code to work around overly strict visibility restrictions.
How do I get access to private variables?
type
TBase = class(TObject)
private
FMemberVar: integer;
end;
And how do I get access to plain or virtual private methods?
type
TBase2 = class(TObject)
private
procedure UsefullButHidden;
procedure VirtualHidden; virtual;
procedure PreviouslyProtected; override;
end;
Previously I would use a class helper to break open the base class.
type
TBaseHelper = class helper for TBase
function GetMemberVar: integer;
In Delphi 10.1 Berlin, class helpers no longer have access to private members of the subject class or record.
Is there an alternative way to access private members?
If there is extended RTTI info generated for the class private members - fields and/or methods you can use it to gain access to them.
Of course, accessing through RTTI is way slower than it was through class helpers.
Accessing methods:
var
Base: TBase2;
Method: TRttiMethod;
Method := TRttiContext.Create.GetType(TBase2).GetMethod('UsefullButHidden');
Method.Invoke(Base, []);
Accessing variables:
var
Base: TBase;
v: TValue;
v := TRttiContext.Create.GetType(TBase).GetField('FMemberVar').GetValue(Base);
Default RTTI information generated for RTL/VCL/FMX classes is following
Fields - private, protected, public, published
Methods - public, published
Properties - public, published
Unfortunately, that means accessing private methods via RTTI for core Delphi libraries is not available. #LU RD's answer covers hack that allows private method access for classes without extended RTTI.
Working with RTTI
There is still a way to use class helpers for access of private methods in Delphi 10.1 Berlin:
type
TBase2 = class(TObject)
private
procedure UsefullButHidden;
procedure VirtualHidden; virtual;
procedure PreviouslyProtected; override;
end;
TBase2Helper = class helper for TBase2
procedure OpenAccess;
end;
procedure TBase2Helper.OpenAccess;
var
P : procedure of object;
begin
TMethod(P).Code := #TBase2.UsefullButHidden;
TMethod(P).Data := Self;
P; // Call UsefullButHidden;
// etc
end;
Unfortunately there is no way to access strict private/private fields by class helpers with Delphi 10.1 Berlin. RTTI is an option, but can be considered slow if performance is critical.
Here is a way to define the offset to a field at startup using class helpers and RTTI:
type
TBase = class(TObject)
private // Or strict private
FMemberVar: integer;
end;
type
TBaseHelper = class helper for TBase
private
class var MemberVarOffset: Integer;
function GetMemberVar: Integer;
procedure SetMemberVar(value: Integer);
public
class constructor Create; // Executed at program start
property MemberVar : Integer read GetMemberVar write SetMemberVar;
end;
class constructor TBaseHelper.Create;
var
ctx: TRTTIContext;
begin
MemberVarOffset := ctx.GetType(TBase).GetField('FMemberVar').Offset;
end;
function TBaseHelper.GetMemberVar: Integer;
begin
Result := PInteger(Pointer(NativeInt(Self) + MemberVarOffset))^;
end;
procedure TBaseHelper.SetMemberVar(value: Integer);
begin
PInteger(Pointer(NativeInt(Self) + MemberVarOffset))^ := value;
end;
This will have the benefit that the slow RTTI part is only executed once.
Note: Using RTTI for access of protected/private methods
The RTL/VCL/FMX have not declared visibility for access of protected/private methods with RTTI. It must be set with the local directive {$RTTI}.
Using RTTI for access of private/protected methods in other code requires for example setting :
{$RTTI EXPLICIT METHODS([vcPublic, vcProtected, vcPrivate])}
If you want a clean way that does not impact performance, you still can access private fields from a record helper using the with statement.
function TValueHelper.GetAsInteger: Integer;
begin
with Self do begin
Result := FData.FAsSLong;
end;
end;
I hope they keep this method open, because we have code with high performance demands.
Assuming that extended RTTI is not available, then without resorting to what would be considered hacking, you cannot access private members from code in a different unit. Of course, if RTTI is available it can be used.
It is my understanding that the ability to crack private members using helpers was an unintentional accident. The intention is that private members only be visible from code in the same unit, and strict private members only be visible from code in the same class. This change corrects the accident.
Without the ability to have the compiler crack the class for you, you would need to resort to other ways to do so. For instance, you could re-declare enough of the TBase class to be able to trick the compiler into telling you where a member lived.
type
THackBase = class(TObject)
private
FMemberVar: integer;
end;
Now you can write
var
obj: TBase;
....
MemberVar := THackBase(obj).FMemberVar;
But this is horrendously brittle and will break as soon as the layout of TBase is changed.
That will work for data members, but for non-virtual methods, you'd probably need to use runtime disassembly techniques to find the location of the code. For virtual members this technique can be used to find the VMT offset.
Further reading:
http://hallvards.blogspot.nl/2004/06/hack-5-access-to-private-fields.html
https://bitbucket.org/NickHodges/delphi-unit-tests/wiki/Accessing%20Private%20Members
If you don't need ARM compiler support, you can find another solution here.
With inline asembler, you can access private field or method, easily.
I think David's answer is better in most case, but if you need a quick solution for a huge class, this method could be more useful.
Update(June 17): I've just noticed, I forgot to share his sample code for accessing private fields from his post. sorry.
unit UnitA;
type
THoge = class
private
FPrivateValue: Integer;
procedure PrivateMethod;
end;
end.
unit UnitB;
type
THogeHelper = class helper for THoge
public
function GetValue: Integer;
procedure CallMethod;
end;
function THogeHelper.GetValue: Integer;
asm
MOV EAX,Self.FPrivateValue
end;
procedure THogeHelper.CallMethod;
asm
CALL THoge.PrivateMethod
end;
Here is his sample code for calling private method.
type
THoge = class
private
procedure PrivateMethod (Arg1, Arg2, Arg3 : Integer);
end;
// Method 1
// Get only method pointer (if such there is a need to assign a method pointer to somewhere)
type
THogePrivateProc = procedure (Self: THoge; Arg1, Arg2, Arg3: Integer);
THogePrivateMethod = procedure (Arg1, Arg2, Arg3: Integer) of object;
function THogeHelper.GetMethodAddr: Pointer;
asm
{$ifdef CPUX86}
LEA EAX, THoge.PrivateMethod
{$else}
LEA RAX, THoge.PrivateMethod
{$endif}
end;
var
hoge: THoge;
proc: THogePrivateProc;
method: THogePrivateMethod;
begin
// You can either in here of the way,
proc := hoge.GetMethodAddr;
proc (hoge, 1, 2, 3);
// Even here of how good
TMethod (method) .Code := hoge.GetMethodAddr;
TMethod (method) .Data := hoge;
method (1, 2, 3) ;
end;
// Method 2
// To jump (here is simple if you just simply call)
procedure THogeHelper.CallMethod (Arg1, Arg2, Arg3 : Integer);
asm
JMP THoge.PrivateMethod
end;
unit UnitA;
type
THoge = class
private
FPrivateValue: Integer;
procedure PrivateMethod;
end;
end.
Just use 'with' statement to access private fields !
See the sample code below, taken from this article I noticed today. (Thanks, Mr.DEKO as always !)
This hack is originally reported on QualityPortal in August 2019 as described on above aritcle. (login required)
before rewrite (using "asm" method)
function TPropertyEditorHelper.GetPropList: PInstPropList;
{$IF CompilerVersion < 31.0}
begin
Result := Self.FPropList;
end;
{$ELSE}
// http://d.hatena.ne.jp/tales/20160420/1461081751
asm
MOV EAX, Self.FPropList;
end;
{$IFEND}
rewrite using 'with'
function TPropertyEditorHelper.GetPropList: PInstPropList;
begin
with Self do
Result := FPropList;
end;
I was amazed it's so simple :-)
I have a record that looks like:
TBigint = record
PtrDigits: Pointer; <-- The data is somewhere else.
Size: Byte;
MSB: Byte;
Sign: Shortint;
...
class operator Implicit(a: TBigint): TBigint; <<-- is this allowed?
....
The code is pre-class operator legacy code, but I want to add operators.
I know the data should really be stored in a dynamic array of byte, but I do not want to change the code, because all the meat is in x86-assembly.
I want to following code to trigger the class operator at the bottom:
procedure test(a: TBignum);
var b: TBignum;
begin
b:= a; <<-- naive copy will tangle up the `PtrDigit` pointers.
....
If I add the implicit typecast to itself, will the following code be executed?
class operator TBigint.Implicit(a: TBigint): TBigint;
begin
sdpBigint.CreateBigint(Result, a.Size);
sdpBigint.CopyBigint(a, Result);
end;
(Will test and add the answer if it works as I expect).
My first answer attempts to dissuade against the idea of overriding the assignment operator. I still stand by that answer, because many of the problems to be encountered are better solved with objects.
However, David quite rightly pointed out that TBigInt is implemented as a record to leverage operator overloads. I.e. a := b + c;. This is a very good reason to stick with a record based implementation.
Hence, I propose this alternative solution that kills two birds with one stone:
It removes the memory management risks explained in my other answer.
And provides a simple mechanism to implement Copy-on-Write semantics.
(I do still recommend that unless there's a very good reason to retain a record based solution, consider switching to an object based solution.)
The general idea is as follows:
Define an interface to represent the BigInt data. (This can initially be minimalist and support only control of the pointer - as in my example. This would make the initial conversion of existing code easier.)
Define an implementation of the above interface which will be used by the TBigInt record.
The interface solves the first problem, because interfaces are a managed type; and Delphi will dereference the interface when a record goes out of scope. Hence, the underlying object will destroy itself when no longer needed.
The interface also provides the opportunity to solve the second problem, because we can check the RefCount to know whether we should Copy-On-Write.
Note that long term it might prove beneficial to move some of the BigInt implementation from the record to the class & interface.
The following code is trimmed-down "big int" implementation purely to illustrate the concepts. (I.e. The "big" integer is limited to a regular 32-bit number, and only addition has been implemented.)
type
IBigInt = interface
['{1628BA6F-FA21-41B5-81C7-71C336B80A6B}']
function GetData: Pointer;
function GetSize: Integer;
procedure Realloc(ASize: Integer);
function RefCount: Integer;
end;
type
TBigIntImpl = class(TInterfacedObject, IBigInt)
private
FData: Pointer;
FSize: Integer;
protected
{IBigInt}
function GetData: Pointer;
function GetSize: Integer;
procedure Realloc(ASize: Integer);
function RefCount: Integer;
public
constructor CreateCopy(ASource: IBigInt);
destructor Destroy; override;
end;
type
TBigInt = record
PtrDigits: IBigInt;
constructor CreateFromInt(AValue: Integer);
class operator Implicit(AValue: TBigInt): Integer;
class operator Add(AValue1, AValue2: TBigInt): TBigInt;
procedure Add(AValue: Integer);
strict private
procedure CopyOnWriteSharedData;
end;
{ TBigIntImpl }
constructor TBigIntImpl.CreateCopy(ASource: IBigInt);
begin
Realloc(ASource.GetSize);
Move(ASource.GetData^, FData^, FSize);
end;
destructor TBigIntImpl.Destroy;
begin
FreeMem(FData);
inherited;
end;
function TBigIntImpl.GetData: Pointer;
begin
Result := FData;
end;
function TBigIntImpl.GetSize: Integer;
begin
Result := FSize;
end;
procedure TBigIntImpl.Realloc(ASize: Integer);
begin
ReallocMem(FData, ASize);
FSize := ASize;
end;
function TBigIntImpl.RefCount: Integer;
begin
Result := FRefCount;
end;
{ TBigInt }
class operator TBigInt.Add(AValue1, AValue2: TBigInt): TBigInt;
var
LSum: Integer;
begin
LSum := Integer(AValue1) + Integer(AValue2);
Result.CreateFromInt(LSum);
end;
procedure TBigInt.Add(AValue: Integer);
begin
CopyOnWriteSharedData;
PInteger(PtrDigits.GetData)^ := PInteger(PtrDigits.GetData)^ + AValue;
end;
procedure TBigInt.CopyOnWriteSharedData;
begin
if PtrDigits.RefCount > 1 then
begin
PtrDigits := TBigIntImpl.CreateCopy(PtrDigits);
end;
end;
constructor TBigInt.CreateFromInt(AValue: Integer);
begin
PtrDigits := TBigIntImpl.Create;
PtrDigits.Realloc(SizeOf(Integer));
PInteger(PtrDigits.GetData)^ := AValue;
end;
class operator TBigInt.Implicit(AValue: TBigInt): Integer;
begin
Result := PInteger(AValue.PtrDigits.GetData)^;
end;
The following tests were written as I built up the proposed solution. They prove: some basic functionality, that the copy-on-write works as expected, and that there are no memory leaks.
procedure TTestCopyOnWrite.TestCreateFromInt;
var
LBigInt: TBigInt;
begin
LBigInt.CreateFromInt(123);
CheckEquals(123, LBigInt);
//Dispose(PInteger(LBigInt.PtrDigits)); //I only needed this until I
//started using the interface
end;
procedure TTestCopyOnWrite.TestAssignment;
var
LValue1: TBigInt;
LValue2: TBigInt;
begin
LValue1.CreateFromInt(123);
LValue2 := LValue1;
CheckEquals(123, LValue2);
end;
procedure TTestCopyOnWrite.TestAddMethod;
var
LValue1: TBigInt;
begin
LValue1.CreateFromInt(123);
LValue1.Add(111);
CheckEquals(234, LValue1);
end;
procedure TTestCopyOnWrite.TestOperatorAdd;
var
LValue1: TBigInt;
LValue2: TBigInt;
LActualResult: TBigInt;
begin
LValue1.CreateFromInt(123);
LValue2.CreateFromInt(111);
LActualResult := LValue1 + LValue2;
CheckEquals(234, LActualResult);
end;
procedure TTestCopyOnWrite.TestCopyOnWrite;
var
LValue1: TBigInt;
LValue2: TBigInt;
begin
LValue1.CreateFromInt(123);
LValue2 := LValue1;
LValue1.Add(111); { If CopyOnWrite, then LValue2 should not change }
CheckEquals(234, LValue1);
CheckEquals(123, LValue2);
end;
Edit
Added a test demonstrating use of TBigInt as value parameter to a procedure.
procedure TTestCopyOnWrite.TestValueParameter;
procedure CheckValueParameter(ABigInt: TBigInt);
begin
CheckEquals(2, ABigInt.PtrDigits.RefCount);
CheckEquals(123, ABigInt);
ABigInt.Add(111);
CheckEquals(234, ABigInt);
CheckEquals(1, ABigInt.PtrDigits.RefCount);
end;
var
LValue: TBigInt;
begin
LValue.CreateFromInt(123);
CheckValueParameter(LValue);
end;
There is nothing in Delphi that allows you to hook into the assignment process. Delphi has nothing like C++ copy constructors.
Your requirements, are that:
You need a reference to the data, since it is of variable length.
You also have a need for value semantics.
The only types that meet both of those requirements are the native Delphi string types. They are implemented as a reference. But the copy-on-write behaviour that they have gives them value semantics. Since you want an array of bytes, AnsiString is the string type that meets your needs.
Another option would be to simply make your type be immutable. That would let you stop worrying about copying references since the referenced data could never be modified.
It seems to me your TBigInt should be a class rather than a record. Because you're concerned about PtrDigits being tangled up, it sounds like you're needing extra memory management for what the pointer references. Since records don't support destructors there's no automatic management of that memory. Also if you simply declare a variable of TBigInt, but don't call the CreatBigInt constructor, the memory is not correctly initialised. Again, this is because you cannot override a record's default parameterless constructor.
Basically you have to always remember what has been allocated for the record and remember to manually deallocate. Sure you can have a deallocate procedure on the record to help in this regard, but you still have to remember to call it in the correct places.
However that said, you could implement an explicit Copy function, and add an item to your code-review checklist that TBitInt has been copied correctly. Unfortunately you'll have to be very careful with the implied copies such as passing the record via a value parameter to another routine.
The following code illustrates an example conceptually similar to your needs and demonstrates how the CreateCopy function "untangles" the pointer. It also highlights some of the memory management problems that crop up, which is why records are probably not a good way to go.
type
TMyRec = record
A: PInteger;
function CreateCopy: TMyRec;
end;
function TMyRec.CreateCopy: TMyRec;
begin
New(Result.A);
Result.A^ := A^;
end;
var
R1, R2: TMyRec;
begin
New(R1.A); { I have to manually allocate memory for the pointer
before I can use the reocrd properly.
Even if I implement a record constructor to assist, I
still have to remember to call it. }
R1.A^ := 1;
R2 := R1;
R2.A^ := 2; //also changes R1.A^ because pointer is the same (or "tangled")
Writeln(R1.A^);
R2 := R1.CreateCopy;
R2.A^ := 3; //Now R1.A is different pointer so R1.A^ is unchanged
Writeln(R1.A^);
Dispose(R1.A);
Dispose(R2.A); { <-- Note that I have to remember to Dispose the additional
pointer that was allocated in CreateCopy }
end;
In a nutshell, it seems you're trying to sledgehammer records into doing things they're not really suited to doing.
They are great at making exact copies. They have simple memory management: Declare a record variable, and all memory is allocated. Variable goes out of scope and all memory is deallocated.
Edit
An example of how overriding the assignment operator can cause a memory leak.
var
LBigInt: TBigInt;
begin
LBigInt.SetValue(123);
WriteBigInt(LBigInt); { Passing the value by reference or by value depends
on how WriteBigInt is declared. }
end;
procedure WriteBigInt(ABigInt: TBigInt);
//ABigInt is a value parameter.
//This means it will be copied.
//It must use the overridden assignment operator,
// otherwise the point of the override is defeated.
begin
Writeln('The value is: ', ABigInt.ToString);
end;
//If the assignment overload allocated memory, this is the only place where an
//appropriate reference exists to deallocate.
//However, the very last thing you want to do is have method like this calling
//a cleanup routine to deallocate the memory....
//Not only would this litter your code with extra calls to accommodate a
//problematic design, would also create a risk that a simple change to taking
//ABigInt as a const parameter could suddenly lead to Access Violations.
I read with interest Nick Hodges blog on Why You Should Be Using Interfaces
and since I'm already in love with interfaces at a higher level in my coding I decided to look at how I could extend this to quite low levels and to investigate what support for this existed in the VCL classes.
A common construct that I need is to do something simple with a TStringList, for example this code to load a small text file list into a comma text string:
var
MyList : TStrings;
sCommaText : string;
begin
MyList := TStringList.Create;
try
MyList.LoadFromFile( 'c:\temp\somefile.txt' );
sCommaText := MyList.CommaText;
// ... do something with sCommaText.....
finally
MyList.Free;
end;
end;
It would seem a nice simplification if I could write with using MyList as an interface - it would get rid of the try-finally and improve readability:
var
MyList : IStrings;
//^^^^^^^
sCommaText : string;
begin
MyList := TStringList.Create;
MyList.LoadFromFile( 'c:\temp\somefile.txt' );
sCommaText := MyList.CommaText;
// ... do something with sCommaText.....
end;
I can't see an IStrings defined though - certainly not in Classes.pas, although there are references to it in connection with OLE programming online. Does it exist? Is this a valid simplification? I'm using Delphi XE2.
There is no interface in the RTL/VCL that does what you want (expose the same interface as TStrings). If you wanted to use such a thing you would need to invent it yourself.
You would implement it with a wrapper like this:
type
IStrings = interface
function Add(const S: string): Integer;
end;
TIStrings = class(TInterfacedObject, IStrings)
private
FStrings: TStrings;
public
constructor Create(Strings: TStrings);
destructor Destroy; override;
function Add(const S: string): Integer;
end;
constructor TIStrings.Create(Strings: TStrings);
begin
inherited Create;
FStrings := Strings;
end;
destructor TIStrings.Destroy;
begin
FStrings.Free; // don't use FreeAndNil because Nick might see this code ;-)
inherited;
end;
function TIStrings.Add(const S: string): Integer;
begin
Result := FStrings.Add(S);
end;
Naturally you would wrap up the rest of the TStrings interface in a real class. Do it with a wrapper class like this so that you can wrap any type of TStrings just by having access to an instance of it.
Use it like this:
var
MyList : IStrings;
....
MyList := TIStrings.Create(TStringList.Create);
You may prefer to add a helper function to actually do the dirty work of calling TIStrings.Create.
Note also that lifetime could be an issue. You may want a variant of this wrapper that does not take over management of the lifetime of the underlying TStrings instance. That could be arranged with a TIStrings constructor parameter.
Myself, I think this to be an interesting thought experiment but not really a sensible approach to take. The TStrings class is an abstract class which has pretty much all the benefits that interfaces offer. I see no real downsides to using it as is.
Since TStrings is an abstract class, an interface version of it wouldn't provide much. Any implementer of that interface would surely be a TStrings descendant anyway, because nobody would want to re-implement all the things TStrings does. I see two reasons for wanting a TStrings interface:
Automatic resource cleanup. You don't need a TStrings-specific interface for that. Instead, use the ISafeGuard interface from the JCL. Here's an example:
var
G: ISafeGuard;
MyList: TStrings;
sCommaText: string;
begin
MyList := TStrings(Guard(TStringList.Create, G));
MyList.LoadFromFile('c:\temp\somefile.txt');
sCommaText := MyList.CommaText;
// ... do something with sCommaText.....
end;
To protect multiple objects that should have the same lifetime, use IMultiSafeGuard.
Interoperation with external modules. This is what IStrings is for. Delphi implements it with the TStringsAdapter class, which is returned when you call GetOleStrings on an existing TStrings descendant. Use that when you have a string list and you need to grant access to another module that expects IStrings or IEnumString interfaces. Those interfaces are clunky to use otherwise — neither provides all the things TStrings does — so don't use them unless you have to.
If the external module you're working with is something that you can guarantee will always be compiled with the same Delphi version that your module is compiled with, then you should use run-time packages and pass TStrings descendants directly. The shared package allows both modules to use the same definition of the class, and memory management is greatly simplified.
I'd like to pass a method of a class as callback to a WinAPI function. Is this possible and if yes, how?
Example case for setting a timer:
TMyClass = class
public
procedure TimerProc(Wnd:HWND; uMsg:DWORD; idEvent:PDWORD; dwTime:DWORD);
procedure DoIt;
end;
[...]
procedure TMyClass.DoIt;
begin
SetTimer(0, 0, 8, #TimerProc); // <-???- that's what I want to do (last param)
end;
Thanks for your help!
Edit: The goal is to specify a method of this class as callback. No procedure outside the class.
Edit2: I appreciate all your help but as long as the method has no "TMyClass." in front of its name it is not what I am searching for. I used to do it this way but wondered if could stay fully in the object oriented world. Pointer magic welcome.
Madshi has a MethodToProcedure procedure. It's in the "madTools.pas" which is in the "madBasic" package. If you use it, you should change the calling convention for "TimerProc" to stdcall and DoIt procedure would become,
TMyClass = class
private
Timer: UINT;
SetTimerProc: Pointer;
[...]
procedure TMyClass.DoIt;
begin
SetTimerProc := MethodToProcedure(Self, #TMyClass.TimerProc);
Timer := SetTimer(0, 0, 8, SetTimerProc);
end;
// After "KillTimer(0, Timer)" is called call:
// VirtualFree(SetTimerProc, 0, MEM_RELEASE);
I've never tried but I think one could also try to duplicate the code in the "classses.MakeObjectInstance" for passing other procedure types than TWndMethod.
Which version of Delphi are you using?
In recent ones you can use static class methods for this:
TMyClass = class
public
class procedure TimerProc(Wnd:HWND; uMsg:DWORD; idEvent:PDWORD; dwTime:DWORD); stdcall; static;
procedure DoIt;
end;
[...]
procedure TMyClass.DoIt;
begin
SetTimer(0, 0, 8, #TimerProc);
end;
The TimerProc procedure should be a standard procedure, not a method pointer.
A method pointer is really a pair of
pointers; the first stores the address
of a method, and the second stores a
reference to the object the method
belongs to
Edit
This might be as much OOP as you are going to get it. All the nasty stuff is hidden from anyone using your TMyClass.
unit Unit2;
interface
type
TMyClass = class
private
FTimerID: Integer;
FPrivateValue: Boolean;
public
constructor Create;
destructor Destroy; override;
procedure DoIt;
end;
implementation
uses
Windows, Classes;
var
ClassList: TList;
constructor TMyClass.Create;
begin
inherited Create;
ClassList.Add(Self);
end;
destructor TMyClass.Destroy;
var
I: Integer;
begin
I := ClassList.IndexOf(Self);
if I <> -1 then
ClassList.Delete(I);
inherited;
end;
procedure TimerProc(Wnd:HWND; uMsg:DWORD; idEvent:PDWORD; dwTime:DWORD); stdcall;
var
I: Integer;
myClass: TMyClass;
begin
for I := 0 to Pred(ClassList.Count) do
begin
myClass := TMyClass(ClassList[I]);
if myClass.FTimerID = Integer(idEvent) then
myClass.FPrivateValue := True;
end;
end;
procedure TMyClass.DoIt;
begin
FTimerID := SetTimer(0, 0, 8, #TimerProc); // <-???- that's what I want to do (last param)
end;
initialization
ClassList := TList.Create;
finalization
ClassList.Free;
end.
Edit: (as mentioned by glob)
Don't forget to add the stdcall calling convention.
Response to your second edit:
If you want a reply that includes a pointer to a TMyClass instance, you may be out of luck. Fundamentally, the procedure Windows will call has a certain signature and is not an object method. You cannot directly work around that, not even with __closure or procedure of object magic, except as described below and in other answers. Why?
Windows has no knowledge of it being an object method, and wants to call a procedure with a specific signature.
The pointer is no longer a simple pointer - it has two halves, the object instance and the method. It needs to save the Self, as well as the method.
By the way, I don't understand what is wrong with a short dip outside the object-oriented world. Non-OO code is not necessarily dirty if used well.
Original, pre-your-edit answer:
It's not possible exactly as you are trying to do it. The method that SetTimer wants must exactly follow the TIMERPROC signature - see the MSDN documentation. This is a simple, non-object procedure.
However, the method TMyClass.DoIt is an object method. It actually has two parts: the object on which it is called, and the method itself. In Delphi, this is a "procedure of object" or a "closure" (read about procedural types here). So, the signatures are not compatible, and you cannot store the object instance, which you need in order to call an object method. (There are also calling convention problems - standard Delphi methods are implemented using the fastcall convention, whereas TIMERPROC specifies CALLBACK which, from memory, is a macro that expands to stdcall. Read more about calling conventions and especially fastcall.)
So, what do you do? You need to map your non-object-oriented callback into object-oriented code.
There are several ways, and the simplest is this:
If you only have one timer ever, then you know that when your timer callback is called it is that specific timer that fired. Save a method pointer in a variable that is of type procedure of object with the appropriate signature. See the Embarcadero documentation link above for more details. It will probably look like:
type TMyObjectProc = procedure of object;
var pfMyProc : TMyObjectProc;
Then, initialise pfMyProc to nil. In TMyClass.DoIt, set pfMyProc to #DoIt - that is, it is now pointing at the DoIt procedure in the context of that specific TMyClass instantiation. Your callback can then call that method.
(If you're interested, class variables that are of a procedural type like this are how event handlers are stored internally. The OnFoo properties of a VCL object are pointers to object procedures.)
Unfortunately this procedural architecture is not object-oriented, but it's how it has to be done.
Here's what some full code might look like (I'm not at a compiler, so it may not work as written, but it should be close):
type TMyObjectProc = procedure of object;
var pfMyProc : TMyObjectProc;
initialization
pfMyProc = nil;
procedure MyTimerCallback(hWnd : HWND; uMsg : DWORD; idEvent : PDWORD; dwTime : DWORD); stdcall;
begin
if Assigned(pfMyProc) then begin
pfMyProc(); // Calls DoIt, for the object that set the timer
pfMyProc = nil;
end;
end;
procedure TMyClass.MyOOCallback;
begin
// Handle your callback here
end;
procedure TMyClass.DoIt;
begin
pfMyProc = #MyOOCallback;
SetTimer(0, 0, 8, # MyTimerCallback);
end;
Another way would be to take advantage of the fact your timer has a unique ID. Save a mapping between the timer ID and the the object. In the callback, convert from the ID to the pointer, and call the object's method.
Edit: I've noticed a comment to another answer suggesting using the address of your object as the timer ID. This will work, but is a potentially dangerous hack if you end up having two objects at the same address at different times, and you don't call KillTimer. I've used that method but don't personally like it - I think the extra bookkeeping of keeping a (timer ID, object pointer) map is better. It really comes down to personal style, though.
I've used MakeObjectInstance a few times to do the same.
Here's an article on the subject:
How to use a VCL class member-function as a Win32 callback
TMyClass = class
public
procedure DoIt;
procedure DoOnTimerViaMethod;
end;
var MyReceiverObject: TMyClass;
[...]
procedure TimerProc(Wnd:HWND; uMsg:DWORD; idEvent:PDWORD; dwTime:DWORD); stdcall:
begin
if Assigned(MyReceiverObject) then
MyReceiverObject.DoOnTimerViaMethod;
end;
procedure TMyClass.DoIt;
begin
MyReceiverObject := Self;
SetTimer(0, 0, 8, #TimerProc); // <-???- that's what I want to do (last param)
end;
Not perfect. Watch for the threads, variable overwriting etc. But it does the job.
What techniques exist to automatically free objects in delphi applications?
Use interfaces instead of objects. They are reference counted and freed automatically when the reference count reaches 0.
I have written a function GC(obj: TObject) (for Garbage Collect) which takes an object and frees it when the execution leaves the current method. It's kind of like a one-line shorthand function for a Try Finally Free block.
Instead of:
procedure Test;
var AQuery: TQuery;
begin
AQuery := TQuery.Create(nil);
try
...
finally
FreeAndNil(AQuery);
end;
end;
I just have:
procedure Test;
var AQuery: TQuery;
begin
AQuery := TQuery.Create(nil);
GC(AQuery);
...
end;
The GC function simply returns an object in the form of an interface.
function GC(obj: TObject): IGarbo;
begin
Result := TGarbo.Create(obj);
end;
Because the TGarbo class descends from TInterfacedObject, when the TGarbo object goes out of scope it will automatically get freed. In the destructor of the TGarbo object, it also frees the object you passed to it in it's constructor (the object you passed in the GC function).
type
IGarbo = interface
['{A6E17957-C233-4433-BCBD-3B53C0C2C596}']
function Obj: TObject;
end;
TGarbo = class(TInterfacedObject, IGarbo)
private
FObj: TObject;
public
constructor Create(AObjectToGC: TObject);
destructor Destroy; override;
function Obj: TObject;
end;
{ TGarbo }
constructor TGarbo.Create(AObjectToGC: TObject);
begin
inherited Create;
FObj := AObjectToGC;
end;
destructor TGarbo.Destroy;
begin
if Assigned(FObj) then
FreeAndNil(FObj);
inherited;
end;
function TGarbo.Obj: TObject;
begin
Result := FObj;
end;
Being stuck in the world of Delphi 7 with no sight of upgrading to a version of Delphi with built-in garbage collection in the near future, I'm addicted to using this short-hand method of easily freeing local temporary objects! :)
Along the lines of interfaces, you can try the Guard function in the JclSysUtils unit, part of the free Jedi Code Library. It allows you to associate an object with a separate interface reference, so when that interface reference is destroyed, the object is destroyed along with it. This can be useful when you don't have the option of modifying the classes you're using to make them support interfaces of their own.
var
G: ISafeGuard;
foo: TStrings;
begin
// Guard returns TObject, so a type-cast is necessary
foo := Guard(TStringList.Create, G) as TStrings;
// Use the object as normal
foo.Add('bar');
end; // foo gets freed automatically as G goes out of scope
There are overloads for objects and GetMem-allocated pointers. There is also IMultiSafeGuard, which can ensure that multiple objects get freed.
If you have a factory function, you might be creating an object, setting some of its properties, and then returning it. If an exception occurs while setting the properties, you'll want to make sure you free the object since you can't return it. One way to do that is like this:
function Slurp(const source: TFileName): TStrings;
begin
Result := TStringList.Create;
try
Result.LoadFromFile(source);
except
Result.Free;
raise;
end;
end;
With Guard, it would become this:
function Slurp(const source: TFileName): TStrings;
var
G: ISafeGuard;
begin
Result := Guard(TStringList.Create, G) as TStrings;
Result.LoadFromFile(source);
G.ReleaseItem;
end;
The ReleaseItem method revokes the ISafeGuard's ownership of the object. If an exception occurs before that happens, then as the stack unwinds and the interface is released, the guard will free the object.
I have to say, I don't like "hiding" the Free of an object. Far better to have the traditional code:
MyObject := TObject.Create;
try
// do stuff
finally
FreeAndNil(MyObject);
end;
No way it can go wrong, works as expected, and people recognise the pattern.
Use the object ownership of components that the VCL provides. As long as you create objects with a non-nil owner you don't need to free them explicitely. See also my answer to this question.
Here is the API for Boehm Garbage Collector DLL for Delphi. The Delphi API is written by Barry Kelly, who works for CodeGear writing the compiler now.
Smart Pointers work really well if you have Delphi 2009.
If you use Delphi for .Net / Delphi Prism you get Garbage Collection which takes care of all the freeing.