frmform.frm

visual basic课程设计案例精编

                    End If
                    Judge_Rotate = False
                    Exit Function
                End If
            Case 2  '2字
                If intRotate Mod 2 = 0 Then
                    Judge_Rotate = Get_Y_Value
                    Exit Function
                Else
                    Judge_Rotate = Get_X_Value
                    Exit Function
                End If
            Case 3  '7字
                Select Case intRotate Mod 4
                    Case 0
                        Judge_Rotate = Get_X_Value
                        Exit Function
                    Case 1
                        Judge_Rotate = Get_Y_Value
                        Exit Function
                    Case 2
                        Judge_Rotate = Get_X_Value
                        Exit Function
                    Case 3
                        Judge_Rotate = Get_Y_Value
                        Exit Function
                End Select
            Case 4  'T字
                Select Case intRotate Mod 4
                    Case 0
                        Judge_Rotate = Get_Y_Value
                        Exit Function
                    Case 1
                        Judge_Rotate = Get_X_Value
                        Exit Function
                    Case 2
                        Judge_Rotate = Get_Y_Value
                        Exit Function
                    Case 3
                        Judge_Rotate = Get_X_Value
                        Exit Function
                End Select
            Case 5  '反7字
                Select Case intRotate Mod 4
                    Case 0
                        Judge_Rotate = Get_X_Value
                        Exit Function
                    Case 1
                        Judge_Rotate = Get_Y_Value
                        Exit Function
                    Case 2
                        Judge_Rotate = Get_X_Value
                        Exit Function
                    Case 3
                        Judge_Rotate = Get_Y_Value
                        Exit Function
                End Select
            Case 6  '反2字
                If intRotate Mod 2 = 0 Then
                    Judge_Rotate = Get_Y_Value
                    Exit Function
                Else
                    Judge_Rotate = Get_X_Value
                    Exit Function
                End If
        End Select
End Function

Function JudgeX_Left()
'判断能否向左移动
    Call GetCoor
    For i = 1 To 4
            On Error Resume Next
            If Xs(i).cY > 0 Then
                If Total(Xs(i).cX - 1, Xs(i).cY) Or Xs(i).cX = 0 Then
                    JudgeX_Left = False
                    Exit Function
                End If
            End If
    Next
    JudgeX_Left = True
End Function

Function JudgeX_Right()
'判断能否向右移动
    GetCoor
    For i = 1 To 4
            On Error Resume Next
            If Xs(i).cY > 0 Then
                If Total(Xs(i).cX + 1, Xs(i).cY) Or Xs(i).cX = 10 Then
                    JudgeX_Right = False
                    Exit Function
                End If
            End If
    Next
    JudgeX_Right = True
End Function
'判断能否向下移动
    Sub JudgeY()
    GetCoor
    For i = 1 To 4
        If Xs(i).cZ Then
            On Error Resume Next
            If Xs(i).cY > 0 Then
                If Total(Xs(i).cX, Xs(i).cY + 1) Or Xs(i).cY = 20 Then
                    '如果不能移动，将4点位置的坐标设置为 True,并将图形固定下来
                    For j = 1 To 4
                        Total(Xs(j).cX, Xs(j).cY) = True
                    Next j
                    picBackGround.PaintPicture picPictureNow.Picture, picPictureNow.Left, picPictureNow.Top, picPictureNow.Width, picPictureNow.Height, , , , , vbSrcAnd
                    Judge_Full
                    If picPictureNow.Visible Then Init
                    Exit Sub
                End If
            End If
        End If
    Next
End Sub

Sub Sel_Next()
    '随机从 7 个放块中选择一个
    Randomize
    Type_Next = Int((7 * Rnd) + 1)
    Select Case Type_Next
        Case 1
            imgPictureNext.Picture = LoadResPicture(11, 0)
        Case 2
            imgPictureNext.Picture = LoadResPicture(13, 0)
        Case 3
            imgPictureNext.Picture = LoadResPicture(15, 0)
        Case 4
            imgPictureNext.Picture = LoadResPicture(19, 0)
        Case 5
            imgPictureNext.Picture = LoadResPicture(23, 0)
        Case 6
            imgPictureNext.Picture = LoadResPicture(27, 0)
        Case 7
            imgPictureNext.Picture = LoadResPicture(29, 0)
    End Select
    imgPictureNext.Move (picPictureNextBackGround.Width - imgPictureNext.Width) \ 2 - 30, (picPictureNextBackGround.Height - imgPictureNext.Height) \ 2 - 30
