umypersistent.pas

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

unit uMyPersistent;

interface

uses
  SysUtils, Classes, Controls, Graphics, ExtCtrls;

type
  TMyPersistent = class(TComponent)
  private
    iValue : Integer;
    fValue : double;
    bValue : Boolean;
    aImage : TImage;

    procedure StoreIntegerProperty(Writer: TWriter);
    procedure LoadIntegerProperty(Reader: TReader);

    procedure StoreDoubleProperty(Writer: TWriter);
    procedure LoadDoubleProperty(Reader: TReader);

    procedure StoreBooleanProperty(Writer: TWriter);
    procedure LoadBooleanProperty(Reader: TReader);

    procedure StoreStringProperty(Writer: TWriter);
    procedure LoadStringProperty(Reader: TReader);

    procedure StoreImageProperty(Writer: TWriter);
    procedure LoadImageProperty(Reader: TReader);
  public
    sValue : String;
    procedure DefineProperties(Filer: TFiler); override;

    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;
    function GetiValue : Integer;
    function GetfValue : double;
    function GetbValue : Boolean;
    function GetsValue : String;
    function GetImage : TImage;

    procedure SetiValue(const ive : Integer);
    procedure SetbValue(const bve : Boolean);
    procedure SetfValue(const fve : double);
    procedure SetsValue(const sve : String);
    procedure SetImage(img : TImage);
  end;

implementation

{ TMyPersistent }

uses EncdDecd;

const
  TIMAGEFILE = 'timg.cks';

constructor TMyPersistent.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  iValue := 100;
  fValue := 200.02;
  bValue := True;
  sValue := '我是一个持久化对象';
  aImage := TImage.Create(Self);
end;

procedure TMyPersistent.DefineProperties(Filer: TFiler);
begin
  Inherited;
  Filer.DefineProperty('MyIntegerProperty', LoadIntegerProperty,
    StoreIntegerProperty, True);
  Filer.DefineProperty('MyDoubleProperty', LoadDoubleProperty,
    StoreDoubleProperty, True);
  Filer.DefineProperty('MyBooleanrProperty', LoadBooleanProperty,
    StoreBooleanProperty, True);
  Filer.DefineProperty('MyStringProperty', LoadStringProperty,
    StoreStringProperty, True);
  Filer.DefineProperty('MyImageProperty', LoadImageProperty,
    StoreImageProperty, True);
end;

destructor TMyPersistent.Destroy;
begin
  FreeAndNil(aImage);
  inherited;
end;

function TMyPersistent.GetbValue: Boolean;
begin
  Result := bValue;
end;

function TMyPersistent.GetfValue: double;
begin
  Result := fValue;
end;

function TMyPersistent.GetImage: TImage;
begin
  Result := aImage;
end;

function TMyPersistent.GetiValue: Integer;
begin
  Result := iValue;
end;

function TMyPersistent.GetsValue: String;
begin
  Result := sValue;
end;

procedure TMyPersistent.LoadBooleanProperty(Reader: TReader);
begin
  if Reader.ReadBoolean then
    bValue := Reader.ReadBoolean;
end;

procedure TMyPersistent.LoadDoubleProperty(Reader: TReader);
begin
  if Reader.ReadBoolean then
    fValue := Reader.ReadFloat;
end;

procedure TMyPersistent.LoadImageProperty(Reader: TReader);
var
  acmp : TComponent;
begin
  if Reader.ReadBoolean then
  begin
    try
      FindClass('TImage');
    except
      on e: EClassNotFound do
        RegisterClass(TImage);
    end;    // try/except

    acmp := Reader.ReadComponent(nil);
    aImage := TImage(acmp);
  end;
end;

procedure TMyPersistent.LoadIntegerProperty(Reader: TReader);
begin
  if Reader.ReadBoolean then
    iValue := Reader.ReadInteger;
end;

procedure TMyPersistent.LoadStringProperty(Reader: TReader);
begin
  if Reader.ReadBoolean then
    sValue := Reader.ReadString;
end;

procedure TMyPersistent.SetbValue(const bve: Boolean);
begin
  bValue := bve;
end;

procedure TMyPersistent.SetfValue(const fve: double);
begin
  fValue := fve;
end;

procedure TMyPersistent.SetImage(img: TImage);
begin
  aImage.Picture.Assign(img.Picture);
end;

procedure TMyPersistent.SetiValue(const ive: Integer);
begin
  iValue := ive;
end;

procedure TMyPersistent.SetsValue(const sve: String);
begin
  sValue := sve;
end;

procedure TMyPersistent.StoreBooleanProperty(Writer: TWriter);
begin
  Writer.WriteBoolean(bValue <> False);
  if (bValue <> False) then
    Writer.WriteBoolean(bValue);
end;

procedure TMyPersistent.StoreDoubleProperty(Writer: TWriter);
begin
  Writer.WriteBoolean(fValue <> 0);
  if (fValue <> 0.0) then
    Writer.WriteFloat(fValue);
end;

procedure TMyPersistent.StoreImageProperty(Writer: TWriter);
begin
  Writer.WriteBoolean(aImage <> nil);
  if (aImage <> nil) then
    Writer.WriteComponent(aImage);
end;

procedure TMyPersistent.StoreIntegerProperty(Writer: TWriter);

begin
  Writer.WriteBoolean(iValue <> 0);
  if iValue <> 0 then
    Writer.WriteInteger(iValue);
end;

procedure TMyPersistent.StoreStringProperty(Writer: TWriter);
begin
  Writer.WriteBoolean(sValue <> '');
  if sValue <> '' then
    Writer.WriteString(sValue);
end;

end.