File Properties

Download File

Download

//==============================================================================
// Unit:       Fish
//
// Purpose:    Declare TFish (ABC for "logical" fish) and TFishView (display
//             helper which paints fish on a canvas).
//
// Copyright:  1997, Palladion Software
//==============================================================================
unit Fish;

interface

uses
	Sysutils,
    Classes,
    Graphics,
    Controls;

type

  EFishError = Exception;

  TFish = class;		// forward for function declaration

  TFishBuilder = function( aPersistentState : string ) : TFish;

  //----------------------------------------------------------------------------
  // Class:     TFish
  //
  // Purpose:   Abstract base class for logical "fish" in aquarium
  //----------------------------------------------------------------------------
  TFish = class( TObject )

  protected

  	function GetCommonName : string;						virtual; abstract;
  	function GetScientificName : string;					virtual; abstract;
    function GetWidth : integer;							virtual; abstract;
    function GetHeight : integer;							virtual; abstract;
    function GetBitmap : TBitmap;							virtual; abstract;
  	function GetAsString : string;							virtual; abstract;

  public

  	property CommonName : string
        read GetCommonName;

  	property ScientificName : string
        read GetScientificName;

    property Width : integer
        read GetWidth;

    property Height : integer
        read GetHeight;

    property Bitmap : TBitmap
        read GetBitmap;

    property AsString : string
    	read GetAsString;


    procedure Swim( var X : integer; var Y : integer;
    				maxX, maxY : integer );					virtual; abstract;

    function Clone : TFish;									virtual; abstract;
                                                                    

    class
    procedure RegisterBuilder( aClassName : string; aBuilder : TFishBuilder );
    
    class
    function BuildFish( aClassName, aPersistentState : string ) : TFish;

  end;


  //----------------------------------------------------------------------------
  // Class:     TFishView
  //
  // Purpose:   View class for displaying logical "fish" as defined by TFish
  //----------------------------------------------------------------------------
  TFishView = class( TGraphicControl )

  private

  	FFish		: TFish;

  protected

  	function  GetFish : TFish;
    procedure SetFish( newFish : TFish );

  	procedure Paint;										override;

  public

  	constructor Create( AOwner : TComponent );				override;
    destructor  Destroy;									override;

    property Fish : TFish
        read GetFish
       write SetFish;

    procedure Animate;

  end;

implementation


var
	TheFactoryList	: TStringList;

//------------------------------------------------------------------------------
// TFish implementation
//
// Empty, except perhaps for class procedures/functions, since TFish is an ABC.
//------------------------------------------------------------------------------
                               
class
procedure TFish.RegisterBuilder( aClassName : string; aBuilder : TFishBuilder );

var
	dummy	: integer;

begin

	if ( TheFactoryList.Find( aClassName, dummy ) ) then
    	raise EFishError.CreateFmt( 'Duplicate registration for class %s.',
        								[ aClassName ] );

    dummy := TheFactoryList.AddObject( aClassName, TObject( @aBuilder ) );
end;

class
function TFish.BuildFish( aClassName, aPersistentState : string ) : TFish;

var
	ndx 	: integer;
    bldr	: TFishBuilder;

begin
	if not TheFactoryList.Find( aClassName, ndx ) then
    	raise EFishError.CreateFmt( 'Unregistered class %s.', [ aClassName ] );

    bldr := TFishBuilder( TheFactoryList.Objects[ ndx ] );

    Result := bldr( aPersistentState );
end;

//------------------------------------------------------------------------------
// TFishView implementation
//------------------------------------------------------------------------------

constructor TFishView.Create( AOwner : TComponent );
begin
	inherited Create( AOwner );
	FFish := Nil;
end;

destructor  TFishView.Destroy;
begin
	FFish.Free;
    inherited Destroy;
end;

function TFishView.GetFish : TFish;
begin
	if( FFish = Nil ) then
    	raise EFishError.Create( 'No fish assigned to FishView' );

    Result := FFish;
end;

procedure TFishView.SetFish( newFish : TFish );
begin
	if ( FFish <> newFish ) then
    begin
    	FFish.Free;
        FFish := newFish;
    end;
end;

procedure TFishView.Animate;

var
	x, y : integer;

begin
	if ( FFish = Nil ) then
    	raise EFishError.Create( 'No fish assigned to FishView' );

    x := Left;
    y := Top;

	Fish.Swim( x, y, Parent.ClientWidth, Parent.ClientHeight );

    Left := x;
    Top  := y;
end;

procedure TFishView.Paint;

begin

	if ( FFish = Nil ) then
    	raise EFishError.Create( 'No fish assigned to FishView' );

	Canvas.StretchDraw( ClientRect, Fish.Bitmap );
end;



procedure Setup;
begin
	TheFactoryList := TStringList.Create;
end;

procedure Cleanup;
begin
	TheFactoryList.Free;
end;

initialization

	Setup;

finalization

	Cleanup;

end.