frmform.frm

一个俄罗斯方块的小游戏,是用VB做的,有完整的源代码

                            If MaxX - CurX <= 2 Then
                                Adjust_Left = MaxX - 3 - 1
                            Else
                                If CurX = MinX Then
                                    Adjust_Left = CurX - 1
                                Else
                                    Adjust_Left = CurX - 1 - 1
                                End If
                            End If
                            Judge_Rotate = True
                            Exit Function
                        End If
                    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()
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 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
        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 mnuGameAbout_Click()
MsgBox "旋转俄罗斯 1.0 Demo", vbInformation
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
'改变 tmrDrop 的 Interval 值即可改变游戏速度
tmrDrop.Interval = 1000
Sel_Next
Init
End Sub

Private Sub mnuHelpKey_Click()
MsgBox "键盘控制方法：" + vbCrLf + "← 控制方块向左移动；" _
        + vbCrLf + "→ 控制方块向右移动；" _
        + vbCrLf + "↓ 控制方块向下快速移动；" _
        + vbCrLf + "↑ 控制方块的顺时针方向的翻转。", 64, "旋转俄罗斯 1.0 键盘操作帮助"
End Sub

Private Sub tmrDrop_Timer()
'方块下落
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