You must associate a unique integer value with classes

Question

Ok, so I have a base class that we will call TFruit. From this there are various descendants, such as TApple, TOrangeand so on. I need to save the properties of the descendant classes to a file.

To create the correct class when loading data, each class must have IDwhich I write to the file before writing the actual data. Currently, I have come up with the following method:

type
  TFruit = class
    const ID = 0;
  end;

  TApple = class(TFruit)
    const ID = 1;
  end;

  TOrange = class(TFruit)
    const ID = 2;
  end;

Checking this, I found out that I need to be very careful what class I declare. If I use this:

  var Fruit: TFruit;

  Fruit := TOrange.Create;

... then Fruit.IDwill return zero . However, declaring Fruithow TOrangewill produce the expected result Fruit.ID = 2(does anyone know why?)

, , ? ( , ).

Answer 1

, , .

< >

• .
• .
• .

  RegisterClass.Register(0, TFruit);
  RegisterClass.Register(1, TApple);
  RegisterClass.Register(2, TOrange);

  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;

, . Delphi5, .

, IsAlreadyRegistered

Answer 2

, :

function TFruit.GetClassId(): Word;
begin
  Result := CRC16(ClassName);
end;

Answer 3

- ?

? TFruit, ID = 0. ID = 2. . TOrange TFruit, , .

Delphi 2010+, :

[ClassId(4)] TOrange = class(TFruit)

? , . .

var t: TOrange;
begin
  writeFile(t.Classname, t.Data);

, -- :

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;

(, , )

Answer 4

type
  TFruit = class
  end;

  TApple = class(TFruit)
  end;

  TOrange = class(TFruit)
  end;

Fruit.ClassName Fruit.ClassType, ?

function ClassToID(const Fruit: TFruit): word;
begin
  if Fruit is TApple then
    result := 1
  else if Fruit is TOrange then
    result := 2;
end;

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 5

Delphi 2010, attributes, .

Answer 6

: ( const)?

:

 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 sample code will work now. (Descendants can see FId because it is a protected field). EDIT: changes the visibility from public to published . But the same thing can be achieved with the $ RTTI directive, which allows RTTI to public users.