Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Работа с коллекциями - сохранение и загрузка



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.

Загрузить весь проект

Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.