Сохранение и загрузка коллекций
01.01.2007
unit DelphiPt; interface uses Classes, Graphics; type TDDHPoint = class (TCollectionItem) private fX, fY: Integer; public Text: string; procedure WriteText (Writer: TWriter); procedure ReadText (Reader: TReader); procedure DefineProperties (Filer: TFiler); override; procedure Paint (Canvas: TCanvas); procedure Assign (Pt: TPersistent); override; published property X: Integer read fX write fX; property Y: Integer read fY write fY; end; TWrapper = class (TComponent) private FColl: TCollection; published property MyColl: TCollection read FColl write FColl; public constructor Create (Owner: TComponent); override; destructor Destroy; override; end; implementation // TWrapper constructor and destructor constructor TWrapper.Create (Owner: TComponent); begin inherited Create (Owner); FColl := TCollection.Create (TDDHPoint); end; destructor TWrapper.Destroy; begin FColl.Clear; FColl.Free; inherited Destroy; end; // class TDDHPoint methods procedure TDDHPoint.WriteText (Writer: TWriter); begin Writer.WriteString (Text); end; procedure TDDHPoint.ReadText (Reader: TReader); begin Text := Reader.ReadString; end; procedure TDDHPoint.DefineProperties (Filer: TFiler); begin Filer.DefineProperty ( 'Text', ReadText, WriteText, (Text <> '')); end; procedure TDDHPoint.Paint (Canvas: TCanvas); begin Canvas.Ellipse (fX - 3, fY - 3, fX + 3, fY + 3); Canvas.TextOut (fX + 5, fY + 5, Text); end; procedure TDDHPoint.Assign (Pt: TPersistent); begin if Pt is TDDHPoint then begin fx := TDDHPoint (Pt).fX; fY := TDDHPoint (Pt).fY; Text := TDDHPoint (Pt).Text; end else // raise an exception inherited Assign (pt); end; //initialization //RegisterClass (TWrapper); end.
unit PersForm; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Buttons, StdCtrls, ExtCtrls; type TForm1 = class(TForm) Panel1: TPanel; Label1: TLabel; Edit1: TEdit; SpeedButtonLoad: TSpeedButton; SpeedButtonSave: TSpeedButton; OpenDialog1: TOpenDialog; SaveDialog1: TSaveDialog; procedure FormCreate(Sender: TObject); procedure SpeedButtonSaveClick(Sender: TObject); procedure SpeedButtonLoadClick(Sender: TObject); procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormDestroy(Sender: TObject); procedure FormPaint(Sender: TObject); private PtList: TCollection; end; var Form1: TForm1; implementation {$R *.DFM} uses DelphiPt; procedure TForm1.FormCreate(Sender: TObject); begin PtList := TCollection.Create (TDDHPoint); end; procedure TForm1.SpeedButtonSaveClick(Sender: TObject); var Str1: TFileStream; Wrap: TWrapper; begin if SaveDialog1.Execute then begin Str1 := TFileStream.Create (SaveDialog1.FileName, fmOpenWrite or fmCreate); try Wrap := TWrapper.Create (self); try Wrap.MyColl.Assign (ptList); Str1.WriteComponent (Wrap); finally Wrap.Free; end; finally Str1.Free; end; end; end; procedure TForm1.SpeedButtonLoadClick(Sender: TObject); var Str1: TFileStream; Wrap: TWrapper; begin if OpenDialog1.Execute then begin Str1 := TFileStream.Create ( OpenDialog1.Filename, fmOpenRead); try Wrap := TWrapper.Create (self); try Wrap := Str1.ReadComponent (Wrap) as TWrapper; ptList.Assign (Wrap.MyColl); finally Wrap.Free; end; finally Str1.Free; Invalidate; Edit1.Text := 'Point ' + IntToStr (PtList.Count + 1); end; end; end; procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var Pt: TDDHPoint; begin Pt := PtList.Add as TDDHPoint; Pt.X := X; Pt.Y := Y; Pt.Text := Edit1.Text; Edit1.Text := 'Point ' + IntToStr (PtList.Count + 1); Invalidate; end; procedure TForm1.FormDestroy(Sender: TObject); begin // empty and destroy the list PtList.Clear; PtList.Free; end; procedure TForm1.FormPaint(Sender: TObject); var I: Integer; begin for I := 0 to PtList.Count - 1 do TDDHPoint (PtList.Items [I]).Paint (Canvas); end; end.
Взято с https://delphiworld.narod.ru