Drop Box Game VB 6.0 Code

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

RANDOM COMMAND BUTTON SELECTION AND ELAPSED TIME USING VB

VB PROGRAM CODE:-

Private mintCount As Integer

Private Sub Command1_Click(Index As Integer)

Dim n As Integer

Static t As Integer

For n = 0 To 30

Command1(n).Caption = ""

Next

Randomize Timer

n = Int(Rnd * 31)

If Index = n Then

Command1(n).Caption = "0"

Command1(n).BackColor = vbRed

Else: Command1(n).Caption = "0"

Command1(n).BackColor = vbRed

End If

Label6.Caption = t

t = t + 1

End Sub

Private Sub Command2_Click()

 mintCount = 0

Cls

Timer1.Enabled = True

End Sub

Private Sub Command3_Click()

Timer1.Enabled = False

Label4.Caption = mintCount / 30

End Sub

Private Sub Timer1_Timer()

mintCount = mintCount + 1

Label2.Caption = mintCount

End Sub

OUTPUT:-