PDA

View Full Version : handle of object?



slenkar
01-12-2010, 08:00 PM
is there any way to convert an object into an integer handle (or pointer)
and then convert it back?

I want to be able to serialize an object like this



type
warrior=class(Tobject)
enemy:warrior


so I need to know.. when I save the warrior to a file, who his enemy is, so I need to convert the enemy to an integer handle, so I can serialize it
( I know you cant save handles to a file and then convert them back into objects when you load a new game, but they are useful to stop cyclic references when loading or saving a game)

Brainer
01-12-2010, 08:35 PM
I'd declare a base class with methods to save/load an instance to a stream or a file. Or take a look at the TPersistent (http://docs.embarcadero.com/products/rad_studio/delphiAndcpp2009/HelpUpdate2/EN/html/delphivclwin32/Classes_TPersistent.html) class.

slenkar
01-12-2010, 09:07 PM
do you have a little example of saving an object with Tpersistent?

I tried running the example xmlstream in the lazarus folder but it says
streamasxmldemo.lpr(7,3) Fatal: Can't find unit Interfaces used by StreamAsXMLDemo

User137
02-12-2010, 03:12 PM
Do you have latest Lazarus daily snapshot or SVN? I just added Interfaces in my uses path and it compiled fine.

slenkar
02-12-2010, 06:00 PM
I managed to get the example running but the code is very long and uncommented

I put together a little program based on online examples:


program pascalreflect;

{$mode objfpc}{$H+}

uses
classes,typinfo;
type

warrior =class(Tobject)

property
name:String;
hp:integer;
end;
var
TypeInfo: PTypeInfo;
TypeData: PTypeData;
PropList: PPropList;
classref:Tclass;
war:warrior;
war2:warrior;
listy:array of string;
iter:integer;
{$IFDEF WINDOWS}{$R pascalreflect.rc}{$ENDIF}

begin
war:=warrior.create;


ClassRef := warrior.ClassType;

war2:=classref.newinstance as warrior;
//classname
writeln (classref.ClassName);
//typeinfo
TypeInfo := warrior.ClassInfo;
if typeinfo=nil then
begin
writeln('typeinfo is nil');
end
else
begin
TypeData := GetTypeData(TypeInfo);
end;




end.

typeinfo is null though

why is that?

User137
02-12-2010, 08:07 PM
I have 1 guess; you are using .ClassInfo on type instead of war or war2 instances.
You can't do warrior.name:='test';

The next line seems also wrong:
lassRef := warrior.ClassType;
should be lassRef := war.ClassType;

For clarity i recommend using capital T in classnames, such as TWarrior. This makes it harder to mix classes with variable names.

slenkar
04-12-2010, 06:45 PM
ok got a bit closer to getting the features I need to save a game


uses
rttiutils,typinfo,classes;


type
warrior =class(Tpersistent)
public
hp:integer;
warname:string;
published

property Php:integer read hp write hp;
property Pwarname:string read warname write warname;
end;


Var
O : warrior;
PT : PTypeData;
PI : PTypeInfo;
I,J : Longint;
PP : PPropList;
prI : PPropInfo;

begin
O:=warrior.Create;
PI:=O.ClassInfo;
PT:=GetTypeData(PI);
Writeln('Property Count : ',PT^.PropCount);
GetMem (PP,PT^.PropCount*SizeOf(Pointer));
GetPropInfos(PI,PP);
For I:=0 to PT^.PropCount-1 do
begin
With PP^[i]^ do
begin
Write('Property ',i+1:3,': ',name:30);
writeln(' Type: ',typinfo.PropType(O,Name));
end;
end;
FreeMem(PP);
O.Free;
end.

slenkar
04-12-2010, 06:58 PM
ok now i can get and set strings and integers without having to know the names of the fields.
getting closer to having a serialization library for pascal



Program pasreflect;

{ This program demonstrates the GetPropList function }

uses
rttiutils,typinfo,classes,sysutils;


type
warrior =class(Tpersistent)
public
hp:integer;
warname:string;
published

property Php:integer read hp write hp;
property Pwarname:string read warname write warname;
end;


