Delphi - interface as another interface - delphi

I have two interfaces, ISomeInterfaceRO (read only) and ISomeInterface.
ISomeInterfaceRO = interface(IInterface) ['{B28A9FB0-841F-423D-89AF-E092FE04433F}']
function GetTest: Integer;
property Test : integer read GetTest;
end;
ISomeInterface = interface(ISomeInterfaceRO) ['{C7148E40-568B-4496-B923-89BB891A7310}']
procedure SetTest(const aValue: Integer);
property Test : integer read GetTest write SetTest;
end;
TSomeClass = class(TInterfacedObject, ISomeInterfaceRO, ISomeInterface)
private
fTest: integer;
protected
function GetTest: integer;
procedure SetTest(const aValue: integer);
public
property Test: integer read GetTest write SetTest;
end;
function TSomeClass.GetTest: integer;
begin
Result := fTest;
end;
procedure TSomeClass.SetTest(const aValue: integer);
begin
fTest := aValue;
end;
Then, i use read only interface except one place, when i create TSomeClass instance as ISomeInterface and fill it. example:
Function GetSome: ISomeInterfaceRO;
var
SomeInterface: ISomeInterface;
begin
SomeInterface := TSomeClass.Create;
SomeInterface.Test := 10;
result := SomeInterface as ISomeInterfaceRO;
end;
My question is: that "result := SomeInterface as ISomeInterfaceRO;" is a safe and recommended construction? Or is a another way to do this?
I debugged that code, and compiler properly decreased reference count to ISomeInterface and increased to ISomeInterfaceRO when i use "as".

Result := SomeInterface as ISomeInterfaceRO;
is safe but not necessary at all because ISomeInterface inherits from ISomeInterfaceRO and thus SomeInterface is assignment compatible to Result. That means you can just write
Result := SomeInterface;
I however would put a constructor on TSomeClass that takes the value so you can directly write:
Result := TSomeClass.Create(10);

Related

Delphi copy generic object with unknown base type at compile time

