TRecord = class; TRecordClass = class of TRecord; TRecordList<T : TRecord> = class;
TRecord = class private FChildsDict : TDictionary<TRecordType, TRecordList<TRecord>>; FParent: TRecordList<TRecord>; F_ID: Integer; F_Index: Double; F_PID: Integer; procedure Set_Index(const Value: Double); protected class function GetRecordType: TRecordType; virtual; class procedure RegistryClass; public class function GetClass(ARecordType : TRecordType) : TRecordClass; constructor Create(AParent: TRecordList<TRecord>); reintroduce; virtual; destructor Destroy; override; function Childs<T : TRecord> : TRecordList<T>; overload; function Childs(ARecordType : TRecordType) : TRecordList<TRecord>; overload; procedure Post; property Parent: TRecordList<TRecord> read FParent; property _ID: Integer read F_ID; property _Index: Double read F_Index write Set_Index; property _PID: Integer read F_PID; property _Type: TRecordType read GetRecordType; end;
TRecordList<T : TRecord> = class private FCount: Integer; FItems : TList<T>; FParent: TRecord; function GetItems(Index: Integer): T; function GetRecordType: TRecordType; public constructor Create(AParent: TRecord); reintroduce; virtual; destructor Destroy; override; function Add: T; procedure Clear; procedure Delete(AIndex: Integer); procedure Remove(AItem: T); class procedure Test; property Count: Integer read FCount; property Items[Index: Integer]: T read GetItems; property Parent: TRecord read FParent; property RecordType: TRecordType read GetRecordType; end;
type TRecord1 = class(TRecord) protected class function GetRecordType: TRecordType; override; end; TRecord2 = class(TRecord) protected class function GetRecordType: TRecordType; override; end;
implementation
var G_RecordClassDict : TDictionary<TRecordType, TRecordClass>;
destructor TRecord.Destroy; var pair : TPair<TRecordType, TRecordList<TRecord>>; begin for pair in FChildsDict do begin pair.Value.FParent := nil; pair.Value.Free; end; FChildsDict.Free; inherited; end;
function TRecord.Childs(ARecordType: TRecordType): TRecordList<TRecord>; var pair : TPair<TRecordType, TRecordList<TRecord>>; cls : TRecordClass; begin for pair in FChildsDict do if pair.Key = ARecordType then Exit(pair.Value); cls := TRecord.GetClass(ARecordType); if Assigned(cls) then begin //问题所在,如何创建? Result := TRecordList<cls>.Create(Self) as TRecordList<TRecord>; FChildsDict.Add(Result.RecordType, Result); end else Result := nil; end;
function TRecord.Childs<T>: TRecordList<T>; var pair : TPair<TRecordType, TRecordList<TRecord>>; begin for pair in FChildsDict do if pair.Key = T.GetRecordType then Exit(TRecordList<T>(pair.Value)); Result := TRecordList<T>.Create(Self); FChildsDict.Add(Result.RecordType, TRecordList<TRecord>(Result)); end;
class function TRecord.GetClass(ARecordType: TRecordType): TRecordClass; begin if not G_RecordClassDict.TryGetValue(ARecordType, Result) then Result := nil; end;
class function TRecord.GetRecordType: TRecordType; begin Result := 0; end;
procedure TRecord.Post; begin // TODO -cMM: TRecord.Post default body inserted end;
class procedure TRecord.RegistryClass; begin if G_RecordClassDict.ContainsKey(Self.GetRecordType) then raise Exception.Create('重复注册.'); G_RecordClassDict.Add(Self.GetRecordType, Self); end;
procedure TRecord.Set_Index(const Value: Double); begin F_Index := Value; end;
TRecord = class; TRecordClass = class of TRecord; TRecordList<T : TRecord> = class;
TRecord = class private FChildsDict : TDictionary<TRecordType, TRecordList<TRecord>>; FParent: TRecordList<TRecord>; F_ID: Integer; F_Index: Double; F_PID: Integer; procedure Set_Index(const Value: Double); protected class function CreateList(AParent: TRecord): TRecordList<TRecord>; virtual; abstract; class function GetRecordType: TRecordType; virtual; abstract; class procedure RegistryClass; public constructor Create(AParent: TRecordList<TRecord>); reintroduce; virtual; destructor Destroy; override; function Childs(ARecordType : TRecordType) : TRecordList<TRecord>; overload; function Childs<T : TRecord> : TRecordList<T>; overload; class function GetClass(ARecordType : TRecordType) : TRecordClass; procedure Post; property Parent: TRecordList<TRecord> read FParent; property _ID: Integer read F_ID; property _Index: Double read F_Index write Set_Index; property _PID: Integer read F_PID; property _Type: TRecordType read GetRecordType; end;
TRecordList<T : TRecord> = class private FItems : TList<T>; FParent: TRecord; function GetCount: Integer; function GetItems(Index: Integer): T; function GetRecordType: TRecordType; public constructor Create(AParent: TRecord); reintroduce; virtual; destructor Destroy; override; function Add: T; virtual; //必须virtual/dynamic,否则子类list强转再add会有问题 procedure Clear; procedure Delete(AIndex: Integer); procedure Remove(AItem: T); class procedure Test; property Count: Integer read GetCount; property Items[Index: Integer]: T read GetItems; property Parent: TRecord read FParent; property RecordType: TRecordType read GetRecordType; end;
type TRecord1 = class(TRecord) protected class function CreateList(AParent: TRecord) : TRecordList<TRecord>; override; class function GetRecordType: TRecordType; override; end; TRecord2 = class(TRecord) protected class function CreateList(AParent: TRecord) : TRecordList<TRecord>; override; class function GetRecordType: TRecordType; override; end;
implementation
var G_RecordClassDict : TDictionary<TRecordType, TRecordClass>;
destructor TRecord.Destroy; var pair : TPair<TRecordType, TRecordList<TRecord>>; begin for pair in FChildsDict do begin pair.Value.FParent := nil; pair.Value.Free; end; FChildsDict.Free; inherited; end;
function TRecord.Childs(ARecordType: TRecordType): TRecordList<TRecord>; var pair : TPair<TRecordType, TRecordList<TRecord>>; cls : TRecordClass; begin for pair in FChildsDict do if pair.Key = ARecordType then Exit(pair.Value); cls := TRecord.GetClass(ARecordType); if Assigned(cls) then begin Result := cls.CreateList(Self); FChildsDict.Add(ARecordType, Result); end else Result := nil; end;
function TRecord.Childs<T>: TRecordList<T>; var pair : TPair<TRecordType, TRecordList<TRecord>>; begin for pair in FChildsDict do if pair.Key = T.GetRecordType then Exit(TRecordList<T>(pair.Value)); Result := TRecordList<T>.Create(Self); FChildsDict.Add(Result.RecordType, TRecordList<TRecord>(Result)); end;
class function TRecord.GetClass(ARecordType: TRecordType): TRecordClass; begin if not G_RecordClassDict.TryGetValue(ARecordType, Result) then Result := nil; end;
procedure TRecord.Post; begin // TODO -cMM: TRecord.Post default body inserted end;
class procedure TRecord.RegistryClass; begin if G_RecordClassDict.ContainsKey(Self.GetRecordType) then raise Exception.Create('重复注册.'); G_RecordClassDict.Add(Self.GetRecordType, Self); end;
procedure TRecord.Set_Index(const Value: Double); begin F_Index := Value; end;
dlist := TRecordList<TRecord2>(cItem.Childs(2)); if Assigned(dlist) then begin ditem := dlist.Add; Writeln(dlist.ClassName); //TRecordList<uBaseRecord.TRecord2> Writeln(ditem.ClassName); //TRecord2 end;
elist := cItem.Childs(2); if Assigned(elist) then begin eitem := elist.Add; Writeln(elist.ClassName); //TRecordList<uBaseRecord.TRecord2> Writeln(eitem.ClassName); //TRecord ?? end; finally Free; end; end;
{ TRecord1 }
class function TRecord1.CreateList(AParent: TRecord): TRecordList<TRecord>; begin Result := TRecordList<TRecord>(TRecordList<TRecord1>.Create(AParent)); end;
class function TRecord1.GetRecordType: TRecordType; begin Result := 1; end;
{ TRecord2 }
class function TRecord2.CreateList(AParent: TRecord): TRecordList<TRecord>; begin Result := TRecordList<TRecord>(TRecordList<TRecord2>.Create(AParent)); end;
class function TRecord2.GetRecordType: TRecordType; begin Result := 2; end;