Home: Code Repository: Mastering Delphi 5

Project MULTINH

Project Structure

MULTINH.DPR
MULTFORM.PAS
MULTANIM.PAS
MULTFORM.DFM

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.

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.

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.

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