I would like to copy generic object but its type can only be obtained by the "class of" construct at runtime as the source object type may be different (TItem or TSpecificItem etc.):
type
TItem = class
//...
procedure Assign(Source: TItem);virtual; abstract; //edit
end;
TSpecificItem = class(TItem)
//...
end;
TEvenMoreSpecificItem = class(TSpecificItem)
//...
end;
TItemClass = class of TItem;
TItemContainer = class
FItems: TObjectList<TItem>; //edit
procedure Assign(Source: TObject); //edit
function GetItem(Index: Integer): TItem; inline; //edit
procedure SetItem(Index: Integer; Item: TItem); inline; //edit
function Count: Integer; //edit;
function ItemClass: TItemClass; virtual; abstract;
property Items[Index: Integer]: TItem read GetItem write SetItem; //edit
end;
TItemContainer<T: TItem> = class(TItemContainer)
//...
function GetItem(Index: Integer): T; inline; //edit
procedure SetItem(Index: Integer; Item: T); inline; //edit
function ItemClass: TItemClass; override;
property Items[Index: Integer]: T read GetItem write SetItem; default; //edit
end;
//start of edit
function TItemContainer.Count: Integer;
begin
Result := FItems.Count;
end;
function TItemContainer.GetItem(Index: Integer): TItem;
begin
Result := FItems[Index];
end;
procedure TItemContainer.SetItem(Index: Integer; Item: TItem);
begin
FItems[Index].Assign(Item);
end;
procedure TItemContainer.Assign(Source: TObject);
var
I: Integer;
Item: TItem;
Cls: TClass;
begin
if Source is TItemContainer then
begin
FItems.Clear;
for I := 0 to TItemContainer(Source).Count - 1 do
begin
Item := TItemContainer(Source).Items[I];
Cls := Item.ClassType;
Item := TItemClass(Cls).Create;
Item.Assign(TItemContainer(Source).Items[I]);
FItems.Add(Item);
end;
end;
end;
function TItemContainer<T>.GetItem(Index: Integer): T;
begin
Result := T(inherited GetItem(Index));
end;
procedure TItemContainer<T>.SetItem(Index: Integer; Item: T);
begin
inherited SetItem(Index, Item);
end;
//end of edit
function TItemContainer<T>.ItemClass: TItemClass;
begin
Result := TItemClass(GetTypeData(PTypeInfo(TypeInfo(T)))^.ClassType);
end;
function CopyGenericObject(Source: TItemContainer): TItemContainer;
var
Cls: TItemClass;
begin
Cls := Source.ItemClass;
Result := TItemContainer<Cls>.Create; // compiler reports error "incompatible types"
Result.Assign(Source);
end;
// edit:
procedure DoCopy;
var
Source: TItemContainer<TEvenMoreSpecificItem>;
Dest: TItemContainer;
begin
Source := TItemContainer<TEvenMoreSpecificItem>.Create; // for example
//add some items to Source
Dest := CopyGenericObject(Source);
//use the result somewhere
end;
I must Use Delphi XE.
I've found
http://docwiki.embarcadero.com/RADStudio/XE6/en/Overview_of_Generics
Dynamic instantiation
Dynamic instantiation at run time is not supported.
Is it what I want to do?
If I understand well, what you are looking for is to implement a routine that will create an instance of a class of the same type as a given source. This can be done like this :
type
TItemContainerclass = class of TItemContainer;
function CopyGenericObject(Source: TItemContainer): TItemContainer;
begin
Result := TItemContainerclass(Source.ClassType).Create;
end;
Also, you can simplify the ItemClass routine to
function TItemContainer<T>.ItemClass: TItemClass;
begin
Result := T;
end;
Note that this will only create a new instance and not a copy of the source, but since your code doesn't show any attempt to copy the object and only create a new instance, I presumed this is your intended result.
Note : This works in Delphi 10, I don't have access to XE to test it.
The line
Cls := Source.ItemClass;
will create the TItemClass instance at run time only. For Generics, the compiler needs to know the type at compile time. Without knowing it, the compiler can not generate the binary code which implements your specific TItemContainer<Cls>. Or, said in other words, Cls must not be a variable, it has to be a specific class type, known at compile time.
So for example these will compile:
Result := TItemContainer<TSpecificItem>.Create;
or
Result := TItemContainer<TEvenMoreSpecificItem>.Create;
but not this
Result := TItemContainer</* type will be known later */>.Create;
because the compiler is not able to come back later and complete the binary application code based on the actual type of Cls.
You can make CopyGenericObject function as a method of your generic object instead of stand-alone function:
TItemContainer<T: TItem> = class(TItemContainer)
...
function Copy: TItemContainer<T>;
end;
In this case, it "knows" at compile-time, what class to create just because there are now several of them (one for each Instantiated type) after compiler did its work, each making copy of itself.
There is one more trick which may be useful in your case: how to copy various objects. For example, you have common class TAnimal and its descendants: TCat and TDog. You store them in TItemContainer, that's the whole point of inheritance that you can do it and treat them generally. Now, you want to implement creating a copy of this container and you don't know at compile time, which elements will be dogs and which will be cats. Standart method is to define abstract function Copy in TAnimal:
TAnimal = class
public
...
function Copy: TAnimal; virtual; abstract;
end;
and then implement it in each descendant, so then you can copy your TItemContainer like this:
function TItemContainer<T>.Copy: TItemContainer<T>;
var i: T;
begin
Result:=TItemContainer<T>.Create;
for i in Items do
//I don't know exact structure of your container,
//maybe that's more like
// for j:=0 to Count-1 do begin
// i:=Items[j];
//but I hope it's obvious what happens here
Result.Add(i.copy as T);
end;
So if you have container of cats, then i.copy will return TAnimal (but actually a cat) which will be cast to TCat at last. It works but a bit ugly.
In delphi I came up with better solution: make this copy a constructor, not a function:
TAnimal = class
public
...
constructor Copy(source: TAnimal); virtual;
end;
In that case copying your container is like this:
function TItemContainer<T>.Copy: TItemContainer<T>;
var i,j: T;
begin
Result:=TItemContainer<T>.Create;
for i in Items do
Result.Add(T.Copy(i));
end;
no extra casting which is good. What's more, you can for example derive your classes from TPersistent and implement Assign procedure everywhere you need (very useful thing) and then once and for all write a copy constructor:
TAnimal = class(TPersistent)
public
constructor Copy(source: TPersistent); //or maybe source: TAnimal
end;
//implementation
constructor TAnimal.Copy(source: TPersistent);
begin
Create;
Assign(source);
end;

