Работа с коллекциями - сохранение и загрузка

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.


Взято с http://delphiworld.narod.ru

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...