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.
|
Главная
Каталог файлов
