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