[Mickel007]

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

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

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

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

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

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

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

[Mickel007]

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

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

[Mickel007]

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

[roamer]

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

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16

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
Например здесь читается и пишется кнопка и таблица

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209

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.

и форма

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125

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

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

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

Код:

1 2 3 4

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

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

Код:

1 2 3 4

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 не помогает

А так?:

Код:

1 2 3 4 5 6 7 8 9 10 11 12

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;