Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

ВИДЕОКУРС ВЗЛОМ
выпущен 12 ноября!


УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Сохранение и загрузка формы с компонентами потоком



 unit InfoForm;
 
 interface
 
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
   StdCtrls, ExtCtrls, Buttons, Clipbrd, Comctrls, Db, Dbcgrids,
   Dbctrls, Dbgrids, Dblookup, Dbtables, Ddeman, Dialogs,
   Filectrl, Grids, Mask, Menus, Mplayer, Oleconst, Olectnrs,
   Olectrls, Outline, Tabnotbk, Tabs;
 
 type
   TMainForm = class(TForm)
     Panel1: TPanel;
     ComboBox1: TComboBox;
     Label1: TLabel;
     Label2: TLabel;
     ComboBox2: TComboBox;
     SpeedSaveForm: TSpeedButton;
     SpeedText: TSpeedButton;
     SpeedLoadForm: TSpeedButton;
     SpeedSavePas: TSpeedButton;
     OpenDialog1: TOpenDialog;
     SaveDialog1: TSaveDialog;
     procedure FormCreate(Sender: TObject);
     procedure SpeedSaveFormClick(Sender: TObject);
     procedure SpeedLoadFormClick(Sender: TObject);
     procedure SpeedSavePasClick(Sender: TObject);
     procedure SpeedTextClick(Sender: TObject);
   public
     function GetNextName (MyClass: TComponentClass): string;
     procedure UpdateList;
   end;
 
 var
   MainForm: TMainForm;
 
 implementation
 
 {$R *.DFM}
 
 uses
   OutForm, MemoF;
 
 type
   TClassArray = array [1..107] of TPersistentClass;
 
   // definition temporary used to check the data types
   //  TClassArray = array [1..107] of TComponentClass;
 
 const
   ClassArray: TClassArray = (
     TApplication, TDDEServerItem, TPanel, TAutoIncField,
     TDirectoryListBox, TPopupMenu, TBatchMove, TDrawGrid,
     TPrintDialog, TBCDField, TDriveComboBox, TPrinterSetupDialog,
     TBevel, TEdit, TProgressBar, TBitBtn,
     TField, TQuery, TBlobField, TFileListBox,
     TRadioButton, TBooleanField, TFilterComboBox, TRadioGroup,
     TButton, TFindDialog, TReplaceDialog, TBytesField,
     TFloatField, TCheckBox, TFontDialog,
     TRichEdit, TColorDialog, TForm, TSaveDialog,
     TComboBox, TGraphicField, TScreen, TCurrencyField,
     TGroupBox, TScrollBar, TDatabase, THeader,
     TScrollBox, TDataSource, THeaderControl, TSession,
     TDateField, THotKey, TShape, TDateTimeField,
     TImage, TSmallIntField, TDBCheckBox, TImageList,
     TSpeedButton, TDBComboBox, TIntegerField, TStatusBar,
     TDBCtrlGrid, TLabel, TStoredProc, TDBEdit,
     TListBox, TStringField, TDBGrid, TListView,
     TStringGrid, TDBImage, TMainMenu, TTabbedNotebook,
     TDBListBox, TMaskEdit, TTabControl, TDBLookupCombo,
     TMediaPlayer, TTable, TMemoField, TDBLookupComboBox,
     TMemo, TTabSet, TDBLookupList, TTabSheet,
     TDBLookupListBox, TMenuItem, TTimeField, TDBMemo,
     TNotebook, TDBNavigator, TOleContainer, TTimer,
     TDBRadioGroup, TOpenDialog, TTrackBar, TDBText,
     TOutline, TTreeView, TDDEClientConv, TOutline,
     TUpdateSQL, TDDEClientItem, TPageControl, TUpDown,
     TDDEServerConv, TPaintBox, TVarBytesField, TWordField);
 
 procedure TMainForm.FormCreate(Sender: TObject);
 var
   I: Integer;
 begin
   // register all of the classes
   RegisterClasses (Slice (ClassArray, High (ClassArray)));
   // copy class names to the listbox
   for I := Low (ClassArray) to High (ClassArray) do
     ComboBox1.Items.Add (ClassArray [I].ClassName);
 end;
 
 function TMainForm.GetNextName (MyClass: TComponentClass): string;
 var
   I, nTot: Integer;
 begin
   nTot := 0;
   with OutputForm do
   begin
     for I := 0 to ComponentCount - 1 do
       if Components [I].ClassType = MyClass then
         Inc (nTot);
     Result := Copy (MyClass.ClassName, 2, Length (MyClass.ClassName) - 1) +
       IntToStr (nTot);
   end;
 end;
 
 procedure TMainForm.UpdateList;
 var
   I: Integer;
 begin
   Combobox2.Items.Clear;
   with OutputForm do
     for I := 0 to ComponentCount - 1 do
       ComboBox2.Items.Add (Components [I].Name);
 end;
 
 procedure TMainForm.SpeedSaveFormClick(Sender: TObject);
 var
   Str1 : TFileStream;
 begin
   if SaveDialog1.Execute then
   begin
     Str1 := TFileStream.Create (SaveDialog1.FileName,
       fmOpenWrite or fmCreate);
     try
       // disable the event
       OutputForm.OnMouseDown := nil;
       Str1.WriteComponentRes (
         OutputForm.ClassName, OutputForm);
     finally
       Str1.Free;
       OutputForm.OnMouseDown := OutputForm.FormMouseDown;
     end;
   end;
 end;
 
 procedure TMainForm.SpeedLoadFormClick(Sender: TObject);
 var
   Str1: TFileStream;
   TempForm1: TOutputForm;
 begin
   if OpenDialog1.Execute then
   begin
     Str1 := TFileStream.Create (OpenDialog1.FileName,
       fmOpenRead);
     try
       TempForm1 := TOutputForm.Create (Application);
       Str1.ReadComponentRes (TempForm1);
       OutputForm.Free;
       OutputForm := TempForm1;
       OutputForm.Show;
       OutputForm.OnMouseDown := OutputForm.FormMouseDown;
     finally
       Str1.Free;
     end;
   end;
 end;
 
 procedure TMainForm.SpeedSavePasClick(Sender: TObject);
 var
   File1 : TextFile;
   FileName: string;
   I: Integer;
 begin
   // save the DFM file
   SpeedSaveFormClick (self);
   // change extension (using the proper VCL routine)
   FileName := SaveDialog1.FileName;
   FileName := ChangeFileExt (FileName, '.pas');
   AssignFile (File1, FileName);
   try
     // create the pascal file...
     Rewrite (File1);
     FileName := ChangeFileExt (FileName, '');
     Writeln (File1, 'unit ' + ExtractFileName (FileName) + ';');
     Writeln (File1, '');
     Writeln (File1, 'interface');
     Writeln (File1, '');
     Writeln (File1, 'uses');
     Writeln (File1, '  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,');
     Writeln (File1, '  StdCtrls, ExtCtrls, Buttons, Clipbrd, Comctrls, Db, Dbcgrids,');
     Writeln (File1, '  Dbctrls, Dbgrids, Dblookup, Dbtables, Ddeman, Dialogs,');
     Writeln (File1, '  Filectrl, Grids, Mask, Menus, Mplayer, Oleconst, Olectnrs,');
     Writeln (File1, '  Olectrls, Outline, Tabnotbk, Tabs;');
     Writeln (File1, '');
     Writeln (File1, 'type');
     Writeln (File1, '  TOutputForm = class(TForm)');
     // add components declarations
     for I := 0 to OutputForm.ComponentCount - 1 do
     begin
       Writeln (File1, '    ' +
         OutputForm.Components[I].Name + ': ' +
         OutputForm.Components[I].ClassName + ';');
     end;
     Writeln (File1, '  private');
     Writeln (File1, '    { Private declarations }');
     Writeln (File1, '  public');
     Writeln (File1, '    { Public declarations }');
     Writeln (File1, '  end;');
     Writeln (File1, '');
     Writeln (File1, 'var');
     Writeln (File1, '  OutputForm: TOutputForm;');
     Writeln (File1, '');
     Writeln (File1, 'implementation');
     Writeln (File1, '');
     Writeln (File1, '{$R *.DFM}');
     Writeln (File1, '');
     Writeln (File1, 'end.');
   finally
     CloseFile (File1);
   end;
 end;
 
 procedure TMainForm.SpeedTextClick(Sender: TObject);
 var
   StrBin, StrTxt: TMemoryStream;
 begin
   StrBin := TMemoryStream.Create;
   StrTxt := TMemoryStream.Create;
   try
     OutputForm.OnMouseDown := nil;
     // write the form to a memory stream
     StrBin.WriteComponentRes (
       OutputForm.ClassName, OutputForm);
     // go back to the beginning
     StrBin.Seek (0, soFromBeginning);
     // convert the form to text
     ObjectResourceToText (StrBin, StrTxt);
     // go back to the beginning
     StrTxt.Seek (0, soFromBeginning);
     // load the text
     FormMemo.Memo1.Lines.LoadFromStream (StrTxt);
     FormMemo.ShowModal;
   finally
     StrBin.Free;
     StrTxt.Free;
     OutputForm.OnMouseDown := OutputForm.FormMouseDown;
   end;
 end;
 
 end.


 unit MemoF;
 
 interface
 
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   StdCtrls, Buttons, ExtCtrls;
 
 type
   TFormMemo = class(TForm)
     Memo1: TMemo;
     BitBtn1: TBitBtn;
     Panel1: TPanel;
     BitBtn2: TBitBtn;
     procedure FormResize(Sender: TObject);
     procedure BitBtn2Click(Sender: TObject);
   private
     { Private declarations }
   public
     { Public declarations }
   end;
 
 var
   FormMemo: TFormMemo;
 
 implementation
 
 uses OutForm;
 
 {$R *.DFM}
 
 procedure TFormMemo.FormResize(Sender: TObject);
 begin
   // approximately in the middle
   BitBtn1.Left := Panel1.Width div 2 - BitBtn1.Width - 5;
   BitBtn2.Left := Panel1.Width div 2 + 5;
 end;
 
 procedure TFormMemo.BitBtn2Click(Sender: TObject);
 var
   StrBin, StrTxt: TMemoryStream;
   TempForm1: TOutputForm;
 begin
   StrBin := TMemoryStream.Create;
   StrTxt := TMemoryStream.Create;
   // copy the text of the memo
   Memo1.Lines.SaveToStream (StrTxt);
   // go back to the beginning
   StrTxt.Seek (0, soFromBeginning);
   try
     // convert to binary
     ObjectTextToResource (StrTxt, StrBin);
     // go back to the beginning
     StrBin.Seek (0, soFromBeginning);
     // loading code...
     TempForm1 := TOutputForm.Create (Application);
     StrBin.ReadComponentRes (TempForm1);
     OutputForm.Free;
     OutputForm := TempForm1;
     OutputForm.Show;
     // close the memo form
     ModalResult := mrOk;
   except
     on E: Exception do
     begin
       E.Message :=
         'Error converting form'#13#13 +
         '(' + E.MEssage + ')';
       Application.ShowException (E);
     end;
   end;
 end;
 
 end.


 unit OutForm;
 
 interface
 
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
 
 type
   TOutputForm = class(TForm)
     procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
       Shift: TShiftState; X, Y: Integer);
   private
     { Private declarations }
   public
     { Public declarations }
   end;
 
 var
   OutputForm: TOutputForm;
 
 implementation
 
 {$R *.DFM}
 
 uses
   InfoForm;
 
 procedure TOutputForm.FormMouseDown (
   Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
 var
   MyClass: TComponentClass;
   MyComp: TComponent;
 begin
   MyClass := TComponentClass (
     GetClass (MainForm.ComboBox1.Text));
   if MyClass = nil then
     Beep
   else
   begin
     MyComp := MyClass.Create (self);
     MyComp.Name := MainForm.GetNextName (MyClass);
     if MyClass.InheritsFrom (TControl) then
     begin
       TControl (MyComp).Left := X;
       TControl (MyComp).Top := Y;
       TControl (MyComp).Parent := self;
     end;
   end;
   MainForm.UpdateList;
 end;
 
 initialization
   RegisterClass (TOutputForm);
 end.

Загрузить весь проект




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS