everybody.
I'm trying to save my class:
TA= class(TPersistent)
private
FItems: TObjectList<TB>;
FOnChanged: TNotifyEvent;
public
constructor Create;
destructor Destroy; override;
...
procedure Delete(Index: Integer);
procedure Clear;
procedure SaveToFile(const FileName: string);
...
property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
end;
to file using the following code:
var
Storage: TJvAppXMLFileStorage;
begin
Storage := TJvAppXMLFileStorage.Create(nil);
try
Storage.WritePersistent('', Self);
Storage.Xml.SaveToFile(FileName);
finally
Storage.Free;
end;
but file is always empty.
What am I doing the wrong way?
It looks like TJvCustomAppStorage does not support Generics in properties. The code makes no use of extended RTTI and the call to TJvCustomAppStorage.GetPropCount returns 0.
This leads to another question - Are there Delphi object serialization libraries with support for Generics??
My test code:
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils, Classes, Generics.Collections, JvAppXmlStorage;
type
TA = class(TPersistent)
private
FItems: TObjectList<TPersistent>;
public
constructor Create;
published
property
Items: TObjectList < TPersistent > read FItems write FItems;
end;
{ TA }
constructor TA.Create;
begin
FItems := TObjectList<TPersistent>.Create;
end;
var
Storage: TJvAppXMLFileStorage;
Test: TA;
begin
Test := TA.Create;
Test.Items.Add(TPersistent.Create);
Storage := TJvAppXMLFileStorage.Create(nil);
try
Storage.WritePersistent('', Test);
WriteLn(Storage.Xml.SaveToString);
ReadLn;
finally
Storage.Free;
end;
end.
I'm not sure but if TJvAppXMLFileStorage uses RTTI then I think you have to publish the properties that you want to save / load.
Related
I'm trying to create a minimal example, that does the same thing as the Spring4D [inject] Attribute. It's supposed to automatically resolve my TOrderAdapter.FDetailsAdapter, which I want to manually instantiate inside a Factory unit (not like the Spring4D container works, registering interfaces from the outside first). The Factory should hand out any desired interfaces requested with [inject].
It is pretty obvious that the code I have can not work (TOrderAdapter.FDetailsAdapter not being injected, giving me a nil pointer Access Violation on ButtonClick, the first use). Reading through the Spring4D source, I fail to see where this logical piece is, that I'm missing for the desired functionality to work in my example.
program OrderDetails;
uses
Vcl.Forms,
Order.Adapter in 'Order.Adapter.pas',
Details in 'Details.pas',
Details.Adapter in 'Details.Adapter.pas',
Factory.Adapter in 'Factory.Adapter.pas',
Factory in 'Factory.pas',
Order in 'Order.pas',
Order.View in 'Order.View.pas' {OrderForm};
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TOrderForm, OrderForm);
Factory.Adapter.Factory := TFactoryAdapter.Create;
Application.Run;
end.
unit Factory;
uses
Rtti, TypInfo;
type
InjectAttribute = class(TCustomAttribute)
private
fServiceType: PTypeInfo;
fValue: TValue;
public
constructor Create(ServiceType: PTypeInfo); overload;
property ServiceType: PTypeInfo read fServiceType;
property Value: TValue read fValue;
end;
implementation
constructor InjectAttribute.Create(ServiceType: PTypeInfo);
begin
inherited Create;
fServiceType := ServiceType;
end;
end.
unit Factory.Adapter;
uses
Details, Details.Adapter, Order, Order.Adapter;
type
TFactoryAdapter = class
private
FDetailsAdapter: IDetailsAdapter;
FOrderAdapter: IOrderAdapter;
public
constructor Create;
function Inject: IInterface; overload; // unused
end;
var
Factory: TFactoryAdapter;
implementation
constructor TFactoryAdapter.Create;
begin
FDetailsAdapter := TDetailsAdapter.Create;
FOrderAdapter := TOrderAdapter.Create;
end;
function TFactoryAdapter.Inject: IInterface; // unused
begin
Result := FDetailsAdapter;
end;
end.
unit Details.Adapter;
uses
Details, Winapi.Windows, SysUtils;
type
TDetailsAdapter = class(TInterfacedObject, IDetailsAdapter)
private
FID: Integer;
public
procedure SetID(AID: Integer);
function GetID: Integer;
published
property ID: Integer read GetID write SetID;
end;
implementation
procedure TDetailsAdapter.SetID(AID: Integer);
begin
FID := AID;
OutputDebugString(PWideChar('OrderDetail ID set to ' + IntToStr(FID)));
end;
function TDetailsAdapter.GetID: Integer;
begin
Result := FID;
end;
end.
unit Order.Adapter;
uses
Order, Order.View, Details, Factory,
Vcl.Forms;
type
TOrderAdapter = class(TInterfacedObject, IOrderAdapter)
private
[inject]
FDetailsAdapter: IDetailsAdapter;
public
constructor Create;
procedure ButtonClick(Sender: TObject);
end;
var
OrderForm: TOrderForm;
implementation
constructor TOrderAdapter.Create;
begin
OrderForm.Button1.OnClick := ButtonClick;
end;
procedure TOrderAdapter.ButtonClick(Sender: TObject);
begin
FDetailsAdapter.ID := 5;
end;
end.
The container uses RTTI to collect the members that have this attribute and injects the correct services into them.
I have made a data module and a button. When I send info to the data module it gives an access violation when the program is done even when nothing needs to be done. What is going wrong? I use Delphi XE on w8.1.
procedure TForm1.btnCalcClick(Sender: TObject);
var
ACake: TCake;
begin
ACake.Diameter:= StrToFloat(edtDiam.Text);
modMain.Calc(ACake);
end;
Here is the data module unit:
interface
uses
System.SysUtils, System.Classes, classdef;
type
TmodMain = class(TDataModule)
private
{ Private declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Calc(ACake: TCake);
end;
var
modMain: TmodMain;
implementation
{%CLASSGROUP 'System.Classes.TPersistent'}
{$R *.dfm}
{ TmodMain }
procedure TmodMain.Calc(ACake: TCake);
begin
end;
constructor TmodMain.Create(AOwner: TComponent);
begin
inherited;
end;
destructor TmodMain.Destroy;
begin
inherited;
end;
end.
To clarify my class definitions unit I will post it here.
Here is my classdef unit:
unit classdef;
interface
type
TCake = class
private
FDiameter: Double;
public
property Diameter: Double read FDiameter write FDiameter;
end;
implementation
end.
The problem is that you need to create a class instance before you can use it.
In this example I assume that your datamodule has been autocreated by the IDE.
So your code:
procedure TForm1.btnCalcClick(Sender: TObject);
var
ACake: TCake;
begin
ACake.Diameter:= StrToFloat(edtDiam.Text);
modMain.Calc(ACake);
end;
becomes:
procedure TForm1.btnCalcClick(Sender: TObject);
var
ACake: TCake;
begin
ACake := TCake.Create;
try
ACake.Diameter:= StrToFloat(edtDiam.Text);
modMain.Calc(ACake);
finally
ACake.Free;
end;
end;
I'm trying to create a VCL component like TImage, that lets me add a variable amount of different sized TPictures.
The Goal is to be able to assign that number of TPictures through the VCL editor in the property list.
delphi component property: TObjectList<TPicture> here we came to the conclusion, that a TCollection with TCollectionItems should be used. This is what I'm trying to do now, but as many times before i end up with the compiler error: "Published property 'Pictures' can not be of Type ARRAY" in this line:
property Pictures[Index: Integer]: TPic read GetPic write SetPic;
unit ImageMultiStates;
interface
uses
Vcl.Graphics, Vcl.StdCtrls, System.SysUtils, System.Classes, Vcl.Controls, Vcl.ExtCtrls, Forms, Generics.Collections;
type
TPic = class(TCollectionItem)
private
FPicture: TPicture;
public
procedure Assign(Source: TPersistent); override;
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
published
property Picture: TPicture read FPicture write FPicture;
end;
TPictures = class(TCollection)
private
function GetPic(Index: Integer): TPic;
procedure SetPic(Index: Integer; APicture: TPic);
public
constructor Create;
published
property Pictures[Index: Integer]: TPic read GetPic write SetPic;
end;
TImageMultiStates = class(TImage)
private
FPictures: TPictures;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Activate(Index: Integer);
end;
procedure Register;
implementation
constructor TPic.Create(Collection: TCollection);
begin
inherited Create(Collection);
end;
destructor TPic.Destroy;
begin
FPicture.Free;
inherited Destroy;
end;
procedure TPic.Assign(Source: TPersistent);
begin
FPicture.Assign(Source);
end;
constructor TPictures.Create;
begin
inherited Create(TPic);
end;
procedure TPictures.SetPic(Index: Integer; APicture: TPic);
begin
Items[Index].Assign(APicture);
end;
function TPictures.GetPic(Index: Integer): TPic;
begin
Result := TPic(inherited Items[Index]);
end;
constructor TImageMultiStates.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
destructor TImageMultiStates.Destroy;
begin
FPictures.Free;
inherited Destroy;
end;
procedure TImageMultiStates.Activate(Index: Integer);
begin
Picture.Assign(FPictures.Items[Index]);
end;
procedure Register;
begin
RegisterComponents('Standard', [TImageMultiStates]);
end;
end.
Since noone seems to expect this error to be thrown, maybe it's related to my installed components? I used the internal GetIt Package-Manager to install the Jedi Code Library 2.8, Jedi Visual Component Library and PNGComponents 1.0. I guess that's about it as far as TImage-related components are concerned. Maybe one of these overrides some of my TImage contents with funky stuff...
I experimented a little and derived a TPicturePanel from TPanel. It has a Pictures property, which is a TPictures, a descendant of TOwnedCollection and which contains TPics. Each TPic has a Picture property. I can install this component, and it allows me to edit the Pictures collection using the so called Collection editor, which allows you to add or remove TPic instances. If you select a TPic in the Collection editor, you can assign a picture to its Picture property, i.e. load from file, etc.
Here is the working code for TPicturePanel. You can model your component after this:
unit PicturePanels;
interface
uses
System.SysUtils, System.Classes, Vcl.Controls, Vcl.ExtCtrls, Vcl.Graphics;
type
TPic = class(TCollectionItem)
private
FPicture: TPicture;
procedure SetPicture(const Value: TPicture);
public
procedure Assign(Source: TPersistent); override;
constructor Create(AOwner: TCollection); override;
destructor Destroy; override;
published
property Picture: TPicture read FPicture write SetPicture;
end;
TPictures = class(TOwnedCollection)
private
function GetItem(Index: Integer): TPic;
procedure SetItem(Index: Integer; const Value: TPic);
public
constructor Create(AOwner: TPersistent);
property Items[Index: Integer]: TPic read GetItem write SetItem;
end;
TPicturePanel = class(TPanel)
private
FPictures: TPictures;
procedure SetPictures(const Value: TPictures);
published
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Pictures: TPictures read FPictures write SetPictures;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TPicturePanel]);
end;
{ TPicturePanel }
constructor TPicturePanel.Create(AOwner: TComponent);
begin
inherited;
FPictures := TPictures.Create(Self);
end;
destructor TPicturePanel.Destroy;
begin
FPictures.Free;
inherited;
end;
procedure TPicturePanel.SetPictures(const Value: TPictures);
begin
FPictures.Assign(Value);
end;
{ TPic }
procedure TPic.Assign(Source: TPersistent);
begin
inherited;
if Source is TPic then
FPicture.Assign(TPic(Source).FPicture);
end;
constructor TPic.Create(AOwner: TCollection);
begin
inherited;
FPicture := TPicture.Create;
end;
destructor TPic.Destroy;
begin
FPicture.Free;
inherited;
end;
procedure TPic.SetPicture(const Value: TPicture);
begin
FPicture.Assign(Value);
end;
{ TPictures }
constructor TPictures.Create(AOwner: TPersistent);
begin
inherited Create(AOwner, TPic);
end;
function TPictures.GetItem(Index: Integer): TPic;
begin
Result := inherited GetItem(Index) as TPic;
end;
procedure TPictures.SetItem(Index: Integer; const Value: TPic);
begin
inherited SetItem(Index, Value);
end;
end.
Your indexed property uses syntax that looks like it returns an array, but it doesn't do that. The pictures property returns an indexed TPic. It can only ever return one TPic at a time.
If you want to return an array you'll have to say so:
function GetPictures: TArray<TPicture>;
procedure SetPictures(const value: TArray<TPicture>);
property Pictures: TArray<TPicture> read GetPictures write SetPictures;
//GetPictures might look something like this:
function TMyClass.GetPictures: TArray<TPicture>;
var
i: integer;
begin
SetLength(Result, Self.FPictureCount);
for i:= 0 to FPictureCount - 1 do begin
Result[i]:= GetMyPicture[i];
end;
end;
I'm not sure how your TPic collection works, so you'll have to adjust it to suit your needs.
Obviously you can have an TArray<TArray<TPicture>> (aka: array of array of TPicture) if you so desire.
I create my own class and I want to use it in my new component but I am getting an error...
The code is the following:
type
TMyClass = class
Name: string;
Number: double;
end;
TMyComponent = class(TCustomPanel)
private
FMyClass: TMyClass;
public
procedure SetMyClass(aName: string; aNumber: double);
published
property MyClass: TMyClass write SetMyClass;
end;
procedure SetMyClass(aName: string; aNumber: double);
begin
FMyClass.Name:= aName;
FMyClass.Number:= aNumber;
end;
it appears that the property has incompatible types, I don't know why.
Does anybody has a clue about that and how can I solve this problem.
Having a FName and FNumber as fields in TMyComponent is not an option, my code is more complex and this is a simple example to explain my goal.
thanks
The things that I can see wrong with your code at present are:
The property setter must receive a single parameter of the same type as the property, namely TMyClass.
The property setter must be a member of the class, but you've implemented it as a standalone procedure.
A published property needs to have a getter.
So the code would become:
type
TMyClass = class
Name: string;
Number: double;
end;
TMyComponent = class(TCustomPanel)
private
FMyClass: TMyClass;
procedure SetMyClass(Value: TMyClass);
published
property MyClass: TMyClass read FMyClass write SetMyClass;
end;
procedure TMyComponent.SetMyClass(Value: TMyClass);
begin
FMyClass.Name:= Value.Name;
FMyClass.Number:= Value.Number;
end;
This code does not instantiate FMyClass. I'm guessing that the code that does instantiate FMyClass is part of the larger component code that has been excised for the sake of this question. But obviously you do need to instantiate FMyClass.
An alternative to instantiating FMyClass is to turn TMyClass into a record. Whether or not that would suit your needs I cannot tell.
It looks like you are having some problems instantiating this object. Do it like this:
type
TMyClass = class
Name: string;
Number: double;
end;
TMyComponent = class(TCustomPanel)
private
FMyClass: TMyClass;
procedure SetMyClass(Value: TMyClass);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property MyClass: TMyClass read FMyClass write SetMyClass;
end;
constructor TMyComponent.Create(AOwner: TComponent);
begin
inherited;
FMyClass:= TMyClass.Create;
end;
destructor TMyComponent.Destroy;
begin
FMyClass.Free;
inherited;
end;
procedure TMyComponent.SetMyClass(Value: TMyClass);
begin
FMyClass.Name:= Value.Name;
FMyClass.Number:= Value.Number;
end;
One final comment. Using MyClass for an object is a bad name. Use class for the type, and object for the instance. So, your property should be MyObject and the member field should be FMyObject etc.
Try this:
type
TMyClass = class
Name: string;
Number: double;
end;
TMyComponent = class(TCustomPanel)
private
FMyClass: TMyClass;
public
procedure SetMyClass(Value: TMyClass);
published
property MyClass: TMyClass write SetMyClass;
end;
procedure TMyComponent.SetMyClass(Value);
begin
FMyClass := Value;
end;
unit MyComponentTest2;
interface
uses SysUtils, Classes, Controls, Forms, ExtCtrls, Messages, Dialogs;
type
TMyClass = class
Name: string;
Number: double;
end;
TMyComponentTest2 = class(TCustomPanel)
private
FMyClass: TMyClass;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetMyClass(Value: TMyClass);
published
property MyClass: TMyClass read FMyClass write SetMyClass;
end;
procedure Register;
implementation
constructor TMyComponentTest2.Create(AOwner: TComponent);
begin
Inherited Create(AOwner);
FMyClass:= TMyClass.Create;
end;
destructor TMyComponentTest2.Destroy;
begin
Inherited;
FMyClass.Free;
end;
procedure TMyComponentTest2.SetMyClass(Value: TMyClass);
begin
FMyClass.Name:= Value.Name;
FMyClass.Number:= Value.Number;
end;
procedure Register;
begin
RegisterComponents('MyComponents', [TMyComponentTest2]);
end;
end.
Summarization:
1. Manual typecast when debugging, as LachlanG and Ken pointed out.
2. Make use of the concept of Debugger Visualizers introduced since Delphi 2010.
3. Switch to generics counterparts.
=========================================
Take the following code for example:
If breakpoints are set at the end of TestRegular, and at the end of TestGenerics, respectively, one can see the items of the generic list(and even the content of the items) through the debug inspector, but nothing meaningful (not even the count) for the regular tobjectlist, when one hovers the mouse on the tmp variable. I am wondering if there is some way to achieve similar debug-time functionality for regular tobjectlist?
unit Unit2;
interface
uses
Contnrs, Generics.Collections,
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TMyItem = class;
TMyItemList = class;
TForm2 = class;
TMyItem = class
private
fname: string;
public
property name: string read fname;
constructor Create(aName: string);
end;
TMyItemList = class(TObjectList)
protected
procedure SetObject (Index: Integer; Item: TMyItem);
function GetObject (Index: Integer): TMyItem;
public
function Add (Obj: TMyItem): Integer;
procedure Insert (Index: Integer; Obj: TMyItem);
property Objects [Index: Integer]: TMyItem
read GetObject write SetObject; default;
end;
TForm2 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure TestRegular;
procedure TestGenerics;
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
{ TMyItem }
constructor TMyItem.Create(aName: string);
begin
fname := aName;
end;
{ TMyItemList }
function TMyItemList.Add(Obj: TMyItem): Integer;
begin
Result := inherited Add (Obj);
end;
procedure TMyItemList.SetObject(Index: Integer; Item: TMyItem);
begin
inherited SetItem (Index, Item);
end;
function TMyItemList.GetObject(Index: Integer): TMyItem;
begin
Result := inherited GetItem (Index) as TMyItem;
end;
procedure TMyItemList.Insert(Index: Integer; Obj: TMyItem);
begin
inherited Insert(Index, Obj);
end;
{TForm2}
procedure TForm2.FormCreate(Sender: TObject);
begin
TestGenerics;
TestRegular;
end;
procedure TForm2.TestRegular;
var
tmp: TMyItemList;
begin
tmp := TMyItemList.Create;
tmp.Add(TMyItem.Create('1'));
tmp.Add(TMyItem.Create('2'));
tmp.Free;
end;
procedure TForm2.TestGenerics;
var
tmp: TObjectList<TMyItem>;
begin
tmp := TObjectList<TMyItem>.Create;
tmp.Add(TMyItem.Create('1'));
tmp.Add(TMyItem.Create('2'));
tmp.Free;
end;
end.
I don't think you'll be able to improve what appear in the mouse cursor hover hint.
You can however use typecasts inside Debug windows just as you can within source code.
For example you could typecast the tmp variable to TObjectList(tmp) from within the Evaluation Window (Ctrl F7) or create a Watch (Ctrl F5) on the typecasted variable.
There are Debugger Visualizers that allow you to customise the debugger's visualization capabilities. I've never used them, but it is my understanding that you could combine them with some RTTI and give richer information about a TObject instance.
However, using generics is what you want here. It gives compile time typing which has manifest advantages. I'd simply do it that way.