DELPHI/Часто задаваемые вопросы и ответы на них/Компоненты



На главную

Подписка

Новости

Главная / 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.

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

Источник получения информации: http://www.delphiworld.narod.ru