3D Beer Pong - Visual Basic Source Code

Back to: Main Programming Page

A 3D program of the popular college game, beer pong. It's done with wireframe graphics, using the simple line and circle commands built into Visual Basic. Eventually, I'd like to learn how to use Direct3D for the graphics, but that's down the road a ways. Probably the most difficult part of this program was the collisions between the ball and the cups- much harder to figure out than the 3D graphics.

 

Source Code:

FormAbout:
FormAbout Screenshot 
Private Sub cmdOK_Click()
  Unload Me
End Sub
FormCalibrate:
FormCalibrate Screenshot 
Private Sub CommandCancel_Click()
  TextCalibrationFactor.Text = FormMain.CalibrationFactor
  FormCalibrate.Hide
End Sub

Private Sub CommandOkay_Click()
  Dim TestString As String
  Dim Digit As String
  Dim NumberTest As Boolean
  Dim NumberDecimals As Integer
  
  TestString = TextCalibrationFactor.Text
  NumberTest = True
  
  If Len(TestString) = 0 Then
    NumberTest = False
  Else
    For ctr = 1 To Len(TestString)
      Digit = Mid(TestString, ctr, 1)
      If Digit <> "0" And Digit <> "1" And Digit <> "2" And Digit <> "3" And Digit <> "4" And Digit <> "5" And Digit <> "6" And Digit <> "7" And Digit <> "8" And Digit <> "9" And Digit <> "." Then
        NumberTest = False
      End If
      If Digit = "." Then
        NumberDecimals = NumberDecimals + 1
      End If
    Next ctr
  End If
  
  If NumberDecimals > 1 Then
    NumberTest = False
  End If
  
  If NumberDecimals = 1 And Len(TestString) < 2 Then
    NumberTest = False
  End If
  
  If NumberTest Then
    FormMain.CalibrationFactor = TextCalibrationFactor.Text
    
    Open "BeerPong.dat" For Random As #1
    Put #1, 2, FormMain.CalibrationFactor
    Close #1
    
    FormCalibrate.Hide
  Else
    Call MsgBox("Please enter a valid positive number.")
  End If
End Sub

Private Sub Form_Load()
  TextCalibrationFactor.Text = FormMain.CalibrationFactor
End Sub
FormColors:
FormColors Screenshot 
Private Sub PictureBackgroundYellow_Click()
  FormMain.Picture1.BackColor = &HFFFF&
  Call FormMain.DrawScene
End Sub
Private Sub PictureBackgroundWhite_Click()
  FormMain.Picture1.BackColor = &HFFFFFF
  Call FormMain.DrawScene
End Sub
Private Sub PictureBackgroundRed_Click()
  FormMain.Picture1.BackColor = &HFF&
  Call FormMain.DrawScene
End Sub
Private Sub PictureBackgroundGreen_Click()
  FormMain.Picture1.BackColor = &HFF00&
  Call FormMain.DrawScene
End Sub
Private Sub PictureBackgroundBlue_Click()
  FormMain.Picture1.BackColor = &HFF0000
  Call FormMain.DrawScene
End Sub
Private Sub PictureBackgroundLightBlue_Click()
  FormMain.Picture1.BackColor = &HFFFF00
  Call FormMain.DrawScene
End Sub
Private Sub PictureBackgroundGrey_Click()
  FormMain.Picture1.BackColor = &HC0C0C0
  Call FormMain.DrawScene
End Sub
Private Sub PictureBackgroundBlack_Click()
  FormMain.Picture1.BackColor = &H0&
  Call FormMain.DrawScene
End Sub
Private Sub PictureBackgroundLightGrey_Click()
  FormMain.Picture1.BackColor = &H8000000F
  Call FormMain.DrawScene
End Sub
Private Sub PictureBackgroundOrange_Click()
  FormMain.Picture1.BackColor = &H80FF&
  Call FormMain.DrawScene
End Sub
Private Sub PictureBackgroundViolet_Click()
  FormMain.Picture1.BackColor = &HC000C0
  Call FormMain.DrawScene
End Sub

'Ball Colors
Private Sub PictureBallYellow_Click()
  FormMain.ColorBall = &HFFFF&
  Call FormMain.DrawScene
End Sub
Private Sub PictureBallWhite_Click()
  FormMain.ColorBall = &HFFFFFF
  Call FormMain.DrawScene
End Sub
Private Sub PictureBallRed_Click()
  FormMain.ColorBall = &HFF&
  Call FormMain.DrawScene
End Sub
Private Sub PictureBallGreen_Click()
  FormMain.ColorBall = &HFF00&
  Call FormMain.DrawScene
End Sub
Private Sub PictureBallBlue_Click()
  FormMain.ColorBall = &HFF0000
  Call FormMain.DrawScene
End Sub
Private Sub PictureBallLightBlue_Click()
  FormMain.ColorBall = &HFFFF00
  Call FormMain.DrawScene
End Sub
Private Sub PictureBallGrey_Click()
  FormMain.ColorBall = &HC0C0C0
  Call FormMain.DrawScene
End Sub
Private Sub PictureBallBlack_Click()
  FormMain.ColorBall = &H0&
  Call FormMain.DrawScene
End Sub
Private Sub PictureBallLightGrey_Click()
  FormMain.ColorBall = &H8000000F
  Call FormMain.DrawScene
End Sub
Private Sub PictureBallOrange_Click()
  FormMain.ColorBall = &H80FF&
  Call FormMain.DrawScene
End Sub
Private Sub PictureBallViolet_Click()
  FormMain.ColorBall = &HC000C0
  Call FormMain.DrawScene
End Sub

'Table Colors
Private Sub PictureTableYellow_Click()
  FormMain.ColorTable = &HFFFF&
  Call FormMain.DrawScene
End Sub
Private Sub PictureTableWhite_Click()
  FormMain.ColorTable = &HFFFFFF
  Call FormMain.DrawScene
End Sub
Private Sub PictureTableRed_Click()
  FormMain.ColorTable = &HFF&
  Call FormMain.DrawScene
End Sub
Private Sub PictureTableGreen_Click()
  FormMain.ColorTable = &HFF00&
  Call FormMain.DrawScene
End Sub
Private Sub PictureTableBlue_Click()
  FormMain.ColorTable = &HFF0000
  Call FormMain.DrawScene
End Sub
Private Sub PictureTableLightBlue_Click()
  FormMain.ColorTable = &HFFFF00
  Call FormMain.DrawScene
End Sub
Private Sub PictureTableGrey_Click()
  FormMain.ColorTable = &HC0C0C0
  Call FormMain.DrawScene
End Sub
Private Sub PictureTableBlack_Click()
  FormMain.ColorTable = &H0&
  Call FormMain.DrawScene
End Sub
Private Sub PictureTableLightGrey_Click()
  FormMain.ColorTable = &H8000000F
  Call FormMain.DrawScene
End Sub
Private Sub PictureTableOrange_Click()
  FormMain.ColorTable = &H80FF&
  Call FormMain.DrawScene
End Sub
Private Sub PictureTableViolet_Click()
  FormMain.ColorTable = &HC000C0
  Call FormMain.DrawScene
End Sub

'Cup Color
Private Sub PictureCupsYellow_Click()
  FormMain.ColorCups = &HFFFF&
  Call FormMain.DrawScene
End Sub
Private Sub PictureCupsWhite_Click()
  FormMain.ColorCups = &HFFFFFF
  Call FormMain.DrawScene
End Sub
Private Sub PictureCupsRed_Click()
  FormMain.ColorCups = &HFF&
  Call FormMain.DrawScene
End Sub
Private Sub PictureCupsGreen_Click()
  FormMain.ColorCups = &HFF00&
  Call FormMain.DrawScene
End Sub
Private Sub PictureCupsBlue_Click()
  FormMain.ColorCups = &HFF0000
  Call FormMain.DrawScene
End Sub
Private Sub PictureCupsLightBlue_Click()
  FormMain.ColorCups = &HFFFF00
  Call FormMain.DrawScene
End Sub
Private Sub PictureCupsGrey_Click()
  FormMain.ColorCups = &HC0C0C0
  Call FormMain.DrawScene
End Sub
Private Sub PictureCupsBlack_Click()
  FormMain.ColorCups = &H0&
  Call FormMain.DrawScene
End Sub
Private Sub PictureCupsLightGrey_Click()
  FormMain.ColorCups = &H8000000F
  Call FormMain.DrawScene
End Sub
Private Sub PictureCupsOrange_Click()
  FormMain.ColorCups = &H80FF&
  Call FormMain.DrawScene
End Sub
Private Sub PictureCupsViolet_Click()
  FormMain.ColorCups = &HC000C0
  Call FormMain.DrawScene
End Sub

'Opponent Cup Color
Private Sub PictureCupsOpponentYellow_Click()
  FormMain.ColorCupsOpponent = &HFFFF&
  Call FormMain.DrawScene
End Sub
Private Sub PictureCupsOpponentWhite_Click()
  FormMain.ColorCupsOpponent = &HFFFFFF
  Call FormMain.DrawScene
End Sub
Private Sub PictureCupsOpponentRed_Click()
  FormMain.ColorCupsOpponent = &HFF&
  Call FormMain.DrawScene
End Sub
Private Sub PictureCupsOpponentGreen_Click()
  FormMain.ColorCupsOpponent = &HFF00&
  Call FormMain.DrawScene
End Sub
Private Sub PictureCupsOpponentBlue_Click()
  FormMain.ColorCupsOpponent = &HFF0000
  Call FormMain.DrawScene
End Sub
Private Sub PictureCupsOpponentLightBlue_Click()
  FormMain.ColorCupsOpponent = &HFFFF00
  Call FormMain.DrawScene
End Sub
Private Sub PictureCupsOpponentGrey_Click()
  FormMain.ColorCupsOpponent = &HC0C0C0
  Call FormMain.DrawScene
End Sub
Private Sub PictureCupsOpponentBlack_Click()
  FormMain.ColorCupsOpponent = &H0&
  Call FormMain.DrawScene
End Sub
Private Sub PictureCupsOpponentLightGrey_Click()
  FormMain.ColorCupsOpponent = &H8000000F
  Call FormMain.DrawScene
End Sub
Private Sub PictureCupsOpponentOrange_Click()
  FormMain.ColorCupsOpponent = &H80FF&
  Call FormMain.DrawScene
End Sub
Private Sub PictureCupsOpponentViolet_Click()
  FormMain.ColorCupsOpponent = &HC000C0
  Call FormMain.DrawScene
End Sub

'Hand Color
Private Sub PictureHandYellow_Click()
  FormMain.ColorHand = &HFFFF&
  Call FormMain.DrawScene
End Sub
Private Sub PictureHandWhite_Click()
  FormMain.ColorHand = &HFFFFFF
  Call FormMain.DrawScene
End Sub
Private Sub PictureHandRed_Click()
  FormMain.ColorHand = &HFF&
  Call FormMain.DrawScene
End Sub
Private Sub PictureHandGreen_Click()
  FormMain.ColorHand = &HFF00&
  Call FormMain.DrawScene
End Sub
Private Sub PictureHandBlue_Click()
  FormMain.ColorHand = &HFF0000
  Call FormMain.DrawScene
End Sub
Private Sub PictureHandLightBlue_Click()
  FormMain.ColorHand = &HFFFF00
  Call FormMain.DrawScene
End Sub
Private Sub PictureHandGrey_Click()
  FormMain.ColorHand = &HC0C0C0
  Call FormMain.DrawScene
End Sub
Private Sub PictureHandBlack_Click()
  FormMain.ColorHand = &H0&
  Call FormMain.DrawScene
End Sub
Private Sub PictureHandLightGrey_Click()
  FormMain.ColorHand = &H8000000F
  Call FormMain.DrawScene
End Sub
Private Sub PictureHandOrange_Click()
  FormMain.ColorHand = &H80FF&
  Call FormMain.DrawScene
End Sub
Private Sub PictureHandViolet_Click()
  FormMain.ColorHand = &HC000C0
  Call FormMain.DrawScene
End Sub
FormHelp:
FormHelp Screenshot 
Private Sub CommandOkay_Click()
  FormHelp.Hide
End Sub
FormHighScores:
FormHighScores Screenshot 
Private Sub CommandOK_Click()
  FormHighScores.Hide
End Sub

Private Sub CommandReset_Click()
  YesNo = MsgBox("Are you sure?", vbOKCancel)
  If YesNo = 1 Then
    Open "BeerPong.dat" For Random As #1
      Put #1, 3, "Anonymous"
      Put #1, 4, Int(999)
      Put #1, 5, "Anonymous"
      Put #1, 6, Int(999)
      Put #1, 7, "Anonymous"
      Put #1, 8, Int(999)
      Put #1, 9, "Anonymous"
      Put #1, 10, Int(999)
    Close #1

    FormMain.NameBeginner = "Anonymous"
    FormMain.NameIntermediate = "Anonymous"
    FormMain.NameExpert = "Anonymous"
    FormMain.NamePro = "Anonymous"
    
    FormMain.HighScoreBeginner = 999
    FormMain.HighScoreIntermediate = 999
    FormMain.HighScoreExpert = 999
    FormMain.HighScorePro = 999

    Call RefreshScores
  End If
End Sub

Private Sub Form_Activate()
  Call RefreshScores
End Sub

Private Sub Form_Load()
  Call RefreshScores
End Sub


Private Sub RefreshScores()
  LabelNameBeginner.Caption = FormMain.NameBeginner
  LabelNameIntermediate.Caption = FormMain.NameIntermediate
  LabelNameExpert.Caption = FormMain.NameExpert
  LabelNamePro.Caption = FormMain.NamePro
  
  LabelScoreBeginner.Caption = FormMain.HighScoreBeginner
  LabelScoreIntermediate.Caption = FormMain.HighScoreIntermediate
  LabelScoreExpert.Caption = FormMain.HighScoreExpert
  LabelScorePro.Caption = FormMain.HighScorePro
   
  LabelPercentageBeginner.Caption = Left(Str(Int(1000 / FormMain.HighScoreBeginner)), 3) & " %"
  LabelPercentageIntermediate.Caption = Left(Str(Int(1000 / FormMain.HighScoreIntermediate)), 3) & " %"
  LabelPercentageExpert.Caption = Left(Str(Int(1000 / FormMain.HighScoreExpert)), 3) & " %"
  LabelPercentagePro.Caption = Left(Str(Int(1000 / FormMain.HighScorePro)), 3) & " %"
End Sub
FormMain:
FormMain Screenshot 
Const PI = 3.141592653592
Dim ScreenXOffset As Double
Dim ScreenYOffset As Double
Dim SF As Double

Dim CubeX(8) As Double
Dim CubeY(8) As Double
Dim CubeZ(8) As Double
Dim CubeA(8) As Double
Dim CubeB(8) As Double
Dim CubeMainX As Double
Dim CubeMainY As Double
Dim CubeMainZ As Double

Dim TableX(4) As Double
Dim TableY(4) As Double
Dim TableZ(4) As Double
Dim TableA(4) As Double
Dim TableB(4) As Double

Dim BallX As Double
Dim BallY As Double
Dim BallZ As Double
Dim BallR As Double

Dim NumberCups As Integer
Dim CupTopR As Double
Dim CupTopD As Double
Dim CupBottomR As Double
Dim CupBottomD As Double
Dim CupHeight As Double

Dim Cups(10) As Boolean
Dim LeadCupZ As Double
Dim LeadCupZOri As Double
Dim CupX(10) As Double
Dim CupY As Double
Dim CupZ(10) As Double

Dim CupsPrevious(10) As Boolean
Dim LeadCupZPrevious As Double
Dim LeadCupZOriPrevious As Double
Dim CupXPrevious(10) As Double
Dim CupYPrevious As Double
Dim CupZPrevious(10) As Double

Dim CupsActual(10) As Boolean
Dim LeadCupZActual As Double
Dim LeadCupZOriActual As Double
Dim CupXActual(10) As Double
Dim CupYActual As Double
Dim CupZActual(10) As Double

Dim NumberCupsOpponent As Integer

Dim CupsOpponent(10) As Boolean
Dim LeadCupZOpponent As Double
Dim LeadCupZOriOpponent As Double
Dim CupXOpponent(10) As Double
Dim CupYOpponent As Double
Dim CupZOpponent(10) As Double

Dim CupsPreviousOpponent(10) As Boolean
Dim LeadCupZPreviousOpponent As Double
Dim LeadCupZOriPreviousOpponent As Double
Dim CupXPreviousOpponent(10) As Double
Dim CupYPreviousOpponent As Double
Dim CupZPreviousOpponent(10) As Double

Dim CupsActualOpponent(10) As Boolean
Dim LeadCupZActualOpponent As Double
Dim LeadCupZOriActualOpponent As Double
Dim CupXActualOpponent(10) As Double
Dim CupYActualOpponent As Double
Dim CupZActualOpponent(10) As Double

Dim Replay As Boolean

Dim CameraX As Double
Dim CameraY As Double
Dim CameraZ As Double
Dim CameraXCenter As Double
Dim CameraYCenter As Double
Dim CameraZCenter As Double

Dim Theta As Double
Dim Phi As Double

Dim HandX As Double
Dim HandY As Double
Dim HandZ As Double
Dim HandWidth As Double

Dim HandXOpponent As Double
Dim HandYOpponent As Double
Dim HandZOpponent As Double

Dim HandXPrevious As Double
Dim HandYPrevious As Double
Dim HandZPrevious As Double

Dim HandXPreviousOpponent As Double
Dim HandYPreviousOpponent As Double
Dim HandZPreviousOpponent As Double

Dim TableDamping As Double
Dim RimDamping As Double
Dim SideDamping As Double

Dim ShotsTaken As Integer
Dim ShotsTakenOpponent As Integer


Dim Power As Double
Dim MinPower
Dim MaxPower
Dim Angle As Double
Dim Azimuth As Double
Dim ShotMade As Boolean
Dim ClosestCup As Integer
Dim Pause As Boolean
Dim StopLoop As Boolean
Dim ShotStage As Integer

Dim PowerPrevious As Double
Dim AnglePrevious As Double
Dim AzimuthPrevious As Double
Dim ShotMadePrevious As Boolean
Dim ShotMadeActual As Boolean

Dim PowerPreviousOpponent As Double
Dim AnglePreviousOpponent As Double
Dim AzimuthPreviousOpponent As Double
Dim ShotMadePreviousOpponent As Boolean
Dim shotMadeActualOpponent As Boolean

Dim SkillLevel As Double
Dim SkillLevelOpponent As Double


Dim PowerRangeOpponent As Double
Dim AngleRangeOpponent As Double
Dim AzimuthRangeOpponent As Double

'Dim CalibrationFactor As Double
Dim PowerFactor As Double
Dim AngleFactor As Double
Dim AzimuthFactor As Double
Dim ShotFactor As Double
Dim SlowMotionFactor As Double
Dim NewGame As Boolean

Public NameBeginner As String
Public NameIntermediate As String
Public NameExpert As String
Public NamePro As String
Public HighScoreBeginner As Integer
Public HighScoreIntermediate As Integer
Public HighScoreExpert As Integer
Public HighScorePro As Integer

Dim NumericUsed As Boolean

Public ColorCups
Public ColorCupsOpponent
Public ColorTable
Public ColorBall
Public ColorHand
Public CalibrationFactor As Double

Dim HeadToHead As Boolean



'BeerPong.dat placeholders
'1-Warning message
'2-Calibration Factor
'3-Beginner Name
'4-Beginner High Score
'5-Intermediate Name
'6-Intermediate High Score
'7-Expert Name
'8-Expert High Score
'9-Pro Name
'10-Pro High Score



Function asin(X) 'arcsin
  asin = Atn(X / Sqr(-X * X + 1))
End Function


Private Sub Form_Load()
  SkillLevel = 1
  SkillLevelOpponent = 1
  HeadToHead = True
  
  ColorCups = &HFF&
  ColorCupsOpponent = &HFF0000
  ColorTable = &HC0C0C0
  ColorBall = &H80FF&
  ColorHand = vbBlack
  Randomize
  
  Call InitCameraVars
  Call InitVars
  Call DrawScene
  Call DrawShotControl
End Sub
Sub InitCameraVars()
  ScreenXOffset = Picture1.Width / 2
  ScreenYOffset = -2000

  ydisp = 100

  CameraX = 0
  CameraY = 72
  CameraZ = -200
  CameraXCenter = CameraX
  CameraYCenter = CameraY
  CameraZCenter = CameraZ

  SF = 1440 * 12            'scale factor

  Theta = 0
  Phi = 0
End Sub
Private Sub InitVars()
  NewGame = True
  
  ShotStage = 0

  HandX = 0
  HandY = 30
  HandZ = -48
  HandWidth = 2.5
  BallX = HandX
  BallY = HandY
  BallZ = HandZ
  BallR = 0.75
  TextHandX.Text = HandX

  HandXOpponent = 0
  HandYOpponent = 30
  HandZOpponent = 48

  PowerRangeOpponent = 20
  AngleRangeOpponent = 10
  AzimuthRangeOpponent = 10

  Open "BeerPong.dat" For Random As #1
    Get #1, 2, CalibrationFactor
    Get #1, 3, NameBeginner
    Get #1, 4, HighScoreBeginner
    Get #1, 5, NameIntermediate
    Get #1, 6, HighScoreIntermediate
    Get #1, 7, NameExpert
    Get #1, 8, HighScoreExpert
    Get #1, 9, NamePro
    Get #1, 10, HighScorePro
  Close #1
  
  PowerFactor = 0.2
  AngleFactor = 0.7
  AzimuthFactor = 0.4
  ShotFactor = 0.001
  SlowMotionFactor = 1

  Power = 1100
  MinPower = 1100
  MaxPower = 1450
  TextPower.Text = Power

  Angle = 5
  TextAngle.Text = Angle
  
  Azimuth = 0
  TextAzimuth.Text = Azimuth
  
  CupY = 0
  LeadCupZ = 36
  LeadCupZOri = LeadCupZ
  CupHeight = 4
  CupTopR = 2
  CupTopD = CupTopR * 2
  CupBottomR = 1.25
  CupBottomD = CupBottomR * 2

  For ctr = 1 To 10
    Cups(ctr) = True
  Next ctr
  NumberCups = 10

  CupX(1) = 0
  CupX(2) = -CupTopR
  CupX(3) = CupTopR
  CupX(4) = -2 * CupTopR
  CupX(5) = 0
  CupX(6) = 2 * CupTopR
  CupX(7) = -3 * -CupTopR
  CupX(8) = -CupTopR
  CupX(9) = CupTopR
  CupX(10) = 3 * -CupTopR

  CupZ(1) = 0
  CupZ(2) = CupTopR * Sqr(3)
  CupZ(3) = CupTopR * Sqr(3)
  CupZ(4) = 2 * CupTopR * Sqr(3)
  CupZ(5) = 2 * CupTopR * Sqr(3)
  CupZ(6) = 2 * CupTopR * Sqr(3)
  CupZ(7) = 3 * CupTopR * Sqr(3)
  CupZ(8) = 3 * CupTopR * Sqr(3)
  CupZ(9) = 3 * CupTopR * Sqr(3)
  CupZ(10) = 3 * CupTopR * Sqr(3)
  
  CupYOpponent = 0
  LeadCupZOpponent = -36
  LeadCupZOriOpponent = LeadCupZOpponent

  For ctr = 1 To 10
    CupsOpponent(ctr) = True
  Next ctr
  NumberCupsOpponent = 10

  CupXOpponent(1) = 0
  CupXOpponent(2) = -CupTopR
  CupXOpponent(3) = CupTopR
  CupXOpponent(4) = -2 * CupTopR
  CupXOpponent(5) = 0
  CupXOpponent(6) = 2 * CupTopR
  CupXOpponent(7) = -3 * -CupTopR
  CupXOpponent(8) = -CupTopR
  CupXOpponent(9) = CupTopR
  CupXOpponent(10) = 3 * -CupTopR

  CupZOpponent(1) = 0
  CupZOpponent(2) = -CupTopR * Sqr(3)
  CupZOpponent(3) = -CupTopR * Sqr(3)
  CupZOpponent(4) = -2 * CupTopR * Sqr(3)
  CupZOpponent(5) = -2 * CupTopR * Sqr(3)
  CupZOpponent(6) = -2 * CupTopR * Sqr(3)
  CupZOpponent(7) = -3 * CupTopR * Sqr(3)
  CupZOpponent(8) = -3 * CupTopR * Sqr(3)
  CupZOpponent(9) = -3 * CupTopR * Sqr(3)
  CupZOpponent(10) = -3 * CupTopR * Sqr(3)

  CubeX(1) = -5
  CubeX(2) = 5
  CubeX(3) = -5
  CubeX(4) = 5
  CubeX(5) = -5
  CubeX(6) = 5
  CubeX(7) = -5
  CubeX(8) = 5

  CubeY(1) = -5
  CubeY(2) = -5
  CubeY(3) = -5
  CubeY(4) = -5
  CubeY(5) = 5
  CubeY(6) = 5
  CubeY(7) = 5
  CubeY(8) = 5

  CubeZ(1) = -5
  CubeZ(2) = -5
  CubeZ(3) = 5
  CubeZ(4) = 5
  CubeZ(5) = -5
  CubeZ(6) = -5
  CubeZ(7) = 5
  CubeZ(8) = 5

  TableX(1) = -24
  TableX(2) = 24
  TableX(3) = -24
  TableX(4) = 24

  For ctr = 1 To 4
    TableY(ctr) = CupY
  Next ctr

  TableZ(1) = 48
  TableZ(2) = 48
  TableZ(3) = -48
  TableZ(4) = -48
  
  Pause = False
  
  Replay = False
  
  ShotsTaken = 0
  
  TableDamping = 0.95
  RimDamping = 0.5
  SideDamping = 0.6
  
  NumericUsed = False
  
  TextShotsTaken.Text = "0"
  TextShotsMade.Text = "0"
  TextShootingPercentage.Text = "0"
End Sub
Private Sub CommandPause_Click()
  Pause = Not Pause
End Sub
Private Sub CommandReplay_Click()
  If ShotsTaken > 0 And Not Replay Then
    If ShotStage = 5 Then
      Replay = True
      Call ShootBall
    End If
    If ShotStage = 0 Then
      Replay = True
      If HeadToHead Then
        Call ShootBallOpponent
      Else
        Call ShootBall
      End If
    End If
  End If
End Sub
Private Sub CommandCheatShoot_Click()
  If ShotStage = 5 Then
    Call ShootBallOpponent
  Else
    ShotStage = 4
    NumericUsed = True
    Power = TextPower.Text
    Angle = TextAngle.Text
    Azimuth = TextAzimuth.Text
    HScrollHand.Value = TextHandX.Text / 24 * HScrollHand.Max
    Call DrawShotControl
    Call ShootBall
  End If
End Sub
Private Sub CommandShoot_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Select Case ShotStage
    Case 5
      Call ShootBallOpponent
    Case 3
      ShotStage = 4
      Call ShootBall
    Case 2
      ShotStage = 3
      Call GetAzimuth
    Case 1
      ShotStage = 2
      Call GetAngle
    Case 0
      Azimuth = 0
      Angle = 5
      Power = MinPower
      ShotStage = 1
      Call GetPower
  End Select
End Sub
Private Sub CommandResetView_Click()
  Call InitCameraVars
  Call DrawScene
End Sub
Private Sub CommandSlow_Click()
  Select Case SlowMotionFactor
    Case 1
      SlowMotionFactor = 300
      CommandSlow.Caption = "Slow"
    Case 300
      SlowMotionFactor = 1
      CommandSlow.Caption = "Normal"
  End Select
End Sub
Private Sub CommandStopLoop_Click()
  StopLoop = True
  If ShotStage = 5 Then
    ShotStage = 0
  End If
  If ShotStage = 4 Then
    If HeadToHead Then
      ShotStage = 5
    Else
      ShotStage = 0
    End If
  End If
  BallX = HandX
  BallY = HandY
  BallZ = HandZ
  
  If Replay Then
    Replay = False
    For ctr = 1 To 10
      Cups(ctr) = CupsActual(ctr)
      CupX(ctr) = CupXActual(ctr)
      CupZ(ctr) = CupZActual(ctr)
    Next ctr
    CupY = CupYActual
    LeadCupZ = LeadCupZActual
    LeadCupZOri = LeadCupZOriActual
    ShotMade = ShotMadeActual
  Else
    'TextShootingPercentage.Text = (10 - NumberCups) / ShotsTaken * 100
  End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
  End
End Sub
Private Sub MenuOptionAbout3DBP_Click()
  FormAbout.Show
End Sub
Private Sub MenuOptionBeginner_Click()
  If ShotsTaken <> 0 And Not MenuOptionBeginner.Checked Then
    ChangeLevel = MsgBox("Do you want to change skill level and start a new game?", vbOKCancel)
    If ChangeLevel = 1 Then
      Call InitVars
      SkillLevel = 1
      MenuOptionBeginner.Checked = True
      MenuOptionIntermediate.Checked = False
      MenuOptionExpert.Checked = False
      MenuOptionPro.Checked = False
      
      StopLoop = True
      Call DrawScene
      Call DrawShotControl
    End If
  Else
    SkillLevel = 1
    MenuOptionBeginner.Checked = True
    MenuOptionIntermediate.Checked = False
    MenuOptionExpert.Checked = False
    MenuOptionPro.Checked = False
  End If
End Sub

Private Sub MenuOptionHelp_Click()
  FormHelp.Show
End Sub

Private Sub MenuOptionIntermediate_Click()
  If ShotsTaken <> 0 And Not MenuOptionIntermediate.Checked Then
    ChangeLevel = MsgBox("Do you want to change skill level and start a new game?", vbOKCancel)
    If ChangeLevel = 1 Then
      Call InitVars
      SkillLevel = 0.5
      MenuOptionBeginner.Checked = False
      MenuOptionIntermediate.Checked = True
      MenuOptionExpert.Checked = False
      MenuOptionPro.Checked = False
      
      StopLoop = True
      Call DrawScene
      Call DrawShotControl
    End If
  Else
    SkillLevel = 0.5
    MenuOptionBeginner.Checked = False
    MenuOptionIntermediate.Checked = True
    MenuOptionExpert.Checked = False
    MenuOptionPro.Checked = False
  End If
End Sub
Private Sub MenuOptionExpert_Click()
  If ShotsTaken <> 0 And Not MenuOptionExpert.Checked Then
    ChangeLevel = MsgBox("Do you want to change skill level and start a new game?", vbOKCancel)
    If ChangeLevel = 1 Then
      Call InitVars
      SkillLevel = 0.2
      MenuOptionBeginner.Checked = False
      MenuOptionIntermediate.Checked = False
      MenuOptionExpert.Checked = True
      MenuOptionPro.Checked = False
      
      StopLoop = True
      Call DrawScene
      Call DrawShotControl
    End If
  Else
    SkillLevel = 0.2
    MenuOptionBeginner.Checked = False
    MenuOptionIntermediate.Checked = False
    MenuOptionExpert.Checked = True
    MenuOptionPro.Checked = False
  End If
End Sub
Private Sub MenuOptionPro_Click()
  If ShotsTaken <> 0 And Not MenuOptionPro.Checked Then
    ChangeLevel = MsgBox("Do you want to change skill level and start a new game?", vbOKCancel)
    If ChangeLevel = 1 Then
      Call InitVars
      SkillLevel = 0.1
      MenuOptionBeginner.Checked = False
      MenuOptionIntermediate.Checked = False
      MenuOptionExpert.Checked = False
      MenuOptionPro.Checked = True
      
      StopLoop = True
      Call DrawScene
      Call DrawShotControl
    End If
  Else
    SkillLevel = 0.1
    MenuOptionBeginner.Checked = False
    MenuOptionIntermediate.Checked = False
    MenuOptionExpert.Checked = False
    MenuOptionPro.Checked = True
  End If
End Sub
Private Sub MenuOptionBeginnerOpponent_Click()
  If ShotsTaken <> 0 And Not MenuOptionBeginnerOpponent.Checked Then
    ChangeLevel = MsgBox("Do you want to change opponent skill level and start a new game?", vbOKCancel)
    If ChangeLevel = 1 Then
      Call InitVars
      SkillLevelOpponent = 1
      MenuOptionBeginnerOpponent.Checked = True
      MenuOptionIntermediateOpponent.Checked = False
      MenuOptionExpertOpponent.Checked = False
      MenuOptionProOpponent.Checked = False
      MenuOptionProTrickShooterOpponent.Checked = False

      StopLoop = True
      Call DrawScene
      Call DrawShotControl
    End If
  Else
    SkillLevelOpponent = 1
    MenuOptionBeginnerOpponent.Checked = True
    MenuOptionIntermediateOpponent.Checked = False
    MenuOptionExpertOpponent.Checked = False
    MenuOptionProOpponent.Checked = False
    MenuOptionProTrickShooterOpponent.Checked = False
  End If
End Sub
Private Sub MenuOptionIntermediateOpponent_Click()
  If ShotsTaken <> 0 And Not MenuOptionIntermediateOpponent.Checked Then
    ChangeLevel = MsgBox("Do you want to change opponent skill level and start a new game?", vbOKCancel)
    If ChangeLevel = 1 Then
      Call InitVars
      SkillLevelOpponent = 0.5
      MenuOptionBeginnerOpponent.Checked = False
      MenuOptionIntermediateOpponent.Checked = True
      MenuOptionExpertOpponent.Checked = False
      MenuOptionProOpponent.Checked = False
      MenuOptionTrickShooterOpponent.Checked = False
      
      StopLoop = True
      Call DrawScene
      Call DrawShotControl
    End If
  Else
    SkillLevelOpponent = 0.5
    MenuOptionBeginnerOpponent.Checked = False
    MenuOptionIntermediateOpponent.Checked = True
    MenuOptionExpertOpponent.Checked = False
    MenuOptionProOpponent.Checked = False
    MenuOptionTrickShooterOpponent.Checked = False
  End If
End Sub
Private Sub MenuOptionExpertOpponent_Click()
  If ShotsTaken <> 0 And Not MenuOptionExpertOpponent.Checked Then
    ChangeLevel = MsgBox("Do you want to change skill level and start a new game?", vbOKCancel)
    If ChangeLevel = 1 Then
      Call InitVars
      SkillLevelOpponent = 0.2
      MenuOptionBeginnerOpponent.Checked = False
      MenuOptionIntermediateOpponent.Checked = False
      MenuOptionExpertOpponent.Checked = True
      MenuOptionProOpponent.Checked = False
      MenuOptionTrickShooterOpponent.Checked = False
      
      StopLoop = True
      Call DrawScene
      Call DrawShotControl
    End If
  Else
    SkillLevelOpponent = 0.2
    MenuOptionBeginnerOpponent.Checked = False
    MenuOptionIntermediateOpponent.Checked = False
    MenuOptionExpertOpponent.Checked = True
    MenuOptionProOpponent.Checked = False
    MenuOptionTrickShooterOpponent.Checked = False
  End If
End Sub
Private Sub MenuOptionProOpponent_Click()
  If ShotsTaken <> 0 And Not MenuOptionPro.Checked Then
    ChangeLevel = MsgBox("Do you want to change skill level and start a new game?", vbOKCancel)
    If ChangeLevel = 1 Then
      Call InitVars
      SkillLevelOpponent = 0.16
      MenuOptionBeginnerOpponent.Checked = False
      MenuOptionIntermediateOpponent.Checked = False
      MenuOptionExpertOpponent.Checked = False
      MenuOptionProOpponent.Checked = True
      MenuOptionTrickShooterOpponent.Checked = False
      
      StopLoop = True
      Call DrawScene
      Call DrawShotControl
    End If
  Else
    SkillLevelOpponent = 0.16
    MenuOptionBeginnerOpponent.Checked = False
    MenuOptionIntermediateOpponent.Checked = False
    MenuOptionExpertOpponent.Checked = False
    MenuOptionProOpponent.Checked = True
    MenuOptionTrickShooterOpponent.Checked = False
  End If
