winmine.cls

一个用vb做的扫雷源马

    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