//============================================================================== // 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.