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 MULTINH

Project Structure


MULTINH.DPR

program MultInh;

uses
  Forms,
  MultForm in 'MultForm.pas' {FormAnimMi},
  MultAnim in 'MultAnim.pas';

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TFormAnimMi, FormAnimMi);
  Application.Run;
end.

MULTFORM.PAS

unit MultForm;

interface

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

type
  TFormAnimMi = class(TForm)
    Memo1: TMemo;
    BtnKindI: TButton;
    BtnFlyI: TButton;
    BtnSwimI: TButton;
    BtnWalkI: TButton;
    BtnMammalsI: TButton;
    procedure FormCreate(Sender: TObject);
    procedure BtnKindIClick(Sender: TObject);
    procedure BtnFlyIClick(Sender: TObject);
    procedure BtnSwimIClick(Sender: TObject);
    procedure BtnWalkIClick(Sender: TObject);
    procedure BtnMammalsIClick(Sender: TObject);
  private
    AnimIntf: array [1..5] of IAnimal;
  end;

var
  FormAnimMi: TFormAnimMi;

implementation

{$R *.DFM}

procedure TFormAnimMi.FormCreate(Sender: TObject);
begin
  AnimIntf[1] := TEagle.Create;
  AnimIntf[2] := TPenguin.Create;
  AnimIntf[3] := TDuck.Create;
  AnimIntf[4] := TBat.Create;
  AnimIntf[5] := TMonkey.Create;
end;

procedure TFormAnimMi.BtnKindIClick(Sender: TObject);
var
  I: Integer;
begin
  Memo1.Lines.Add ('Kinds:');
  for I := 1 to 5 do
    Memo1.Lines.Add (AnimIntf[I].Kind);
  Memo1.Lines.Add ('');
end;

procedure TFormAnimMi.BtnFlyIClick(Sender: TObject);
var
  I: Integer;
  Fly1: ICanFly;
begin
  Memo1.Lines.Add ('Fly:');
  for I := 1 to 5 do
  begin
    AnimIntf[i].QueryInterface (ICanFly, Fly1);
    if Assigned (Fly1) then
      Memo1.Lines.Add (Fly1.Fly);
  end;
  Memo1.Lines.Add ('');
end;

procedure TFormAnimMi.BtnSwimIClick(Sender: TObject);
var
  I: Integer;
  Swim1: ICanSwim;
begin
  Memo1.Lines.Add ('Swim:');
  for I := 1 to 5 do
    if AnimIntf[i].QueryInterface (
        ICanSwim, Swim1) <> E_NoInterface then
      Memo1.Lines.Add (Swim1.Swim);
  Memo1.Lines.Add ('');

end;

procedure TFormAnimMi.BtnWalkIClick(Sender: TObject);
var
  I: Integer;
  Walker1: ICanWalk;
begin
  Memo1.Lines.Add ('Walk:');
  for I := 1 to 5 do
  try
    Walker1 := AnimIntf[i] as ICanWalk;
    Memo1.Lines.Add (Walker1.Walk);
  except
  end;
  Memo1.Lines.Add ('');
end;

procedure TFormAnimMi.BtnMammalsIClick(Sender: TObject);
var
  I: Integer;
  Mam1: IMammal;
begin
  Memo1.Lines.Add ('Mammals:');
  for I := 1 to 5 do
  begin
    AnimIntf[i].QueryInterface (IMammal, Mam1);
    if Assigned (Mam1) then
      Memo1.Lines.Add (Mam1.Kind);
  end;
  Memo1.Lines.Add ('');
end;

end.

MULTANIM.PAS

unit MultAnim;

interface