Var
O : warrior;
PT : PTypeData;
PI : PTypeInfo;
I,J : Longint;
PP : PPropList;
prI : PPropInfo;

begin
O:=warrior.Create;
PI:=O.ClassInfo;
PT:=GetTypeData(PI);
Writeln('Property Count : ',PT^.PropCount);
GetMem (PP,PT^.PropCount*SizeOf(Pointer));
GetPropInfos(PI,PP);
For I:=0 to PT^.PropCount-1 do
begin
With PP^[i]^ do
begin
Write('Property ',i+1,': ',name);
PrI:=GetPropInfo(O,name);
if typinfo.PropType(O,Name)=tkinteger then
begin
SetOrdProp(O,PrI,31);
writeln('value'+ inttostr(GetOrdProp(O,PrI)));
end;
if typinfo.PropType(O,Name)=tksstring then
begin
SetstrProp(O,PrI,'bill');
writeln('value'+ (GetstrProp(O,PrI)));
end;

writeln(' Type: ',typinfo.PropType(O,Name));
end;
end;
FreeMem(PP);


writeln (inttostr(O.hp));

O.Free;
end.

slenkar
04-12-2010, 08:04 PM
I need a unique ID number for each object

I tried using the pointer address but the compiler said it wasnt portable
how else can I get a unique ID number for each object?

it has to be compatible with Tobject, as the serialization doesnt know the real object type.

I tried looking at the JSON library in lazarus.. is it cross platform?

Brainer
04-12-2010, 09:00 PM
Below is a link you may find interesting. It's in Polish though. Try Google Translate or if you don't really need to understand the article's text, just focus on the code itself. :)
http://delphi.dathox.com/2009/12/serializacja-klas-cz1-cz2-i-cz3.html

slenkar
04-12-2010, 11:41 PM
the source code (and comments) gets messed up with google translate, ill have to try out the examples to see what they do

after removing some procedure code I got it to work but it doesnt serialize an array:




(************************************************* ******************************
Serializacja klas w Delphi cz.2

DaThoX 2004-2008

Maciej Izak (hnb.code[at]gmail[dot]com)

Na dzisiejszej lekcji zajmiemy się obsługą zapisu przypisanej metody do pola
(Delphi umożliwia zapamiętanie jaką metodę przypisaliśmy polu typu
proceduralnego obiektowego)

Poznamy także procedury umozliwiajace odczyt/zapis klasy z/do pliku
************************************************** ****************************)
program Lesson_02;

{$APPTYPE CONSOLE}

uses
SysUtils,
Classes, // <- podstawowe klasy z kt??rych bedziemy dziedziczyć
Dialogs,
dtxUtils; // <- napisałem procedury ułatwiające serializację klas
{-------------------------------------------------------------------------------
Na dole w gł??wnym bloku begin ... end. znajduje się opis zapisu i odczytu klas
z jak i do pliku ...

------------------------------------------------------------------------------
/// Funkcje pomocnicze z dtxUtils.pas ///
------------------------------------------------------------------------------

---
1 procedure StringToComponent(Value: string; Comp: TComponent);
---
------------------------------------------------------------------------------
Konwertuje dane z łańcucha znak??w na dane do obiektu i inicjalizuje
jego dane. Przekazywana klasa Comp musi być wczesniej stworzona.


---
2 function ComponentToString(Component: TComponent): string;
---
------------------------------------------------------------------------------
Konwertuje komponent na łańcuch


---
3 procedure SaveComponent(AFile: string; AComponent: TComponent;
--- AText: boolean = true);
------------------------------------------------------------------------------
Zapisuje komponent do pliku tekstowego. Parametr AText ustawia czy ma być
to w postaci czytelnej dla człowieka (tekstowej) czy też binarnej.
Wersja binarna zajmuje nieco mniej miejsca.


---
4 procedure LoadComponent(AFile: string; AComponent: TComponent;
--- AText: boolean = true);
------------------------------------------------------------------------------
Robi dokładnie to co SaveComponent tylko w drugą stronę

------------------------------------------------------------------------------
/// Funkcje i typy pomocnicze z "Classes.pas" ///
------------------------------------------------------------------------------

---
1 type
--- TStreamOriginalFormat = (sofUnknown, sofBinary, sofText);
------------------------------------------------------------------------------
Typ m??wiący o tym w jakiej postaci zapisaliśmy obiekt (binarna/tekstowa)


---
2 procedure ObjectBinaryToText(Input, Output: TStream); overload;
--- procedure ObjectBinaryToText(Input, Output: TStream;
var OriginalFormat: TStreamOriginalFormat); overload;
procedure ObjectTextToBinary(Input, Output: TStream); overload;
procedure ObjectTextToBinary(Input, Output: TStream;
var OriginalFormat: TStreamOriginalFormat); overload;
------------------------------------------------------------------------------
Funkcje konwertujące obiekt w postaci binarnej do tekstowej (i odwrotnie)
operujące na strumieniach


---
3 procedure ObjectResourceToText(Input, Output: TStream); overload;
--- procedure ObjectResourceToText(Input, Output: TStream;
var OriginalFormat: TStreamOriginalFormat); overload;
procedure ObjectTextToResource(Input, Output: TStream); overload;
procedure ObjectTextToResource(Input, Output: TStream;
var OriginalFormat: TStreamOriginalFormat); overload;
------------------------------------------------------------------------------
Funkcje konwertujące postać tekstową do zasob??w i odwrotnie


---
4 function TestStreamFormat(Stream: TStream): TStreamOriginalFormat;
---
------------------------------------------------------------------------------
Funkcja sprawdzająca jakiego typu są dane zserializowanego obiektu

------------------------------------------------------------------------------}





