Marco Cantù 1998, Mastering Delphi 4

Project: MULTINH.DPR

Project Structure

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

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)
    BtnKind: TButton;
    BtnFly: TButton;
    Memo1: TMemo;
    BtnSwim: TButton;
    BtnWalk: TButton;
    BtnDuck: TButton;
    BtnKindI: TButton;
    BtnFlyI: TButton;
    BtnSwimI: TButton;
    BtnWalkI: TButton;
    Label1: TLabel;
    Label2: TLabel;
    BtnMammalsI: TButton;
    procedure BtnKindClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BtnFlyClick(Sender: TObject);
    procedure BtnSwimClick(Sender: TObject);
    procedure BtnWalkClick(Sender: TObject);
    procedure BtnDuckClick(Sender: TObject);
    procedure BtnKindIClick(Sender: TObject);
    procedure BtnFlyIClick(Sender: TObject);
    procedure BtnSwimIClick(Sender: TObject);
    procedure BtnWalkIClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BtnMammalsIClick(Sender: TObject);
  private
    Animals: array [1..5] of TAnimal;
    AnimIntf: array [1..5] of IAnimal;
  end;

var
  FormAnimMi: TFormAnimMi;

implementation

{$R *.DFM}

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

  for I := 1 to 5 do
    (Animals[I] as IAnimal)._AddRef;

  AnimIntf[1] := TEagle.Create;
  AnimIntf[2] := TPenguin.Create;
  AnimIntf[3] := TDuck.Create;
  AnimIntf[4] := TBat.Create;
  AnimIntf[5] := TMonkey.Create;
end;

procedure TFormAnimMi.BtnKindClick(Sender: TObject);
var
  I: Integer;
begin
  Memo1.Lines.Add ('Kinds:');
  for I := 1 to 5 do
    // standard polymorphic method call
    Memo1.Lines.Add (Animals[I].Kind);
  Memo1.Lines.Add ('');
end;

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

procedure TFormAnimMi.BtnSwimClick(Sender: TObject);
var
  I: Integer;
  Swim1: ICanSwim;
begin
  Memo1.Lines.Add ('Swim:');
  for I := 1 to 5 do
    if Animals[i].GetInterface (ICanSwim, Swim1) then
      Memo1.Lines.Add (Swim1.Swim);
  Memo1.Lines.Add ('');
end;

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

procedure TFormAnimMi.BtnDuckClick(Sender: TObject);
var
  I: Integer;
  Duck1: TDuck;
begin
  Memo1.Lines.Add ('Duck:');
  for I := 1 to 5 do
    if Animals[I] is TDuck then
    begin
      Duck1 := TDuck (Animals[I]);
      Memo1.Lines.Add (Duck1.Kind);
      Memo1.Lines.Add (Duck1.Walk);
      Memo1.Lines.Add (Duck1.Fly);
      Memo1.Lines.Add (Duck1.Swim);
      Memo1.Lines.Add (Duck1.LayEggs);
      Memo1.Lines.Add (IntToStr(Duck1.RefCount));
    end;
end;

procedure TFormAnimMi.BtnKindIClick(Sender: TObject);
var
  I: Integer;
begin
  Memo1.Lines.Add ('Kinds:');
  for I := 1 to 5 do
    // standard polymorphic method call
    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.FormDestroy(Sender: TObject);
var
  I: Integer;
begin
  for I := 1 to 5 do
    Animals[I].Free;
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 = 194
  Top = 116
  Width = 596
  Height = 305
  Caption = 'Anim MI'
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 8
    Top = 16
    Width = 44
    Height = 13
    Caption = 'Objects'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsBold]
    ParentFont = False
  end
  object Label2: TLabel
    Left = 440
    Top = 16
    Width = 58
    Height = 13
    Caption = 'Interfaces'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsBold]
    ParentFont = False
  end
  object BtnKind: TButton
    Left = 8
    Top = 40
    Width = 145
    Height = 25
    Caption = 'Animals kind'
    TabOrder = 0
    OnClick = BtnKindClick
  end
  object BtnFly: TButton
    Left = 8
    Top = 72
    Width = 145
    Height = 25
    Caption = 'Animals fly'
    TabOrder = 1
    OnClick = BtnFlyClick
  end
  object Memo1: TMemo
    Left = 160
    Top = 16
    Width = 265
    Height = 249
    ScrollBars = ssVertical
    TabOrder = 2
  end
  object BtnSwim: TButton
    Left = 8
    Top = 104
    Width = 145
    Height = 25
    Caption = 'Animals swim '
    TabOrder = 3
    OnClick = BtnSwimClick
  end
  object BtnWalk: TButton
    Left = 8
    Top = 136
    Width = 145
    Height = 25
    Caption = 'Animals walk'
    TabOrder = 4
    OnClick = BtnWalkClick
  end
  object BtnDuck: TButton
    Left = 8
    Top = 184
    Width = 145
    Height = 25
    Caption = 'As Duck'
    TabOrder = 5
    OnClick = BtnDuckClick
  end
  object BtnKindI: TButton
    Left = 440
    Top = 40
    Width = 145
    Height = 25
    Caption = 'Animals kind'
    TabOrder = 6
    OnClick = BtnKindIClick
  end
  object BtnFlyI: TButton
    Left = 440
    Top = 72
    Width = 145
    Height = 25
    Caption = 'Animals fly'
    TabOrder = 7
    OnClick = BtnFlyIClick
  end
  object BtnSwimI: TButton
    Left = 440
    Top = 104
    Width = 145
    Height = 25
    Caption = 'Animals swim '
    TabOrder = 8
    OnClick = BtnSwimIClick
  end
  object BtnWalkI: TButton
    Left = 440
    Top = 136
    Width = 145
    Height = 25
    Caption = 'Animals walk'
    TabOrder = 9
    OnClick = BtnWalkIClick
  end
  object BtnMammalsI: TButton
    Left = 440
    Top = 184
    Width = 145
    Height = 25
    Caption = 'List Mammals'
    TabOrder = 10
    OnClick = BtnMammalsIClick
  end
end