Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
Разработка программного обеспечения
KANSoftWare

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

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.

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

Статья Сохранение и загрузка формы с компонентами потоком раздела Компоненты и Классы Потоки может быть полезна для разработчиков на Delphi и FreePascal.


Комментарии и вопросы


Ваше мнение или вопрос к статье в виде простого текста (Tag <a href=... Disabled). Все комментарии модерируются, модератор оставляет за собой право удалить непонравившейся ему комментарий.

заголовок

e-mail

Ваше имя

Сообщение

Введите код




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.



:: Главная :: Потоки ::


реклама

::


©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru Rambler's Top100
16.12.2019 10:27:57/0.031394004821777/2