End Sub
Private Sub MenuOptionTrickShooterOpponent_Click()
  If ShotsTaken <> 0 And Not MenuOptionPro.Checked Then
    ChangeLevel = MsgBox("Do you want to change skill level and start a new game?", vbOKCancel)
    If ChangeLevel = 1 Then
      Call InitVars
      SkillLevelOpponent = 0
      MenuOptionBeginnerOpponent.Checked = False
      MenuOptionIntermediateOpponent.Checked = False
      MenuOptionExpertOpponent.Checked = False
      MenuOptionProOpponent.Checked = False
      MenuOptionTrickShooterOpponent.Checked = True

      StopLoop = True
      Call DrawScene
      Call DrawShotControl
    End If
  Else
    SkillLevelOpponent = 0
    MenuOptionBeginnerOpponent.Checked = False
    MenuOptionIntermediateOpponent.Checked = False
    MenuOptionExpertOpponent.Checked = False
    MenuOptionProOpponent.Checked = False
    MenuOptionTrickShooterOpponent.Checked = True

  End If
End Sub
Private Sub MenuOptionIndividual_Click()
  If ShotsTaken <> 0 And Not MenuOptionIndividual.Checked Then
    ChangeLevel = MsgBox("Do you want to start a new game?", vbOKCancel)
    If ChangeLevel = 1 Then
      Call InitVars
      HeadToHead = False
      MenuOptionIndividual.Checked = True
      MenuOptionHeadToHead.Checked = False
      
      StopLoop = True
      Call DrawScene
      Call DrawShotControl
    End If
  Else
    HeadToHead = False
    MenuOptionIndividual.Checked = True
    MenuOptionHeadToHead.Checked = False
    Call DrawScene
  End If
End Sub
Private Sub MenuOptionHeadToHead_Click()
  If ShotsTaken <> 0 And Not MenuOptionHeadToHead.Checked Then
    ChangeLevel = MsgBox("Do you want to start a new game?", vbOKCancel)
    If ChangeLevel = 1 Then
      Call InitVars
      HeadToHead = True
      MenuOptionIndividual.Checked = False
      MenuOptionHeadToHead.Checked = True
      
      StopLoop = True
      Call DrawScene
      Call DrawShotControl
    End If
  Else
    HeadToHead = True
    MenuOptionIndividual.Checked = False
    MenuOptionHeadToHead.Checked = True
    Call DrawScene
  End If
End Sub
Private Sub MenuOptionCalibrate_Click()
  FormCalibrate.Show
End Sub

Private Sub MenuOptionAutoCalibrate_Click()
  Call CalibrateToSystem
End Sub
Private Sub MenuOptionColors_Click()
  FormColors.Show
End Sub
Private Sub MenuOptionExit_Click()
  FormAbout.Hide
  FormHighScores.Hide
  FormColors.Hide
  FormCalibrate.Hide
  End
End Sub
Private Sub MenuOptionNewGame_Click()
  StopLoop = True
  NewGame = True
  Call InitVars
  Call DrawScene
  Call DrawShotControl
End Sub
Private Sub MenuOptionOptions_Click()
  FormOptions.Show
End Sub
Private Sub MenuOptionNumericShooting_Click()
  If MenuOptionNumericShooting.Checked = True Then
    MenuOptionNumericShooting.Checked = False
    CommandCheatShoot.Visible = False
  Else
    UseNumeric = MsgBox("Are you sure?  If you shoot numerically, you will no longer be able to set a high score.", vbOKCancel)
    If UseNumeric = 1 Then
      MenuOptionNumericShooting.Checked = True
      CommandCheatShoot.Visible = True
    End If
  End If
End Sub
Private Sub MenuOptionViewHighScores_Click()
  FormHighScores.Show
End Sub

Private Sub TextHandX_Change()
  If TextHandX.Text <> "-" And TextHandX.Text <> "" And TextHandX.Text <> "." Then
    'Check to make sure the value of the string is the same as the string (no goofy characters in the middle)
    If Val(TextHandX.Text) > 0 Then
      If TextHandX.Text <> Right$(Str(Val(TextHandX.Text)), Len(Str(Val(TextHandX.Text))) - 1) And Right$(TextHandX.Text, 1) <> "." Then
        TextHandX.Text = Right$(Str(Val(TextHandX.Text)), Len(Str(Val(TextHandX.Text))) - 1)
      End If
    Else
      If TextHandX.Text <> (Val(TextHandX.Text)) And Right$(TextHandX.Text, 1) <> "." Then
        TextHandX.Text = (Val(TextHandX.Text))
      End If
    End If

    'Keep textbox within same bounds as scrollbar
    If Val(TextHandX.Text) > 24 Then
      TextHandX.Text = 24
    End If
    If Val(TextHandX.Text) < -24 Then
      TextHandX.Text = -24
    End If
    
    HScrollHand.Value = Val(TextHandX.Text) / 24 * HScrollHand.Max
  End If
End Sub
Private Sub TextHandX_KeyPress(KeyAscii As Integer)
  If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 And KeyAscii <> 46 And KeyAscii <> 45 Then
    KeyAscii = 0
  End If
  If KeyAscii = 46 Then '.
    If InStr(TextHandX.Text, ".") Then
      KeyAscii = 0
    End If
  End If
  If KeyAscii = 45 Then '-
    If InStr(TextHandX.Text, "-") Then
      KeyAscii = 0
    Else
      TextHandX.Text = Val(TextHandX.Text)
    End If
  End If
End Sub

'Private Sub TextPower_Change()
'  Power = TextPower.Text
'End Sub
'Private Sub TextAngle_Change()
'  Angle = TextAngle.Text
'End Sub
'Private Sub TextAzimuth_Change()
'  Azimuth = TextAzimuth.Text
'End Sub
Private Sub VScrollPan_Change()
  CameraY = VScrollPan.Value / 2 + CameraYCenter
  Call DrawScene
End Sub
Private Sub VScrollPan_Scroll()
  CameraY = VScrollPan.Value / 2 + CameraYCenter
  Call DrawScene
End Sub
Private Sub HScrollPan_Change()
  CameraX = -HScrollPan.Value / 10
  Call DrawScene
End Sub
Private Sub HScrollPan_Scroll()
  CameraX = -HScrollPan.Value / 10
  Call DrawScene
End Sub
Private Sub HScrollZoom_Change()
  CameraZ = -HScrollZoom.Value / 10 + CameraZCenter
  Call DrawScene
End Sub
Private Sub HScrollZoom_Scroll()
  CameraZ = -HScrollZoom.Value / 10 + CameraZCenter
  Call DrawScene
End Sub
Private Sub HScrollRotate_Change()
  Phi = HScrollRotate.Value / HScrollRotate.Max
  Phi = Phi * 360
  Call DrawScene
End Sub
Private Sub HScrollRotate_Scroll()
  Phi = HScrollRotate.Value / HScrollRotate.Max
  Phi = Phi * 360
  Call DrawScene
End Sub
Private Sub HScrollRotate2_Change()
  Theta = HScrollRotate2.Value / HScrollRotate2.Max
  Theta = Theta * 90
  Call DrawScene
End Sub
Private Sub HScrollRotate2_Scroll()
  Theta = HScrollRotate2.Value / HScrollRotate2.Max
  Theta = Theta * 90
  Call DrawScene
End Sub
Private Sub HScrollHand_Change()
  HandX = HScrollHand.Value / HScrollHand.Max
  HandX = HandX * 24
  TextHandX.Text = HandX
  Call DrawScene
End Sub
Private Sub HScrollHand_Scroll()
  HandX = HScrollHand.Value / HScrollHand.Max
  HandX = HandX * 24
  TextHandX.Text = HandX
  Call DrawScene
End Sub


Sub CalibrateToSystem()
  Dim ctr As Double
  ctr = 1
  StartTime = Timer
  While ctr < 1000000000 And Timer < StartTime + 3
    ctr = ctr + 1
  Wend
  CalibrationFactor = ctr / 3 / 100 '100th of a second
  Open "BeerPong.dat" For Random As #1
  Put #1, 2, CalibrationFactor
  Close #1
  Call MsgBox("Calibration Completed")
End Sub
Sub GetPower()
  CommandShoot.Caption = "Power"
  Power = 1100
  PowerIncrement = 0.5
  While ShotStage = 1
    StartTime = Timer
    Power = Power + PowerIncrement
    If Power >= 1450 Then
      PowerIncrement = -0.5
    End If
    If Power <= 1100 Then
      PowerIncrement = 0.5
    End If
    Call DrawShotControl
    TextPower.Text = Power
    For ctr = 1 To Int(SkillLevel * PowerFactor * CalibrationFactor)
      DoEvents
    Next ctr
  Wend
End Sub
Sub GetAngle()
  CommandShoot.Caption = "Vertical Angle"
  AngleIncrement = 0.5
  While ShotStage = 2
    Angle = Angle + AngleIncrement
    If Angle >= 85 Then
      AngleIncrement = -0.5
    End If
    If Angle <= 5 Then
      AngleIncrement = 0.5
    End If
    Call DrawShotControl
    TextAngle.Text = Angle
    For ctr = 1 To Int(SkillLevel * AngleFactor * CalibrationFactor)
      DoEvents
    Next ctr
  Wend
End Sub
Sub GetAzimuth()
  CommandShoot.Caption = "Horizontal Angle"
  FalseAzimuth = Azimuth
  AzimuthIncrement = 5
  While ShotStage = 3
    FalseAzimuth = FalseAzimuth + AzimuthIncrement
    Azimuth = FalseAzimuth / 100
    If Azimuth >= 8 Then
      AzimuthIncrement = -5
    End If
    If Azimuth <= -8 Then
      AzimuthIncrement = 5
    End If
    Call DrawShotControl
    TextAzimuth.Text = Azimuth
    For ctr = 1 To Int(SkillLevel * AzimuthFactor * CalibrationFactor)
      DoEvents
    Next ctr
  Wend
End Sub
Private Sub DrawShotControl()
  'Power
  Picture2.Line (100, 300)-(400, 2100), vbBlack, BF
  Picture2.Line (120, 320)-(390, 2090), vbWhite, BF
  
  'Azimuth
  Picture2.Line (600, 1800)-(2400, 2100), vbBlack, BF
  Picture2.Line (620, 1820)-(2380, 2090), vbWhite, BF
  
  'Angle
  Picture2.Line (1350, 300)-(1650, 1700), vbBlack, BF
  Picture2.Line (1370, 320)-(1630, 1680), vbWhite, BF
  
  PowerTop = (1100 - Power) * 1770 / 350 + 2090
  Picture2.Line (120, PowerTop)-(390, 2090), vbBlue, BF
  
  AngleTop = (5 - Angle) * 1360 / 80 + 1680
  Picture2.Line (1370, AngleTop)-(1630, 1680), vbBlue, BF
  
  AzimuthA = (Azimuth) * 885 / 8 + 1500
  Picture2.Line (AzimuthA, 1820)-(1500, 2090), vbBlue, BF
