Работа с переменными класса класса-наследника в базовом классе

Зачем это нужно?

С такой необходимостью я столкнулся, например, при сериализации классов. Было желание вынести весь рутинный код и информацию о классах-наследниках в базовый класс. Ну, лень ведь, прописывать одно и то же для каждого дочернего класса. Вот и призадумался, может сюда дженерики прикрутить.

И так, необходимые переменные класса можно завернуть в record, динамически выделить для них память и дальше использовать через указатель. Храниться этот указатель будет в переменной класса промежуточного обобщенного класса. Этот обобщённый класс и станет новым уникальным базовым классом для различных классов-наслеников.

Для доступа к такими данными из конкретного экземпляра класса можно добавить поле-указатель, которое будет инициализироваться в конструкторе обобщенного класса. А для передачи этого указателя в классовые методы базового класса использовать дополнительный параметр. Подстановка значения этого параметра, возможно, взамен скрытого ClassSelf, будет осуществляться в перегруженных методах промежуточного обобщённого класса.

Вариант реализации базового и обобщенного классов:

unit MyStore;

interface
uses System.Generics.Collections;

type

TDataBase = class  //abstract
protected type
 TDataType = class of TDataBase;
 TDataList = TList<TDataBase>;
 TDataInfo = array of Integer;  
 PClassVar = ^TClassVar;
 TClassVar = record
  cType :TDataType;
  cObjs :TDataList;
  cInfo :TDataInfo;
 end;
protected
 fVar :PClassVar;
 class function  Init(var cVar :PClassVar):Pointer;   overload;
 class procedure Done(var cVar :PClassVar);           overload; static;
 class procedure AddFild( cVar :PClassVar; var Fild); overload; static;                 
public
 Tag :Integer;
 procedure       Save; 
 constructor     Create;   virtual;
 destructor      Destroy;  override; 
end;


TDataProx<T:class> = class(TDataBase)
protected
 class var cVar :TDataBase.PClassVar;
 class function  Init:T;            overload; inline;
 class procedure Done;              overload; inline;
 class procedure AddFild(var Fild); overload; inline;
public
 constructor     Create;            overload; override; 
 class function  Objs:TList<T>;     inline;
end;

implementation

{ TDataBase }

class procedure TDataBase.AddFild(cVar: PClassVar; var Fild); // static;
begin
 with cVar^ do begin
  SetLength(cInfo,Length(cInfo)+1);
  cInfo[Length(cInfo)-1]:=Integer(PByte(@Fild) - PByte(@cType));
 end;
end;

procedure TDataBase.Save;
begin
 with fVar^ do begin end;
end;

constructor TDataBase.Create;
begin
 with fVar^ do cObjs.Add(Self); 
end;

destructor TDataBase.Destroy;
begin
 with fVar^ do cObjs.Extract(Self); 
 inherited;
end;

class procedure TDataBase.Done(var cVar: PClassVar); // static;
var
 Obj :TDataBase;
begin
 with cVar^ do begin
  for Obj in cObjs do begin 
   Obj.Save;
   Obj.Free;
  end;
  cObjs.Free;
  Finalize(cInfo);
 end;
 Dispose(cVar);
end;

class function TDataBase.Init(var cVar: PClassVar):Pointer; // uses ClassSelf
begin
 New(cVar);
 with cVar^ do begin
  cType:=Self;
  cObjs:=TDataList.Create;
  Initialize(cInfo);
  Result:=@cType;                                // synthetic Object  :)
 end;
 AddFild(cVar,(TObject(Result) as Self).Tag); 
end;

{ TDataProx<T> }

class procedure TDataProx<T>.AddFild(var Fild); // inline;
begin
 AddFild(cVar, Fild);
end;

constructor TDataProx<T>.Create;
begin
 fVar := cVar;  // !
 inherited;     // ! after fVar := cVar;
end;

class procedure TDataProx<T>.Done;              // inline;
begin
 Done(cVar);
end;

class function TDataProx<T>.Init:T;             // inline;
begin
 Result:=Init(cVar);
end;

class function TDataProx<T>.Objs: TList<T>;     // inline
begin
 Result:=TList<T>(cVar.cObjs);
end;

end.

Пример использования:

unit MyData;

interface
uses MyStore;

type
TDataA = class(TDataProx<TDataA>)
 Data :Integer;
 Note: string;     
 class constructor Init;
 class destructor  Done;
 class procedure   Work; 
end;

TDataB = class(TDataProx<TDataB>)
 Data :Double;
 Memo :array of string; 
 class constructor Init;
 class destructor  Done;
end;

implementation

{ DataA }

class destructor TDataA.Done;
begin
 Done;
end;

class constructor TDataA.Init;
begin
 with Init do begin 
  AddFild(Data);
  AddFild(Note);  
 end;
end;

class procedure TDataA.Work;
var
 i :Integer;
begin
 for i:=0 to Objs.Count-1 do 
  with Objs[i] do Inc(Data,Tag);
end;

{ DataB }

class destructor TDataB.Done;
begin
 Done;
end;

class constructor TDataB.Init;
begin
 with Init do begin 
  AddFild(Data);
  AddFild(Memo);  
 end;
end;

end.

Автор: v2v

Источник