?? winmine.cls
字號:
Else
intY = intY + 1
If (intXStart = intX And intYStart = intY) Then Exit Do
End If
Else
blnGoDown = False
blnGoLeft = True
intX = intX - 1
If (intXStart = intX And intYStart = intY) Then Exit Do
End If
ElseIf blnGoLeft Then
If mbytMineStatus(intY - 1, intX) = NONE Then
If intX = 0 Then
blnGoLeft = False
LFT: colX(intY).Add intX
If intY = 0 Then GoTo UP
intY = intY - 1
If (intXStart = intX And intYStart = intY) Then Exit Do
While mbytMineStatus(intY, intX) = NONE
colX(intY).Add intX
If intY = 0 Then GoTo UP
intY = intY - 1
If (intXStart = intX And intYStart = intY) Then Exit Do
Wend
colX(intY).Add intX
blnGoRight = True
Else
intX = intX - 1
If (intXStart = intX And intYStart = intY) Then Exit Do
End If
Else
blnGoLeft = False
blnGoUp = True
colX(intY).Add intX
intY = intY - 1
If (intXStart = intX And intYStart = intY) Then Exit Do
End If
End If
End If
Loop
For y = 0 To mintRows - 1
If colX(y).Count > 0 Then
For x = 1 To colX(y).Count
Dim intXValue As Integer
intXValue = colX(y)(x)
If intXValue < 10 Then
intXValue = intXValue + 48
ElseIf intXValue >= 10 Then
intXValue = intXValue + 55
End If
mfrmDisplay.lstSortedX.AddItem Chr$(intXValue)
Next
For x = 0 To mfrmDisplay.lstSortedX.ListCount - 1 Step 2
Dim intR1 As Integer
Dim intC1 As Integer
Dim intColStart As Integer
Dim intColEnd As Integer
Dim intDx As Integer
Dim intWidth As Integer
intR1 = y * mintButtonHeight
intColStart = Asc(mfrmDisplay.lstSortedX.List(x))
If intColStart <= 57 Then
intColStart = intColStart - 48
ElseIf intColStart >= 65 Then
intColStart = intColStart - 55
End If
intColEnd = Asc(mfrmDisplay.lstSortedX.List(x + 1))
If intColEnd <= 57 Then
intColEnd = intColEnd - 48
ElseIf intColEnd >= 65 Then
intColEnd = intColEnd - 55
End If
intC1 = intColStart * mintButtonWidth
intDx = intColEnd - intColStart + 1
intWidth = intDx * mintButtonWidth
mfrmDisplay.PaintPicture mfrmDisplay.imgOpenBlocks, intC1, intR1, , , 0, 0, intWidth, mintButtonHeight
For i = 0 To intDx - 1
If mbytMarked(y, intColStart + i) > NONE Then
If mbytMarked(y, intColStart + i) = QUESTION Then
mfrmDisplay.PaintPicture mfrmDisplay.imgQuestion, intC1 + i * mintButtonWidth, intR1
Else
mfrmDisplay.PaintPicture mfrmDisplay.imgFlag, intC1 + i * mintButtonWidth, intR1
End If
ElseIf mbytMineStatus(y, intColStart + i) > NONE Then
mfrmDisplay.CurrentX = intC1 + i * mintButtonWidth
mfrmDisplay.CurrentY = intR1
If mbytMineStatus(y, intColStart + i) >= BEEN Then
mfrmDisplay.ForeColor = QBColor(mbytMineStatus(y, intColStart + i) - BEEN)
mfrmDisplay.Print mbytMineStatus(y, intColStart + i) - BEEN
ElseIf mbytMineStatus(y, intColStart + i) = MINE Then
mfrmDisplay.PaintPicture mfrmDisplay.imgButton, intC1 + i * mintButtonWidth, intR1
Else
mfrmDisplay.ForeColor = QBColor(mbytMineStatus(y, intColStart + i))
mfrmDisplay.Print mbytMineStatus(y, intColStart + i)
mbytMineStatus(y, intColStart + i) = mbytMineStatus(y, intColStart + i) + BEEN
End If
End If
Next
Next
' 清空收集
mfrmDisplay.lstSortedX.Clear
End If
Next
End Sub
Private Sub ResizeDisplay()
' 設置外框邊界尺寸
mfrmDisplay.ScaleMode = 1
mfrmDisplay.Width = mfrmDisplay.Width - mfrmDisplay.ScaleWidth + mintCols * mintButtonWidth * Screen.TwipsPerPixelX
mfrmDisplay.Height = mfrmDisplay.Height - mfrmDisplay.ScaleHeight + mintRows * mintButtonHeight * Screen.TwipsPerPixelY + mfrmDisplay.lblMinesLeft.Height
' 設置標簽尺寸
mfrmDisplay.lblMinesLeft.Left = 0
mfrmDisplay.lblMinesLeft.Top = mfrmDisplay.ScaleHeight - mfrmDisplay.lblMinesLeft.Height
mfrmDisplay.lblMinesLeft.Width = mfrmDisplay.ScaleWidth
mfrmDisplay.lblMinesLeft = "Mines Left : " & mbytNumMines
mfrmDisplay.ScaleMode = 3
End Sub
Public Sub TrackHitTest(intButton As Integer, intX As Single, intY As Single)
Dim blnLeftDown As Boolean
blnLeftDown = (intButton And LEFT_BUTTON) > 0
' 如果鼠標左健點擊
If blnLeftDown Then
' 如果當前沒有執行鼠標點擊,則取消
If Not mblnHitTestBegun Then Exit Sub
' 通過鼠標坐標確定柵格坐標
intX = Int(intX / mintButtonWidth)
intY = Int(intY / mintButtonHeight)
' 如果鼠標點擊在游戲邊界外邊,則取消
If intX >= mintCols Or intY >= mintRows Or intX < 0 Or intY < 0 Then
mfrmDisplay.imgQsPressed.Visible = False
mfrmDisplay.imgPressed.Visible = False
Exit Sub
End If
' 如果當前的方格已被標注,則取消
If mbytMarked(intY, intX) >= FLAGGED Then
mfrmDisplay.imgQsPressed.Visible = False
mfrmDisplay.imgPressed.Visible = False
Exit Sub
End If
Dim intRowOld As Integer
Dim intColOld As Integer
' 存儲前面柵格指針的位置
intRowOld = mintRow
intColOld = mintCol
' 計算當前鼠標指針的位置
mintCol = intX * mintButtonWidth
mintRow = intY * mintButtonHeight
'如果當前的柵格坐標發生變化,顯示方格被標注
If intRowOld = mintRow And intColOld = mintCol Then
If mfrmDisplay.imgPressed.Visible Or mfrmDisplay.imgQsPressed.Visible Then
Exit Sub
End If
End If
' 如果當前的方格已被打開,則取消
If mbytMineStatus(intY, intX) >= BEEN Then
mfrmDisplay.imgPressed.Visible = False
mfrmDisplay.imgQsPressed.Visible = False
Exit Sub
End If
If mbytMarked(intY, intX) = QUESTION Then
mfrmDisplay.imgPressed.Visible = False
mfrmDisplay.imgQsPressed.Visible = False
mfrmDisplay.imgQsPressed.Left = mintCol
mfrmDisplay.imgQsPressed.Top = mintRow
mfrmDisplay.imgQsPressed.Visible = True
Else
mfrmDisplay.imgQsPressed.Visible = False
mfrmDisplay.imgPressed.Visible = False
mfrmDisplay.imgPressed.Left = mintCol
mfrmDisplay.imgPressed.Top = mintRow
mfrmDisplay.imgPressed.Visible = True
End If
End If
End Sub
Private Sub Class_Initialize()
mbytNumMines = 10
mbytCorrectHits = 0
mbytTotalHits = 0
mintRows = 8
mintCols = 8
mintRow = -1
mintCol = -1
mblnNewGame = False
mblnHitTestBegun = False
Set mfrmDisplay = Nothing
' 計算隨機地雷的位置
InitializeMineField
End Sub
Public Sub SetMineFieldDimension(intRows As Integer, intCols As Integer, bytMines As Byte, blnLevelCustom As Boolean)
mintRows = intRows
If intRows < MIN_ROWS Then mintRows = MIN_ROWS
If intRows > MAX_ROWS Then mintRows = MAX_ROWS
mintCols = intCols
If intCols < MIN_COLS Then mintCols = MIN_COLS
If intCols > MAX_COLS Then mintCols = MAX_COLS
mbytNumMines = bytMines
If blnLevelCustom Then
Dim intMines As Integer
intMines = (mintRows * mintCols) \ 5
If bytMines < intMines Then
mbytNumMines = intMines
bytMines = intMines
ElseIf bytMines > (intMines * 4) \ 3 Then
mbytNumMines = (intMines * 4) \ 3
bytMines = mbytNumMines
End If
End If
If bytMines < MIN_MINES Then mbytNumMines = MIN_MINES
If bytMines > MAX_MINES Then mbytNumMines = MAX_MINES
' 清空現在的顯示,重新開始游戲
mfrmDisplay.Cls
' 調整游戲邊界尺寸
ResizeDisplay
End Sub
Private Sub Class_Terminate()
Erase mbytMineStatus
Erase mbytMarked
Erase mbytMineLocations
Dim i As Integer ' 循環計數
For i = 1 To mcolWrongLocations.Count
mcolWrongLocations.Remove 1
Next
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -