Logo Delphi Handbooks Collection

Delphi Developer Days 2012
March-May
Cantù-Jensen
(UK, NL, US, D, I)

Menu for Development

Site Menu
Delphi 2010 Handbook
Delphi 2009 Handbook
Delphi 2007 Handbook
Mastering Borland Delphi 2005
Essential Pascal
Essential Delphi
Buy Books Online
Code Repository
Newsgroups
White Papers
Tools
Conferences
Training
Delphi Links
Contact Marco

My Other Sites
Italian Site (www.marcocantu.it)
Developers Newsgroups Browser (dev.newswhat.com)
My town (www.piazzacavalli.net)
the delphi search
Wintech Italia (my company)

Advertising
Home My Blog Handbooks Development Links Marco
Delphi Developer Days 2012


Home: Code Repository: Mastering Delphi 6

Chapter 03 - Project Animals3

Project Structure

Animals3.dpr
program Animals3;

uses
  Forms,
  AnimF in 'AnimF.pas' {FormAnimals},
  Anim in 'Anim.pas';

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TFormAnimals, FormAnimals);
  Application.Run;
end.
AnimF.pas
unit AnimF;

interface

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

type
  TFormAnimals = class(TForm)
    LabelVoice: TLabel;
    BtnVoice: TButton;
    RbtnAnimal: TRadioButton;
    RbtnDog: TRadioButton;
    RbtnCat: TRadioButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BtnVoiceClick(Sender: TObject);
    procedure RbtnAnimalClick(Sender: TObject);
    procedure RbtnDogClick(Sender: TObject);
    procedure RbtnCatClick(Sender: TObject);
  private
    MyAnimal: TAnimal;
  public
    { Public declarations }
  end;

var
  FormAnimals: TFormAnimals;

implementation

{$R *.DFM}

procedure TFormAnimals.FormCreate(Sender: TObject);
begin
  MyAnimal := TDog.Create;
end;

procedure TFormAnimals.FormDestroy(Sender: TObject);
begin
  MyAnimal.Free;
end;

procedure TFormAnimals.BtnVoiceClick(Sender: TObject);
begin
  LabelVoice.Caption := MyAnimal.Voice;
end;

procedure TFormAnimals.RbtnAnimalClick(Sender: TObject);
begin
  MyAnimal.Free;
  MyAnimal := TAnimal.Create;
end;

procedure TFormAnimals.RbtnDogClick(Sender: TObject);
begin
  MyAnimal.Free;
  MyAnimal := TDog.Create;
end;

procedure TFormAnimals.RbtnCatClick(Sender: TObject);
begin
  MyAnimal.Free;
  MyAnimal := TCat.Create;
end;

end.
Anim.pas
unit Anim;

interface

type
  TAnimal = class
  public
    constructor Create;
    function GetKind: string;
    function Voice: string; virtual; abstract;
  private
    Kind: string;
  end;

  TDog = class (TAnimal)
  public
    constructor Create;
    function Voice: string; override;
    function Eat: string; virtual;
  end;

  TCat = class (TAnimal)
  public
    constructor Create;
    function Voice: string; override;
    function Eat: string; virtual;
  end;

implementation

uses
  MMSystem;

constructor TAnimal.Create;
begin
  Kind := 'An animal';
end;

function TAnimal.GetKind: string;
begin
  GetKind := Kind;
end;

constructor TDog.Create;
begin
  Kind := 'A dog';
end;

function TDog.Voice: string;
begin
  Voice := 'Arf Arf';
  PlaySound ('dog.wav', 0, snd_Async);
end;

function TDog.Eat: string;
begin
  Eat := 'A bone, please!';
end;

constructor TCat.Create;
begin
  Kind := 'A cat';
end;

function TCat.Voice: string;
begin
  Voice := 'Mieow';
  PlaySound ('cat.wav', 0, snd_Async);
end;

function TCat.Eat: string;
begin
  Eat := 'A mouse, please!';
end;

end.
AnimF.dfm
object FormAnimals: TFormAnimals
  Left = 208
  Top = 106
  Width = 278
  Height = 233
  ActiveControl = BtnVoice
  Caption = 'Animals'
  Color = clBtnFace
  Font.Charset = ANSI_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object LabelVoice: TLabel
    Left = 39
    Top = 168
    Width = 201
    Height = 17
    Alignment = taCenter
    AutoSize = False
    Caption = 'Voice'
    Font.Charset = ANSI_CHARSET
    Font.Color = clBlack
    Font.Height = -16
    Font.Name = 'Arial'
    Font.Style = [fsBold]
    ParentFont = False
  end
  object BtnVoice: TButton
    Left = 152
    Top = 56
    Width = 89
    Height = 33
    Caption = '&Voice'
    TabOrder = 0
    OnClick = BtnVoiceClick
  end
  object RbtnAnimal: TRadioButton
    Left = 24
    Top = 40
    Width = 113
    Height = 41
    Caption = '&Animal'
    TabOrder = 1
    OnClick = RbtnAnimalClick
  end
  object RbtnDog: TRadioButton
    Left = 24
    Top = 72
    Width = 113
    Height = 41
    Caption = '&Dog'
    Checked = True
    TabOrder = 2
    TabStop = True
    OnClick = RbtnDogClick
  end
  object RbtnCat: TRadioButton
    Left = 24
    Top = 104
    Width = 113
    Height = 41
    Caption = '&Cat'
    TabOrder = 3
    OnClick = RbtnCatClick
  end
end