?? frmform.frm

?? visual basic課程設計案例精編
?? FRM
?? 第 1 頁 / 共 3 頁
字號:
上一頁 1 23
                    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
上一頁 1 23
?? 文件大小 2422 K
?? 上傳用戶 xufengping716
?? 所屬分類系統設計方案
??? 相關標簽

#visual #basic #案例 #精編
?? 快捷鍵說明

復制代碼 Ctrl + C
搜索代碼 Ctrl + F
全屏模式 F11
切換主題 Ctrl + Shift + D
顯示快捷鍵 ?
增大字號 Ctrl + =
減小字號 Ctrl + -
亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频

?? frmform.frm

?? 快捷鍵說明
