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

Автор: Rick Rogers
WEB-сайт: http://www.lmc-mediaagentur.de

How can I save properties of a TList to a stream? I need the entire list to be saved as a whole and not as individual objects.

A TList doesn't have any intrinsic streaming capability built into it, but it is very easy to stream anything that you want with a little elbow grease. Think about it: a stream is data. Classes have properties, whose values are data. It isn't too hard to write property data to a stream. Here's a simple example to get you going. This is but just one of many possible approaches to saving object property data to a stream:

unit uStreamableExample;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    StdCtrls, Contnrs;

type
  TStreamableObject = class(TPersistent)
  protected
    function ReadString(Stream: TStream): string;
    function ReadLongInt(Stream: TStream): LongInt;
    function ReadDateTime(Stream: TStream): TDateTime;
    function ReadCurrency(Stream: TStream): Currency;
    function ReadClassName(Stream: TStream): ShortString;
    procedure WriteString(Stream: TStream; const Value: string);
    procedure WriteLongInt(Stream: TStream; const Value: LongInt);
    procedure WriteDateTime(Stream: TStream; const Value: TDateTime);
    procedure WriteCurrency(Stream: TStream; const Value: Currency);
    procedure WriteClassName(Stream: TStream; const Value: ShortString);
  public
    constructor CreateFromStream(Stream: TStream);
    procedure LoadFromStream(Stream: TStream); virtual; abstract;
    procedure SaveToStream(Stream: TStream); virtual; abstract;
  end;

  TStreamableObjectClass = class of TStreamableObject;

  TPerson = class(TStreamableObject)
  private
    FName: string;
    FBirthDate: TDateTime;
  public
    constructor Create(const AName: string; ABirthDate: TDateTime);
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    property Name: string read FName write FName;
    property BirthDate: TDateTime read FBirthDate write FBirthDate;
  end;

  TCompany = class(TStreamableObject)
  private
    FName: string;
    FRevenues: Currency;
    FEmployeeCount: LongInt;
  public
    constructor Create(const AName: string; ARevenues: Currency; AEmployeeCount:
      LongInt);
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    property Name: string read FName write FName;
    property Revenues: Currency read FRevenues write FRevenues;
    property EmployeeCount: LongInt read FEmployeeCount write FEmployeeCount;
  end;

  TStreamableList = class(TStreamableObject)
  private
    FItems: TObjectList;
    function Get_Count: LongInt;
    function Get_Objects(Index: LongInt): TStreamableObject;
  public
    constructor Create;
    destructor Destroy; override;
    function FindClass(const AClassName: string): TStreamableObjectClass;
    procedure Add(Item: TStreamableObject);
    procedure Delete(Index: LongInt);
    procedure Clear;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    property Objects[Index: LongInt]: TStreamableObject read Get_Objects;
      default;
    property Count: LongInt read Get_Count;
  end;

  TForm1 = class(TForm)
    SaveButton: TButton;
    LoadButton: TButton;
    procedure SaveButtonClick(Sender: TObject);
    procedure LoadButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    Path: string;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

resourcestring
  DEFAULT_FILENAME = 'test.dat';

procedure TForm1.SaveButtonClick(Sender: TObject);
var
  List: TStreamableList;
  Stream: TStream;
begin
  List := TStreamableList.Create;
  try
    List.Add(TPerson.Create('Rick Rogers', StrToDate('05/20/68')));
    List.Add(TCompany.Create('Fenestra', 1000000, 7));
    Stream := TFileStream.Create(Path + DEFAULT_FILENAME, fmCreate);
    try
      List.SaveToStream(Stream);
    finally
      Stream.Free;
    end;
  finally
    List.Free;
  end;
end;

{ TPerson }

constructor TPerson.Create(const AName: string; ABirthDate: TDateTime);
begin
  inherited Create;
  FName := AName;
  FBirthDate := ABirthDate;
end;

procedure TPerson.LoadFromStream(Stream: TStream);
begin
  FName := ReadString(Stream);
  FBirthDate := ReadDateTime(Stream);
end;

procedure TPerson.SaveToStream(Stream: TStream);
begin
  WriteString(Stream, FName);
  WriteDateTime(Stream, FBirthDate);
end;

{ TStreamableList }

procedure TStreamableList.Add(Item: TStreamableObject);
begin
  FItems.Add(Item);
end;

procedure TStreamableList.Clear;
begin
  FItems.Clear;
end;

constructor TStreamableList.Create;
begin
  FItems := TObjectList.Create;
end;

procedure TStreamableList.Delete(Index: LongInt);
begin
  FItems.Delete(Index);
end;

