File Properties

Download File

Download

//==============================================================================
// Unit:       FFishTnk
//
// Purpose:    Main form for Fishtank demo app.
//
// Copyright:  1997, Palladion Software
//==============================================================================
unit ffishtnk;

interface

uses
  Windows,
  Messages,
  SysUtils,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  StdCtrls,
  DBCtrls,
  DBCGrids,
  DB,
  DBTables,
  ExtCtrls,
  Mask,
  Menus,
  Fish,
  Parser;

type

  TfrmFishtank = class(TForm)
    pnlControls: TPanel;
    tblBiolife: TTable;
    dtsBiolife: TDataSource;
    pnlFishtank: TPanel;
    pnlImage: TPanel;
    imgFish: TDBImage;
    tblBiolifeSpeciesNo: TFloatField;
    tblBiolifeCategory: TStringField;
    tblBiolifeCommon_Name: TStringField;
    tblBiolifeSpeciesName: TStringField;
    tblBiolifeLengthcm: TFloatField;
    tblBiolifeLength_In: TFloatField;
    tblBiolifeNotes: TMemoField;
    tblBiolifeGraphic: TGraphicField;
    lblCommon_Name: TLabel;
    edtCommon_Name: TDBEdit;
    lblLengthCm: TLabel;
    edtLengthCm: TDBEdit;
    navBiolife: TDBNavigator;
    tmrSwim: TTimer;
    chkSwim: TCheckBox;
    btnClearTank: TButton;
    pupFishOptions: TPopupMenu;
    itmRemove: TMenuItem;
    itmHorizontalSpeed: TMenuItem;
    itmVerticalSpeed: TMenuItem;
    imgGoofFish: TImage;
    mnuFishtank: TMainMenu;
    itmFile: TMenuItem;
    itmNew: TMenuItem;
    itmOpen: TMenuItem;
    itmSave: TMenuItem;
    itmSeparator: TMenuItem;
    itmExit: TMenuItem;
    dlgLoadTank: TOpenDialog;
    dlgSaveTank: TSaveDialog;
    itmFish: TMenuItem;
    itmSwim: TMenuItem;
    itmAbout: TMenuItem;

    procedure pnlFishtankDragOver( Sender, Source: TObject; X, Y: Integer;
      							   State: TDragState; var Accept: Boolean );
    procedure pnlFishtankDragDrop( Sender, Source: TObject; X, Y: Integer );
    procedure TimeToSwim(Sender: TObject);
    procedure ToggleSwim(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ClearTank(Sender: TObject);
    procedure itmRemoveClick(Sender: TObject);
    procedure pupFishOptionsPopup(Sender: TObject);
    procedure ExitFishtank(Sender: TObject);
    procedure SaveTank(Sender: TObject);
    procedure LoadTank(Sender: TObject);
    procedure AboutFishtank(Sender: TObject);

  private

    FFishViews			: TList;
    FSelectedImage		: TFishView;
    FParser				: TPatternParser;

    procedure ZapFishViews;

  public
    { Public declarations }
  end;

var
  frmFishtank: TfrmFishtank;

implementation

{$R *.DFM}

uses
	Bio_Fish,
    GoofFish, about;

procedure TfrmFishTank.ZapFishViews;

var
	iFish	: integer;

begin
	for iFish := FFishViews.Count - 1 downto 0 do
    	TFishView( FFishViews[ iFish ] ).Free;

    FFishViews.Clear;
end;

procedure TfrmFishtank.pnlFishtankDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
	Accept := ( Source is TDBImage ) or ( Source is TImage );
end;

procedure TfrmFishtank.pnlFishtankDragDrop(Sender, Source: TObject; X, Y: Integer);

var
	fv		: TFishView;

begin

	fv := TFishView.Create( self );

    with fv do
    begin

    	if ( Source is TDBImage ) then
        begin
    		Fish 	:= TBiolifeFish.Create( tblBioLifeSpeciesNo.AsInteger );
        end
        else
        begin
        	Fish	:= TGoofFish.Create;
        end;

        Parent 		:= pnlFishtank;
        PopupMenu   := pupFishOptions;
        Visible		:= True;
        Top			:= Y;
        Left		:= X;
        Width		:= Fish.Width;
        Height		:= Fish.Height;
    end;

    fv.Tag := FFishViews.Add( fv )

end;

procedure TfrmFishtank.TimeToSwim(Sender: TObject);

var
	i 			: integer;

begin

	for i := 0 to FFishViews.Count - 1 do
    	TFishView( FFishViews[i] ).Animate;
end;

procedure TfrmFishtank.ToggleSwim(Sender: TObject);
begin
    if not ( Sender is TCheckBox ) then
        chkSwim.Checked := not chkSwim.Checked;
    itmSwim.Checked := chkSwim.Checked;
	tmrSwim.Enabled := chkSwim.Checked;
end;

procedure TfrmFishtank.FormCreate(Sender: TObject);
begin
	FFishViews := TList.Create;
    FParser := TPatternParser.Create;
    FParser.Placeholder := '$$';
    FParser.Pattern := '[$$,$$]$$:$$';
end;

procedure TfrmFishtank.ClearTank(Sender: TObject);

var
	i		: integer;

begin
	ZapFishViews;
end;

procedure TfrmFishtank.pupFishOptionsPopup(Sender: TObject);

var
	cmp : TComponent;
begin
	cmp := (Sender as TPopupMenu).PopupComponent;
	if ( cmp is TFishView ) then
    	FSelectedImage := cmp as TFishView
    else
    	FSelectedImage := Nil;
end;

procedure TfrmFishtank.itmRemoveClick(Sender: TObject);

var
	fv : TFishView;

begin

	if ( FSelectedImage = Nil ) then
    	raise Exception.Create( 'No selected fish.' );

    FFishViews.Remove( FSelectedImage );

    FSelectedImage.Free;
    FSelectedImage := Nil;
end;

procedure TfrmFishtank.ExitFishtank(Sender: TObject);
begin
	Close;
end;

procedure TfrmFishtank.SaveTank(Sender: TObject);

var
	F		: TextFile;
    iFish	: integer;
    fv		: TFishView;
    fish	: TFish;

begin
	with dlgSaveTank do
    begin
    	if Execute then
        begin
  			AssignFile( F, filename );
  			Rewrite( F );

            for iFish := 0 to FFishViews.Count - 1 do
            begin
                fv 		:= TFishView( FFishViews[ iFish ] );
            	fish 	:= fv.Fish;

                Write( F, '[',fv.Left,',',fv.Top,']' );
            	Writeln( F, fish.ClassName, ':', fish.AsString );
            end;

  			CloseFile(F);
        end;
    end;
end;

procedure TfrmFishtank.LoadTank(Sender: TObject);

var
	F		: TextFile;
    buf 	: string;

    fv		: TFishView;

begin
	with dlgLoadTank do
    begin

    	if Execute then
        begin

  			AssignFile( F, filename );
  			Reset( F );

            ZapFishViews;

            try

                while not Eof( f ) do
                begin
                    Readln( F, buf );
                    FParser.ToParse := buf;

                    if ( FParser.Status <> parseOk ) then
                        raise EFishError.Create( 'Invalid fishtank file.' );

                    fv := TFishView.Create( self );

                    with fv do
                    begin
                        Parent 		:= pnlFishtank;
                        PopupMenu	:= pupFishOptions;               
                        Left 		:= StrToInt( FParser.Tokens[0] );
                        Top 		:= StrToInt( FParser.Tokens[1] );
                        Fish 		:= TFish.BuildFish( FParser.Tokens[2],
                                                        FParser.Tokens[3] );
                        Width		:= Fish.Width;
                        Height		:= Fish.Height;
                    end;

                    FFishViews.Add( fv );
                end;

            finally

  				CloseFile(F);

            end;
        end;
    end;
end;

procedure TfrmFishtank.AboutFishtank(Sender: TObject);
begin
    AboutBox.ShowModal;
end;

end.