type
  IAnimal = interface
    ['{248CC900-64CB-11D1-98D1-004845400FAA}']
    function Kind: string;
  end;

  ICanFly = interface (IAnimal)
    ['{248CC901-64CB-11D1-98D1-004845400FAA}']
    function Fly: string;
  end;

  ICanWalk = interface (IAnimal)
    ['{248CC902-64CB-11D1-98D1-004845400FAA}']
    function Walk: string;
  end;

  ICanSwim = interface (IAnimal)
    ['{248CC903-64CB-11D1-98D1-004845400FAA}']
    function Swim: string;
  end;

  IMammal = interface (IAnimal)
    ['{248CC904-64CB-11D1-98D1-004845400FAA}']
    function CarryChild: string;
  end;

  IBird = interface (IAnimal)
    ['{248CC905-64CB-11D1-98D1-004845400FAA}']
    function LayEggs: string;
  end;

  TAnimal = class (TInterfacedObject, IAnimal)
    function Kind: string; virtual; abstract;
    destructor Destroy; override;
      end;

  TMammal = class (TAnimal, IMammal)
    function CarryChild: string; virtual;
  end;

  TBird = class (TAnimal, IBird)
    function LayEggs: string; virtual;
  end;

  TEagle = class (TBird, ICanFly)
    function Kind: string; override;
    function Fly: string; virtual;
  end;

  TPenguin = class (TBird, ICanWalk, ICanSwim)
    function Kind: string; override;
    function Walk: string; virtual;
    function Swim: string; virtual;
  end;

  TDuck = class (TBird, ICanWalk, ICanFly, ICanSwim)
    function Kind: string; override;
    function Walk: string; virtual;
    function Fly: string; virtual;
    function Swim: string; virtual;
  end;

  TBat = class (TMammal, ICanFly)
    function Kind: string; override;
    function Fly: string; virtual;
  end;

  TMonkey = class (TMammal, ICanWalk)
    function Kind: string; override;
    function Walk: string; virtual;
  end;

implementation

uses
  Windows;

destructor TAnimal.Destroy;
begin
  // MessageBox (0, pChar ('Destroying ' + Kind),
  //   'Anim MI', MB_OK);
  inherited;
end;

function TMammal.CarryChild: string;
begin
  Result := 'Female mammals carry children for months';
end;

function TBird.LayEggs: string;
begin
  Result := 'Birds lay eggs';
end;

function TEagle.Kind: string;
begin
  Result := 'Eagle';
end;

function TEagle.Fly: string;
begin
  Result := 'Eagles fly over mountains';
end;

function TPenguin.Kind: string;
begin
  Result := 'Penguin';
end;

function TPenguin.Walk: string;
begin
  Result := 'Penguins walk on ice';
end;

function TPenguin.Swim: string;
begin
  Result := 'Penguins swim better than they walk';
end;

function TBat.Kind: string;
begin
  Result := 'Bat';
end;

function TBat.Fly: string;
begin
  Result := 'Bats fly in the night';
end;

function TDuck.Kind: string;
begin
  Result := 'Duck';
end;

function TDuck.Walk: string;
begin
  Result := 'Ducks walk in a funny way';
end;

function TDuck.Fly: string;
begin
  Result := 'Ducks fly and migrate';
end;

function TDuck.Swim: string;
begin
  Result := 'Ducks swim as well';
end;

function TMonkey.Kind: string;
begin
  Result := 'Monkey';
end;

function TMonkey.Walk: string;
begin
  Result := 'A walking monkey';
end;

end.

MULTFORM.DFM

object FormAnimMi: TFormAnimMi
  Left = 191
  Top = 111
  Width = 463
  Height = 305
  Caption = 'Anim MI'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Memo1: TMemo
    Left = 176
    Top = 16
    Width = 265
    Height = 249
    ScrollBars = ssVertical
    TabOrder = 0
  end
  object BtnKindI: TButton
    Left = 16
    Top = 16
    Width = 145
    Height = 25
    Caption = 'Animals kind'
    TabOrder = 1
    OnClick = BtnKindIClick
  end
  object BtnFlyI: TButton
    Left = 16
    Top = 48
    Width = 145
    Height = 25
    Caption = 'Animals fly'
    TabOrder = 2
    OnClick = BtnFlyIClick
  end
  object BtnSwimI: TButton
    Left = 16
    Top = 80
    Width = 145
    Height = 25
    Caption = 'Animals swim '
    TabOrder = 3
    OnClick = BtnSwimIClick
  end
  object BtnWalkI: TButton
    Left = 16
    Top = 112
    Width = 145
    Height = 25
    Caption = 'Animals walk'
    TabOrder = 4
    OnClick = BtnWalkIClick
  end
  object BtnMammalsI: TButton
    Left = 16
    Top = 160
    Width = 145
    Height = 25
    Caption = 'List Mammals'
    TabOrder = 5
    OnClick = BtnMammalsIClick
  end
end