?? winmine.cls
字號(hào):
Dim blnGoLeft As Boolean
' stores the X and Y co-ords of the square from which the trace for
' the border starts
Dim intXStart As Integer
Dim intYStart As Integer
' index used for collection item
Dim intPos As Integer
' variant used in For Each loop
Dim element As Variant
' Loop counters
Dim y As Integer
Dim x As Integer
Dim i As Integer
' A dynamic array of collections of intgers. Each element in the
' array is a collection of starting and ending X co-ord pairs that
' define a part of the scan line going through the region enclosed
' by the traced out border
Dim colX() As New Collection
' Size of this array is the same as the number of rows in the minefield
ReDim colX(mintRows - 1)
' keep going left, until you reach a non-empty mine
While mbytMineStatus(intY, intX) = NONE
intX = intX - 1
If intX < 0 Then
intX = 0
intXStart = intX
intYStart = intY
GoTo LFT
End If
Wend
' first direction to go is up
blnGoUp = True
' store this first non-empty mine location as the starting point.
intXStart = intX
intYStart = intY
' trace out a border iteratively, until you return back to the
' starting point
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
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
' iterate through the collection for each scanline and paint
' the opened squares in one go
For y = 0 To mintRows - 1
If colX(y).Count > 0 Then
' Sort the X co-ord pairs in ascending order, by using
' a standard Listbox control
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
' Display opened squares between and including each X co-ord
' pair for the collection in the current scanline
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
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -