mine.frm

vb精彩编程希望大家有用

           For Y1 = mY To mY + 2
               If X1 = mX + 1 And Y1 = mY + 1 Then
               Else
                  If X1 >= 1 And X1 <= NowWidth Then
                     If Y1 >= 1 And Y1 <= NowHeight Then
                        x2 = X1: y2 = Y1
                        Picture1_MouseUp vbLeftButton, 0, x2, y2
                     End If
                  End If
                  
               End If
           Next
       Next
          Exit Sub
       End If
    End If
    End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, _
    X As Single, Y As Single)
If Button = vbLeftButton Then
   '左击
   If What(mX + 1, mY + 1) = 10 Then
      '点到雷
      Timer1.Enabled = False
      Picture1.PaintPicture Image1(13).Picture, mX, mY
      Picture1.Enabled = False
      Label3 = "哇！你点到雷了呀！重来吧！！！"
      EndGame
      Timer1 = False
      Picture1.Enabled = False
      Exit Sub
   ElseIf What(mX + 1, mY + 1) >= 1 And What(mX + 1, mY + 1) <= 9 Then
      '点到数字
      OpenFlag = OpenFlag + 1
      Picture1.PaintPicture Image1(What(mX + 1, mY + 1)).Picture, mX, mY
      What(mX + 1, mY + 1) = -What(mX + 1, mY + 1)
   ElseIf What(mX + 1, mY + 1) = 0 Then
      '点到空
      Picture1.PaintPicture Image1(0).Picture, mX, mY
      What(mX + 1, mY + 1) = 11
      OpenBlank mX + 1, mY + 1
   End If
   If MineFlag + OpenFlag = NowHeight * NowWidth Then
      Label3 = "恭喜恭喜！你过关了！"
      Timer1.Enabled = False
      Picture1.Enabled = False
   End If
ElseIf Button = vbRightButton Then
   '右击
   If What(mX + 1, mY + 1) >= 0 And What(mX + 1, mY + 1) <= 10 Then
      '未标记过的进行标记
      Save(mX + 1, mY + 1) = What(mX + 1, mY + 1)
      What(mX + 1, mY + 1) = 13
      Picture1.PaintPicture Image1(10).Picture, mX, mY
      MineFlag = MineFlag + 1
      Label1 = TotMine - MineFlag
   ElseIf What(mX + 1, mY + 1) = 13 Then
      '已经标记过则改为?
      What(mX + 1, mY + 1) = 14
      MineFlag = MineFlag - 1
      Label1 = TotMine - MineFlag
      Picture1.PaintPicture Image1(11).Picture, mX, mY
   ElseIf What(mX + 1, mY + 1) = 14 Then
      '标记过?号的则
      What(mX + 1, mY + 1) = Save(mX + 1, mY + 1)
      Picture1.PaintPicture Image1(9).Picture, mX, mY
   End If
End If
End Sub
Private Sub ClearStart(ByVal mWidth As Long, ByVal mHeight As Long, ByVal MineNumber As Long)
    '预置雷位置
    Randomize
    mTime = 0
    MineFlag = 0
    OpenFlag = 0
    '清空数组
    Erase What
    For T = 1 To MineNumber
aa:
        '任意取一个坐标(X,Y)
        X = Rnd * (mWidth - 1)
        Y = Rnd * (mHeight - 1)
        '如果已经取过该坐标则重新再取
        If What(X + 1, Y + 1) = 10 Then GoTo aa
        '将当前坐标标记为有雷
        What(X + 1, Y + 1) = 10
        Save(X + 1, Y + 1) = 10
    Next
