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 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