Drop Box Game VB 6.0 Code:-
-----------------------------------------------------------------------------------------------------
Dim rev As Boolean, Lastone As Boolean, noanim As Boolean
Dim CBLOCK As Byte, SYC As Integer, BAlive(255) As Boolean, LastLand As Byte
Dim TWrong As Byte, TCorrect As Byte, TBlocks As Byte, TRemain As Byte, Goal As Byte
Sub Annoy(mID As Byte)
Select Case mID
Case 0
PLand_T.ForeColor = vbBlack
PLand_T.Caption = "Get Ready!"
Case 1
PLand_T.ForeColor = vbBlue
PLand_T.Caption = "Perfect Landing!"
Case 2
PLand_T.ForeColor = vbRed
PLand_T.Caption = "MISSED!"
Case 3
PLand_T.ForeColor = vbBlack
PLand_T.Caption = "That was the Last one!"
cmdU.Visible = True
cmdD.Visible = True
End Select
PLand_T.Visible = True
PLand.Enabled = True
End Sub
Sub DropBlock()
'if a block is still falling, stop the procedure
If BlockLever.Enabled = True Or Lastone = True Then Exit Sub
If TRemain - 1 = 0 Then
'stop crane
CCMove.Enabled = False
'hide mother block
Block(0).Visible = False
'hide crane cable
CraneCable.Visible = False
Lastone = True
Call Annoy(3)
End If
'load a new one
CBLOCK = CBLOCK + 1
Load Block(CBLOCK) 'load block
Block(CBLOCK).ZOrder
Block(CBLOCK).Visible = True
BlockLever.Enabled = True
'every 2 correct blocks, screen goes up
'set total
TBlocks = CBLOCK
lbTotal.Caption = TBlocks
'show remaining
TRemain = Goal - TBlocks
lbRemain.Caption = TRemain
End Sub
Private Sub BlockLever_Timer()
Block(CBLOCK).Top = Block(CBLOCK).Top + 150
If CBLOCK = 1 Then
If Block(CBLOCK).Top + Block(CBLOCK).Height >= BaseBlock.Top Then
BlockLever.Enabled = False
BAlive(CBLOCK) = True
LastLand = 1
'annoy the correct
TCorrect = TCorrect + 1
lbCorrect.Caption = TCorrect
End If
Else
'Y offset X Position
If Block(CBLOCK).Top + Block(CBLOCK).Height >= Block(LastLand).Top - 150 And Block(CBLOCK).Left > Block(LastLand).Left - (Block(CBLOCK).Width \ 2) And Block(CBLOCK).Left < Block(LastLand).Left + Block(LastLand).Width - (Block(CBLOCK).Width \ 2) Then
BlockLever.Enabled = False
BAlive(CBLOCK) = True
'dock to correct y position
Block(CBLOCK).Top = Block(LastLand).Top - Block(CBLOCK).Height
'dock to correct x position on low differece
If Block(CBLOCK).Left > Block(LastLand).Left - 200 And Block(CBLOCK).Left < Block(LastLand).Left + 200 Then
Block(CBLOCK).Left = Block(LastLand).Left
'Perfect Land!
Call Annoy(1)
End If
LastLand = CBLOCK
'increment corrects
TCorrect = TCorrect + 1
lbCorrect.Caption = TCorrect
'every 2 correct blocks, screen goes up
If TCorrect Mod 2 = 0 Then ScreenAnim.Enabled = True
'last block
If TRemain = 1 Then
Block(0).Picture = LoadPicture("pix\HBlock.bmp")
End If
End If
End If
'if out
If Block(CBLOCK).Top > Me.Height Then
BlockLever.Enabled = False 'stop the lever
BAlive(CBLOCK) = False 'this block is dead
TWrong = TWrong + 1
lbWrong.Caption = TWrong
'last block
If TRemain = 1 Then
Block(0).Picture = LoadPicture("pix\HBlock.bmp")
End If
Call Annoy(2)
End If
End Sub
Private Sub CCMove_Timer()
If rev Then
'go right
Block(0).Left = Block(0).Left + 100
CraneCable.X2 = Block(0).Left + (Block(0).Width \ 2)
If Block(0).Left > BaseBlock.Left + BaseBlock.Width - (Block(0).Width \ 2) Then rev = False
Else
'go left
Block(0).Left = Block(0).Left - 100
CraneCable.X2 = Block(0).Left + (Block(0).Width \ 2)
'y wave under construction!
If Block(0).Left < BaseBlock.Left - (Block(0).Width \ 2) Then rev = True
End If
'Me.Caption = rev
End Sub
Private Sub cmdD_Click()
ScreenAnim.Enabled = True
End Sub
Private Sub cmdU_Click()
noanim = True
ScreenAnim.Enabled = True
End Sub
Private Sub Command1_Click()
End
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeySpace Then Call DropBlock 'drop the block when space key is hit
End Sub
Private Sub Form_Load()
CBLOCK = 0
rev = False 'move forward
Goal = 15 'max blocks
cmdU.Visible = False 'hide UP button
cmdD.Visible = False 'hide DOWN button
TRemain = Goal - TBlocks 'calculate remaining blocks
Call Annoy(0) 'show a message
End Sub
Private Sub PLand_Timer()
PLand_T.Visible = False 'hide message
PLand.Enabled = False 'disable the timer
End Sub
Private Sub ScreenAnim_Timer()
SYC = SYC + 1
jump = 225
If noanim Then jump = -225
For i = 1 To CBLOCK
'if block is alive
If BAlive(i) Then Block(i).Top = Block(i).Top + jump
Next i
BaseBlock.Top = BaseBlock.Top + jump
If SYC = 10 Then
noanim = False
SYC = 0
ScreenAnim.Enabled = False
End If
End Sub
No comments:
Post a Comment