For row = 0 To matrix.GetLength(0) 1
For column = 0 To matrix.GetLength(1) 1
theBlock = matrix(row, column)
If Not theBlock Is Nothing Then
theBlock.MarkedForDeletion = False
End If
Next
Next
' Remove any columns that are now empty.
CollapseColumns()
End Sub
'''
''' Provides access into the grid.
'''
'''
'''
'''
'''
Default Public Property Item(ByVal row As Integer, _
ByVal column As Integer) As Block
Get
Return matrix(row, column)
End Get
Set(ByVal Value As Block)
matrix(row, column) = Value
End Set
End Property
Private blocksToExamine As ArrayList
'''
''' Set MarkedForDeletion to True for each neighboring block
''' of the same color.
'''
'''
'''
'''
Private Sub FindSameColorNeighbors(ByVal row As Integer, _
ByVal column As Integer)
Dim color As Color = matrix(row, column).Color
blocksToExamine = New ArrayList
blocksToExamine.Add(New Point(row, column))
matrix(row, column).MarkedForDeletion = True
' Each time you find a neighbor, mark it for deletion, and
' add it to the list of blocks to look for neighbors.
' After you
' examine it, remove it from the list. Keep doing this
' until there are no more blocks to look at.
While blocksToExamine.Count > 0
FindNeighbors()
End While
End Sub
'''
''' Look to the blocks on each side.
'''
'''
Private Sub FindNeighbors()
' Take the first block out of the arraylist and examine it.
Dim location As Point = CType(blocksToExamine(0), Point)
Dim currentBlock As Block = matrix(location.X, location.Y)
Dim row As Integer = location.X
Dim column As Integer = location.Y
blocksToExamine.RemoveAt(0)
Dim nextRow As Integer
Dim nextCol As Integer
Dim selected As Block
' look up
If row < matrix.GetLength(0) 1 Then
nextRow = row + 1
selected = matrix(nextRow, column)
ExamineNeighbor(selected, nextRow, column, _
currentBlock.Color)
End If
' look down
If row > 0 Then
nextRow = row 1
selected = matrix(nextRow, column)
ExamineNeighbor(selected, nextRow, column, _
currentBlock.Color)
End If
' look left
If column > 0 Then
nextCol = column 1
selected = matrix(row, nextCol)
ExamineNeighbor(selected, row, nextCol, _
currentBlock.Color)
End If
' look right
If column < matrix.GetLength(1) 1 Then
nextCol = column + 1
selected = matrix(row, nextCol)
ExamineNeighbor(selected, row, nextCol, _
currentBlock.Color)
End If
End Sub
'''
''' If the neighbor is the same color, add it to the blocks
''' to examine.
'''
'''
'''
'''
'''
'''
Private Sub ExamineNeighbor(ByVal selected As Block, _
ByVal row As Integer, ByVal column As Integer, _
ByVal color As Color)
If Not selected Is Nothing Then
If selected.Color.Equals(color) Then
If Not selected.MarkedForDeletion Then
selected.MarkedForDeletion = True
blocksToExamine.Add(New Point(row, column))
End If
End If
End If
End Sub
End Class
По второму варианту, в панели Solution Explorer выполняем правый щелчок по имени проекта и в контекстном меню выбираем Add, New Item, в панели Add New Item выделяем шаблон Code File, в окне Name записываем имя HighScore.vb и щёлкаем кнопку Add. В проект (и в панель Solution Explorer) добавляется этот файл, открывается пустое окно редактирования кода, в которое записываем код со следующего листинга.
Листинг 20.18. Новый файл.
'''
''' Represents one high score.
'''
'''
Public Class HighScore
Implements IComparable
Public nameValue As String
Public scoreValue As Integer
Public Property Name() As String
Get
Return nameValue
End Get
Set(ByVal Value As String)
nameValue = Value
End Set
End Property
Public Property Score() As Integer
Get
Return scoreValue
End Get
Set(ByVal Value As Integer)
scoreValue = Value
End Set
End Property
Public Overrides Function ToString() As String
Return Name & ":" & Score
End Function
Public Sub New(ByVal saved As String)
Name = saved.Split(":".ToCharArray)(0)
Score = CInt(saved.Split(":".ToCharArray)(1))
End Sub
Public Function CompareTo(ByVal obj As Object) As Integer Implements System.IComparable.CompareTo
Dim other As HighScore
other = CType(obj, HighScore)
Return Me.Score other.Score
End Function
End Class
По второму варианту, в панели Solution Explorer выполняем правый щелчок по имени проекта и в контекстном меню выбираем Add, New Item, в панели Add New Item выделяем шаблон Code File, в окне Name записываем имя HighScores.vb и щёлкаем кнопку Add. В проект (и в панель Solution Explorer) добавляется этот файл, открывается пустое окно редактирования кода, в которое записываем код со следующего листинга.
Листинг 20.19. Новый файл.
Imports Microsoft.Win32
'''
''' Reads and writes the top three high scores to the registry.
'''
'''
Public Class HighScores
'''
''' Read scores from the registry.
'''
'''
'''
Public Shared Function GetHighScores() As HighScore()
Dim tops(2) As HighScore
Dim scoreKey As RegistryKey = Registry.CurrentUser. _
CreateSubKey("Software\VBSamples\Collapse\HighScores")
For index As Integer = 0 To 2
Dim key As String = "place" & index.ToString
Dim score As New HighScore(CStr(scoreKey.GetValue(key)))
tops(index) = score
Next
scoreKey.Close()
Return tops
End Function
'''
''' Update and write the high scores.
'''
'''
'''
Public Shared Sub UpdateScores(ByVal score As Integer)
Dim tops(3) As HighScore
Dim scoreKey As RegistryKey = Registry.CurrentUser. _
CreateSubKey("Software\VBSamples\Collapse\HighScores")
tops(0) = New HighScore(scoreKey.GetValue("Place0").ToString)
tops(1) = New HighScore(scoreKey.GetValue("Place1").ToString)
tops(2) = New HighScore(scoreKey.GetValue("Place2").ToString)
If score > tops(2).Score Then
Dim name As String = InputBox("New high score of " & _
score & " for:")
tops(3) = New HighScore(" :0")
tops(3).Name = name
tops(3).Score = score
Array.Sort(tops)
Array.Reverse(tops)
scoreKey.SetValue("Place0", tops(0).ToString)
scoreKey.SetValue("Place1", tops(1).ToString)
scoreKey.SetValue("Place2", tops(2).ToString)
End If
scoreKey.Close()
End Sub
'''
''' Set up the entries for new scores.
'''
'''
Shared Sub SetUpHighScores()
Dim scoreKey As RegistryKey = Registry.CurrentUser. _
CreateSubKey("Software\VBSamples\Collapse\HighScores")
If scoreKey.GetValue("Place1") Is Nothing Then
scoreKey.SetValue("Place0", " :0")
scoreKey.SetValue("Place1", " :0")
scoreKey.SetValue("Place2", " :0")
End If
scoreKey.Close()
End Sub
'''
''' Reset scores.
'''
'''
Shared Sub ResetScores()
Dim scoreKey As RegistryKey = Registry.CurrentUser. _
CreateSubKey("Software\VBSamples\Collapse\HighScores")
scoreKey.SetValue("Place0", " :0")
scoreKey.SetValue("Place1", " :0")
scoreKey.SetValue("Place2", " :0")
scoreKey.Close()
End Sub
End Class
По второму варианту, в панели Solution Explorer выполняем правый щелчок по имени проекта и в контекстном меню выбираем Add, New Item, в панели Add New Item выделяем шаблон Code File, в окне Name записываем имя PointTranslator.vb и щёлкаем кнопку Add. В проект (и в панель Solution Explorer) добавляется этот файл, открывается пустое окно редактирования кода, в которое записываем код со следующего листинга.
Листинг 20.20. Новый файл.
'''
''' Form coordinates have the top, left as (0,0). For the game grid,
''' it is easier to have the bottom left of the grid as (0,0). This
''' translates the points.
'''
'''
Public Class PointTranslator
Private Shared graphicsValue As Graphics
Private Shared height As Integer
Public Shared Property Graphics() As Graphics
Get
Return graphicsValue
End Get
Set(ByVal Value As Graphics)
graphicsValue = Value
height = CInt(graphicsValue.VisibleClipBounds.Height())
End Set
End Property
' Translates an (X,Y) point from the top left to
' an (X, Y) point from the bottom left.
Public Shared Function TranslateToBL(ByVal topleft As Point) _
As Point
Dim newPoint As Point
newPoint.X = topleft.X
newPoint.Y = height topleft.Y
Return newPoint
End Function
Public Shared Function TranslateToTL(ByVal bottomleft As Point) _
As Point
Dim newPoint As Point
newPoint.X = bottomleft.X
newPoint.Y = height bottomleft.Y
Return newPoint
End Function
End Class
После этих добавлений ( Block.vb, Grid.vb, HighScore.vb, HighScores.vb, PointTranslator.vb) в панели Solution Explorer должны быть файлы, показанные выше. Дважды щёлкая по имени файла, любой файл можно открыть, изучить и редактировать.