Need to associate unique integer value with classes - delphi

Question

Alright, so I have a base class which we'll call TFruit. From this there are various descendants like TApple, TOrange and so on. I need to save the properties of the descendant classes to a file.
In order to be able to create the right class when loading the data, each class needs to have an ID that I write to the file before writing the actual data. Currently, I've come up with the following way of doing it:
type
TFruit = class
const ID = 0;
end;
TApple = class(TFruit)
const ID = 1;
end;
TOrange = class(TFruit)
const ID = 2;
end;
Testing this, I found out that I need to be super careful which class I declare. If I use this:
var Fruit: TFruit;
Fruit := TOrange.Create;
...then Fruit.ID will return zero. However, declaring Fruit as a TOrange will yield the expected result Fruit.ID = 2 (anyone know why?)
So basically, am I doing this right or is there a better way to do it? Having to create a class function and return a value from there seems very ugly by comparison (extra function declaration, implementation and code).

Answer 1

An easier to maintain solution would be to create a mapping class where you register all classes you'd like to convert to an integer.
Advantages
Ability to detect duplicate registrations.
Independent of your class structure.
Includes the transformation back to a classname.
Usage
RegisterClass.Register(0, TFruit);
RegisterClass.Register(1, TApple);
RegisterClass.Register(2, TOrange);
Implementation
TRegisterClass = class
private
FList: TStringList;
public
function FindID(AClass: TClass): Integer;
function FindClassName(const ID: Integer): string;
procedure Register(const ID: Integer; AClass: TClass);
end;
...
function TRegisterClass.FindID(AClass: TClass): Integer;
begin
Assert(Assigned(AClass));
Result := -1;
if FList.IndexOf(AClass.ClassName) <> -1 then
Result := Integer(FList.Objects[FList.IndexOf(AClass.ClassName)]);
end;
function TRegisterClass.FindClassName(const ID: Integer): string;
var
I: Integer;
begin
Result := EmptyStr;
for I := 0 to Pred(FList.Count) do
if Integer(FList.Objects[I]) = ID then
begin
Result := FList[I];
Exit;
end;
end;
procedure TRegisterClass.Register(const ID: Integer; AClass: TClass);
begin
if IsAlreadyRegistered(ID) then
raise Exception.Create('Duplicate ID Registration')
else if IsAlreadyRegistered(AClass) then
raise Exception.Create('Duplicate Class Registration');
FList.AddObject(AClass.ClassName, Pointer(ID));
end;
Please note that there are better structures to map a String to an Integer. Writing this without a compiler and don't knowing many basic structures beyond Delphi5, I've chosen an obvious implementation.
Note that the IsAlreadyRegistered overloaded functions still have to be written

Answer 2

there are many possibilities, for example:
function TFruit.GetClassId(): Word;
begin
Result := CRC16(ClassName);
end;

Answer 3

anyone know why?
Because you're declaring a class field? TOrange inherits from TFruit, so it has the ID=0 field too. Then you override it with another ID=2 field. Now you have two of these. If you cast TOrange to TFruit then you're getting inherited field, this is precisely the way to access them.
If you're on Delphi 2010+, use attributes:
[ClassId(4)] TOrange = class(TFruit)
But why do you need these IDs in the first place? You'll have to manually mark your every class type, this is prone to errors. Just use class name.
var t: TOrange;
begin
writeFile(t.Classname, t.Data);
If you're so concerned with space, keep a classname-id table at the beginning of the file and assign IDs dynamically as you go:
procedure WriteObject(c: TObject);
var id: integer;
begin
if not GetAlreadyRegisteredClassnameId(c.Classname, id) then
id := AddClassnameToTable(c.Classname);
writeToCache(id, c.Data)
end;
procedure WriteFile()
var i: integer;
begin
for i := 0 to ObjectCount-1 do
WriteObject(objects[i]);
OutputClassnameTableToFile;
OutputObjectCacheToFile;
end;
(Of course ignoring memory constraints here for demonstrative purposes, but it's easy to do this without memory cache too)

Answer 4

If you're using Delphi 2010 you can use attributes to tag your classes with the ID.

Answer 5

First, you need
type
TFruit = class
end;
TApple = class(TFruit)
end;
TOrange = class(TFruit)
end;
and then you can use Fruit.ClassName and Fruit.ClassType, can't you?
function ClassToID(const Fruit: TFruit): word;
begin
if Fruit is TApple then
result := 1
else if Fruit is TOrange then
result := 2;
end;
or
TFruitClass = class of TFruit;
type
TFruitAndID = record
FruitClass: TFruitClass;
ID: word;
end;
const FruitIDs: array[0..1] of TFruitAndID =
((FruitClass: TApple; ID: 1), (FruitClass: TOrange; ID: 2));
function ClassToID(Fruit: TFruit): word;
var
i: Integer;
begin
for i := 0 to high(FruitIDs) do
if FruitIDs[i].FruitClass = Fruit.ClassType then
Exit(FruitIDs[i].ID);
end;

Answer 6

Looking on other angle: why ID is not an read-only object property (instead of a class const)?
So:
type
TFruit = class
protected
FId: Integer;
published
property ID:Integer read FId;
end;
TApple = class(TFruit)
constructor Create;
end;
TOrange = class(TFruit)
constructor Create;
end;
<...>
constructor TApple.Create;
begin
FId := 1;
end;
constructor TOrange.Create;
begin
FId := 2;
end;
So, your example code will work now. (The descendants can see FId because it's a protected field).
EDIT: changes the visibility from public to published. But the same can be achieved using the $RTTI directive to allow RTTI to public members.