[Mickel007]

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

Суть проблемы:
1. При сохранении формы в файл процедурой WriteComponentResFile, осуществляется корректное сохранение формы, расположенных на ней компонентов, всех свойств и "событий".
2. Если это проделать с отдельным компонентом – сохраняется всё, кроме "событий".

В первом случае, при загрузке формы из файла, как форма объекта, так и все расположенные на ней компоненты корректно реагируют на заданные события. Во втором случае соответственно реакций на события нет.

Если в первом случае в созданном бинарном файле имеются данные с названием событий, например |??#&@OnMouseMove??MyControlMouseMove#%8#, то во втором случае такие данные отсутствуют…

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

[M.A.D.M.A.N.]

MethodAddress(), MethodName() тебе в помощь.

[Mickel007]

MethodAddress(), MethodName() тебе в помощь.

Я так понимаю, Вы предлагаете после загрузки сохраненного файла повторно назначять события каждому компоненту? Это конечно вариант, но хотелось бы добраться до истины!

[Mickel007]

Мда, третий день эксперементов в пустую. Не удалось одержать победу в данной ситуации... Судя по всему придется писать свой врайтер/ридер...

[roamer]

Может поможет:

Код:

procedure TForm1.Save_Me2;
var
  ms: TMemoryStream;
  fs: TFileStream;
begin
  fs := TFileStream.Create('C:\987.222', fmCreate or fmOpenWrite);
  ms := TMemoryStream.Create;
  try
    ms.WriteComponent(self);
    ms.Seek(0, soFromBeginning);
    ObjectBinaryToText(ms, fs);
  finally
    ms.Free;
    fs.free;
  end;
end;

Нашел здесь: http://www.delphimaster.ru/articles/frames/index.html

[Mickel007]

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

Может поможет:

Благодарю, roamer, но к сожалению результат выполнения этой подпрограммы аналогичен результату выполнения процедуры WriteComponentResFile(), т.е. в файл сохраняется всё кроме ссылок на события...

[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

[Mickel007]

Спасибо, icWasya. Ваши наработки в действительности осуществляют сохранение всех данных компонента. Бегло просмотрел исходники стандартных подпрограмм WriteComponentResFile/ReadComponentResFile - по сути код идентичен приведенному Вами (работа так же осуществляется с TWriter и TReader). В Вашем примере всё работает, а стандартные - работают не корректно, но да бог с ним... Еще раз огробное спасибо за пример.

[icWasya]

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

Спасибо, icWasya.... Бегло просмотрел исходники стандартных подпрограмм WriteComponentResFile/ReadComponentResFile - по сути код идентичен приведенному Вами (работа так же осуществляется с TWriter и TReader). ....

Ну так оттуда и слизано.

[komp]

Выдает сообщение "Компоненты не совпадают" ХЕЕЕЛП!!!

[poli-smen]

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

Выдает сообщение "Компоненты не совпадают" ХЕЕЕЛП!!!

А у меня не выдаёт.
Единственно только ошибка есть здесь:

Код:

procedure TForm1.LoadTableClick(Sender: TObject);
begin
  RestoreComponentFromFile('Table1',ChangeFileExt(ParamStr(0),'.TestButton.dfm'));
end;

Должно быть так:

Код:

procedure TForm1.LoadTableClick(Sender: TObject);
begin
  RestoreComponentFromFile('Table1',ChangeFileExt(ParamStr(0),'.Table1.dfm'));
end;

[komp]

У меня вот такая структура
Form-Panel-ScrollBox-RichEdit
Мне нужно сохранить ScrollBox со всеми компонентами на ней
Вроде сохраняет и в файлике можно посмотреть если блокнотом открыть
а когда считываю, то ScrollBox.ComponentCount=0, хотя они на ней появляются, помогите пожулуйста

[poli-smen]

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

У меня вот такая структура
Form-Panel-ScrollBox-RichEdit
Мне нужно сохранить ScrollBox со всеми компонентами на ней
Вроде сохраняет и в файлике можно посмотреть если блокнотом открыть
а когда считываю, то ScrollBox.ComponentCount=0, хотя они на ней появляются, помогите пожулуйста

Вот рабочий пример: Сохранение и загрузка формы с компонентами потоком

[komp]

Добрый день, с этим вроде разобрался, вот только возникла другая проблемка у ScrollBox, на который выводятся компоненты отваливается Canvas.
До восстановления компонент из файла все ок. После ничего не могу рисовать на ScrollBox. Знаю что у ScrollBox нет свойства Canvas, поэтомуделаю вот так
Canva:=TCanvas.Create;
Canva.Handle:=getdc(ScrollBox1.Handle); и все прокатывало
после восстановления компонент, рушится какая-то связка, пересоздать канву и переназначить Handle не помогает

[poli-smen]

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

Добрый день, с этим вроде разобрался, вот только возникла другая проблемка у ScrollBox, на который выводятся компоненты отваливается Canvas.
До восстановления компонент из файла все ок. После ничего не могу рисовать на ScrollBox. Знаю что у ScrollBox нет свойства Canvas, поэтомуделаю вот так
Canva:=TCanvas.Create;
Canva.Handle:=getdc(ScrollBox1.Handle); и все прокатывало
после восстановления компонент, рушится какая-то связка, пересоздать канву и переназначить Handle не помогает

А так?:

Код:

var
  Canva: TControlCanvas;
begin
  Canva := TControlCanvas.Create;
  try
    Canva.Control := ScrollBox1;
    Canva.Brush.Color := clRed;
    Canva.Ellipse(10, 20, 30, 40);
  finally
    Canva.Free;
  end;
end;