fmdemomain.pas

多数代码可以直接在Delphi6和Delphi7环境下运行。部分涉及.NET技术内容的代码

unit fmDemoMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, uMyPersistent, ExtDlgs;

type
  TForm1 = class(TForm)
    btnCreateObject: TButton;
    ledtiValue: TLabeledEdit;
    ledtbValue: TLabeledEdit;
    ledtfValue: TLabeledEdit;
    ledtsValue: TLabeledEdit;
    btnClearObject: TButton;
    btnLoadObject: TButton;
    btnSaveObject: TButton;
    Image1: TImage;
    btnLoadImage: TButton;
    opdDlg: TOpenPictureDialog;
    procedure btnCreateObjectClick(Sender: TObject);
    procedure btnClearObjectClick(Sender: TObject);
    procedure btnLoadObjectClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnSaveObjectClick(Sender: TObject);
    procedure btnLoadImageClick(Sender: TObject);
  private
    { Private declarations }
    fss : TMemoryStream;
    po : TMyPersistent;
  public
    { Public declarations }
    procedure ClearValues;
    procedure CreateMyPersistent;
    procedure ShowProperties(po: TMyPersistent);
    procedure LoadPerObject; 
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  PERFILENAME = 'DemoPersistentFile.cks';

procedure TForm1.btnCreateObjectClick(Sender: TObject);
begin
  CreateMyPersistent;
  ShowProperties(po);
end;

procedure TForm1.btnClearObjectClick(Sender: TObject);
begin
  FreeAndNil(po);
  ClearValues;
end;

procedure TForm1.btnLoadObjectClick(Sender: TObject);
begin
  FreeAndNil(po);
  LoadPerObject;
  ShowProperties(po);
end;

procedure TForm1.ClearValues;
var
  iCount : Integer;
  acmp : TComponent;
begin
  for iCount := 0 to Self.ComponentCount - 1 do    // Iterate
  begin
    acmp := Self.Components[iCount];
    if (acmp is TLabeledEdit) then
      TLabeledEdit(acmp).Text := '';
  end;    // for
end;

procedure TForm1.CreateMyPersistent;
begin
  po := TMyPersistent.Create(Self);
end;

procedure TForm1.LoadPerObject;
begin
  fss.LoadFromFile(PERFILENAME);
  if (not Assigned(po)) then
    CreateMyPersistent;

  fss.ReadComponent(po);
end;

procedure TForm1.ShowProperties(po: TMyPersistent);
begin
  ledtiValue.Text := IntToStr(po.GetiValue);
  ledtfValue.Text := FloatToStr(po.GetfValue);
  if (po.GetbValue) then
    ledtbValue.Text := 'True'
  else
    ledtbValue.Text := 'False';
  ledtsValue.Text := po.GetsValue;
  Self.Image1.Picture.Assign(po.GetImage.Picture);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  fss := TMemoryStream.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if (Assigned(po)) then
    FreeAndNil(po);

  FreeAndNil(fss);
end;

procedure TForm1.btnSaveObjectClick(Sender: TObject);
begin
  po.SetiValue(StrToInt(ledtiValue.Text));
  po.SetsValue(ledtsValue.Text);
  po.SetfValue(StrToFloat(ledtfValue.Text));
  if (ledtbValue.Text = 'True') then
    po.SetbValue(True)
  else
    po.SetbValue(False);
  po.SetImage(Self.Image1);

  fss.WriteComponent(po);
  fss.SaveToFile(PERFILENAME);
end;

procedure TForm1.btnLoadImageClick(Sender: TObject);
begin
  if (Self.opdDlg.Execute) then
    Image1.Picture.LoadFromFile(opdDlg.FileName);
end;

end.