關於繼承自TCollection及TCollectionItem類的對象序列化存儲 |
尚未結案
|
taoyufei
一般會員 發表:2 回覆:1 積分:0 註冊:2005-04-21 發送簡訊給我 |
在從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 |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |