File Properties

Download File

Download

//==============================================================================
// Unit:       Fishtank
//
// Purpose:    Main form for Fishtank demo app ("Clone" version)
//
// 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;

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;
    About1: TMenuItem;

    procedure pnlFishtankDragOver( Sender, Source: TObject; X, Y: Integer;
      							   State: TDragState; var Accept: Boolean );
    procedure pnlFishtankDragDrop( Sender, Source: TObject; X, Y: Integer );
    procedure tmrSwimTimer(Sender: TObject);
    procedure chkSwimClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnClearTankClick(Sender: TObject);
    procedure itmRemoveClick(Sender: TObject);
    procedure pupFishOptionsPopup(Sender: TObject);
    procedure AboutFishtank(Sender: TObject);

  private

    FImages				: TList;
    FSelectedImage		: TFishView;

  public
    { Public declarations }
  end;

var
  frmFishtank: TfrmFishtank;

implementation

{$R *.DFM}

uses
	Bio_Fish,
    GoofFish, About;

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 := FImages.Add( fv )

end;

procedure TfrmFishtank.tmrSwimTimer(Sender: TObject);

var
	i 			: integer;

begin

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

procedure TfrmFishtank.chkSwimClick(Sender: TObject);
begin
	tmrSwim.Enabled := (Sender as TCheckBox).Checked;
end;

procedure TfrmFishtank.FormCreate(Sender: TObject);
begin
	FImages := TList.Create;
end;

procedure TfrmFishtank.btnClearTankClick(Sender: TObject);

var
	i		: integer;

begin

	for i := FImages.Count - 1 downto 0 do
    	TFishView( FImages[i] ).Free;

    FImages.Clear;
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.' );

    FImages.Remove( FSelectedImage );

    FSelectedImage.Free;
    FSelectedImage := Nil;
end;

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

end.