End Sub

Private Sub cmdDisplay_Click()
    imgPictureNext.Visible = Not (imgPictureNext.Visible)
    If imgPictureNext.Visible Then
        cmdDisplay.Caption = "隐藏(&D)"
    Else
        cmdDisplay.Caption = "显示(&S)"
    End If
End Sub

Private Sub Command1_Click()
    mnuGameNew_Click
End Sub

Private Sub Command2_Click()
    tmrDrop.Interval = 0
    Command1.Enabled = True
    Command2.Enabled = False
    frmForm.Cls
End Sub

Private Sub Command3_Click()
    End
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'改变 Case 的 KeyCode 值就可以改变键盘控制按钮
Select Case KeyCode
    Case vbKeyLeft
        If picPictureNow.Left - 1 >= 0 Then
            J_Value = JudgeX_Left
            If J_Value Then
                picPictureNow.Picture = imgPictureNowBackup.Picture
                r = BitBlt(picPictureTemp.hDC, 0, 0, picPictureNow.Width * 20, picPictureNow.Height * 20, picBackGround.hDC, (picPictureNow.Left - 1) * 20, picPictureNow.Top * 20, vbSrcCopy)
                picPictureNow.Left = picPictureNow.Left - 1
                r = BitBlt(picPictureNow.hDC, 0, 0, picPictureNow.Width * 20, picPictureNow.Height * 20, picPictureTemp.hDC, 0, 0, vbSrcAnd)
            End If
        End If
    Case vbKeyRight
        If picPictureNow.Left + picPictureNow.Width < picBackGround.ScaleWidth Then
            J_Value = JudgeX_Right
            If J_Value Then
                picPictureNow.Picture = imgPictureNowBackup.Picture
                r = BitBlt(picPictureTemp.hDC, 0, 0, picPictureNow.Width * 20, picPictureNow.Height * 20, picBackGround.hDC, (picPictureNow.Left + 1) * 20, picPictureNow.Top * 20, vbSrcCopy)
                picPictureNow.Left = picPictureNow.Left + 1
                r = BitBlt(picPictureNow.hDC, 0, 0, picPictureNow.Width * 20, picPictureNow.Height * 20, picPictureTemp.hDC, 0, 0, vbSrcAnd)
            End If
        End If
    Case vbKeyDown
        Call tmrDrop_Timer
    Case vbKeyUp
      If Judge_Rotate Then
        intRotate = intRotate + 1
        Select Case Type_Now
            Case 1  '长条
                If intRotate Mod 2 = 1 Then
                    picPictureNow.Picture = LoadResPicture(12, 0)
                    picPictureNow.Top = picPictureNow.Top + 3
                    picPictureNow.Left = Adjust_Left
                Else
                    picPictureNow.Picture = LoadResPicture(11, 0)
                    picPictureNow.Top = Adjust_Top
                    picPictureNow.Left = picPictureNow.Left + 1
                End If
            Case 2  '2字
                If intRotate Mod 2 = 1 Then
                    picPictureNow.Picture = LoadResPicture(14, 0)
                    picPictureNow.Top = Adjust_Top
                Else
                    picPictureNow.Picture = LoadResPicture(13, 0)
                    picPictureNow.Top = picPictureNow.Top + 1
                    picPictureNow.Left = Adjust_Left
                End If
            Case 3  '7字
                Select Case intRotate Mod 4
                    Case 0
                        picPictureNow.Picture = LoadResPicture(15, 0)
                        picPictureNow.Top = Adjust_Top
                    Case 1
                        picPictureNow.Picture = LoadResPicture(16, 0)
                        picPictureNow.Top = picPictureNow.Top + 1
                        picPictureNow.Left = Adjust_Left
                    Case 2
                        picPictureNow.Picture = LoadResPicture(17, 0)
                        picPictureNow.Top = Adjust_Top
                    Case 3
                        picPictureNow.Picture = LoadResPicture(18, 0)
                        picPictureNow.Top = picPictureNow.Top + 1
                        picPictureNow.Left = Adjust_Left
                End Select
            Case 4  'T字
                Select Case intRotate Mod 4
                    Case 0
                        picPictureNow.Picture = LoadResPicture(19, 0)
                        picPictureNow.Top = picPictureNow.Top + 1
                        picPictureNow.Left = Adjust_Left
                    Case 1
                        picPictureNow.Picture = LoadResPicture(20, 0)
                        picPictureNow.Top = Adjust_Top
                    Case 2
                        picPictureNow.Picture = LoadResPicture(21, 0)
                        picPictureNow.Top = picPictureNow.Top + 1
                        picPictureNow.Left = Adjust_Left
                    Case 3
                        picPictureNow.Picture = LoadResPicture(22, 0)
                        picPictureNow.Top = Adjust_Top
                End Select
            Case 5  '反7字
                Select Case intRotate Mod 4
                    Case 0
                        picPictureNow.Picture = LoadResPicture(23, 0)
                        picPictureNow.Top = Adjust_Top
                    Case 1
                        picPictureNow.Picture = LoadResPicture(24, 0)
                        picPictureNow.Top = picPictureNow.Top + 1
                        picPictureNow.Left = Adjust_Left
                    Case 2
                        picPictureNow.Picture = LoadResPicture(25, 0)
                        picPictureNow.Top = Adjust_Top
                    Case 3
                        picPictureNow.Picture = LoadResPicture(26, 0)
                        picPictureNow.Top = picPictureNow.Top + 1
                        picPictureNow.Left = Adjust_Left
                End Select
            Case 6  '反2字
                If intRotate Mod 2 = 1 Then
                    picPictureNow.Picture = LoadResPicture(28, 0)
                    picPictureNow.Top = Adjust_Top
                Else
                    picPictureNow.Picture = LoadResPicture(27, 0)
                    picPictureNow.Top = picPictureNow.Top + 1
                    picPictureNow.Left = Adjust_Left
                End If
        End Select
        imgPictureNowBackup.Picture = picPictureNow.Picture
      End If