End Sub
Sub DrawScene()
  Dim CupTopA(10) As Double
  Dim CupTopB(10) As Double
  Dim CupTopApparentR(10) As Double
  Dim CupTopAR(10) As Double

  Dim CupBottomA(10) As Double
  Dim CupBottomB(10) As Double
  Dim CupBottomApparentR(10) As Double
  Dim CupBottomAR(10) As Double

  Dim CupTopAOpponent(10) As Double
  Dim CupTopBOpponent(10) As Double
  Dim CupTopApparentROpponent(10) As Double
  Dim CupTopAROpponent(10) As Double

  Dim CupBottomAOpponent(10) As Double
  Dim CupBottomBOpponent(10) As Double
  Dim CupBottomApparentROpponent(10) As Double
  Dim CupBottomAROpponent(10) As Double

  Picture1.Cls


  'Convert Cup 3D coords to 2d coords
  For ctr = 1 To 10
    'Find cup bottom circles
    Call TransformTo3D(CupX(ctr), CupY, (CupZ(ctr) + LeadCupZ), CupBottomR, Theta, Phi, CameraX, CameraY, CameraZ, CupBottomA(ctr), CupBottomB(ctr), CupBottomApparentR(ctr), CupBottomAR(ctr))
    Call TransformTo3D(CupXOpponent(ctr), CupYOpponent, (CupZOpponent(ctr) + LeadCupZOpponent), CupBottomR, Theta, Phi, CameraX, CameraY, CameraZ, CupBottomAOpponent(ctr), CupBottomBOpponent(ctr), CupBottomApparentROpponent(ctr), CupBottomAROpponent(ctr))
 
    'Find cup top circles
    Call TransformTo3D(CupX(ctr), (CupY + CupHeight), (CupZ(ctr) + LeadCupZ), CupTopR, Theta, Phi, CameraX, CameraY, CameraZ, CupTopA(ctr), CupTopB(ctr), CupTopApparentR(ctr), CupTopAR(ctr))
    Call TransformTo3D(CupXOpponent(ctr), (CupYOpponent + CupHeight), (CupZOpponent(ctr) + LeadCupZOpponent), CupTopR, Theta, Phi, CameraX, CameraY, CameraZ, CupTopAOpponent(ctr), CupTopBOpponent(ctr), CupTopApparentROpponent(ctr), CupTopAROpponent(ctr))
  Next ctr

  'Convert Cube 3d coords to 2d coords
  'For ctr = 1 To 8
  '  Call TransformTo3D(CubeX(ctr), CubeY(ctr), (CubeZ(ctr) + CubeMainZ), radius, Theta, Phi, CameraX, CameraY, CameraZ, CubeA(ctr), CubeB(ctr), apparentR, ar)
  'Next ctr
  
  'Convert Crosshair 3d coords to 2d coords
  Call TransformTo3D(HandX - HandWidth, HandY, HandZ, radius, Theta, Phi, CameraX, CameraY, CameraZ, HandA1, HandB1, apparentR, ar)
  Call TransformTo3D(HandX + HandWidth, HandY, HandZ, radius, Theta, Phi, CameraX, CameraY, CameraZ, HandA2, HandB2, apparentR, ar)
  Call TransformTo3D(HandX, HandY - HandWidth, HandZ, radius, Theta, Phi, CameraX, CameraY, CameraZ, HandA3, HandB3, apparentR, ar)
  Call TransformTo3D(HandX, HandY + HandWidth, HandZ, radius, Theta, Phi, CameraX, CameraY, CameraZ, HandA4, HandB4, apparentR, ar)

  'Convert Table 3d coords to 2d coords
  For ctr = 1 To 4
    Call TransformTo3D(TableX(ctr), TableY(ctr), TableZ(ctr), radius, Theta, Phi, CameraX, CameraY, CameraZ, TableA(ctr), TableB(ctr), apparentR, ar)
  Next ctr

  'Draw Table
  Picture1.Line (TableA(1), TableB(1))-(TableA(2), TableB(2)), ColorTable
  Picture1.Line (TableA(1), TableB(1))-(TableA(3), TableB(3)), ColorTable
  Picture1.Line (TableA(4), TableB(4))-(TableA(2), TableB(2)), ColorTable
  Picture1.Line (TableA(4), TableB(4))-(TableA(3), TableB(3)), ColorTable
  
  'Draw Cups
  For ctr = 1 To 10
    If Cups(ctr) Then
      Picture1.Circle (CupBottomA(ctr), CupBottomB(ctr)), CupBottomApparentR(ctr), ColorCups, , , CupBottomAR(ctr)
      Picture1.Circle (CupTopA(ctr), CupTopB(ctr)), CupTopApparentR(ctr), ColorCups, , , CupTopAR(ctr)
      Picture1.Line (CupBottomA(ctr) + CupBottomApparentR(ctr), CupBottomB(ctr))-((CupTopA(ctr) + CupTopApparentR(ctr)), CupTopB(ctr)), ColorCups
      Picture1.Line (CupBottomA(ctr) - CupBottomApparentR(ctr), CupBottomB(ctr))-((CupTopA(ctr) - CupTopApparentR(ctr)), CupTopB(ctr)), ColorCups
    End If

    If CupsOpponent(ctr) And HeadToHead Then
      Picture1.Circle (CupBottomAOpponent(ctr), CupBottomBOpponent(ctr)), CupBottomApparentROpponent(ctr), ColorCupsOpponent, , , CupBottomAROpponent(ctr)
      Picture1.Circle (CupTopAOpponent(ctr), CupTopBOpponent(ctr)), CupTopApparentROpponent(ctr), ColorCupsOpponent, , , CupTopAROpponent(ctr)
      Picture1.Line (CupBottomAOpponent(ctr) + CupBottomApparentROpponent(ctr), CupBottomBOpponent(ctr))-((CupTopAOpponent(ctr) + CupTopApparentROpponent(ctr)), CupTopBOpponent(ctr)), ColorCupsOpponent
      Picture1.Line (CupBottomAOpponent(ctr) - CupBottomApparentROpponent(ctr), CupBottomBOpponent(ctr))-((CupTopAOpponent(ctr) - CupTopApparentROpponent(ctr)), CupTopBOpponent(ctr)), ColorCupsOpponent
    End If
  Next ctr

  'Draw Crosshair
  Picture1.Line (HandA1, HandB1)-(HandA2, HandB2), ColorHand
  Picture1.Line (HandA3, HandB3)-(HandA4, HandB4), ColorHand

  'Convert Ball 3d coords to 2d coords
  Call TransformTo3D(BallX, BallY, BallZ, BallR, Theta, Phi, CameraX, CameraY, CameraZ, BallA, BallB, BallApparentR, aspectratio)

  'Draw Ball
  Picture1.Circle (BallA, BallB), BallApparentR, ColorBall


  'Draw Cube
  'Picture1.Line (CubeA(1), CubeB(1))-(CubeA(2), CubeB(2))
  'Picture1.Line (CubeA(1), CubeB(1))-(CubeA(3), CubeB(3))
  'Picture1.Line (CubeA(4), CubeB(4))-(CubeA(2), CubeB(2))
  'Picture1.Line (CubeA(4), CubeB(4))-(CubeA(3), CubeB(3))

  'Picture1.Line (CubeA(5), CubeB(5))-(CubeA(6), CubeB(6))
  'Picture1.Line (CubeA(5), CubeB(5))-(CubeA(7), CubeB(7))
  'Picture1.Line (CubeA(8), CubeB(8))-(CubeA(6), CubeB(6))
  'Picture1.Line (CubeA(8), CubeB(8))-(CubeA(7), CubeB(7))

  'Picture1.Line (CubeA(1), CubeB(1))-(CubeA(5), CubeB(5))
  'Picture1.Line (CubeA(2), CubeB(2))-(CubeA(6), CubeB(6))
  'Picture1.Line (CubeA(3), CubeB(3))-(CubeA(7), CubeB(7))
  'Picture1.Line (CubeA(4), CubeB(4))-(CubeA(8), CubeB(8))
End Sub
Private Sub TransformTo3D(X, Y, z, radius, Theta, Phi, CameraX, CameraY, CameraZ, a, b, apparentradius, aspectratio)
  'x - point 3D x coordinate
  'y - point 3D y coordinate
  'z - point 3D z coordinate
  'radius - radius of object
  'theta - rotation angle about x axis
  'phi - rotation angle about y axis
  'camerax - camera 3D x coordinate
  'cameray - camera 3D y coordinate
  'cameraz - camera 3D z coordinate
  'a - 2D x coordinate
  'b - 2D y coordinate
  'apparentradius - 2D project radius of a 3D circle or sphere
  'aspectratio - aspectratio to use in drawing elipse to represent a circle

  'rx - radial distance to x axis
  'ry - radial distance to y axis
  'xr - 3D x coordinate rotated about an axis
  'yr - 3D y coordinate rotated about an axis
  'zr - 3D z coordinate rotated about an axis

  phirad = Phi * PI / 180
  thetarad = Theta * PI / 180

  'Find distance to x-axis
  rx = (Y ^ 2 + z ^ 2) ^ 0.5


  'Find angle to x-axis
  If z = 0 Then
    If Y >= 0 Then
      q = PI / 2
    ElseIf Y < 0 Then
      q = -PI / 2
    End If
  Else
    tang = Y / z
    q = Atn(tang)
    If z < 0 Then
      q = q + PI
    End If
  End If

  'Rotate about x-axis
  xr = X
  yr = rx * Sin(q + thetarad)
  zr = rx * Cos(q + thetarad)


  'Find distance to y-axis
  If (xr * xr + zr * zr) > 0 Then
    ry = (xr ^ 2 + zr ^ 2) ^ 0.5
  Else
    ry = 0
  End If


  'Find angle to y-axis
  If xr = 0 Then
    If zr > 0 Then
      p = PI / 2
    ElseIf zr < 0 Then
      p = -PI / 2
    End If
  Else
    tang = zr / xr
    p = Atn(tang)
    If xr < 0 Then
      p = p + PI
    End If
  End If

  'Rotate about y-axis
  xr = ry * Cos(p + phirad)
  yr = yr
  zr = ry * Sin(p + phirad)

  'Convert 3D coords to 2D coords

  a = (xr - CameraX) / (zr - CameraZ) * SF + ScreenXOffset
  b = -((yr - CameraY) / (zr - CameraZ) * SF) + ScreenYOffset

  apparentradius = radius / (zr - CameraZ) * SF
  aspectratio = Abs(Atn((yr - CameraY) / (zr - CameraZ))) / PI * 2
  'aspectratio = (Abs(Atn((yr - CameraY) / (zr - CameraZ))) + (Theta * PI / 180)) / PI * 2
End Sub
Private Sub ShootBall()
Dim t As Double
Dim BallVxz As Double
Dim CollisionCount As Integer
Dim CollisionCountLimit As Integer
Dim UserName As String

CommandShoot.Caption = "Ball in motion"
CommandShoot.Enabled = False

If Replay Then
  For ctr = 1 To 10
    CupsActual(ctr) = Cups(ctr)
    Cups(ctr) = CupsPrevious(ctr)
    
    CupXActual(ctr) = CupX(ctr)
    CupX(ctr) = CupXPrevious(ctr)
    
    CupZActual(ctr) = CupZ(ctr)
    CupZ(ctr) = CupZPrevious(ctr)
  Next ctr
  CupYActual = CupY
  CupY = CupYPrevious
  
  LeadCupZActual = LeadCupZ
  LeadCupZ = LeadCupZPrevious
  
  LeadCupZOriActual = LeadCupZOri
  LeadCupZOri = LeadCupZOriPrevious
  
  Power = PowerPrevious
  Angle = AnglePrevious
  Azimuth = AzimuthPrevious
  
  HandX = HandXPrevious
  HandY = HandYPrevious
  HandZ = HandZPrevious
  
  ShotMadeActual = ShotMade
  ShotMade = ShotMadePrevious
Else 'Replay
  For ctr = 1 To 10
    CupsPrevious(ctr) = Cups(ctr)
    CupXPrevious(ctr) = CupX(ctr)
    CupZPrevious(ctr) = CupZ(ctr)
  Next ctr
  CupYPrevious = CupY
  LeadCupZPrevious = LeadCupZ
  LeadCupZOriPrevious = LeadCupZOri
  
  PowerPrevious = Power
  AnglePrevious = Angle
  AzimuthPrevious = Azimuth
  
  HandXPrevious = HandX
  HandYPrevious = HandY
  HandZPrevious = HandZ
  
  ShotMadePrevious = ShotMade
  
  ShotsTaken = ShotsTaken + 1
  TextShotsTaken.Text = ShotsTaken
End If 'Replay

