filestreamfrm.~pas

关于利用DELPHI来进行企业级方案解决的著作的附书源码

unit FileStreamFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ToolWin, Menus;
type
  TMyType = class of TControl;
type
  TfsForm = class(TForm)
    ToolBar1: TToolBar;
    ButtonRadio: TRadioButton;
    LabelRadio: TRadioButton;
    EditRadio: TRadioButton;
    NewButton: TToolButton;
    SaveButton: TToolButton;
    OpenButton: TToolButton;
    ExitButton: TToolButton;
    ToolButton5: TToolButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    procedure ButtonRadioClick(Sender: TObject);
    procedure LabelRadioClick(Sender: TObject);
    procedure EditRadioClick(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure NewButtonClick(Sender: TObject);
    procedure OpenButtonClick(Sender: TObject);
    procedure SaveButtonClick(Sender: TObject);
    procedure ExitButtonClick(Sender: TObject);
  private
    MyType: TMyType;
    Count: Integer;
  public
    { Public declarations }
  end;

var
  fsForm: TfsForm;

implementation

{$R *.dfm}

procedure TfsForm.ButtonRadioClick(Sender: TObject);
begin
 MyType:=TButton;
end;

procedure TfsForm.LabelRadioClick(Sender: TObject);
begin
 MyType:=TLabel;
end;

procedure TfsForm.EditRadioClick(Sender: TObject);
begin
 MyType:=TEdit;
end;

procedure TfsForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  NewCom: TControl;
  NewName: String;
begin
  NewCom:= MyType.Create(self);
  NewCom.Parent:= self;
  Inc(count);
  NewName:= MyType.ClassName + IntToStr(count);
  NewName:= Copy(NewName,2,20);
  NewCom.Name:= NewName;
  NewCom.Left:= X;
  NewCom.Top:= Y;
end;

procedure TfsForm.NewButtonClick(Sender: TObject);
var i:Integer;
begin
 while ControlCount>1 do
 //for i:= ControlCount-1 downto 0 do
  begin
   if Controls[i].ClassName<>'TToolBar' then
    Controls[i].Free;
  end;
 Count:=0;
end;

procedure TfsForm.OpenButtonClick(Sender: TObject);
var
 fs: TFileStream;
 NewCom: TComponent;
begin
 if OpenDialog1.Execute then
  begin
   NewButtonClick(self);
   fs:=TFileStream.Create(OpenDialog1.FileName,fmOpenRead);
   try
    while fs.Position < fs.Size do
     begin
      NewCom:= fs.ReadComponent(nil);
      InsertControl(NewCom as TControl);
      Inc(Count);
     end;
   finally
    fs.Free;
   end;
  end;
end;

procedure TfsForm.SaveButtonClick(Sender: TObject);
var
 fs:TFileStream;
 i: Integer;
begin
 if SaveDialog1.Execute then
  begin
   fs:=TFileStream.Create(SaveDialog1.FileName,fmOpenWrite or fmCreate);
   try
     for i:=0 to ControlCount-1 do
     if Controls[i].ClassName<>'TToolBar' then
      fs.WriteComponent(Controls[i]);
   finally
     fs.Free;
   end;
  end;
end;

procedure TfsForm.ExitButtonClick(Sender: TObject);
begin
 close;
end;

initialization
 RegisterClasses([TButton,TLabel,TEdit]);
end.