Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 5

Project OBJCLONE

Project Structure


OBJCLONE.DPR

program ObjClone;

uses
  Forms,
  UNit1 in 'UNit1.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

UNIT1.PAS

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ScrollBox1: TScrollBox;
    Label1: TLabel;
    CheckBox1: TCheckBox;
    Label2: TLabel;
    Button2: TButton;
    Edit1: TEdit;
    BitBtn1: TBitBtn;
    SpeedButton1: TSpeedButton;
    GroupBox1: TGroupBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    procedure Button1Click(Sender: TObject);
    procedure ClickComp(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
  AForm: TForm;
begin
  // clone the 'Self' object
  Application.CreateForm (
    TFormClass(Self.ClassType), AForm);
  // move the form and show it
  AForm.Left := Left  + 50;
  AForm.Top := Top  + 50;
  AForm.Show;
end;

procedure TForm1.ClickComp(Sender: TObject);
var
  ControlText: string;
begin
  with TControlClass (Sender.ClassType).Create (Self) do
  begin
    Parent := (Sender as TControl).Parent;
    Left := (Sender as TControl).Left + 10;
    Top := (Sender as TControl).Top + 10;
    SetLength (ControlText, 50);
    (Sender as TControl).GetTextBuf(
      PChar(ControlText), 50);
    ControlText := PChar(ControlText) + ' *';
    SetTextBuf (PChar (ControlText));
  end;
end;



end.

UNIT1.DFM

object Form1: TForm1
  Left = 197
  Top = 116
  Width = 358
  Height = 248
  Caption = 'ObjClone'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 16
    Top = 16
    Width = 161
    Height = 13
    Caption = 'Click on a component to clone it...'
  end
  object Button1: TButton
    Left = 224
    Top = 8
    Width = 89
    Height = 25
    Caption = 'Clone Form'
    TabOrder = 0
    OnClick = Button1Click
  end
  object ScrollBox1: TScrollBox
    Left = 16
    Top = 40
    Width = 321
    Height = 169
    TabOrder = 1
    object Label2: TLabel
      Left = 8
      Top = 32
      Width = 32
      Height = 13
      Caption = 'Label2'
      OnClick = ClickComp
    end
    object SpeedButton1: TSpeedButton
      Left = 216
      Top = 104
      Width = 25
      Height = 25
      OnClick = ClickComp
    end
    object CheckBox1: TCheckBox
      Left = 8
      Top = 8
      Width = 97
      Height = 17
      Caption = 'CheckBox1'
      TabOrder = 0
      OnClick = ClickComp
    end
    object Button2: TButton
      Left = 32
      Top = 104
      Width = 75
      Height = 25
      Caption = 'Button2'
      TabOrder = 1
      OnClick = ClickComp
    end
    object Edit1: TEdit
      Left = 8
      Top = 56
      Width = 121
      Height = 21
      TabOrder = 2
      Text = 'Edit1'
      OnClick = ClickComp
    end
    object BitBtn1: TBitBtn
      Left = 120
      Top = 104
      Width = 75
      Height = 25
      Caption = 'BitBtn1'
      TabOrder = 3
      OnClick = ClickComp
    end
    object GroupBox1: TGroupBox
      Left = 144
      Top = 8
      Width = 129
      Height = 73
      Caption = 'GroupBox1'
      TabOrder = 4
      OnClick = ClickComp
      object RadioButton1: TRadioButton
        Left = 8
        Top = 16
        Width = 113
        Height = 17
        Caption = 'RadioButton1'
        TabOrder = 0
        OnClick = ClickComp
      end
      object RadioButton2: TRadioButton
        Left = 8
        Top = 40
        Width = 113
        Height = 17
        Caption = 'RadioButton2'
        TabOrder = 1
        OnClick = ClickComp
      end
    end
  end
end