こんにちは、ぜえた です。



TPersistentを継承したクラスの実装例です。
TSampleは最も簡単な Assignの実装例。
TTextは AssignTo, DefinePropertiesの実装例です。TStrings,
TClipboardのオブジェクトと互いに Assignできます。

unit Samples;

interface

uses Windows, Classes, Clipbrd;

type
  TSample = class(TPersistent)
  private
    FFoo: Integer;
    FBar: string;
    FBaz: string;
  public
    procedure Assign(Source: TPersistent); override;
  published
    property Foo: Integer read FFoo write FFoo;
    property Bar: string read FBar write FBar;
    property Baz: string read FBaz write FBaz;
  end;

  TText = class(TPersistent)
  private
    FText: string;
    procedure ReadData(Reader: TReader);
    procedure WriteData(Writer: TWriter);
  protected
    procedure AssignTo(Dest: TPersistent); override;
    procedure DefineProperties(Filer: TFiler); override;
  public
    procedure Assign(Source: TPersistent); override;
    property Text: string read FText write FText;
  end;

implementation

{ TSample }

procedure TSample.Assign(Source: TPersistent); //override;
begin
  if Source is TSample then begin
    FFoo := TSample(Source).FFoo;
    FBar := TSample(Source).FBar;
    FBaz := TSample(Source).FBaz;
  end else begin
    inherited Assign(Source);
  end;
end;

{ TText }

procedure TText.Assign(Source: TPersistent); //override;
begin
  if Source is TText then begin
    FText := TText(Source).FText;
  end else if Source is TStrings then begin
    FText := TStrings(Source).Text;
  end else if Source is TClipboard then begin
    with TClipboard(Source) do
      if HasFormat(CF_TEXT) then FText := AsText;
  end else begin
    inherited Assign(Source);
  end;
end;

procedure TText.AssignTo(Dest: TPersistent); //override;
begin
  if Dest is TStrings then begin
    TStrings(Dest).Text := FText;
  end else if Dest is TClipboard then begin
    TClipboard(Dest).AsText := FText;
  end else begin
    inherited AssignTo(Dest);
  end;
end;

procedure TText.DefineProperties(Filer: TFiler); //override;

  function DoWrite: Boolean;
  begin
    if Filer.Ancestor <> nil then begin
      Result := True;
      if Filer.Ancestor is TText then
        Result := (TText(Filer.Ancestor).FText <> FText);
    end else begin
      Result := (FText <> '');
    end;
  end;

begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('Text', ReadData, WriteData, DoWrite);
end;

procedure TText.ReadData(Reader: TReader);
begin
  FText := Reader.ReadString;
end;

procedure TText.WriteData(Writer: TWriter);
begin
  Writer.WriteString(FText);
end;

end.

                                                    ぜえた (QZC05100)

Original document by ぜえた          氏 ID:(QZC05100)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。