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