File Properties

Download File

Download

//==============================================================================
// Unit:       Bio_Fish
//
// Purpose:    Declare TBiolifeFish, a concrete "default" fish which derives its
//			   properties from the BioLife table.
//
// Copyright:  1997, Palladion Software
//==============================================================================
unit Bio_Fish;

interface

uses
	SysUtils,
    Classes,
    Graphics,
    ExtCtrls,
    Fish,
    DBCtrls;

type


  //----------------------------------------------------------------------------
  // Class:     TBiolifeFish
  //
  // Purpose:   Concrete fish class, deriving all properties (except speed) from
  //             the BioLife table entry for the same name.
  //
  // Note:      This class uses the GOF pattern "Flyweight" for sharing
  //			"specific" information (common name, bitmap, etc.).
  //----------------------------------------------------------------------------
  TBiolifeFish = class( TFish )

  private

    FTableIndex  		: integer;
    FHorizontalSpeed	: integer;
    FVerticalSpeed		: integer;

  protected

  	// Implement inherited abstract methods.
  	function GetCommonName : string;						override;
  	function GetScientificName : string;					override;
    function GetWidth : integer;							override;
    function GetHeight : integer;							override;
    function GetBitmap : TBitmap;							override;
    function GetAsString : string;							override;

    // Property implementation methods.
    function GetSpeciesId : integer;

  public

    constructor Create( aSpeciesId : integer );

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

    property SpeciesId : integer
        read GetSpeciesId;

    function Clone : TFish;									override;

  end;                                                               

  function BiolifeFish_Builder( aPersistentState : string ) : TFish;

implementation

uses
	DB,
    DBTables;

type

  //----------------------------------------------------------------------------
  // Cache entry for shared "specific" data
  //----------------------------------------------------------------------------
  TSpeciesRecord = class

  	SpeciesId 			: integer;
    CommonName			: string;
    ScientificName		: string;
    Height				: integer;
    Width				: integer;
    Image				: TImage;

    destructor Destroy;

  end;

destructor TSpeciesRecord.Destroy;
begin
	Image.Free;
end;

var
  //----------------------------------------------------------------------------
  // Cache for shared "specific" data, indexed by speciesId.
  //----------------------------------------------------------------------------
	TheSpeciesList		: TStringList;

  //----------------------------------------------------------------------------
  // Query for looking up shared "specific" data, parameterized by speciesId.
  //----------------------------------------------------------------------------
    qrySpecies			: TQuery;
    dtsSpecies			: TDataSource;
    imgGraphic			: TDBImage;

//------------------------------------------------------------------------------
// TBiolifeFish implementation.
//------------------------------------------------------------------------------

constructor TBiolifeFish.Create( aSpeciesId : integer );

var
	strSpeciesId	: string;
    specRec			: TSpeciesRecord;
    gf				: TGraphicField;
    ms				: TMemoryStream;

begin

	strSpeciesId := IntToStr( aSpeciesId );

    if not TheSpeciesList.Find( strSpeciesId, FTableIndex ) then
    begin
    	specRec := TSpeciesRecord.Create;

        try
            with specRec, qrySpecies do
            begin
                Close;
                Params[0].AsInteger := aSpeciesId;
                Open;

                if ( RecordCount <> 1 ) then
                	raise EFishError.CreateFmt( 'Invalid species id: %d',
                    								[ aSpeciesid ] );

                SpeciesId 		:= aSpeciesId;
                CommonName 		:= FieldByName( 'Common_Name' ).AsString;
                ScientificName 	:= FieldByName( 'Species Name' ).AsString;
                Width			:= FieldByName( 'Length (cm)' ).AsInteger;

                Image 			:= TImage.Create( Nil );
                Image.Picture.Assign( imgGraphic.Picture );
                
              (*
                gf				:= FieldByName( 'Graphic' ) as TGraphicField;
                ms				:= TMemoryStream.Create;
                gf.SaveToStream( ms );
                Image.Picture.Bitmap.LoadFromStream( ms );
                ms.Free;
               *)

                Height			:= Trunc( Image.Height * Width / Image.Width );
                Image.Height	:= Height;
                Image.Width		:= Width;

                Close;
            end;

        except

            on E : Exception do
            begin
                specRec.Free;
                raise;
            end;

        end;

        FTableIndex := TheSpeciesList.AddObject( strSpeciesId, specRec );
    end;

    //
    // We lack information for setting "real" speeds here.
    //
    FHorizontalSpeed := Random( 11 ) - 5;
    FVerticalSpeed := Random( 11 ) - 5;
end;