How can I convert from generic to Variant in Delphi

I have a Delphi generic class that exposes a function with an argument of the generic type. Inside this function, I need to pass an instance of the generic type on to another object expecting a Variant type. Similar to this:
type
IMyInterface = interface
DoStuff(Value: Variant);
end;
TMyClass<T> = class
FMyIntf: IMyInterface
procedure DoStuff(SomeValue: T);
end;
[...]
procedure MyClass<T>.DoStuff(SomeValue: T);
begin
FMyIntf.DoStuff((*convert SomeValue to Variant here*));
end;
I tried using Rtti.TValue.From(SomeValue).AsVariant. This worked for integral types, but blew up for Booleans. I don't quite see why, since normally I'd be able to assign a Boolean value to a Variant...
Is there a better way to make this conversion? I only need it to work for simple built-in types (excluding enumerations and records)
I think there is no direct way to convert generic type to variant because variant cannot hold all the possible types. You must write your specific conversion routine. E.g.:
interface
//...
type
TDemo = class
public
class function GetAsVariant<T>(const AValue: T): Variant;
end;
//...
implementation
uses
Rtti,
TypInfo;
//...
{ TDemo}
class function TDemo.GetAsVariant<T>(const AValue: T): Variant;
var
val: TValue;
bRes: Boolean;
begin
val := TValue.From<T>(AValue);
case val.Kind of
tkInteger: Result := val.AsInteger;
tkInt64: Result := val.AsInt64;
tkEnumeration:
begin
if val.TryAsType<Boolean>(bRes) then
Result := bRes
else
Result := val.AsOrdinal;
end;
tkFloat: Result := val.AsExtended;
tkString, tkChar, tkWChar, tkLString, tkWString, tkUString:
Result := val.AsString;
tkVariant: Result := val.AsVariant
else
begin
raise Exception.Create('Unsupported type');
end;
end;
end;
Because TValue.AsVariant handles most of the type conversions internally, this function can be simplified. I will handle enumerations in case you could need them later:
class function TDemo.GetAsVariant<T>(const AValue: T): Variant;
var
val: TValue;
begin
val := TValue.From<T>(AValue);
case val.Kind of
tkEnumeration:
begin
if val.TypeInfo = TypeInfo(Boolean) then
Result := val.AsBoolean
else
Result := val.AsOrdinal;
end
else
begin
Result := val.AsVariant;
end;
end;
Possible usage:
var
vValue: Variant;
begin
vValue := TDemo.GetAsVariant<Boolean>(True);
Assert(vValue = True); //now vValue is a correct Boolean
Looks like in my Delphi version 10.2 the Boolean problem is gone and TValue.From<T>(FValue).AsVariant is enough.
Here an example with some other helpful things like comparing the generic type:
TMyValue<T> = class(TPersistent)
private
FValue: T;
procedure SetValue(const AValue: T);
function GetAsVariant: Variant; override;
public
procedure Assign(Source: TPersistent); override;
property Value: T read FValue write SetValue;
property AsVariant: Variant read GetAsVariant;
end;
function TMyValue<T>.GetAsVariant: Variant;
begin
Result:= TValue.From<T>(FValue).AsVariant;
end;
procedure TMyValue<T>.SetValue(const AValue: T);
begin
if TEqualityComparer<T>.Default.Equals(AValue, FValue) then Exit;
FValue:= AValue;
//do something
end;
procedure TMyValue<T>.Assign(Source: TPersistent);
begin
if Source is TMyValue<T> then Value:= (Source as TMyValue<T>).Value
else inherited;
end;
Another way (tested XE10)
Var
old : variant;
val : TValue;
Begin
val := TValue.FromVariant(old);
End;

