|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
Сохранение компонента в файл
Приветствую всех участников форума! Проконсультируйте, по возможности…
Суть проблемы: 1. При сохранении формы в файл процедурой WriteComponentResFile, осуществляется корректное сохранение формы, расположенных на ней компонентов, всех свойств и "событий". 2. Если это проделать с отдельным компонентом – сохраняется всё, кроме "событий". В первом случае, при загрузке формы из файла, как форма объекта, так и все расположенные на ней компоненты корректно реагируют на заданные события. Во втором случае соответственно реакций на события нет. Если в первом случае в созданном бинарном файле имеются данные с названием событий, например |??#&@OnMouseMove??MyControlMouseMove#%8#, то во втором случае такие данные отсутствуют… И собственно вопрос, как добиться того, чтобы при сохранении отдельного компонента, сохранялись данные о событиях? |
#2
|
||||
|
||||
MethodAddress(), MethodName() тебе в помощь.
— Как тебя понимать? — Понимать меня не обязательно. Обязательно меня любить и кормить вовремя. На Delphi, увы, больше не программирую. Рекомендуемая литература по программированию |
#3
|
|||
|
|||
Цитата:
|
#4
|
|||
|
|||
Мда, третий день эксперементов в пустую. Не удалось одержать победу в данной ситуации... Судя по всему придется писать свой врайтер/ридер...
|
#5
|
|||
|
|||
Может поможет:
Код:
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; |
#6
|
|||
|
|||
Цитата:
Благодарю, roamer, но к сожалению результат выполнения этой подпрограммы аналогичен результату выполнения процедуры WriteComponentResFile(), т.е. в файл сохраняется всё кроме ссылок на события... |
#7
|
|||
|
|||
Цитата:
Например здесь читается и пишется кнопка и таблица Код:
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 |
#8
|
|||
|
|||
Спасибо, icWasya. Ваши наработки в действительности осуществляют сохранение всех данных компонента. Бегло просмотрел исходники стандартных подпрограмм WriteComponentResFile/ReadComponentResFile - по сути код идентичен приведенному Вами (работа так же осуществляется с TWriter и TReader). В Вашем примере всё работает, а стандартные - работают не корректно, но да бог с ним... Еще раз огробное спасибо за пример.
|
#9
|
|||
|
|||
Цитата:
|
#10
|
|||
|
|||
Выдает сообщение "Компоненты не совпадают" ХЕЕЕЛП!!!
|
#11
|
||||
|
||||
Цитата:
Единственно только ошибка есть здесь: Код:
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; |
#12
|
|||
|
|||
У меня вот такая структура
Form-Panel-ScrollBox-RichEdit Мне нужно сохранить ScrollBox со всеми компонентами на ней Вроде сохраняет и в файлике можно посмотреть если блокнотом открыть а когда считываю, то ScrollBox.ComponentCount=0, хотя они на ней появляются, помогите пожулуйста |
#13
|
||||
|
||||
Цитата:
|
#14
|
|||
|
|||
Добрый день, с этим вроде разобрался, вот только возникла другая проблемка у ScrollBox, на который выводятся компоненты отваливается Canvas.
До восстановления компонент из файла все ок. После ничего не могу рисовать на ScrollBox. Знаю что у ScrollBox нет свойства Canvas, поэтомуделаю вот так Canva:=TCanvas.Create; Canva.Handle:=getdc(ScrollBox1.Handle); и все прокатывало после восстановления компонент, рушится какая-то связка, пересоздать канву и переназначить Handle не помогает |
#15
|
||||
|
||||
Цитата:
Код:
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; |