BallXOri = HandX
BallYOri = HandY
BallZOri = HandZ
BallX = HandX
BallY = HandY
BallZ = HandZ

BallVy = Power / 50 * Sin(Angle * PI / 180)
BallVxz = Power / 50 * Cos(Angle * PI / 180)
BallVx = BallVxz * Sin(Azimuth * PI / 180)
BallVz = BallVxz * Cos(Azimuth * PI / 180)

t = 0
ShotMade = False
StopLoop = False
Pause = False
CollisionCount = 0
CollisionCountLimit = 5
NewGame = False

Do Until BallY < -10 Or BallZ > (LeadCupZ + 24) Or BallZ < HandZ Or ShotMade = True Or StopLoop = True
  Do Until Not Pause
    DoEvents
  Loop
  'Picture1.Circle (BallA, BallB), BallApparentR, vbWhite
  'BallZ = BallZ2
  
  BallX = BallXOri + BallVx * t
  BallY = BallYOri + 0.5 * -9.81 * t ^ 2 + BallVy * t
  BallZ = BallZOri + BallVz * t
  'BallZ2 = BallZ
  CollisionCount = CollisionCount + 1
  
  If BallX > 24 Or BallX < -24 Then
    StopLoop = True
  End If
  
  If BallY <= 0 Then
    'Hit Table
    BallVy = TableDamping * (-BallVy + 9.81 * t)
    BallYOri = BallY
    BallXOri = BallX
    BallZOri = BallZ
    t = 0
    If (BallYOri + 0.5 * -9.81 * t ^ 2 + BallVy * t) < 0 Then
      BallYOri = 0
    End If
  End If

  Call TransformTo3D(BallX, BallY, BallZ, BallR, Theta, Phi, CameraX, CameraY, CameraZ, BallA, BallB, BallApparentR, aspectratio)
  Picture1.Circle (BallA, BallB), BallApparentR
  Call DrawScene

  DistanceSqrd = (4 * CupTopR) ^ 2

  If BallY < (CupY + CupHeight) Then
    For ctr = 1 To 10
      If Cups(ctr) Then
        DistanceSqrd2 = (CupX(ctr) - BallX) ^ 2 + (CupZ(ctr) + LeadCupZ - BallZ) ^ 2
        If DistanceSqrd2 < DistanceSqrd Then
          DistanceSqrd = DistanceSqrd2
          ClosestCup = ctr
        End If
      End If
    Next ctr
    If DistanceSqrd < CupTopR ^ 2 Then
    'Ball went in cup
      ShotMade = True
      BallX = CupX(ClosestCup)
      BallY = CupY + BallR
      BallZ = CupZ(ClosestCup) + LeadCupZ
    End If
    If DistanceSqrd < (CupTopR + BallR) ^ 2 And CollisionCount > CollisionCountLimit Then
    'Ball Hit Side of Cup
      
      Xtemp = CupX(ClosestCup) - BallX
      Ztemp = (CupZ(ClosestCup) + LeadCupZ) - BallZ

      'Find angle from center of cup to center of ball in XZ plane
      If Xtemp = 0 Then
        If Ztemp > 0 Then
          q = PI / 2
        ElseIf Ztemp < 0 Then
          q = -PI / 2
        End If
      Else
        tang = Ztemp / Xtemp
        q = Atn(tang)
        If Xtemp < 0 Then
          q = q + PI
        End If
      End If

      'Find angle of ball velocity in XZ plane
      If BallVx = 0 Then
        If BallVz > 0 Then
          p = PI / 2
        ElseIf BallVz < 0 Then
          p = -PI / 2
        End If
      Else
        tang = BallVz / BallVx
        p = Atn(tang)
        If BallVx < 0 Then
          p = p + PI
        End If
      End If
      
      pdeg = p * 180 / PI
      qdeg = q * 180 / PI

      'Reflect ball off side of cup
      BallV = Sqr(BallVx ^ 2 + BallVz ^ 2)
      BallVx = SideDamping * (BallV * Cos(2 * q - p - PI))
      BallVz = SideDamping * (BallV * Sin(2 * q - p - PI))
      BallVy = 1 * (BallVy - 9.81 * t)
      BallXOri = CupX(ClosestCup) + (CupTopR + BallR) * Cos(q - PI) 'BallX
      BallYOri = BallY
      BallZOri = CupZ(ClosestCup) + LeadCupZ + (CupTopR + BallR) * Sin(q - PI) 'BallZ
      t = 0
      CollisionCount = 0
    End If
  End If
  
  If (BallY - BallR) < (CupY + CupHeight) And CollisionCount > CollisionCountLimit Then
    For ctr = 1 To 10
      If Cups(ctr) Then
        DistanceSqrd2 = (CupX(ctr) - BallX) ^ 2 + (CupZ(ctr) + LeadCupZ - BallZ) ^ 2
        If DistanceSqrd2 < DistanceSqrd Then
          DistanceSqrd = DistanceSqrd2
          ClosestCup = ctr
        End If
      End If
    Next ctr
    If DistanceSqrd < (CupTopR + BallR) ^ 2 Then
      'Hit Rim
      
      Xtemp = CupX(ClosestCup) - BallX
      Ztemp = (CupZ(ClosestCup) + LeadCupZ) - BallZ

      'Find angle from the rim to center of ball in XZ plane
      If Xtemp = 0 Then
        If Ztemp > 0 Then
          qxz = PI / 2
        ElseIf Ztemp < 0 Then
          qxz = -PI / 2
        End If
      Else
        tang = Ztemp / Xtemp
        qxz = Atn(tang)
        If Xtemp < 0 Then
          qxz = qxz + PI
        End If
      End If
      
      'Find angle of ball velocity in XZ plane
      If BallVx = 0 Then
        If BallVz > 0 Then
          pxz = PI / 2
        ElseIf BallVz < 0 Then
          pxz = -PI / 2
        End If
      Else
        tang = BallVz / BallVx
        pxz = Atn(tang)
        If BallVx < 0 Then
          pxz = pxz + PI
        End If
      End If
      pxzdeg = pxz * 180 / PI
      qxzdeg = qxz * 180 / PI
      
      RimX = CupX(ClosestCup) + CupTopR * Cos(qxz - PI)
      RimZ = CupZ(ClosestCup) + LeadCupZ + CupTopR * Sin(qxz - PI)
      RimY = CupY + CupHeight
      
      DistanceSqrd = (RimX - BallX) ^ 2 + (RimY - BallY) ^ 2 + (RimZ - BallZ) ^ 2
      If DistanceSqrd < BallR ^ 2 Then
        Ytemp = RimY - BallY
        Ztemp = RimZ - BallZ
  
        'Find angle from the rim to center of ball in the YZ plane
        If Ztemp = 0 Then
          If Ytemp > 0 Then
  qyz = PI / 2
          ElseIf Ytemp < 0 Then
  qyz = -PI / 2
          End If
        Else
          tang = Ytemp / Ztemp
          qyz = Atn(tang)
          If Ztemp < 0 Then
  qyz = qyz + PI
          End If
        End If
      
        BallVyTemp = BallVy - 9.81 * t
        'Find angle of ball velocity in YZ plane
        If BallVz = 0 Then
          If BallVyTemp > 0 Then
  pyz = PI / 2
          ElseIf BallVyTemp < 0 Then
  pyz = -PI / 2
          End If
        Else
          tang = BallVyTemp / BallVz
          pyz = Atn(tang)
          If BallVz < 0 Then
  pyz = pyz + PI
          End If
        End If
        pyzdeg = pyz * 180 / PI
        qyzdeg = qyz * 180 / PI
        
        RimX = CupX(ClosestCup) + CupTopR * Cos(qxz - PI)
        RimZ = CupZ(ClosestCup) + LeadCupZ + CupTopR * Sin(qxz - PI)
        RimY = CupY + CupHeight
      
        BallVxz = Sqr(BallVx ^ 2 + BallVz ^ 2)
        BallVzy = Sqr(BallVz ^ 2 + BallVyTemp ^ 2)
        BallVz = RimDamping * (BallVzy * Cos(2 * qyz - pyz - PI))
        BallVy = RimDamping * (BallVzy * Sin(2 * qyz - pyz - PI))
        BallVx = RimDamping * (BallVxz * Cos(2 * qxz - pxz - PI))
        If (BallVx ^ 2 + BallVy ^ 2 + BallVz ^ 2) < 9 Then
          BallVx = 2 * BallVx
          BallVz = 2 * BallVz
          BallVy = 2 * BallVy
        End If
        test1 = BallVz - BallVxz
        test2 = BallVy - BallVxz
        BallXOri = BallX 'RimX + BallR * Cos(qxz - PI) 'CupX(ClosestCup) + (CupTopR + BallR) * Cos(qxz - PI) 'BallX
        BallYOri = BallY 'RimY + BallR * Sin(qyz - PI) 'BallY 'BallY
        BallZOri = BallZ 'RimZ + BallR * Cos(qyz - PI) 'BallZ 'CupZ(ClosestCup) + LeadCupZ + (CupTopR + BallR) * Sin(q - PI) 'BallZ
        t = 0
        CollisionCount = 0
      End If
      
    End If
  End If
  

  t = t + 0.01
  For ctr = 1 To Int(ShotFactor * CalibrationFactor * SlowMotionFactor)
    DoEvents
  Next ctr
Loop
Call DrawScene

If ShotMade = True Then
  If Not Replay Then
    NumberCups = NumberCups - 1
    TextShotsMade.Text = (10 - NumberCups)
    TextShootingPercentage.Text = (10 - NumberCups) / ShotsTaken * 100
  End If
  Cups(ClosestCup) = False
  If HeadToHead Then
    BallX = HandXOpponent
    BallY = HandYOpponent
    BallZ = HandZOpponent
  Else
    BallX = HandX
    BallY = HandY
    BallZ = HandZ
  End If

  If NumberCups = 6 Then
    For ctr = 1 To 6
      Cups(ctr) = True
    Next ctr
    For ctr = 7 To 10
      Cups(ctr) = False
    Next ctr
    LeadCupZ = LeadCupZ + CupTopR * Sqr(3)
  End If

  If NumberCups = 3 Then
    Cups(1) = False
    Cups(2) = False
    Cups(3) = False
    Cups(4) = False
    Cups(6) = False
    Cups(7) = False
    Cups(10) = False
    Cups(5) = True
    Cups(8) = True
    Cups(9) = True
    LeadCupZ = LeadCupZOri
  End If

  If NumberCups = 0 And Not Replay Then
    Select Case SkillLevel
      Case 1
        If ShotsTaken < HighScoreBeginner And Not NumericUsed Then
          HighScoreBeginner = ShotsTaken
          NameBeginner = InputBox("Congratulations.  You earned a new high score.  Please enter your name", "High Score")
          Open "BeerPong.dat" For Random As #1
  Put #1, 3, UserName
  Put #1, 4, NameBeginner
          Close #1
        End If
      Case 0.5
        If ShotsTaken < HighScoreIntermediate And Not NumericUsed Then
          HighScoreIntermediate = ShotsTaken
          NameIntermediate = InputBox("Congratulations.  You earned a new high score.  Please enter your name", "High Score")
          Open "BeerPong.dat" For Random As #1
  Put #1, 4, NameIntermediate
  Put #1, 5, HighScoreIntermediate
          Close #1
        End If
      Case 0.2
        If ShotsTaken < HighScoreExpert And Not NumericUsed Then
          HighScoreExpert = ShotsTaken
          NameExpert = InputBox("Congratulations.  You earned a new high score.  Please enter your name", "High Score")
          Open "BeerPong.dat" For Random As #1
  Put #1, 4, NameExpert
  Put #1, 5, HighScoreExpert
          Close #1
        End If
      Case 0.1
        If ShotsTaken < HighScorePro And Not NumericUsed Then
          HighScorePro = ShotsTaken
          NamePro = InputBox("Congratulations.  You earned a new high score.  Please enter your name", "High Score")
          Open "BeerPong.dat" For Random As #1
  Put #1, 4, NamePro
  Put #1, 5, HighScorePro
          Close #1
        End If
      End Select 'SkillLevel
    
      PlayAgain = MsgBox("You just won.  Do you want to play again?", vbYesNo)
    
      If PlayAgain = 6 Then
        Call InitVars
        Call DrawScene
      End If
    Else 'NumberCups = 0 And Not Replay
      StartTime = Timer
      Do Until Timer > StartTime + 3
        DoEvents
      Loop
    End If 'NumberCups = 0 And Not Replay
    
  Call DrawScene