// wrsja player 2:) - it contains everything that is contained in the previous class
// + small part of a news item :)

type
ship =class(Tcomponent)
public
shipname:string;
published
property pshipname:string read shipname write shipname;
end;
type DynamicshipArray = array of ship;

type
TPlayer2 = class(TComponent)
private
FName: string;
FRememberPasswd: boolean;
FPasswd: string;
ship_array: DynamicshipArray ;
public
// ---
protected
// ---
published
property Name: string read FName write FName;
property RememberPasswd: boolean read FRememberPasswd write FRememberPasswd;
property Passwd: string read FPasswd write FPasswd stored FRememberPasswd;
property Pship_array: DynamicshipArray read ship_array write ship_array;
// tytaj zaczynają się nowości :) ...


// pole pamiętające nasz wyb??r (możemy przypisać mu dowolną metodę będacą
// w sekcji published z klasy w kt??rej ??w właściwość jest zadeklarowana)

end;
{ TPlayer2 }



var
Player: TPlayer2;
c: char;
{-------------------------------------------------------------------------------
Below are the procedures used to record the reading class files and streams.
------------------------------------------------------------------------------}
begin
Player := TPlayer2.Create(nil);
setlength(player.ship_array,6);
player.ship_array[0]:=ship.create(nil);
player.ship_array[0].shipname:='brian';
WriteLn;

WriteLn('That looks like our class converted to string :', sLineBreak, sLineBreak,

ComponentToString(Player)

);

// write to the file
SaveComponent('Player.txt', Player);
//and release
Player.Free;

WriteLn(sLineBreak,
'Class has been written to Player.txt''and''exempt from the memory. '+
'You can open the saved file and edit it - for the moment TPlayer2 class'+
'Will be created again and already the Player.txt''''will be loaded' +
'Content class. Edit the file as you want and press [ENTER] '
+ 'Initialize class and provoke property OnPrint.');
ReadLn;

// tworzymy obiekt od nowa
Player := TPlayer2.Create(nil);
LoadComponent('Player.txt', Player);
WriteLn('That looks like our class is loaded from a file :', sLineBreak, sLineBreak,

ComponentToString(Player)

);

// Call the property :)
WriteLn('For the moment calls the method recorded in the property OnPrint :');
// if c = '1' then
//begin
//Player.OnPrint1;
//end
//else
//begin
//Player.OnPrint2;
//end;
WriteLn;

// zakończ ...
ReadLn;
Player.Free;
end.


it just ignores the array completely


also, using properties seems to be a bust because freepascal doesnt have
GetDynArrayProp