End Sub
Private Sub WriteNumber(ByVal mWidth As Long, ByVal mHeight As Long)
    '写入信息
    Dim X As Long
    Dim Y As Long
    Dim StartX As Long
    Dim StartY As Long
    Dim EndX As Long
    Dim EndY As Long
    Dim T As Long
    Dim TT
    Dim mNumber As Long
    
    For X = 1 To mWidth
        '从当前列的上一列开始
        StartX = X - 1
        If StartX = 0 Then StartX = 1
        '在当前列的下一列结束
        EndX = X + 1
        If EndX > mWidth Then EndX = mWidth
        For Y = 1 To mHeight
            '如果当前位置不是雷则开始计算
            If What(X, Y) <> 10 Then
               '从当前行的上一行开始
               StartY = Y - 1
               If StartY = 0 Then StartY = 1
               '在当前行的下一行结束
               EndY = Y + 1
               If EndY > mHeight Then EndY = mHeight
               '累加器置0
               mNumber = 0
               '计算四周有多少颗雷
               For T = StartX To EndX
                   For TT = StartY To EndY
                       If TT = Y And T = X Then
                         '如果是当前位置则不计入
                       Else
                          '如果是雷则计入
                          If What(T, TT) = 10 Then mNumber = mNumber + 1
                       End If
                   Next
              Next
              If mNumber = 0 Then
                 '如果没有雷在其四周则打开当前位置
                 What(X, Y) = 0
                 Save(X, Y) = 0
              Else
                 '写入雷数
                 What(X, Y) = mNumber
                 Save(X, Y) = mNumber
              End If
           End If
        Next
    Next
End Sub
Private Sub Timer1_Timer()
    Dim sTime As String
    Dim mM As Long
    Dim mS As Long
    Dim sM As String
    Dim sS As String
    mTime = mTime + 1
    mM = Int(mTime / 60)
    mS = mTime - mM * 60
    sS = mS
    sM = mM
    If sM < 10 Then sM = "0" & sM
    If sS < 10 Then sS = "0" & mS
    Label2 = sM & ":" & sS
