Source Code
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Const SRCINVERT = &H660046 ' (DWORD) dest = source XOR dest
Const SRCAND = &H8800C6 ' (DWORD) dest = source AND dest
Dim handx%, handy% 'current hand position
Dim handpos% 'how far through a swing
Const hand_up = 0
Const hand_down = 1
Const hand_hit = 2
Dim ratx%(2, 2), raty%(2, 2), ratpos%(2, 2)
Dim ratspeed%(2, 2)
'hold the sprites
Dim spnx%(15), spny%(15), spnw%(15), spnh%(15), spnox%(15), spnoy%(15)
' game status
Dim difficulty% 'start at 0, (easy), 8=hard
' current frame (will just increment)
' (hopefully won't play till it overflows ;)
Dim frame As Long
'score
Dim score% '+/- 32000 should cover it
Private Sub Command1_Click()
frame = 0
score% = 0
Level% = Val(InputBox("Choose a difficulty from 0 to 8" & Chr$(13) & "8 being the hardest."))
If Level% > 8 Then difficulty% = 8 Else difficulty% = Level%
Timer1.Enabled = True
MousePointer = 99
End Sub
Private Sub Form_Load()
Randomize
u& = BitBlt(Picbuf.hDC, 0, 0, Picbuf.ScaleWidth, Picbuf.ScaleHeight, Picbak.hDC, 0, 0, SRCCOPY)
Timer1.Enabled = False
MousePointer = 0
'load up the sprites
Open App.Path & "\whack_img.spr" For Random As #1 Len = 2
For a% = 0 To 14
Get #1, a% * 6 + 1, spnox%(a% + 1)
Get #1, a% * 6 + 2, spnoy%(a% + 1)
Get #1, a% * 6 + 3, spnx%(a% + 1)
Get #1, a% * 6 + 4, spny%(a% + 1)
Get #1, a% * 6 + 5, spnw%(a% + 1)
Get #1, a% * 6 + 6, spnh%(a% + 1)
Next
Close #1
'position the rats over their holes
stickrat 0, 0, 187, 48, 0
stickrat 1, 0, 127, 79, 0
stickrat 2, 0, 75, 116, 0
stickrat 0, 1, 247, 58, 0
stickrat 1, 1, 189, 90, 0
stickrat 2, 1, 146, 126, 0
stickrat 0, 2, 304, 66, 0
stickrat 1, 2, 262, 98, 0
stickrat 2, 2, 222, 134, 0
End Sub
Sub stickrat(row%, col%, X%, Y%, pos%)
ratx%(row%, col%) = X%
raty%(row%, col%) = Y%
ratpos%(row%, col%) = pos%
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If handpos% = hand_up Then handpos% = hand_down
For col% = 0 To 2
For row% = 0 To 2
sp% = ratpos%(row%, col%)
If sp% > 0 And sp% <= 12 Then
'this rat is trying to popup!
If X > ratx%(row%, col%) + spnox%(sp%) And X < ratx%(row%, col%) + spnox%(sp%) + spnw%(sp%) Then
'inside the left and right of the sprite
If Y > raty%(row%, col%) + spnoy%(sp%) And Y < raty%(row%, col%) + spnoy%(sp%) + spnh%(sp%) Then
'inside the top & bottom too!
'add up the score
score% = score% + ratpos%(row%, col%) * 3
u& = sndPlaySound(App.Path & "\whack_pop.wav", 1)
ratpos%(row%, col%) = 13
ratspeed%(row%, col%) = 10 '10 frames to fade away
End If
End If
End If
Next
Next
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
handpos% = hand_up
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
handx% = X - 15
handy% = Y - 40
End Sub
Private Sub Form_Paint()
u& = BitBlt(hDC, 0, 0, Picbuf.ScaleWidth, Picbuf.ScaleHeight, Picbuf.hDC, 0, 0, SRCCOPY)
End Sub
Private Sub Timer1_Timer()
'copy from background
u& = BitBlt(Picbuf.hDC, 0, 0, Picbuf.ScaleWidth, Picbuf.ScaleHeight, Picbak.hDC, 0, 0, SRCCOPY)
frame = frame + 1
popuprats
'update score and time
Picbuf.CurrentX = 90
Picbuf.CurrentY = 10
Picbuf.Print "Score : " & score%
Picbuf.CurrentX = 90
Picbuf.Print "Time : " & (1000 - frame)
If frame = 1000 Then
'thats the end of this game
Timer1.Enabled = False
MousePointer = 0
End If
'draw some rats
For col% = 0 To 2
For row% = 0 To 2
drawarat ratx%(row%, col%), raty%(row%, col%), ratpos%(row%, col%)
updateRat row%, col%
Next
Next
'place the sprite of the hand
drawhand
'copy to screen
u& = BitBlt(hDC, 0, 0, Picbuf.ScaleWidth, Picbuf.ScaleHeight, Picbuf.hDC, 0, 0, SRCCOPY)
End Sub
Sub drawhand()
Select Case handpos%
Case hand_up
u& = BitBlt(Picbuf.hDC, handx%, handy%, 97, 54, Picmsk.hDC, 0, 0, SRCAND)
u& = BitBlt(Picbuf.hDC, handx%, handy%, 97, 54, Picimg.hDC, 0, 0, SRCINVERT)
Case hand_hit
u& = BitBlt(Picbuf.hDC, handx%, handy%, 90, 64, Picmsk.hDC, 0, 118, SRCAND)
u& = BitBlt(Picbuf.hDC, handx%, handy%, 90, 64, Picimg.hDC, 0, 118, SRCINVERT)
Case hand_down
u& = BitBlt(Picbuf.hDC, handx%, handy% - 6, 90, 64, Picmsk.hDC, 0, 54, SRCAND)
u& = BitBlt(Picbuf.hDC, handx%, handy% - 6, 90, 64, Picimg.hDC, 0, 54, SRCINVERT)
End Select
End Sub
Sub drawarat(X%, Y%, cell%)
If cell% > 0 Then
u& = BitBlt(Picbuf.hDC, X% + spnox%(cell%), Y% + spnoy%(cell%), spnw%(cell%), spnh%(cell%), Picmsk.hDC, spnx%(cell%), spny%(cell%), SRCAND)
u& = BitBlt(Picbuf.hDC, X% + spnox%(cell%), Y% + spnoy%(cell%), spnw%(cell%), spnh%(cell%), Picimg.hDC, spnx%(cell%), spny%(cell%), SRCINVERT)
End If
End Sub
Sub updateRat(row%, col%)
If ratpos%(row%, col%) <= 12 And ratpos%(row%, col%) > 0 Then
'if the rat has started popping up!
'check if time has elapsed sufficent for the speed
If frame Mod ratspeed%(row%, col%) = 0 Then
'e.g. the bigger the speed, the less frequently it will
'be an exact division (e.g. the slower the rat pops up)
ratpos%(row%, col%) = ratpos%(row%, col%) - 1
'change the frame
If ratpos%(row%, col%) = 0 Then
'the rat got away without a hit
score% = score% - 20
End If
End If
ElseIf ratpos%(row%, col%) > 12 Then
If frame Mod ratspeed%(row%, col%) = 0 Then
ratpos%(row%, col%) = ratpos%(row%, col%) + 1
If ratpos%(row%, col%) >= 15 Then
'finished animation, get rid of it
ratpos%(row%, col%) = 0
End If
End If
End If
End Sub
Sub popuprats()
'randomly created rats popping up at random speeds
'the harder the difficulty (higher the value)
'the more likely and the faster the rats.
If Int(Rnd(1) * (30 - difficulty%)) = 1 Then
rndrow% = Int(Rnd(1) * 2.99)
rndcol% = Int(Rnd(1) * 2.99)
If ratpos%(rndrow%, rndcol%) = 0 Then
ratpos%(rndrow%, rndcol%) = 12
ratspeed%(rndrow%, rndcol%) = Int(Rnd(1) * (8 - difficulty%)) + 1
End If
End If
End Sub
Happy Programing
David Brebner