Generics constructor with parameter constraint?

TMyBaseClass=class
constructor(test:integer);
end;
TMyClass=class(TMyBaseClass);
TClass1<T: TMyBaseClass,constructor>=class()
public
FItem: T;
procedure Test;
end;
procedure TClass1<T>.Test;
begin
FItem:= T.Create;
end;
var u: TClass1<TMyClass>;
begin
u:=TClass1<TMyClass>.Create();
u.Test;
end;
How do I make it to create the class with the integer param. What is the workaround?
Just typecast to the correct class:
type
TMyBaseClassClass = class of TMyBaseClass;
procedure TClass1<T>.Test;
begin
FItem:= T(TMyBaseClassClass(T).Create(42));
end;
Also it's probably a good idea to make the constructor virtual.
You might consider giving the base class an explicit method for initialization instead of using the constructor:
TMyBaseClass = class
public
procedure Initialize(test : Integer); virtual;
end;
TMyClass = class(TMyBaseClass)
public
procedure Initialize(test : Integer); override;
end;
procedure TClass1<T>.Test;
begin
FItem:= T.Create;
T.Initialize(42);
end;
Of course this only works, if the base class and all subclasses are under your control.
Update
The solution offered by #TOndrej is far superior to what I wrote below, apart from one situation. If you need to take runtime decisions as to what class to create, then the approach below appears to be the optimal solution.
I've refreshed my memory of my own code base which also deals with this exact problem. My conclusion is that what you are attempting to achieve is impossible. I'd be delighted to be proved wrong if anyone wants to rise to the challenge.
My workaround is for the generic class to contain a field FClass which is of type class of TMyBaseClass. Then I can call my virtual constructor with FClass.Create(...). I test that FClass.InheritsFrom(T) in an assertion. It's all depressingly non-generic. As I said, if anyone can prove my belief wrong I will upvote, delete, and rejoice!
In your setting the workaround might look like this:
TMyBaseClass = class
public
constructor Create(test:integer); virtual;
end;
TMyBaseClassClass = class of TMyBaseClass;
TMyClass = class(TMyBaseClass)
public
constructor Create(test:integer); override;
end;
TClass1<T: TMyBaseClass> = class
private
FMemberClass: TMyBaseClassClass;
FItem: T;
public
constructor Create(MemberClass: TMyBaseClassClass); overload;
constructor Create; overload;
procedure Test;
end;
constructor TClass1<T>.Create(MemberClass: TMyBaseClassClass);
begin
inherited Create;
FMemberClass := MemberClass;
Assert(FMemberClass.InheritsFrom(T));
end;
constructor TClass1<T>.Create;
begin
Create(TMyBaseClassClass(T));
end;
procedure TClass1<T>.Test;
begin
FItem:= T(FMemberClass.Create(666));
end;
var
u: TClass1<TMyClass>;
begin
u:=TClass1<TMyClass>.Create(TMyClass);
u.Test;
end;
Another more elegant solution, if it is possible, is to use a parameterless constructor and pass in the extra information in a virtual method of T, perhaps called Initialize.
What seems to work in Delphi XE, is to call T.Create first, and then call the class-specific Create as a method afterwards. This is similar to Rudy Velthuis' (deleted) answer, although I don't introduce an overloaded constructor. This method also seems to work correctly if T is of TControl or classes like that, so you could construct visual controls in this fashion.
I can't test on Delphi 2010.
type
TMyBaseClass = class
FTest: Integer;
constructor Create(test: integer);
end;
TMyClass = class(TMyBaseClass);
TClass1<T: TMyBaseClass, constructor> = class
public
FItem: T;
procedure Test;
end;
constructor TMyBaseClass.Create(test: integer);
begin
FTest := Test;
end;
procedure TClass1<T>.Test;
begin
FItem := T.Create; // Allocation + 'dummy' constructor in TObject
try
TMyBaseClass(FItem).Create(42); // Call actual constructor as a method
except
// Normally this is done automatically when constructor fails
FItem.Free;
raise;
end;
end;
// Calling:
var
o: TClass1<TMyClass>;
begin
o := TClass1<TMyClass>.Create();
o.Test;
ShowMessageFmt('%d', [o.FItem.FTest]);
end;
type
TBase = class
constructor Create (aParam: Integer); virtual;
end;
TBaseClass = class of TBase;
TFabric = class
class function CreateAsBase (ConcreteClass: TBaseClass; aParam: Integer): TBase;
class function CreateMyClass<T: TBase>(aParam: Integer): T;
end;
TSpecial = class(TBase)
end;
TSuperSpecial = class(TSpecial)
constructor Create(aParam: Integer); override;
end;
class function TFabric.CreateAsBase(ConcreteClass: TBaseClass; aParam: Integer): TBase;
begin
Result := ConcreteClass.Create (aParam);
end;
class function TFabric.CreateMyClass<T>(aParam: Integer): T;
begin
Result := CreateAsBase (T, aParam) as T;
end;
// using
var
B: TBase;
S: TSpecial;
SS: TSuperSpecial;
begin
B := TFabric.CreateMyClass <TBase> (1);
S := TFabric.CreateMyClass <TSpecial> (1);
SS := TFabric.CreateMyClass <TSuperSpecial> (1);