End Sub
Private Sub OpenBlank(ByVal zmX As Long, ByVal zmY As Long)
    Dim Continue As Boolean
    Dim mX As Long
    Dim mY As Long
    OpenFlag = OpenFlag + 1
    Do While True
       Continue = False
       For mY = 1 To NowHeight
           For mX = 1 To NowWidth
               If What(mX, mY) = 11 Then
                  '如果存在未判断的空
                  Continue = True
                  '把它周围的8个点打开
                  '先打开左面的点
                  If mX - 1 >= 1 Then
                     If What(mX - 1, mY) = 0 Then
                        What(mX - 1, mY) = 11
                        Picture1.PaintPicture Image1(0).Picture, mX - 2, mY - 1
                        OpenFlag = OpenFlag + 1
                     ElseIf What(mX - 1, mY) >= 1 And What(mX - 1, mY) <= 9 Then
                        Picture1.PaintPicture Image1(What(mX - 1, mY)).Picture, mX - 2, mY - 1
                        What(mX - 1, mY) = -What(mX - 1, mY)
                        OpenFlag = OpenFlag + 1
                     End If
                  End If
                  '打开左上的点
                  If mX - 1 >= 1 And mY - 1 >= 1 Then
                        If What(mX - 1, mY - 1) = 0 Then
                           What(mX - 1, mY - 1) = 11
                           Picture1.PaintPicture Image1(0).Picture, mX - 2, mY - 2
                           OpenFlag = OpenFlag + 1
                        ElseIf What(mX - 1, mY - 1) >= 1 And What(mX - 1, mY - 1) <= 9 Then
                           Picture1.PaintPicture Image1(What(mX - 1, mY - 1)).Picture, mX - 2, mY - 2
                           What(mX - 1, mY - 1) = -What(mX - 1, mY - 1)
                           OpenFlag = OpenFlag + 1
                        End If
                  End If
                  '再打开上面的点
                  If mY - 1 >= 1 Then
                     If What(mX, mY - 1) = 0 Then
                        What(mX, mY - 1) = 11
                        Picture1.PaintPicture Image1(0).Picture, mX - 1, mY - 2
                        OpenFlag = OpenFlag + 1
                     ElseIf What(mX, mY - 1) >= 1 And What(mX, mY - 1) <= 9 Then
                        Picture1.PaintPicture Image1(What(mX, mY - 1)).Picture, mX - 1, mY - 2
                        What(mX, mY - 1) = -What(mX, mY - 1)
                        OpenFlag = OpenFlag + 1
                     End If
                  End If
                  '打开右上的点
                  If mY - 1 >= 1 And mX + 1 <= NowWidth Then
                        If What(mX + 1, mY - 1) = 0 Then
                           What(mX + 1, mY - 1) = 11
                           Picture1.PaintPicture Image1(0).Picture, mX, mY - 2
                           OpenFlag = OpenFlag + 1
                        ElseIf What(mX + 1, mY - 1) >= 1 And What(mX + 1, mY - 1) <= 9 Then
                           Picture1.PaintPicture Image1(What(mX + 1, mY - 1)).Picture, mX, mY - 2
                           What(mX + 1, mY - 1) = -What(mX + 1, mY - 1)
                           OpenFlag = OpenFlag + 1
                        End If
                  End If
                  '再打开右面的点
                  If mX + 1 <= NowWidth Then
                     If What(mX + 1, mY) = 0 Then
                        What(mX + 1, mY) = 11
                        Picture1.PaintPicture Image1(0).Picture, mX, mY - 1
                        OpenFlag = OpenFlag + 1
                     ElseIf What(mX + 1, mY) >= 1 And What(mX + 1, mY) <= 9 Then
                        Picture1.PaintPicture Image1(What(mX + 1, mY)).Picture, mX, mY - 1
                        What(mX + 1, mY) = -What(mX + 1, mY)
                        OpenFlag = OpenFlag + 1
                     End If
                  End If
                  '再打开右下的点
                  If mY + 1 <= NowHeight And mX + 1 <= NowWidth Then
                        If What(mX + 1, mY + 1) = 0 Then
                           What(mX + 1, mY + 1) = 11
                           Picture1.PaintPicture Image1(0).Picture, mX, mY
                           OpenFlag = OpenFlag + 1
                        ElseIf What(mX + 1, mY + 1) >= 1 And What(mX + 1, mY + 1) <= 9 Then
                           Picture1.PaintPicture Image1(What(mX + 1, mY + 1)).Picture, mX, mY
                           What(mX + 1, mY + 1) = -What(mX + 1, mY + 1)
                           OpenFlag = OpenFlag + 1
                        End If
                  End If
                  '打开下面的点
                  If mY + 1 <= NowHeight Then
                     If What(mX, mY + 1) = 0 Then
                        What(mX, mY + 1) = 11
                        Picture1.PaintPicture Image1(0).Picture, mX - 1, mY
                        OpenFlag = OpenFlag + 1
                     ElseIf What(mX, mY + 1) >= 1 And What(mX, mY + 1) <= 9 Then
                        Picture1.PaintPicture Image1(What(mX, mY + 1)).Picture, mX - 1, mY
                        What(mX, mY + 1) = -What(mX, mY + 1)
                        OpenFlag = OpenFlag + 1
                     End If
                  End If
                  '最后打开左下的点
                  If mY + 1 <= NowHeight And mX - 1 >= 1 Then
                        If What(mX - 1, mY + 1) = 0 Then
                           What(mX - 1, mY + 1) = 11
                           Picture1.PaintPicture Image1(0).Picture, mX - 2, mY
                           OpenFlag = OpenFlag + 1
                        ElseIf What(mX - 1, mY + 1) >= 1 And What(mX - 1, mY + 1) <= 9 Then
                           Picture1.PaintPicture Image1(What(mX - 1, mY + 1)).Picture, mX - 2, mY
                           What(mX - 1, mY + 1) = -What(mX - 1, mY + 1)
                           OpenFlag = OpenFlag + 1
                        End If
                  End If
                  '四点判断完后将本点标记为已判断过
                  What(mX, mY) = 12
               End If
           Next
       Next
       If Continue = False Then Exit Do
    Loop
End Sub
Private Sub EndGame()
    Dim X As Long
    Dim Y As Long
    For Y = 1 To NowHeight
        For X = 1 To NowWidth
            If What(X, Y) = 10 Then
               Picture1.PaintPicture Image1(13).Picture, X - 1, Y - 1
            Else
               If What(X, Y) = 13 Then
                  If Save(X, Y) <> 10 Then
                     Picture1.PaintPicture Image1(12).Picture, X - 1, Y - 1
                  End If
               ElseIf What(X, Y) = 14 Then
                  If Save(X, Y) = 10 Then
                     Picture1.PaintPicture Image1(13).Picture, X - 1, Y - 1
                  End If
               End If
            End If
        Next
    Next
End Sub