infoform.pas

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.