Delphi IS operator - Operator not applicable to this operand type

I guess this should be an easy one cause I must be doing something wrong.
this is my code, I'm trying to do a Strategy pattern in Delphi:
unit Pattern;
interface
type
TContext = class;
IStrategy = interface
function Move(c: TContext): integer;
end;
TStrategy1 = class(TInterfacedObject, IStrategy)
public
function Move(c: TContext): integer;
end;
TStrategy2 = class(TInterfacedObject, IStrategy)
public
function Move(c: TContext): integer;
end;
TContext = class
const
START = 5;
private
FStrategy: IStrategy;
public
FCounter: integer;
constructor Create;
function Algorithm(): integer;
procedure SwitchStrategy();
end;
implementation
{ TStrategy1 }
function TStrategy1.Move(c: TContext): integer;
begin
c.FCounter := c.FCounter + 1;
Result := c.FCounter;
end;
{ TStrategy2 }
function TStrategy2.Move(c: TContext): integer;
begin
c.FCounter := c.FCounter - 1;
Result := c.FCounter;
end;
{ TContext }
function TContext.Algorithm: integer;
begin
Result := FStrategy.Move(Self)
end;
constructor TContext.Create;
begin
FCounter := 5;
FStrategy := TStrategy1.Create();
end;
procedure TContext.SwitchStrategy;
begin
if FStrategy is TStrategy1 then
FStrategy := TStrategy2.Create()
else
FStrategy := TStrategy1.Create();
end;
end.
And the if FStrategy is TStrategy1 then is giving me: Operator not applicable to this operand type.
What am I doing wrong here cause this should work as I understand from a lot of Delphi language references?
You have omitted the GUID from your interface. is can't work without it.
Edit: On second glance, it still won't work. You can't use is to test an interface reference for its implementing object typein Delphi (well, not directly, anyway). You should change your design. For example, you could either alter the interface or add another interface to return a description of the implementation.
You could make this work by adding the IID/GUID as Craig states, and then changing SwitchStrategy to:
procedure TContext.SwitchStrategy;
begin
if (FStrategy as TObject) is TStrategy1 then
FStrategy := TStrategy2.Create()
else
FStrategy := TStrategy1.Create();
end;
This only works with more modern versions of Delphi. I think Delphi 2010 was where the ability to cast an interface to its implementing object was added.
However, I'd be inclined to avoid this solution and go for something like this:
type
IStrategy = interface
function Move(c: TContext): integer;
function Switch: IStrategy;
end;
TStrategy1 = class(TInterfacedObject, IStrategy)
public
function Move(c: TContext): integer;
function Switch: IStrategy;
end;
TStrategy2 = class(TInterfacedObject, IStrategy)
public
function Move(c: TContext): integer;
function Switch: IStrategy;
end;
function TStrategy1.Switch: IStrategy;
begin
Result := TStrategy2.Create;
end;
function TStrategy2.Switch: IStrategy;
begin
Result := TStrategy1.Create;
end;
procedure TContext.SwitchStrategy;
begin
FStrategy := FStrategy.Switch;
end;
When you find yourself asking an object what type it is, that's usually indicative of a design weakness.