function TBiolifeFish.GetCommonName : string;
begin
	Result := TSpeciesRecord(
    			TheSpeciesList.Objects[ FTableIndex ] ).CommonName;
end;


function TBiolifeFish.GetScientificName : string;
begin
	Result := TSpeciesRecord(
    			TheSpeciesList.Objects[ FTableIndex ] ).ScientificName;
end;


function TBiolifeFish.GetWidth : integer;
begin
	Result := TSpeciesRecord( TheSpeciesList.Objects[ FTableIndex ] ).Width;
end;


function TBiolifeFish.GetHeight : integer;
begin
	Result := TSpeciesRecord( TheSpeciesList.Objects[ FTableIndex ] ).Height;
end;


function TBiolifeFish.GetBitmap : TBitmap;
begin
	Result := TSpeciesRecord(
    			TheSpeciesList.Objects[ FTableIndex ] ).Image.Picture.Bitmap;
end;


function TBiolifeFish.GetSpeciesId : integer;
begin
	Result := TSpeciesRecord( TheSpeciesList.Objects[ FTableIndex ] ).SpeciesId;
end;


procedure TBiolifeFish.Swim( var X : integer; var Y : integer;
							 maxX, maxY : integer );
begin

	X := X + FHorizontalSpeed;

    if ( X <= 0 ) or ( X + Width >= maxX ) or ( Random( 100 ) < 5 ) then
    	FHorizontalSpeed := - FHorizontalSpeed;

    Y := Y + FVerticalSpeed;

    if ( Y <= 0 ) or ( Y + Height >= maxY ) or ( Random( 100 ) < 5 ) then
    	FVerticalSpeed := - FVerticalSpeed;
end;


function TBiolifeFish.Clone : TFish;
begin
	Result := TBiolifeFish.Create( FTableIndex );
end;


function TBiolifeFish.GetAsString : string;
begin
	Result := IntToStr( SpeciesId ) + ','
            + IntToStr( FHorizontalSpeed ) + ','
            + IntToStr( FVerticalSpeed );
end;



function BiolifeFish_Builder( aPersistentState : string ) : TFish;

var
	comma			: integer;
    aSpeciesId		: integer;
    bioFish			: TBiolifeFish;

begin

	comma := Pos( ',', aPersistentState );

    if ( comma = 0 ) then
    	raise EFishError.Create( 'Invalid BiolifeFish entry.' );

    aSpeciesId := StrToInt( Copy( aPersistentState, 1, comma - 1 ) );

    bioFish := TBiolifeFish.Create( aSpeciesId );

    Delete( aPersistentState, 1, comma );
    comma := Pos( ',', aPersistentState );

    if ( comma = 0 ) then
    begin
    	bioFish.Free;
    	raise EFishError.Create( 'Invalid BiolifeFish entry.' );
    end;

    with bioFish do
    begin
    	FHorizontalSpeed := StrToInt( Copy( aPersistentState, 1, comma-1 ) );
    	FVerticalSpeed := StrToInt( Copy( aPersistentState, comma+1, 999 ) );
    end;

    Result := bioFish;
end;


procedure Setup;
begin
	TheSpeciesList := TStringList.Create;

    qrySpecies := TQuery.Create( nil );
    with qrySpecies do
    begin
    	DatabaseName := 'DBDEMOS';
        SQL.Add( 'SELECT * FROM BioLife b' );
        SQL.Add( ' WHERE b."Species No" = :SpeciesId' );
        Prepare;
    end;

    dtsSpecies := TDataSource.Create( nil );
    dtsSpecies.Dataset := qrySpecies;

    imgGraphic := TDBImage.Create( nil );
    imgGraphic.Datasource := dtsSpecies;
    imgGraphic.DataField := 'Graphic';

end;
//------------------------------------------------------------------------------
// Flush the cache and free it on unload.
//------------------------------------------------------------------------------
procedure Cleanup;

var
	iSpecies : integer;
    specRec  : TSpeciesRecord;

begin

	imgGraphic.Free;
    dtsSpecies.Free;
	qrySpecies.Free;

	for iSpecies := TheSpeciesList.Count - 1 downto 0 do
    begin
    	specRec := TSpeciesRecord( TheSpeciesList.Objects[ iSpecies ] );
        TheSpeciesList.Objects[ iSpecies ] := Nil;
        specRec.Free;
    end;

    TheSpeciesList.Free;
end;

initialization

	Setup;       
    TFish.RegisterBuilder( TBiolifeFish.ClassName, @BiolifeFish_Builder );

finalization

	Cleanup;

end.