destructor TStreamableList.Destroy;
begin
  FItems.Free;
  inherited;
end;

function TStreamableList.FindClass(const AClassName: string):
  TStreamableObjectClass;
begin
  Result := TStreamableObjectClass(Classes.FindClass(AClassName));
end;

function TStreamableList.Get_Count: LongInt;
begin
  Result := FItems.Count;
end;

function TStreamableList.Get_Objects(Index: LongInt): TStreamableObject;
begin
  Result := FItems[Index] as TStreamableObject;
end;

procedure TStreamableList.LoadFromStream(Stream: TStream);
var
  StreamCount: LongInt;
  I: Integer;
  S: string;
  ClassRef: TStreamableObjectClass;
begin
  StreamCount := ReadLongInt(Stream);
  for I := 0 to StreamCount - 1 do
  begin
    S := ReadClassName(Stream);
    ClassRef := FindClass(S);
    Add(ClassRef.CreateFromStream(Stream));
  end;
end;

procedure TStreamableList.SaveToStream(Stream: TStream);
var
  I: Integer;
begin
  WriteLongInt(Stream, Count);
  for I := 0 to Count - 1 do
  begin
    WriteClassName(Stream, Objects[I].ClassName);
    Objects[I].SaveToStream(Stream);
  end;
end;

{ TStreamableObject }

constructor TStreamableObject.CreateFromStream(Stream: TStream);
begin
  inherited Create;
  LoadFromStream(Stream);
end;

function TStreamableObject.ReadClassName(Stream: TStream): ShortString;
begin
  Result := ReadString(Stream);
end;

function TStreamableObject.ReadCurrency(Stream: TStream): Currency;
begin
  Stream.Read(Result, SizeOf(Currency));
end;

function TStreamableObject.ReadDateTime(Stream: TStream): TDateTime;
begin
  Stream.Read(Result, SizeOf(TDateTime));
end;

function TStreamableObject.ReadLongInt(Stream: TStream): LongInt;
begin
  Stream.Read(Result, SizeOf(LongInt));
end;

function TStreamableObject.ReadString(Stream: TStream): string;
var
  L: LongInt;
begin
  L := ReadLongInt(Stream);
  SetLength(Result, L);
  Stream.Read(Result[1], L);
end;

procedure TStreamableObject.WriteClassName(Stream: TStream; const Value:
  ShortString);
begin
  WriteString(Stream, Value);
end;

procedure TStreamableObject.WriteCurrency(Stream: TStream; const Value:
  Currency);
begin
  Stream.Write(Value, SizeOf(Currency));
end;

procedure TStreamableObject.WriteDateTime(Stream: TStream; const Value:
  TDateTime);
begin
  Stream.Write(Value, SizeOf(TDateTime));
end;

procedure TStreamableObject.WriteLongInt(Stream: TStream; const Value: LongInt);
begin
  Stream.Write(Value, SizeOf(LongInt));
end;

procedure TStreamableObject.WriteString(Stream: TStream; const Value: string);
var
  L: LongInt;
begin
  L := Length(Value);
  WriteLongInt(Stream, L);
  Stream.Write(Value[1], L);
end;

{ TCompany }

constructor TCompany.Create(const AName: string; ARevenues: Currency;
  AEmployeeCount: Integer);
begin
  FName := AName;
  FRevenues := ARevenues;
  FEmployeeCount := AEmployeeCount;
end;

procedure TCompany.LoadFromStream(Stream: TStream);
begin
  FName := ReadString(Stream);
  FRevenues := ReadCurrency(Stream);
  FEmployeeCount := ReadLongInt(Stream);
end;

procedure TCompany.SaveToStream(Stream: TStream);
begin
  WriteString(Stream, FName);
  WriteCurrency(Stream, FRevenues);
  WriteLongInt(Stream, FEmployeeCount);
end;

procedure TForm1.LoadButtonClick(Sender: TObject);
var
  List: TStreamableList;
  Stream: TStream;
  Instance: TStreamableObject;
  I: Integer;
begin
  Stream := TFileStream.Create(Path + DEFAULT_FILENAME, fmOpenRead);
  try
    List := TStreamableList.Create;
    try
      List.LoadFromStream(Stream);
      for I := 0 to List.Count - 1 do
      begin
        Instance := List[I];
        if Instance is TPerson then
          ShowMessage(TPerson(Instance).Name);
        if Instance is TCompany then
          ShowMessage(TCompany(Instance).Name);
      end;
    finally
      List.Free;
    end;
  finally
    Stream.Free;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Path := ExtractFilePath(Application.ExeName);
end;

initialization
  RegisterClasses([TPerson, TCompany]);

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