上学期我们学了Visual Basic.Net技术,期末时我提交的程序是连连看。附件中提供源代码以供参考。
我使用的IDE是Visual Studio 2008。使用图片来自互联网。
首先,我要生成一个8*8的随机地图,把64张图片加载进去(使用二维的PictureBox控件数组)。但是这些图片要两两配对出现,下面是实现这个功能的代码片段:
Private Sub MapShuffle()
Dim rand As New Random()
For i As Integer = 0 To 2010
Dim p_row As Integer = rand.Next(1, MAP_SIZE + 1)
Dim p_col As Integer = rand.Next(1, MAP_SIZE + 1)
Dim q_row As Integer = rand.Next(1, MAP_SIZE + 1)
Dim q_col As Integer = rand.Next(1, MAP_SIZE + 1)
If p_row <> q_row And p_col <> q_col Then
If Map(p_row, p_col) <> -1 And Map(q_row, q_col) <> -1 Then
Dim temp As Integer = Map(p_row, p_col)
Map(p_row, p_col) = Map(q_row, q_col)
Map(q_row, q_col) = temp
End If
End If
Next
End Sub
Private Sub PicturePaint()
For i As Integer = 0 To MAP_SIZE - 1
For j As Integer = 0 To MAP_SIZE - 1
If Map(i + 1, j + 1) <> -1 Then
Picture(i, j).Image = Image(Map(i + 1, j + 1))
End If
Next
Next
End Sub
然后就要添加单击图片控件时的响应代码,首先要检测前后选择的两张图片是否相同(通过Tag值,0表示没有图片,1-8表示不同的八张图片),然后通过FindPath过程来判断是否可以用不大于三个折点的线连接起来,如果可以的话,显示路径并消除这两张图片:
Private Sub Picture_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
ClickCounter = ClickCounter + 1
If GameTimer.Enabled = False Then
GameTimer.Enabled = True
End If
If sender.Tag <> -1 Then
PreClick = CurClick
CurClick = sender.Tag
Picture(CurClick \ MAP_SIZE, CurClick Mod MAP_SIZE).BackColor = Color.LawnGreen
Picture(CurClick \ MAP_SIZE, CurClick Mod MAP_SIZE).Refresh()
End If
If PreClick <> -1 And CurClick <> -1 And PreClick <> CurClick Then
If Map(PreClick \ MAP_SIZE + 1, PreClick Mod MAP_SIZE + 1) = Map(CurClick \ MAP_SIZE + 1, CurClick Mod MAP_SIZE + 1) Then
If FindPath(PreClick \ MAP_SIZE + 1, PreClick Mod MAP_SIZE + 1, CurClick \ MAP_SIZE + 1, CurClick Mod MAP_SIZE + 1) = True Then
Map(PreClick \ MAP_SIZE + 1, PreClick Mod MAP_SIZE + 1) = -1
Map(CurClick \ MAP_SIZE + 1, CurClick Mod MAP_SIZE + 1) = -1
Stage.Controls.Remove(Picture(PreClick \ MAP_SIZE, PreClick Mod MAP_SIZE))
Stage.Controls.Remove(Picture(CurClick \ MAP_SIZE, CurClick Mod MAP_SIZE))
PreClick = -1
CurClick = -1
Counter = Counter - 2
LLKScore = LLKScore + (MAP_SIZE ^ 2 - Counter) * LifeValue.Text / 200
ScoreValue.Text = LLKScore
'Stage.Refresh()
System.Threading.Thread.Sleep(200)
Stage.Controls.Remove(DrawArea)
Else
Picture(PreClick \ MAP_SIZE, PreClick Mod MAP_SIZE).BackColor = Color.Transparent
End If
Else
Picture(PreClick \ MAP_SIZE, PreClick Mod MAP_SIZE).BackColor = Color.Transparent
End If
End If
If Counter = 0 Then
GameTimer.Enabled = False
Congratulations.ShowDialog()
End If
End Sub
最重要的是判断路径可行的算法了,这里我使用的算法不是最优的,但是可以准确判断,它会分别寻找两张图片可以到达的最左最右边界(没有图片作为障碍),然后再这个公共的区域内从左向右或从上至下寻找可达路径(这里表述了为什么不是最优的路径),找到后会用系统的DrawLine通过窗口坐标的划线:
Private Function FindPath(ByVal pre_row As Integer, ByVal pre_col As Integer, ByVal cur_row As Integer, ByVal cur_col As Integer)
Dim left As Integer = Math.Max(FindLeft(pre_row, pre_col), FindLeft(cur_row, cur_col))
Dim right As Integer = Math.Min(FindRight(pre_row, pre_col), FindRight(cur_row, cur_col))
Dim top As Integer = Math.Max(FindTop(pre_row, pre_col), FindTop(cur_row, cur_col))
Dim bottom As Integer = Math.Min(FindBottom(pre_row, pre_col), FindBottom(cur_row, cur_col))
'Dim path As Graphics = Stage.CreateGraphics
'Dim myPen As Pen = New Pen(Color.LawnGreen, 3)
If left <= right Then
For j As Integer = left To right
If LineConnect(pre_row, j, cur_row, j) = True Then
DrawArea = New Button()
DrawArea.Top = 0
DrawArea.Left = 0
DrawArea.Height = 600
DrawArea.Width = 600
DrawArea.BackColor = Color.Transparent
Stage.Controls.Add(DrawArea)
Dim path As Graphics = DrawArea.CreateGraphics
Dim myPen As Pen = New Pen(Color.LawnGreen, 3)
path.DrawLine(myPen, j * 60 + 27, pre_row * 60 + 27, j * 60 + 27, cur_row * 60 + 27)
path.DrawLine(myPen, j * 60 + 27, pre_row * 60 + 27, pre_col * 60 + 27, pre_row * 60 + 27)
path.DrawLine(myPen, j * 60 + 27, cur_row * 60 + 27, cur_col * 60 + 27, cur_row * 60 + 27)
Return True
End If
Next
End If
If top <= bottom Then
For i As Integer = top To bottom
If LineConnect(i, pre_col, i, cur_col) = True Then
DrawArea = New Button()
DrawArea.Top = 0
DrawArea.Left = 0
DrawArea.Height = 600
DrawArea.Width = 600
DrawArea.BackColor = Color.Transparent
Stage.Controls.Add(DrawArea)
Dim path As Graphics = DrawArea.CreateGraphics
Dim myPen As Pen = New Pen(Color.LawnGreen, 3)
path.DrawLine(myPen, pre_col * 60 + 27, i * 60 + 27, cur_col * 60 + 27, i * 60 + 27)
path.DrawLine(myPen, pre_col * 60 + 27, i * 60 + 27, pre_col * 60 + 27, pre_row * 60 + 27)
path.DrawLine(myPen, cur_col * 60 + 27, i * 60 + 27, cur_col * 60 + 27, cur_row * 60 + 27)
Return True
End If
Next
End If
Return False
End Function
Private Function FindLeft(ByVal r As Integer, ByVal c As Integer)
If Map(r, c - 1) <> -1 Then
Return c
Else
For y As Integer = c - 1 To 0 Step -1
If Map(r, y) <> -1 Then
Return y + 1
End If
Next
Return 0
End If
End Function
Private Function FindRight(ByVal r As Integer, ByVal c As Integer)
If Map(r, c + 1) <> -1 Then
Return c
Else
For y As Integer = c + 1 To MAP_SIZE + 1
If Map(r, y) <> -1 Then
Return y - 1
End If
Next
Return MAP_SIZE + 1
End If
End Function
Private Function FindTop(ByVal r As Integer, ByVal c As Integer)
If Map(r - 1, c) <> -1 Then
Return r
Else
For x As Integer = r - 1 To 0 Step -1
If Map(x, c) <> -1 Then
Return x + 1
End If
Next
Return 0
End If
End Function
Private Function FindBottom(ByVal r As Integer, ByVal c As Integer)
If Map(r + 1, c) <> -1 Then
Return r
Else
For x As Integer = r + 1 To MAP_SIZE + 1
If Map(x, c) <> -1 Then
Return x - 1
End If
Next
Return MAP_SIZE + 1
End If
End Function
Private Function LineConnect(ByVal p_row As Integer, ByVal p_col As Integer, ByVal q_row As Integer, ByVal q_col As Integer)
If p_row = q_row Then
Dim min_col As Integer = IIf(p_col < q_col, p_col, q_col)
Dim max_col As Integer = IIf(p_col > q_col, p_col, q_col)
For j As Integer = min_col + 1 To max_col - 1
If Map(p_row, j) <> -1 Then
Return False
End If
Next
Return True
End If
If p_col = q_col Then
Dim min_row As Integer = IIf(p_row < q_row, p_row, q_row)
Dim max_row As Integer = IIf(p_row > q_row, p_row, q_row)
For i As Integer = min_row + 1 To max_row - 1
If Map(i, p_col) <> -1 Then
Return False
End If
Next
Return True
End If
Return False
End Function
最后,附上源代码。建议使用Visual Studio 2008以上版本查看。