在從TCollectionItem類繼承的TmxCustomItem類中自定義一些屬性值(包括數值、對像），能夠正常存出到自定義的外部文件中，但無法正常從自定義的外部文件中讀出當初存入TmxCustomItem類的屬性值？ 參見：http://www.delphipraxis.net/topic28945_tcollection+und+tcollectionitem.html

TmxCustomItem = class(TCollectionItem)
  private
    Fsequence:String;
    FaBoolean: boolean;
    FanExtended: Extended;
    FanInteger: integer;
    FanEnum: TFilerFlag;
    FaSet: TFilerFlags;
    FaTest : String;
    FButton: TSpeedButton;
    FanImage: TBitmap;
    function getSequence: string;
    procedure SetSequence(const Value: string);
    procedure SetImage(const Value: TBitmap);
  protected      published
    property sequence : string read getSequence write SetSequence; // adapter to the binSequence
    property aBoolean : boolean read FaBoolean  write FaBoolean;
    property anInteger : integer read FanInteger  write FanInteger; 
    property anExtended : Extended read FanExtended  write FanExtended; 
    property anEnum :  TFilerFlag read FanEnum  write FanEnum;
    property aSet : TFilerFlags read FaSet  write FaSet;
    property aTest:String read FaTest write FaTest;
    property anImage : TBitmap read FanImage write SetImage stored true;
    property anButton: TSpeedButton read FButton write FButton stored true;
  public
     
  end;      TJsCollection = class(TCollection)
  private
    FCollectionname : String;
    FPanel:TPanel;
    procedure SetCollectionname(const Value: String);
    function getCollectionname: String;
  public
    procedure Assign(Source : TPersistent); override;
    procedure SaveToFile(const Filename : TFilename);
    procedure SaveToStream(Stream : TStream); virtual;
    procedure LoadFromFile(const Filename : TFilename);
    procedure LoadFromStream(Stream : TStream); virtual;
  published
    property Collectionname : String read getCollectionname write SetCollectionname;
  end;      TmxJsCollection = class(TJsCollection)
  private
    FBinary : Boolean; 
  public
    procedure LoadFromStream(aStream: TStream); override;
    procedure SaveToStream(aStream: TStream); override;     
    property  Binary : Boolean read FBinary write FBinary;
  published
    property Collectionname stored false;
  public
    constructor Create;
    function Add:TmxCustomItem;
  end;      TWriterExt = class(TWriter)
  public
    procedure WriteCollectionProperties(Value : TCollection);
  end;      TReaderExt = class(TReader)
  public
    procedure ReadCollectionProperties(Value: TCollection);
  end;    implementation    uses TypInfo;    const 
  iFilerBufferSize = 4096; 
  FilerSignatureEx: String = 'TPF0'; 
  cInvalidName = ' is not a valid CollectionName!';     { TJsCollection }
procedure TJsCollection.Assign(Source: TPersistent);
begin 
  If Source is TJsCollection then 
    FCollectionname:=TJsCollection(Source).Collectionname; 
  inherited Assign(Source); 
end;     function TJsCollection.GetCollectionname: String;
begin
  if FCollectionname = ''
  then result := copy(className,2,length(className)-1)
  else result := FCollectionname;
end;     procedure TJsCollection.LoadFromFile(const Filename: TFilename); 
var 
  FileStream : TFileStream; 
begin 
  Clear;
  FileStream:=TFileStream.Create(Filename,fmOpenRead); 
  Try 
    LoadFromStream(FileStream); 
  Finally 
    FileStream.Free; 
  end; 
end;     procedure TJsCollection.LoadFromStream(Stream: TStream);
var 
  Reader  : TReaderExt; 
begin 
  Reader:=TReaderExt.Create(Stream,iFilerBufferSize); 
  Try 
    Reader.ReadCollectionProperties(Self); 
  Finally 
    Reader.Free; 
  end;
end;     procedure TJsCollection.SaveToFile(const Filename: TFilename);
var
  FileStream : TFileStream; 
begin
  FileStream:=TFileStream.Create(Filename,fmCreate); 
  Try 
    SaveToStream(FileStream);
  Finally 
    FileStream.Free; 
    end; 
end;     procedure TJsCollection.SaveToStream(Stream: TStream); 
var 
  Writer:TWriterExt;
begin
  Writer:=TWriterExt.Create(Stream,iFilerBufferSize);
  Try
    Writer.WriteCollectionProperties(Self);
    Writer.WriteListEnd;
  Finally
    Writer.Free;
  end;
end;    procedure TJsCollection.SetCollectionname(const Value: String); 
begin 
  if not IsValidIdent(Value) 
  then raise exception.Create(#39 Value #39 cInValidName) 
  else FCollectionname := Value; 
end;     { TWriterExt }
procedure TWriterExt.WriteCollectionProperties(Value: TCollection); 
begin 
  WriteProperties(Value);
  WriteStr('items');   
  inherited WriteCollection(Value);
end;     { TReaderExt }
procedure TReaderExt.ReadCollectionProperties(Value: TCollection);
var propName:string; 
    oldPos:integer;
begin
  while not EndOfList do
  begin 
    oldPos :=  Position;
    propName := ReadStr;
    if propName = 'items' then
    begin
      ReadValue;      
     inherited ReadCollection(Value); //從外部文件讀取TJsCollection類的對象屬性值時出錯，如：anImage 及anButton
    end else  begin
      Position := oldPos; 
      ReadProperty(value);
    end; 
  end;
end;     { TmxJsCollection }
function TmxJsCollection.Add: TmxCustomItem;
begin
  Result := TmxCustomItem (inherited add)
end;    constructor TmxJsCollection.Create;
begin
  inherited Create(TmxCustomItem);
end;    procedure TmxJsCollection.LoadFromStream(aStream: TStream);
var Reader       : TReaderExt; 
    StreamInner  : TStream; 
    format       : TStreamOriginalFormat; 
    oldPos       : Int64; 
    SigBuffer    : array[1..4] of char; 
begin 
  oldPos := aStream.Position; 
  aStream.ReadBuffer(SigBuffer[1],sizeOf(SigBuffer)); 
  FBinary := SigBuffer = FilerSignatureEx;
  aStream.Position := oldPos;       if FBinary 
  then StreamInner := aStream 
  else StreamInner := TMemoryStream.Create; 
              
  try    
    // DFM-text parsen 
    if not FBinary then 
    begin 
      format := sofBinary;                              
      ObjectTextToBinary(aStream,StreamInner,format); 
      StreamInner.Position := 0; 
    end; 
                          
    Reader := TReaderExt.Create(StreamInner,iFilerBufferSize);      
    try
      Reader.ReadSignature;
      Reader.ReadStr; // ClassName
      FCollectionname := Reader.ReadStr; // Collectionname          Reader.ReadCollectionProperties(self);          Reader.ReadListEnd;                              
      Reader.ReadListEnd; 
    finally 
      Reader.Free; 
    end; 
  finally 
    if not FBinary then StreamInner.Free; 
  end; 
end;     procedure TmxJsCollection.SaveToStream(aStream: TStream); 
var Writer       : TWriterExt; 
    StreamInner  : TStream; 
    format       : TStreamOriginalFormat;          
begin              
  if FBinary 
  then StreamInner := aStream 
  else StreamInner := TMemoryStream.Create; 
                
  try                                                      
    Writer := TWriterExt.Create(StreamInner,iFilerBufferSize);        
    try          
      Writer.WriteSignature; 
      Writer.WriteStr(ClassName);                    
      Writer.WriteStr(Collectionname);              Writer.WriteCollectionProperties(self); 
      
      Writer.WriteListEnd; 
      Writer.WriteListEnd;                                  
    finally 
      Writer.Free; 
    end; 
    // DFM-text konversion 
    if not FBinary then 
    begin 
      StreamInner.Position := 0;
      format := sofText;                                
      ObjectBinaryToText(StreamInner,aStream,format); 
    end;
  finally 
    if not FBinary then StreamInner.Free;
  end; 
end;      { TmxCustomItem }    function TmxCustomItem.getSequence: string;
begin
  Result := Fsequence;
end;    procedure TmxCustomItem.SetImage(const Value: TBitmap);
begin
  FanImage := Value;
end;    procedure TmxCustomItem.SetSequence(const Value: string);
begin
  Fsequence := Value;
end;

發表人 - wameng 於 2005/04/22 16:32:58