?? winmine.cls
字號:
Dim CRLF As String
CRLF = Chr$(13) & Chr$(10)
MsgBox "You Lose!", vbExclamation, "WinMine"
Case Else: ' 如果當前的方格圍繞著包含有地雷的方格
' 展示這些包含地雷的方格的數目
mfrmDisplay.PaintPicture mfrmDisplay.imgPressed, mintCol, mintRow
mfrmDisplay.CurrentX = mintCol
mfrmDisplay.CurrentY = mintRow
mfrmDisplay.ForeColor = QBColor(mbytMineStatus(intY, intX))
mfrmDisplay.Print mbytMineStatus(intY, intX)
' 將其打開
mbytMineStatus(intY, intX) = mbytMineStatus(intY, intX) + BEEN
End Select
End If
End Sub
Public Property Set frmDisplay(frmDisplay As Form)
Set mfrmDisplay = frmDisplay
mfrmDisplay.FontBold = True
' 重新修改新游戲的外框邊界
ResizeDisplay
End Property
Public Sub GetMineFieldDimensions(frmDialog As Form)
frmDialog.txtRows = mintRows
frmDialog.txtColumns = mintCols
frmDialog.txtMines = mbytNumMines
frmDialog.txtRows.SelLength = Len(frmDialog.txtRows)
frmDialog.txtColumns.SelLength = Len(frmDialog.txtColumns)
frmDialog.txtMines.SelLength = Len(frmDialog.txtMines)
End Sub
Private Sub InitializeMineField()
ReDim mbytMineStatus(mintRows - 1, mintCols - 1)
ReDim mbytMarked(mintRows - 1, mintCols - 1)
ReDim mbytMineLocations(mbytNumMines - 1, 1)
' 隨機布置地雷
Randomize
Dim i As Integer ' 循環計數
Dim r As Integer ' 循環計數
Dim c As Integer ' 循環計數
For i = 0 To mbytNumMines - 1
Dim intX As Integer
Dim intY As Integer
intX = Int(Rnd * mintCols)
intY = Int(Rnd * mintRows)
While mbytMineStatus(intY, intX) = MINE
intX = Int(Rnd * mintCols)
intY = Int(Rnd * mintRows)
Wend
mbytMineStatus(intY, intX) = MINE
mbytMineLocations(i, 0) = intY
mbytMineLocations(i, 1) = intX
For r = -1 To 1
For c = -1 To 1
Dim blnDx As Boolean
Dim blnDy As Boolean
blnDy = intY + r >= 0 And intY + r < mintRows
blnDx = intX + c >= 0 And intX + c < mintCols
If blnDy And blnDx Then
If mbytMineStatus(intY + r, intX + c) <> MINE Then
mbytMineStatus(intY + r, intX + c) = mbytMineStatus(intY + r, intX + c) + 1
End If
End If
Next
Next
Next
End Sub
Public Sub NewGame()
' 刷新在當前界面的顯示
mfrmDisplay.Cls
' 重新設置變量和標注
mbytCorrectHits = 0
mbytTotalHits = 0
mintRow = -1
mintCol = -1
mblnNewGame = False
mblnHitTestBegun = False
Dim i As Integer ' 循環計數
' 清空錯誤坐標的計數
For i = 1 To mcolWrongLocations.Count
mcolWrongLocations.Remove 1
Next
' 重新計數地雷的位置
InitializeMineField
' 重新設置剩余地雷的數目
mfrmDisplay.lblMinesLeft = "Mines Left : " & mbytNumMines
End Sub
Private Sub OpenBlanks(ByVal intX As Single, ByVal intY As Single)
' 標示當前鼠標移動的標記
Dim blnGoUp As Boolean
Dim blnGoRight As Boolean
Dim blnGoDown As Boolean
Dim blnGoLeft As Boolean
Dim intXStart As Integer
Dim intYStart As Integer
' 用來標記收集條目的指數
Dim intPos As Integer
' 每個循環的變量
Dim element As Variant
' 循環計數
Dim y As Integer
Dim x As Integer
Dim i As Integer
Dim colX() As New Collection
ReDim colX(mintRows - 1)
While mbytMineStatus(intY, intX) = NONE
intX = intX - 1
If intX < 0 Then
intX = 0
intXStart = intX
intYStart = intY
GoTo LFT
End If
Wend
' 先移動的方向是向上
blnGoUp = True
' 利用第一個地雷坐標作為起始點
intXStart = intX
intYStart = intY
' 反復確定邊界,直到回到起始點
Do
If mbytMineStatus(intY, intX) = NONE Then
If blnGoUp Then
intX = intX - 1
intY = intY + 1
colX(intY).Remove (colX(intY).Count)
blnGoUp = False
blnGoLeft = True
ElseIf blnGoRight Then
intX = intX - 1
intY = intY - 1
blnGoRight = False
blnGoUp = True
ElseIf blnGoDown Then
intX = intX + 1
intY = intY - 1
colX(intY).Remove (colX(intY).Count)
blnGoDown = False
blnGoRight = True
ElseIf blnGoLeft Then
intX = intX + 1
intY = intY + 1
blnGoLeft = False
blnGoDown = True
End If
If (intXStart = intX And intYStart = intY) Then Exit Do
Else
If blnGoUp Then
colX(intY).Add intX
If mbytMineStatus(intY, intX + 1) = NONE Then
If intY = 0 Then
blnGoUp = False
UP: intX = intX + 1
If (intXStart = intX And intYStart = intY) Then Exit Do
While mbytMineStatus(intY, intX) = NONE
If intX = mintCols - 1 Then GoTo RIGHT
intX = intX + 1
If (intXStart = intX And intYStart = intY) Then Exit Do
Wend
blnGoDown = True
Else
intY = intY - 1
If (intXStart = intX And intYStart = intY) Then Exit Do
End If
Else
blnGoUp = False
blnGoRight = True
intX = intX + 1
If (intXStart = intX And intYStart = intY) Then
If colX(intY).Count Mod 2 <> 0 Then
intPos = 1
For Each element In colX(intY)
If element = intXStart Then
colX(intY).Remove (intPos)
Exit Do
End If
intPos = intPos + 1
Next
End If
Exit Do
End If
End If
ElseIf blnGoRight Then
If mbytMineStatus(intY + 1, intX) = NONE Then
If intX = mintCols - 1 Then
blnGoRight = False
RIGHT: colX(intY).Add intX
intY = intY + 1
If (intXStart = intX And intYStart = intY) Then Exit Do
While mbytMineStatus(intY, intX) = NONE
colX(intY).Add intX
If intY = mintRows - 1 Then GoTo DOWN
intY = intY + 1
If (intXStart = intX And intYStart = intY) Then Exit Do
Wend
colX(intY).Add intX
blnGoLeft = True
Else
intX = intX + 1
If (intXStart = intX And intYStart = intY) Then
If colX(intY).Count Mod 2 <> 0 Then
intPos = 1
For Each element In colX(intY)
If element = intXStart Then
colX(intY).Remove (intPos)
Exit Do
End If
intPos = intPos + 1
Next
End If
Exit Do
End If
End If
Else
blnGoRight = False
blnGoDown = True
colX(intY).Add intX
intY = intY + 1
If (intXStart = intX And intYStart = intY) Then Exit Do
End If
ElseIf blnGoDown Then
colX(intY).Add intX
If mbytMineStatus(intY, intX - 1) = NONE Then
If intY = mintRows - 1 Then
blnGoDown = False
DOWN: intX = intX - 1
If (intXStart = intX And intYStart = intY) Then Exit Do
While mbytMineStatus(intY, intX) = NONE
If intX = 0 Then GoTo LFT
intX = intX - 1
If (intXStart = intX And intYStart = intY) Then Exit Do
Wend
blnGoUp = True
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -