[icWasya]

Сообщение от Mickel007

Приветствую всех участников форума! Проконсультируйте, по возможности…

Суть проблемы WriteComponentResFile/ReadComponentResFile
....

И собственно вопрос, как добиться того, чтобы при сохранении отдельного компонента, сохранялись данные о событиях?

Собственно для этого написаны TWriter и TRead
Например здесь читается и пишется кнопка и таблица

Код:

unit Unit2;

interface

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

type
  TForm1 = class(TForm)
    SaveTable: TButton;
    DatabaseA: TDatabase;
    Table1: TTable;
    Table1NAME: TStringField;
    Table1SIZE: TSmallintField;
    Table1WEIGHT: TSmallintField;
    Table1AREA: TStringField;
    Table1BMP: TBlobField;
    Memo_Show_Writer: TMemo;
    Memo_Log: TMemo;
    DataSource1: TDataSource;
    LoadTable: TButton;
    Memo_Show_Reader: TMemo;
    SaveButton: TButton;
    TestButton: TButton;
    LoadButton: TButton;
    procedure Table1BMPChange(Sender: TField);
    procedure Table1AREAChange(Sender: TField);
    procedure SaveTableClick(Sender: TObject);
    procedure Table1CalcFields(DataSet: TDataSet);
    procedure LoadTableClick(Sender: TObject);
    procedure TestButtonClick(Sender: TObject);
    procedure SaveButtonClick(Sender: TObject);
    procedure LoadButtonClick(Sender: TObject);
  private
    procedure FindAncestorEvent(Writer: TWriter; Component: TComponent;
      const Name: string; var Ancestor, RootAncestor: TComponent);
    procedure ShowBinaryStream(S1: TStream; Lines: TStrings);
    procedure SaveComponentToFile(T: TComponent; FileName:String);
    procedure RestoreComponentFromFile(ComponentName: String; FileName:String);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit3;

{$R *.DFM}
/// следующие методы только для отладки - что бы были
procedure TForm1.Table1BMPChange(Sender: TField);
begin
  Memo_Log.Lines.Add('Table1BMPChange');
end;
procedure TForm1.Table1AREAChange(Sender: TField);
begin
  Memo_Log.Lines.Add('Table1AREAChange');
end;
procedure TForm1.Table1CalcFields(DataSet: TDataSet);
begin
   Memo_Log.Lines.Add('Table1CalcFields'); //
end;

/// процедура вызывается где то изнутри процедур чтения и записи
procedure TForm1.FindAncestorEvent (Writer: TWriter; Component: TComponent;
    const Name: string; var Ancestor, RootAncestor: TComponent);
begin
  Memo_Log.Lines.Add(Name);
end;

/// процедура показывает TStream в удобочитаемом виде
procedure TForm1.ShowBinaryStream(S1:TStream;Lines:TStrings);
var
  S2:TStream;
begin
  S2:=TMemoryStream.Create;
  try
    try
      S1.Position:=0;
      ObjectBinaryToText(S1, S2);
    except
      Memo_Log.Lines.Add('Ошибка конвертации');
    end;
    S2.Position:=0;
    Lines.LoadFromStream(S2);
  finally
    S2.Free;
  end;
end;

/// процедура сохраняет компоненту в файл
procedure TForm1.SaveComponentToFile(T:TComponent; FileName:String);
var//63216
  Writer:TWriter;
  MemoryStream,S2:TStream;
begin
  MemoryStream:=TMemoryStream.Create;
  try
    Writer:=TWriter.Create(MemoryStream, 8192);
    try
      Writer.OnFindAncestor :=  FindAncestorEvent;

      Writer.Root := Self;  // чьи методы будут использоваться
      Writer.WriteSignature; 
      Writer.WriteComponent(T);
    finally
      Writer.Free;
    end;

    // копируем MemoryStream на файл
    MemoryStream.Position:=0;

    S2:=TFileStream.Create(FileName,fmCreate);
    try
      S2.CopyFrom(MemoryStream,0);
    finally
      S2.Free;
    end;

    ShowBinaryStream(MemoryStream,Memo_Show_Writer.Lines);

    FreeAndNil(T); // уничтожаем компонент, что бы потом проверить

  finally
    MemoryStream.Free;
  end;
end;

/// читает компонент из файла
procedure TForm1.RestoreComponentFromFile(ComponentName:String; FileName:String);
var
  Reader:TReader;
  S1:TStream;
  T,T1:TComponent;
begin

  S1:=TFileStream.Create(FileName,fmOpenRead);
  try
    ShowBinaryStream(S1, Memo_Show_Reader.Lines );

    S1.Position:=0;

    Table1.Free;

    Reader:=TReader.Create(S1,8192);
    try
      Reader.BeginReferences;

      Reader.Owner  :=Self; // !!
      Reader.Root   :=Self; // чьи методы будут использоваться

      Reader.ReadSignature;
      T:=Reader.ReadComponent(Nil);
      T1:=FindComponent(ComponentName);
      if T = Nil then
        Memo_Log.Lines.Add('Компонент не прочитался')
      else
      if T1 = Nil then
        Memo_Log.Lines.Add('Компонент не находится')
      else
      if T1<>T then
        Memo_Log.Lines.Add('Компоненты не совпадают')
      else
        Memo_Log.Lines.Add('Компонент прочитался');

      Reader.EndReferences;
    finally
      Reader.Free;
    end;

    if T Is TControl then TControl(T).Parent:=Self;  // это тоже может быть важно

  finally
    S1.Free;
  end;

end;

/// тест сохраняемой кнопки
procedure TForm1.TestButtonClick(Sender: TObject);
begin
  Memo_Log.Lines.Add('Test - OK');
end;

//а теперь пишем и читает таблицу
procedure TForm1.SaveTableClick(Sender: TObject);
begin
  SaveComponentToFile(Table1,ChangeFileExt(ParamStr(0),'.Table1.dfm'))
end;
procedure TForm1.LoadTableClick(Sender: TObject);
begin
  RestoreComponentFromFile('Table1',ChangeFileExt(ParamStr(0),'.TestButton.dfm'));
end;

//а теперь пишем и читает кнопку
procedure TForm1.SaveButtonClick(Sender: TObject);
begin
   SaveComponentToFile(TestButton,ChangeFileExt(ParamStr(0),'.TestButton.dfm'));
end;
procedure TForm1.LoadButtonClick(Sender: TObject);
begin
  RestoreComponentFromFile('TestButton',ChangeFileExt(ParamStr(0),'.TestButton.dfm'));
end;

end.

и форма

Код:

object Form1: TForm1
  Left = 325
  Top = 164
  Width = 634
  Height = 800
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object SaveTable: TButton
    Left = 8
    Top = 8
    Width = 75
    Height = 25
    Caption = 'SaveTable'
    TabOrder = 0
    OnClick = SaveTableClick
  end
  object Memo_Show_Writer: TMemo
    Left = 8
    Top = 232
    Width = 609
    Height = 257
    ScrollBars = ssBoth
    TabOrder = 1
  end
  object Memo_Log: TMemo
    Left = 8
    Top = 72
    Width = 361
    Height = 145
    TabOrder = 2
  end
  object LoadTable: TButton
    Left = 8
    Top = 32
    Width = 75
    Height = 25
    Caption = 'LoadTable'
    TabOrder = 3
    OnClick = LoadTableClick
  end
  object Memo_Show_Reader: TMemo
    Left = 8
    Top = 496
    Width = 609
    Height = 265
    ScrollBars = ssBoth
    TabOrder = 4
  end
  object SaveButton: TButton
    Left = 96
    Top = 8
    Width = 75
    Height = 25
    Caption = 'SaveButton'
    TabOrder = 5
    OnClick = SaveButtonClick
  end
  object TestButton: TButton
    Left = 480
    Top = 24
    Width = 75
    Height = 25
    Caption = 'TestButton'
    TabOrder = 6
    OnClick = TestButtonClick
  end
  object LoadButton: TButton
    Left = 97
    Top = 34
    Width = 73
    Height = 25
    Caption = 'LoadButton'
    TabOrder = 7
    OnClick = LoadButtonClick
  end
  object Table1: TTable
    OnCalcFields = Table1CalcFields
    DatabaseName = 'A'
    MasterSource = DataSource1
    TableName = 'animals.dbf'
    Left = 400
    Top = 24
    object Table1NAME: TStringField
      FieldName = 'NAME'
      Size = 10
    end
    object Table1SIZE: TSmallintField
      FieldName = 'SIZE'
    end
    object Table1WEIGHT: TSmallintField
      FieldName = 'WEIGHT'
    end
    object Table1AREA: TStringField
      FieldName = 'AREA'
      OnChange = Table1AREAChange
    end
    object Table1BMP: TBlobField
      FieldName = 'BMP'
      OnChange = Table1BMPChange
      BlobType = ftTypedBinary
      Size = 1
    end
  end
  object DatabaseA: TDatabase
    AliasName = 'DBDEMOS'
    Connected = True
    DatabaseName = 'A'
    SessionName = 'Default'
    Left = 336
    Top = 24
  end
  object DataSource1: TDataSource
    DataSet = Form3.Table1
    Left = 368
    Top = 24
  end
end