1、经典俄罗斯方块演示：代码如下：Dim Type_Now As Integer 目前方块的类型Dim Type_Next As Integer 下个方块的类型Dim intRotate As Integer 方块旋转的状态Function Get_X_Value()If GetValue(1, 2) Then Get X ValueIf MaxX - MinX = 2 ThenIf MaxX - CurX Xs(i).cX Then MinX = Xs(i).cXIf MaxX Xs(i).cY Then MinY = Xs(i).cYIf MaxY = picPictureNow.Width
2、And OKCount = picPictureNow.Height ThenEmptyCount = EmptyCount + 1OKCount = 0ElseExit ForEnd IfNextMinY = MinY - EmptyCountIf MinY = picPictureNow.Width And OKCount = picPictureNow.Height ThenEmptyCount = EmptyCount + 1OKCount = 0ElseExit ForEnd IfNextMaxY = MaxY + EmptyCountIf MaxY 20 Then MaxY = 2
3、0Else Get X ValueEmptyCount = 0 Get MinXOKCount = 0For i = MinX - 1 To MinX - (nWid - 1) Step -1For j = MinY To MaxYIf Total(i, j) = False Then OKCount = OKCount + 1NextIf OKCount = picPictureNow.Width And OKCount = picPictureNow.Height ThenEmptyCount = EmptyCount + 1OKCount = 0ElseExit ForEnd IfNex
4、tMinX = MinX - EmptyCountIf MinX = picPictureNow.Width And OKCount = picPictureNow.Height ThenEmptyCount = EmptyCount + 1OKCount = 0ElseExit ForEnd IfNextMaxX = MaxX + EmptyCountIf MaxX 10 Then MaxX = 10End IfGetValue = TrueEnd FunctionFunction Get_Y_Value()If GetValue(0, 2) Then Get Y ValueIf MaxY
5、- MinY = 2 ThenIf MaxY - (picPictureNow.Top + 1) = 3 ThenAdjust_Top = MinY - 1Judge_Rotate = TrueExit FunctionEnd IfEnd IfJudge_Rotate = FalseExit FunctionElseIf GetValue(1, 4) Then Get X ValueIf MaxX - MinX = 3 ThenIf MaxX - CurX 0 ThenIf Total(Xs(i).cX - 1, Xs(i).cY) Or Xs(i).cX = 0 ThenJudgeX_Lef
6、t = FalseExit FunctionEnd IfEnd IfNextJudgeX_Left = TrueEnd FunctionFunction JudgeX_Right()判断能否向右移动GetCoorFor i = 1 To 4On Error Resume NextIf Xs(i).cY 0 ThenIf Total(Xs(i).cX + 1, Xs(i).cY) Or Xs(i).cX = 10 ThenJudgeX_Right = FalseExit FunctionEnd IfEnd IfNextJudgeX_Right = TrueEnd Function判断能否向下移动
7、Sub JudgeY()GetCoorFor i = 1 To 4If Xs(i).cZ ThenOn Error Resume NextIf Xs(i).cY 0 ThenIf Total(Xs(i).cX, Xs(i).cY + 1) Or Xs(i).cY = 20 Then如果不能移动，将 4 点位置的坐标设置为 True,并将图形固定下来For j = 1 To 4Total(Xs(j).cX, Xs(j).cY) = TrueNext jpicBackGround.PaintPicture picPictureNow.Picture, picPictureNow.Left, pic
8、PictureNow.Top, picPictureNow.Width, picPictureNow.Height, , , , , vbSrcAndJudge_FullIf picPictureNow.Visible Then InitExit SubEnd IfEnd IfEnd IfNextEnd SubSub Sel_Next()随机从 7 个放块中选择一个RandomizeType_Next = Int(7 * Rnd) + 1)Select Case Type_NextCase 1imgPictureNext.Picture = LoadResPicture(11, 0)Case
9、2imgPictureNext.Picture = LoadResPicture(13, 0)Case 3imgPictureNext.Picture = LoadResPicture(15, 0)Case 4imgPictureNext.Picture = LoadResPicture(19, 0)Case 5imgPictureNext.Picture = LoadResPicture(23, 0)Case 6imgPictureNext.Picture = LoadResPicture(27, 0)Case 7imgPictureNext.Picture = LoadResPicture
10、(29, 0)End SelectimgPictureNext.Move (picPictureNextBackGround.Width - imgPictureNext.Width) 2 - 30, (picPictureNextBackGround.Height - imgPictureNext.Height) 2 - 30End SubPrivate Sub cmdDisplay_Click()imgPictureNext.Visible = Not (imgPictureNext.Visible)If imgPictureNext.Visible ThencmdDisplay.Capt
11、ion = “隐藏(&D)“ElsecmdDisplay.Caption = “显示(&S)“End IfEnd SubPrivate Sub Command1_Click()mnuGameNew_ClickEnd SubPrivate Sub Command2_Click()tmrDrop.Interval = 0Command1.Enabled = TrueCommand2.Enabled = FalsefrmForm.ClsEnd SubPrivate Sub Command3_Click()EndEnd SubPrivate Sub Form_KeyDown(KeyCode As In
12、teger, Shift As Integer)改变 Case 的 KeyCode 值就可以改变键盘控制按钮Select Case KeyCodeCase vbKeyLeftIf picPictureNow.Left - 1 = 0 ThenJ_Value = JudgeX_LeftIf J_Value ThenpicPictureNow.Picture = imgPictureNowBackup.Picturer = BitBlt(picPictureTemp.hDC, 0, 0, picPictureNow.Width * 20, picPictureNow.Height * 20, pi
13、cBackGround.hDC, (picPictureNow.Left - 1) * 20, picPictureNow.Top * 20, vbSrcCopy)picPictureNow.Left = picPictureNow.Left - 1r = BitBlt(picPictureNow.hDC, 0, 0, picPictureNow.Width * 20, picPictureNow.Height * 20, picPictureTemp.hDC, 0, 0, vbSrcAnd)End IfEnd IfCase vbKeyRightIf picPictureNow.Left +
14、picPictureNow.Width 0 Then改变 tmrDrop 的 Interval 值即可改变游戏速度tmrDrop.Interval = HScroll1.ValueLabel1.Caption = “速度： “ + Str(600 - HScroll1.Value)End IfEnd SubPrivate Sub mnuGameAbout_Click()MsgBox “VB 课程设计实例 “ + Chr$(13) + Chr$(10) + “俄罗斯方块“ + Chr$(13) + Chr$(10) + “ 2006.8“, 0, “关于俄罗斯方块“End SubPrivate
15、Sub mnuGameExit_Click()EndEnd SubPrivate Sub mnuGameNew_Click()将 10x20 的坐标全部设置为空For i = 1 To 10For j = 0 To 20Total(i, j) = FalseNext jNext iCurX = 0picBackGround.ClsSel_NextInitCommand1.Enabled = FalseCommand2.Enabled = TrueEnd SubPrivate Sub mnuHelpKey_Click()游戏规则MsgBox “ 控制方块向左移动“ + vbCrLf _+ “ 控
16、制方块向右移动 “ _+ vbCrLf + “ 控制方块向下快速移动“ _+ vbCrLf + “ 控制方块的顺时针方向的翻转 “, 64, “游戏规则“End SubPrivate Sub tmrDrop_Timer()方块下落Call JudgeYpicPictureNow.Picture = imgPictureNowBackup.Picturer = BitBlt(picPictureTemp.hDC, 0, 0, picPictureNow.Width * 20, picPictureNow.Height * 20, picBackGround.hDC, picPictureNow.
17、Left * 20, (picPictureNow.Top + 1) * 20, vbSrcCopy)picPictureNow.Top = picPictureNow.Top + 1r = BitBlt(picPictureNow.hDC, 0, 0, picPictureNow.Width * 20, picPictureNow.Height * 20, picPictureTemp.hDC, 0, 0, vbSrcAnd)DoEventsIf picPictureNow.Top + picPictureNow.Height picBackGround.ScaleHeight Then InitEnd Sub