End If 'ShotsMade = True

If HeadToHead Then
  CommandShoot.Caption = "Opponent's Shot"
  ShotStage = 5
Else
  CommandShoot.Caption = "Shoot"
  ShotStage = 0
End If

If Replay Then
  Replay = False
  For ctr = 1 To 10
    Cups(ctr) = CupsActual(ctr)
    CupX(ctr) = CupXActual(ctr)
    CupZ(ctr) = CupZActual(ctr)
  Next ctr
  CupY = CupYActual
  LeadCupZ = LeadCupZActual
  LeadCupZOri = LeadCupZOriActual
  ShotMade = ShotMadeActual
End If

If Not NewGame Then
  TextShootingPercentage.Text = (10 - NumberCups) / ShotsTaken * 100
End If

CommandShoot.Enabled = True

End Sub 'ShootBall
Private Sub ShootBallOpponent()
Dim t As Double
Dim BallVxz As Double
Dim CollisionCount As Integer
Dim CollisionCountLimit As Integer

CommandShoot.Caption = "Ball in motion"
CommandShoot.Enabled = False

ShotStage = 6

If Replay Then
  For ctr = 1 To 10
    CupsActualOpponent(ctr) = CupsOpponent(ctr)
    CupsOpponent(ctr) = CupsPreviousOpponent(ctr)
    
    CupXActualOpponent(ctr) = CupXOpponent(ctr)
    CupXOpponent(ctr) = CupXPreviousOpponent(ctr)
    
    CupZActualOpponent(ctr) = CupZOpponent(ctr)
    CupZOpponent(ctr) = CupZPreviousOpponent(ctr)
  Next ctr
  CupYActualOpponent = CupYOpponent
  CupYOpponent = CupYPreviousOpponent
  
  LeadCupZActualOpponent = LeadCupZOpponent
  LeadCupZOpponent = LeadCupZPreviousOpponent
  
  LeadCupZOriActualOpponent = LeadCupZOriOpponent
  LeadCupZOriOpponent = LeadCupZOriPreviousOpponent
  
  PowerOpponent = PowerPreviousOpponent
  AngleOpponent = AnglePreviousOpponent
  AzimuthOpponent = AzimuthPreviousOpponent
  
  HandXOpponent = HandXPreviousOpponent
  HandYOpponent = HandYPreviousOpponent
  HandZOpponent = HandZPreviousOpponent
  
  shotMadeActualOpponent = ShotMadeOpponent
  ShotMadeOpponent = ShotMadePreviousOpponent
Else 'Replay
  'Set Opponent's aim based on the cups available and cup configuration
  If SkillLevelOpponent <> 0 Then
    If CupsOpponent(1) Then
      HandXOpponent = 0
      HandYOpponent = 30
      HandZOpponent = 48

      If NumberCupsOpponent > 6 Then
        'Original Configuration
        PowerOpponent = 1250 + PowerRangeOpponent * SkillLevelOpponent * Rnd - 0.5 * PowerRangeOpponent * SkillLevelOpponent
        AngleOpponent = 135 + AngleRangeOpponent * SkillLevelOpponent * Rnd - 0.5 * AngleRangeOpponent * SkillLevelOpponent
        AzimuthOpponent = 0 + AzimuthRangeOpponent * SkillLevelOpponent * Rnd - 0.5 * AzimuthRangeOpponent * SkillLevelOpponent
      Else
        'After First Rerack
        PowerOpponent = 1280 + PowerRangeOpponent * SkillLevelOpponent * Rnd - 0.5 * PowerRangeOpponent * SkillLevelOpponent
        AngleOpponent = 135 + AngleRangeOpponent * SkillLevelOpponent * Rnd - 0.5 * AngleRangeOpponent * SkillLevelOpponent
        AzimuthOpponent = 0 + AzimuthRangeOpponent * SkillLevelOpponent * Rnd - 0.5 * AzimuthRangeOpponent * SkillLevelOpponent
      End If

      ElseIf CupsOpponent(2) Then
      HandXOpponent = -2
      HandYOpponent = 30
      HandZOpponent = 48

      If NumberCupsOpponent > 6 Then
        'Original Configuration
        PowerOpponent = 1280 + PowerRangeOpponent * SkillLevelOpponent * Rnd - 0.5 * PowerRangeOpponent * SkillLevelOpponent
        AngleOpponent = 135 + AngleRangeOpponent * SkillLevelOpponent * Rnd - 0.5 * AngleRangeOpponent * SkillLevelOpponent
        AzimuthOpponent = 0 + AzimuthRangeOpponent * SkillLevelOpponent * Rnd - 0.5 * AzimuthRangeOpponent * SkillLevelOpponent
      Else
        'After First Rerack
        PowerOpponent = 1315 + PowerRangeOpponent * SkillLevelOpponent * Rnd - 0.5 * PowerRangeOpponent * SkillLevelOpponent
        AngleOpponent = 135 + AngleRangeOpponent * SkillLevelOpponent * Rnd - 0.5 * AngleRangeOpponent * SkillLevelOpponent
        AzimuthOpponent = 0 + AzimuthRangeOpponent * SkillLevelOpponent * Rnd - 0.5 * AzimuthRangeOpponent * SkillLevelOpponent
      End If

    ElseIf CupsOpponent(3) Then
      HandXOpponent = 2
      HandYOpponent = 30
      HandZOpponent = 48

      If NumberCupsOpponent > 6 Then
        'Original Configuration
        PowerOpponent = 1280 + PowerRangeOpponent * SkillLevelOpponent * Rnd - 0.5 * PowerRangeOpponent * SkillLevelOpponent
        AngleOpponent = 135 + AngleRangeOpponent * SkillLevelOpponent * Rnd - 0.5 * AngleRangeOpponent * SkillLevelOpponent
        AzimuthOpponent = 0 + AzimuthRangeOpponent * SkillLevelOpponent * Rnd - 0.5 * AzimuthRangeOpponent * SkillLevelOpponent
      Else
        'After First Rerack
        PowerOpponent = 1315 + PowerRangeOpponent * SkillLevelOpponent * Rnd - 0.5 * PowerRangeOpponent * SkillLevelOpponent
        AngleOpponent = 135 + AngleRangeOpponent * SkillLevelOpponent * Rnd - 0.5 * AngleRangeOpponent * SkillLevelOpponent
        AzimuthOpponent = 0 + AzimuthRangeOpponent * SkillLevelOpponent * Rnd - 0.5 * AzimuthRangeOpponent * SkillLevelOpponent
      End If

    ElseIf CupsOpponent(5) Then
      HandXOpponent = 0
      HandYOpponent = 30
      HandZOpponent = 48

      PowerOpponent = 1315 + PowerRangeOpponent * SkillLevelOpponent * Rnd - 0.5 * PowerRangeOpponent * SkillLevelOpponent
      AngleOpponent = 135 + AngleRangeOpponent * SkillLevelOpponent * Rnd - 0.5 * AngleRangeOpponent * SkillLevelOpponent
      AzimuthOpponent = 0 + AzimuthRangeOpponent * SkillLevelOpponent * Rnd - 0.5 * AzimuthRangeOpponent * SkillLevelOpponent

    ElseIf CupsOpponent(8) Then
      HandXOpponent = -2
      HandYOpponent = 30
      HandZOpponent = 48

      PowerOpponent = 1345 + PowerRangeOpponent * SkillLevelOpponent * Rnd - 0.5 * PowerRangeOpponent * SkillLevelOpponent
      AngleOpponent = 135 + AngleRangeOpponent * SkillLevelOpponent * Rnd - 0.5 * AngleRangeOpponent * SkillLevelOpponent
      AzimuthOpponent = 0 + AzimuthRangeOpponent * SkillLevelOpponent * Rnd - 0.5 * AzimuthRangeOpponent * SkillLevelOpponent

    ElseIf CupsOpponent(9) Then
      HandXOpponent = 2
      HandYOpponent = 30
      HandZOpponent = 48

      PowerOpponent = 1345 + PowerRangeOpponent * SkillLevelOpponent * Rnd - 0.5 * PowerRangeOpponent * SkillLevelOpponent
      AngleOpponent = 135 + AngleRangeOpponent * SkillLevelOpponent * Rnd - 0.5 * AngleRangeOpponent * SkillLevelOpponent
      AzimuthOpponent = 0 + AzimuthRangeOpponent * SkillLevelOpponent * Rnd - 0.5 * AzimuthRangeOpponent * SkillLevelOpponent
    End If
  Else
    'These are trick shots.  Each one will go in, bouncing off of other cups.
    'It's set up that for each turn, there are a few possible shots.  Each shot
    'for a turn will sink the same cup, so that there are no worries about setup
    'for subsequent trick shots.
    
    Select Case ShotsTaken
      Case 1
        HandXOpponent = -6.3
        HandYOpponent = 30
        HandZOpponent = 48

        PowerOpponent = 1365.8
        AngleOpponent = 135
        AzimuthOpponent = 0

      Case 2
        HandXOpponent = -0.2
        HandYOpponent = 30
        HandZOpponent = 48

        PowerOpponent = 1237.85
        AngleOpponent = 135
        AzimuthOpponent = 0

      Case 3
        HandXOpponent = 0
        HandYOpponent = 30
        HandZOpponent = 48

        PowerOpponent = 1275.195
        AngleOpponent = 135
        AzimuthOpponent = 0

      Case 4
        HandXOpponent = 4.1
        HandYOpponent = 30
        HandZOpponent = 48

        PowerOpponent = 1335.6
        AngleOpponent = 135
        AzimuthOpponent = 0

      Case 5
        HandXOpponent = 0
        HandYOpponent = 30
        HandZOpponent = 48

        PowerOpponent = 1365.7
        AngleOpponent = 135
        AzimuthOpponent = 0

      Case 6
        HandXOpponent = 0
        HandYOpponent = 30
        HandZOpponent = 48

        PowerOpponent = 1366.1
        AngleOpponent = 135
        AzimuthOpponent = 0

      Case 7
        HandXOpponent = -4.2
        HandYOpponent = 30
        HandZOpponent = 48

        PowerOpponent = 1366
        AngleOpponent = 135
        AzimuthOpponent = 0

      Case 8
        HandXOpponent = 2.1
        HandYOpponent = 30
        HandZOpponent = 48

        PowerOpponent = 1366.1
        AngleOpponent = 135
        AzimuthOpponent = 0.01

      Case 9
        HandXOpponent = 0.1
        HandYOpponent = 30
        HandZOpponent = 48

        PowerOpponent = 1300.55
        AngleOpponent = 135
        AzimuthOpponent = -0.01

      Case 10
        HandXOpponent = -24
        HandYOpponent = 30
        HandZOpponent = 48

        PowerOpponent = 1363.2
        AngleOpponent = 135
        AzimuthOpponent = -14.65
    End Select
  End If 'OpponentSkillLevel <> 0
  
  For ctr = 1 To 10
    CupsPreviousOpponent(ctr) = CupsOpponent(ctr)
    CupXPreviousOpponent(ctr) = CupXOpponent(ctr)
    CupZPreviousOpponent(ctr) = CupZOpponent(ctr)
  Next ctr

  CupYPreviousOpponent = CupYOpponent
  LeadCupZPreviousOpponent = LeadCupZOpponent
  LeadCupZOriPreviousOpponent = LeadCupZOriOpponent
  
  PowerPreviousOpponent = PowerOpponent
  AnglePreviousOpponent = AngleOpponent
  AzimuthPreviousOpponent = AzimuthOpponent
  
  HandXPreviousOpponent = HandXOpponent
  HandYPreviousOpponent = HandYOpponent
  HandZPreviousOpponent = HandZOpponent
  
  ShotMadePreviousOpponent = ShotMadeOpponent