End Select
End Sub

Private Sub HScroll1_Change()
    If tmrDrop.Interval <> 0 Then
        '改变 tmrDrop 的 Interval 值即可改变游戏速度
        tmrDrop.Interval = HScroll1.Value
        Label1.Caption = "速度： " + Str(600 - HScroll1.Value)
    End If
End Sub

Private Sub mnuGameAbout_Click()
    MsgBox "VB课程设计实例" + Chr$(13) + Chr$(10) + "——俄罗斯方块" + Chr$(13) + Chr$(10) + "     2001.12", 0, "关于俄罗斯方块"
End Sub

Private Sub mnuGameExit_Click()
    End
End Sub

Private Sub mnuGameNew_Click()
    '将 10x20 的坐标全部设置为空
    For i = 1 To 10
        For j = 0 To 20
            Total(i, j) = False
        Next j
    Next i
    CurX = 0
    picBackGround.Cls
    Sel_Next
    Init
    Command1.Enabled = False
    Command2.Enabled = True
End Sub

Private Sub mnuHelpKey_Click()
'游戏规则
    MsgBox "← 控制方块向左移动" + vbCrLf _
            + "→ 控制方块向右移动" _
            + vbCrLf + "↓ 控制方块向下快速移动" _
            + vbCrLf + "↑ 控制方块的顺时针方向的翻转", 64, "游戏规则"
End Sub

Private Sub tmrDrop_Timer()
'方块下落
    Call JudgeY
    picPictureNow.Picture = imgPictureNowBackup.Picture
    r = BitBlt(picPictureTemp.hDC, 0, 0, picPictureNow.Width * 20, picPictureNow.Height * 20, picBackGround.hDC, picPictureNow.Left * 20, (picPictureNow.Top + 1) * 20, vbSrcCopy)
    picPictureNow.Top = picPictureNow.Top + 1
    r = BitBlt(picPictureNow.hDC, 0, 0, picPictureNow.Width * 20, picPictureNow.Height * 20, picPictureTemp.hDC, 0, 0, vbSrcAnd)
    DoEvents
    If picPictureNow.Top + picPictureNow.Height > picBackGround.ScaleHeight Then Init
End Sub