Marco Cantù 1998, Mastering Delphi 4
Project: CLASSREF.DPR
Project Structure
CLASSREF.DPR
program Classref;
uses
Forms,
CRefForm in 'CRefForm.pas' {Form1};
{$R *.RES}
begin
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
CREFFORM.PAS
unit CRefForm;
interface
uses
SysUtils, Windows, Messages, Classes,
Graphics, Controls, Forms, Dialogs, StdCtrls,
ExtCtrls, Menus;
type
CRefType = class of TControl;
TForm1 = class(TForm)
MainMenu1: TMainMenu;
File1: TMenuItem;
Exit1: TMenuItem;
N1: TMenuItem;
SaveAs1: TMenuItem;
Open1: TMenuItem;
New1: TMenuItem;
Help1: TMenuItem;
About1: TMenuItem;
Panel1: TPanel;
RadioRadioButton: TRadioButton;
ButtonRadioButton: TRadioButton;
EditRadioButton: TRadioButton;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
SaveAs2: TMenuItem;
N2: TMenuItem;
SaveDialog2: TSaveDialog;
procedure RadioButtonRadioClick(Sender: TObject);
procedure RadioButtonButtonClick(Sender: TObject);
procedure RadioButtonEditClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure New1Click(Sender: TObject);
procedure Open1Click(Sender: TObject);
procedure SaveAs1Click(Sender: TObject);
procedure About1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure SaveAs2Click(Sender: TObject);
private
ClassRef: CRefType;
Counter: Integer;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.RadioButtonRadioClick(Sender: TObject);
begin
ClassRef := TRadioButton;
end;
procedure TForm1.RadioButtonButtonClick(Sender: TObject);
begin
ClassRef := TButton;
end;
procedure TForm1.RadioButtonEditClick(Sender: TObject);
begin
ClassRef := TEdit;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ClassRef := TRadioButton;
Counter := 0;
end;
procedure TForm1.FormMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
MyObj: TControl;
MyName: String;
begin
{create an object using the current class reference}
MyObj := ClassRef.Create (self);
MyObj.Visible := False;
MyObj.Parent := self;
MyObj.Left := X;
MyObj.Top := Y;
Inc (Counter);
{define the name using the class name, without the
initial T, and the number of the Counter}
MyName := ClassRef.ClassName + IntToStr (Counter);
Delete (MyName, 1, 1);
MyObj.Name := MyName;
MyObj.Visible := True;
end;
procedure TForm1.New1Click(Sender: TObject);
var
I: Integer;
begin
{delete all existing components, except the panel}
for I := ControlCount - 1 downto 0 do
if not (Controls[I] is TPanel) then
begin
Controls[I].Free;
Dec (Counter);
end;
end;
procedure TForm1.Open1Click(Sender: TObject);
var
S: TFileStream;
New: TComponent;
begin
if OpenDialog1.Execute then
begin
{remove existing controls}
New1Click (self);
{open the stream}
S := TFileStream.Create (OpenDialog1.FileName,
fmOpenRead);
try
while S.Position < S.Size do
begin
{read a component and add it to the form}
New := S.ReadComponent (nil);
InsertControl (New as TControl);
Inc (Counter);
end;
finally
S.Free;
end;
end;
end;
procedure TForm1.SaveAs1Click(Sender: TObject);
var
S: TFileStream;
I: Integer;
begin
if SaveDialog1.Execute then
begin
{open or create the stream file}
S := TFileStream.Create (SaveDialog1.FileName,
fmOpenWrite or fmCreate);
try
{save each component except the panel}
for I := 0 to ControlCount - 1 do
if not (Controls[I] is TPanel) then
S.WriteComponent (Controls[I]);
finally
S.Free;
end;
end;
end;
procedure TForm1.About1Click(Sender: TObject);
begin
MessageDlg ('CREF2 Example: Save components to file' +
Chr(13) + 'From "Mastering Delphi", by Marco Cantù',
mtInformation, [mbOk], 0);
end;
procedure TForm1.Exit1Click(Sender: TObject);
begin
Close;
end;
{save form file}
procedure TForm1.SaveAs2Click(Sender: TObject);
begin
if SaveDialog2.Execute then
WriteComponentResFile
(SaveDialog2.Filename, self);
end;
initialization
{register the classes of the components; this code is
required by the stream loader}
RegisterClasses ([TRadioButton, TEdit, TButton]);
end.
CREFFORM.DFM
object Form1: TForm1
Left = 105
Top = 209
Width = 474
Height = 382
Caption = 'Component Builder'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = True
OnCreate = FormCreate
OnMouseDown = FormMouseDown
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 0
Width = 466
Height = 33
Align = alTop
TabOrder = 0
object RadioRadioButton: TRadioButton
Left = 8
Top = 8
Width = 105
Height = 17
Caption = 'Radio Button'
Checked = True
TabOrder = 0
TabStop = True
OnClick = RadioButtonRadioClick
end
object ButtonRadioButton: TRadioButton
Left = 136
Top = 8
Width = 61
Height = 17
Caption = 'Button'
TabOrder = 1
OnClick = RadioButtonButtonClick
end
object EditRadioButton: TRadioButton
Left = 224
Top = 8
Width = 49
Height = 17
Caption = 'Edit'
TabOrder = 2
OnClick = RadioButtonEditClick
end
end
object MainMenu1: TMainMenu
Left = 408
Top = 48
object File1: TMenuItem
Caption = '&File'
object New1: TMenuItem
Caption = '&New'
OnClick = New1Click
end
object Open1: TMenuItem
Caption = '&Open...'
OnClick = Open1Click
end
object SaveAs1: TMenuItem
Caption = 'Save &As...'
OnClick = SaveAs1Click
end
object N2: TMenuItem
Caption = '-'
end
object SaveAs2: TMenuItem
Caption = '&Save Form File...'
OnClick = SaveAs2Click
end
object N1: TMenuItem
Caption = '-'
end
object Exit1: TMenuItem
Caption = 'E&xit'
OnClick = Exit1Click
end
end
object Help1: TMenuItem
Caption = '&Help'
object About1: TMenuItem
Caption = '&About...'
OnClick = About1Click
end
end
end
object OpenDialog1: TOpenDialog
Filter = 'Components file (*cmp)|*.cmp|Any file (*.*)|*.*'
Options = [ofPathMustExist, ofFileMustExist]
Left = 408
Top = 104
end
object SaveDialog1: TSaveDialog
Filter = 'Components file (*cmp)|*.cmp|Any file (*.*)|*.*'
Options = [ofOverwritePrompt, ofPathMustExist, ofCreatePrompt]
Left = 408
Top = 152
end
object SaveDialog2: TSaveDialog
DefaultExt = 'DFM'
Filter = 'Delphi Form File (*.dfm)|*.dfm|Any file (*.*)|*.*'
Options = [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist]
Left = 408
Top = 200
end
end
Copyright Marco Cantù 1998