End If 'Replay

BallXOri = HandXOpponent
BallYOri = HandYOpponent
BallZOri = HandZOpponent
BallX = HandXOpponent
BallY = HandYOpponent
BallZ = HandZOpponent

BallVy = PowerOpponent / 50 * Sin(AngleOpponent * PI / 180)
BallVxz = PowerOpponent / 50 * Cos(AngleOpponent * PI / 180)
BallVx = BallVxz * Sin(AzimuthOpponent * PI / 180)
BallVz = BallVxz * Cos(AzimuthOpponent * PI / 180)

t = 0
ShotMadeOpponent = False
StopLoop = False
Pause = False
CollisionCount = 0
CollisionCountLimit = 5
Do Until BallY < -10 Or BallZ < (LeadCupZOpponent - 24) Or BallZ > HandZOpponent Or ShotMadeOpponent = True Or StopLoop = True
  Do Until Not Pause
    DoEvents
  Loop
  'Picture1.Circle (BallA, BallB), BallApparentR, vbWhite
  'BallZ = BallZ2
  
  BallX = BallXOri + BallVx * t
  BallY = BallYOri + 0.5 * -9.81 * t ^ 2 + BallVy * t
  BallZ = BallZOri + BallVz * t
  'BallZ2 = BallZ
  CollisionCount = CollisionCount + 1
  
  If BallX > 24 Or BallX < -24 Then
    StopLoop = True
  End If
  
  If BallY <= 0 Then
    'Hit Table
    BallVy = TableDamping * (-BallVy + 9.81 * t)
    BallYOri = BallY
    BallXOri = BallX
    BallZOri = BallZ
    t = 0
    If (BallYOri + 0.5 * -9.81 * t ^ 2 + BallVy * t) < 0 Then
      BallYOri = 0
    End If
  End If

  Call TransformTo3D(BallX, BallY, BallZ, BallR, Theta, Phi, CameraX, CameraY, CameraZ, BallA, BallB, BallApparentR, aspectratio)
  Picture1.Circle (BallA, BallB), BallApparentR
  Call DrawScene

  DistanceSqrd = (4 * CupTopR) ^ 2

  If BallY < (CupYOpponent + CupHeight) Then
    For ctr = 1 To 10
      If CupsOpponent(ctr) Then
        DistanceSqrd2 = (CupXOpponent(ctr) - BallX) ^ 2 + (CupZOpponent(ctr) + LeadCupZOpponent - BallZ) ^ 2
        If DistanceSqrd2 < DistanceSqrd Then
          DistanceSqrd = DistanceSqrd2
          ClosestCup = ctr
        End If
      End If
    Next ctr
    If DistanceSqrd < CupTopR ^ 2 Then
    'Ball went in cup
      ShotMadeOpponent = True
      BallX = CupXOpponent(ClosestCup)
      BallY = CupYOpponent + BallR
      BallZ = CupZOpponent(ClosestCup) + LeadCupZOpponent
    End If
    If DistanceSqrd < (CupTopR + BallR) ^ 2 And CollisionCount > CollisionCountLimit Then
    'Ball Hit Side of Cup
      
      Xtemp = CupXOpponent(ClosestCup) - BallX
      Ztemp = (CupZOpponent(ClosestCup) + LeadCupZOpponent) - BallZ

      'Find angle from center of cup to center of ball in XZ plane
      If Xtemp = 0 Then
        If Ztemp > 0 Then
          q = PI / 2
        ElseIf Ztemp < 0 Then
          q = -PI / 2
        End If
      Else
        tang = Ztemp / Xtemp
        q = Atn(tang)
        If Xtemp < 0 Then
          q = q + PI
        End If
      End If

      'Find angle of ball velocity in XZ plane
      If BallVx = 0 Then
        If BallVz > 0 Then
          p = PI / 2
        ElseIf BallVz < 0 Then
          p = -PI / 2
        End If
      Else
        tang = BallVz / BallVx
        p = Atn(tang)
        If BallVx < 0 Then
          p = p + PI
        End If
      End If
      
      pdeg = p * 180 / PI
      qdeg = q * 180 / PI

      'Reflect ball off side of cup
      BallV = Sqr(BallVx ^ 2 + BallVz ^ 2)
      BallVx = SideDamping * (BallV * Cos(2 * q - p - PI))
      BallVz = SideDamping * (BallV * Sin(2 * q - p - PI))
      BallVy = 1 * (BallVy - 9.81 * t)
      BallXOri = CupXOpponent(ClosestCup) + (CupTopR + BallR) * Cos(q - PI) 'BallX
      BallYOri = BallY
      BallZOri = CupZOpponent(ClosestCup) + LeadCupZOpponent + (CupTopR + BallR) * Sin(q - PI) 'BallZ
      t = 0
      CollisionCount = 0
    End If
  End If
  
  If (BallY - BallR) < (CupYOpponent + CupHeight) And CollisionCount > CollisionCountLimit Then
    For ctr = 1 To 10
      If CupsOpponent(ctr) Then
        DistanceSqrd2 = (CupXOpponent(ctr) - BallX) ^ 2 + (CupZOpponent(ctr) + LeadCupZOpponent - BallZ) ^ 2
        If DistanceSqrd2 < DistanceSqrd Then
          DistanceSqrd = DistanceSqrd2
          ClosestCup = ctr
        End If
      End If
    Next ctr
    If DistanceSqrd < (CupTopR + BallR) ^ 2 Then
      'Hit Rim
      
      Xtemp = CupXOpponent(ClosestCup) - BallX
      Ztemp = (CupZOpponent(ClosestCup) + LeadCupZOpponent) - BallZ

      'Find angle from the rim to center of ball in XZ plane
      If Xtemp = 0 Then
        If Ztemp > 0 Then
          qxz = PI / 2
        ElseIf Ztemp < 0 Then
          qxz = -PI / 2
        End If
      Else
        tang = Ztemp / Xtemp
        qxz = Atn(tang)
        If Xtemp < 0 Then
          qxz = qxz + PI
        End If
      End If
      
      'Find angle of ball velocity in XZ plane
      If BallVx = 0 Then
        If BallVz > 0 Then
          pxz = PI / 2
        ElseIf BallVz < 0 Then
          pxz = -PI / 2
        End If
      Else
        tang = BallVz / BallVx
        pxz = Atn(tang)
        If BallVx < 0 Then
          pxz = pxz + PI
        End If
      End If
      pxzdeg = pxz * 180 / PI
      qxzdeg = qxz * 180 / PI
      
      RimX = CupXOpponent(ClosestCup) + CupTopR * Cos(qxz - PI)
      RimZ = CupZOpponent(ClosestCup) + LeadCupZOpponent + CupTopR * Sin(qxz - PI)
      RimY = CupYOpponent + CupHeight
      
      DistanceSqrd = (RimX - BallX) ^ 2 + (RimY - BallY) ^ 2 + (RimZ - BallZ) ^ 2
      If DistanceSqrd < BallR ^ 2 Then
        Ytemp = RimY - BallY
        Ztemp = RimZ - BallZ
  
        'Find angle from the rim to center of ball in the YZ plane
        If Ztemp = 0 Then
          If Ytemp > 0 Then
  qyz = PI / 2
          ElseIf Ytemp < 0 Then
  qyz = -PI / 2
          End If
        Else
          tang = Ytemp / Ztemp
          qyz = Atn(tang)
          If Ztemp < 0 Then
  qyz = qyz + PI
          End If
        End If
      
        BallVyTemp = BallVy - 9.81 * t
        'Find angle of ball velocity in YZ plane
        If BallVz = 0 Then
          If BallVyTemp > 0 Then
  pyz = PI / 2
          ElseIf BallVyTemp < 0 Then
  pyz = -PI / 2
          End If
        Else
          tang = BallVyTemp / BallVz
          pyz = Atn(tang)
          If BallVz < 0 Then
  pyz = pyz + PI
          End If
        End If
        pyzdeg = pyz * 180 / PI
        qyzdeg = qyz * 180 / PI
        
        RimX = CupXOpponent(ClosestCup) + CupTopR * Cos(qxz - PI)
        RimZ = CupZOpponent(ClosestCup) + LeadCupZOpponent + CupTopR * Sin(qxz - PI)
        RimY = CupYOpponent + CupHeight
      
        BallVxz = Sqr(BallVx ^ 2 + BallVz ^ 2)
        BallVzy = Sqr(BallVz ^ 2 + BallVyTemp ^ 2)
        BallVz = RimDamping * (BallVzy * Cos(2 * qyz - pyz - PI))
        BallVy = RimDamping * (BallVzy * Sin(2 * qyz - pyz - PI))
        BallVx = RimDamping * (BallVxz * Cos(2 * qxz - pxz - PI))
        If (BallVx ^ 2 + BallVy ^ 2 + BallVz ^ 2) < 9 Then
          BallVx = 2 * BallVx
          BallVz = 2 * BallVz
          BallVy = 2 * BallVy
        End If
        test1 = BallVz - BallVxz
        test2 = BallVy - BallVxz
        BallXOri = BallX 'RimX + BallR * Cos(qxz - PI) 'CupX(ClosestCup) + (CupTopR + BallR) * Cos(qxz - PI) 'BallX
        BallYOri = BallY 'RimY + BallR * Sin(qyz - PI) 'BallY 'BallY
        BallZOri = BallZ 'RimZ + BallR * Cos(qyz - PI) 'BallZ 'CupZ(ClosestCup) + LeadCupZ + (CupTopR + BallR) * Sin(q - PI) 'BallZ
        t = 0
        CollisionCount = 0
      End If
      
    End If
  End If
  

  t = t + 0.01
  For ctr = 1 To Int(ShotFactor * CalibrationFactor * SlowMotionFactor)
    DoEvents
  Next ctr
Loop
Call DrawScene

If ShotMadeOpponent = True Then
  If Not Replay Then
    NumberCupsOpponent = NumberCupsOpponent - 1
  End If
  CupsOpponent(ClosestCup) = False
    BallX = HandX
    BallY = HandY
    BallZ = HandZ
  If NumberCupsOpponent = 6 Then
    For ctr = 1 To 6
      CupsOpponent(ctr) = True
    Next ctr
    For ctr = 7 To 10
      CupsOpponent(ctr) = False
    Next ctr
    LeadCupZOpponent = LeadCupZOpponent - CupTopR * Sqr(3)
  End If
  If NumberCupsOpponent = 3 Then
    CupsOpponent(1) = False
    CupsOpponent(2) = False
    CupsOpponent(3) = False
    CupsOpponent(4) = False
    CupsOpponent(6) = False
    CupsOpponent(7) = False
    CupsOpponent(10) = False
    CupsOpponent(5) = True
    CupsOpponent(8) = True
    CupsOpponent(9) = True
    LeadCupZOpponent = LeadCupZOriOpponent
  End If
  If NumberCupsOpponent = 0 And Not Replay Then
    PlayAgain = MsgBox("You just lost.  Do you want to play again?", vbYesNo)
    If PlayAgain = 6 Then
      Call InitVars
      Call DrawScene
    End If
  Else
    StartTime = Timer
    Do Until Timer > StartTime + 3
      DoEvents
    Loop
  End If
  Call DrawScene
End If

ShotStage = 0

If Replay Then
  Replay = False
  For ctr = 1 To 10
    CupsOpponent(ctr) = CupsActualOpponent(ctr)
    CupXOpponent(ctr) = CupXActualOpponent(ctr)
    CupZOpponent(ctr) = CupZActualOpponent(ctr)
  Next ctr
  CupYOpponent = CupYActualOpponent
  LeadCupZOpponent = LeadCupZActualOpponent
  LeadCupZOriOpponent = LeadCupZOriActualOpponent
  ShotMadeOpponent = shotMadeActualOpponent
End If

CommandShoot.Caption = "Shoot"
CommandShoot.Enabled = True
End Sub 'ShootBallOpponent