Is it possible/advisable to use a TStringList inside a record?

I currently use a record to pass several result parameters for a function and need to add some more data as it follows:
type
TItemType = (itFile, itRegistry);
TItemDetails = record
Success: Boolean;
ItemType: TItemType;
TotalCount: Integer;
TotalSize: Int64;
List: TStringList;
end;
function DoSomething: TItemDetails;
Is it possible/advisable to use a TStringList inside a record for this specific case?
I found on Embarcadero Developer Network a class that allows to declare StringList instead of TStringList and takes care of creating and freeing the list. Would this be an advisable solution?
http://cc.embarcadero.com/Item/25670
Also, if this does indeed works, will I have to manually free the TStringList?
Yes, by all means, just be aware that if the record goes out of scope, then it looses the reference to the object (unless you add code otherwise).
I've used that StringList example you are referring too, and that works great to have a record manage the lifetime of a TStringList. You can adapt that to your usage. The key is the embedded Interface which frees the object when it goes out of scope with the record.
You can also look at Allen Bauer's Nullable record example. I included the code, but you will want to read the article (and comments) too. It uses Generics in Delphi 2009 or newer, but you can adapt it to earlier versions of Delphi. Again the key is the interface, but he takes a different approach.
unit Foo;
interface
uses Generics.Defaults, SysUtils;
type
Nullable<T> = record
private
FValue: T;
FHasValue: IInterface;
function GetValue: T;
function GetHasValue: Boolean;
public
constructor Create(AValue: T);
function GetValueOrDefault: T; overload;
function GetValueOrDefault(Default: T): T; overload;
property HasValue: Boolean read GetHasValue;
property Value: T read GetValue;
class operator NotEqual(ALeft, ARight: Nullable<T>): Boolean;
class operator Equal(ALeft, ARight: Nullable<T>): Boolean;
class operator Implicit(Value: Nullable<T>): T;
class operator Implicit(Value: T): Nullable<T>;
class operator Explicit(Value: Nullable<T>): T;
end;
procedure SetFlagInterface(var Intf: IInterface);
implementation
function NopAddref(inst: Pointer): Integer; stdcall;
begin
Result := -1;
end;
function NopRelease(inst: Pointer): Integer; stdcall;
begin
Result := -1;
end;
function NopQueryInterface(inst: Pointer; const IID: TGUID; out Obj): HResult; stdcall;
begin
Result := E_NOINTERFACE;
end;
const
FlagInterfaceVTable: array[0..2] of Pointer =
(
#NopQueryInterface,
#NopAddref,
#NopRelease
);
FlagInterfaceInstance: Pointer = #FlagInterfaceVTable;
procedure SetFlatInterface(var Intf: IInterface);
begin
Intf := IInterface(#FlagInterfaceInstance);
end;
{ Nullable<T> }
constructor Nullable<T>.Create(AValue: T);
begin
FValue := AValue;
SetFlagInterface(FHasValue);
end;
class operator Nullable<T>.Equal(ALeft, ARight: Nullable<T>): Boolean;
var
Comparer: IEqualityComparer<T>;
begin
if ALeft.HasValue and ARight.HasValue then
begin
Comparer := TEqualityComparer<T>.Default;
Result := Comparer.Equals(ALeft.Value, ARight.Value);
end else
Result := ALeft.HasValue = ARight.HasValue;
end;
class operator Nullable<T>.Explicit(Value: Nullable<T>): T;
begin
Result := Value.Value;
end;
function Nullable<T>.GetHasValue: Boolean;
begin
Result := FHasValue <> nil;
end;
function Nullable<T>.GetValue: T;
begin
if not HasValue then
raise Exception.Create('Invalid operation, Nullable type has no value');
Result := FValue;
end;
function Nullable<T>.GetValueOrDefault: T;
begin
if HasValue then
Result := FValue
else
Result := Default(T);
end;
function Nullable<T>.GetValueOrDefault(Default: T): T;
begin
if not HasValue then
Result := Default
else
Result := FValue;
end;
class operator Nullable<T>.Implicit(Value: Nullable<T>): T;
begin
Result := Value.Value;
end;
class operator Nullable<T>.Implicit(Value: T): Nullable<T>;
begin
Result := Nullable<T>.Create(Value);
end;
class operator Nullable<T>.NotEqual(const ALeft, ARight: Nullable<T>): Boolean;
var
Comparer: IEqualityComparer<T>;
begin
if ALeft.HasValue and ARight.HasValue then
begin
Comparer := TEqualityComparer<T>.Default;
Result := not Comparer.Equals(ALeft.Value, ARight.Value);
end else
Result := ALeft.HasValue <> ARight.HasValue;
end;
end.
It will work, but you'll have to free it manually. And since records clean themselves up automatically when they go out of scope, and don't have destructors, making sure you do it right can be a hassle. You're better off not using objects in records. If you need a data type that contains objects, why not make it an object too?
Any solution for a record correctly lifetime-managing a string list object will involve an interface in one way or another. So why not return an interface from your function in the first place? Add properties to the interface, and for the consuming code it will look like record fields. It will allow you to easily add more "record fields" later on, and you can put arbitrarily complex code in the getters that return the values.
Another issue to be aware of, if you use sizeof to determine the memory footprint of the record, it will only include the size of a pointer for the TStringList. If you attempt to stream it out, the pointer which is stored will NOT be available to later instances, so you would have to ignore the pointer on the load and have another method to load the Tstringlist.
For example:
Procedure SaveRecToStream(Rec: TItemDetails ; Stream:tStream);
var
i : integer;
begin
Stream.Write(Rec,SizeOf(Rec)-SizeOf(tSTringList));
Rec.List.saveToStream(Stream);
end;
Procedure LoadRecFromStream(Rec: TItemDetails ; Stream:tStream);
var
i : integer;
begin
FillMemory(#Rec,SizeOf(Rec),0);
i := Stream.Read(rec,SizeOf(Rec)-SizeOf(tStringList));
if i <> SizeOf(Rec)-SizeOf(tStringList) then
Raise Exception.create('Unable to load record');
Rec.List := tStringlist.create;
Rec.List.LoadFromStream(Stream);
end;
This assumes that each stream contains exactly one record, and that the record variable passed to LoadRecFromStream does not contain a live tStringlist (if it was previously used it must be freed prior to the call or a leak occurs).
Why not use something like
type PStringList = ^TStringList;
type TMyFreakyRecord = record
PointerToAStringList : PStringList;
// some more code here
end;
...
var x : TMyFreakyRecord;
stringlist : TStringList;
begin
stringList := TStringlist.create;
stringList.Add('any data you wish');
x.PointertoaStringList := #stringlist;
// some more code here
end;
and access the record's string list like
procedure ProcedureThatPasses(AFreakyRecord: TFreakyRecord);
var i : integer;
begin
for i := 0 to AFreakyRecord.PointerToAStringList.count -1 do
// something with AFreakyRecord.PointerToAStringList[i];
end;
in order to transparently free the memory allocated you can create a TList variable in which you add every variable of type TStringList that is used inside a record,
var frmMain : TfrmMain;
MyJunkList : TList;
...
implementation
...
procedure clearjunk;
var i : integer;
o : TObject;
begin
for i := MyJunkList.count -1 downto 0 do begin
o := MyJunkList[i];
FreeandNil(o);
end;
MyJunkList.clear;
end;
...
initialization
MyJunkList := TList.Create;
finalization
clearjunk;
FreeAndNil(MyJunkList );
end. // end of unit
if this helps, don't hesitate to visit http://delphigeist.blogspot.com/

Resources