Public Class _2048 '2048窗体类
Private MyA2048 As New a2048 '实例化有游戏类对象
Dim highScore As Integer = My.Settings.a2048HighScore '实例化的时候读取解决方案里面的设置的该游戏的最高分
Private Sub Form1_KeyUp(sender As Object, e As KeyEventArgs) Handles Me.KeyUp
MyA2048.OnKeyUpSub(e) '调用mya2048的键盘点击事件
PictureBox1.Image = MyA2048.MyBitmap '然后图片框的图片应用对象的图片属性
Label1.Text = "当前得分为: " & MyA2048.Scores '显示分数
If MyA2048.Scores >= highScore Then '如果当前分数大于最高分就让标签显示当前分,并且把最高分保存到setting命名空间里面
highScore = MyA2048.Scores
Label2.Text = "最高分: " & highScore
My.Settings.a2048HighScore = highScore
End If
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load '窗体加载事件
PictureBox1.Image = MyA2048.MyBitmap '显示对象的图片属性
End Sub
End Class
Public Class a2048 'a2048游戏的类
'绘图基于表格坐标系
Public MyBitmap As New System.Drawing.Bitmap(400, 400) '一个变量400*400像素的位图
Private objGraphics As Graphics = Graphics.FromImage(MyBitmap) '私有变量,绘图,来源于位图对象
Private m_Site(4, 4) As Integer '位置属性,用来表示4*4方格的位置的数字大小,如果是0就代表是空的
Public Property Site(x As Integer, y As Integer) As Integer
Get
Return m_Site(x, y)
End Get
Set(ByVal value As Integer)
m_Site(x, y) = value
End Set
End Property
Private m_scores As Integer = 0 '游戏当前分数属性
Public Property Scores() As Integer
Get
Return m_scores
End Get
Set(ByVal value As Integer)
m_scores = value
End Set
End Property
Private sounder As New System.Media.SoundPlayer(My.Resources.卡片) '声音对象,主要用来播放声音
Private Sub raiseNewCube() '私有过程
Randomize() '初始化随机变量
Dim TempNullNumberCubeArray As New List(Of Point) '声明一个泛型集合,元素类型是点
For i As Integer = 1 To 4
For j As Integer = 1 To 4
If Site(i, j) = 0 Then
TempNullNumberCubeArray.Add(New Point(i, j)) '上面的集合收集空的位置
End If
Next
Next
If TempNullNumberCubeArray.Count = 0 Then
ElseIf TempNullNumberCubeArray.Count > 16 Then
Throw New Exception("初始化错误") '不可能大于16,用来捕获错误
End If
Dim rndNumber As Integer = CInt(Rnd() * (TempNullNumberCubeArray.Count - 1)) '接下来从空位置里面选择一个空的位置然后
Dim rnd4Or2 As Integer = Int(Rnd() * 0) '让被选择的空位置随机产生2或者4
Select Case rnd4Or2
Case 0
Site(TempNullNumberCubeArray(rndNumber).X, TempNullNumberCubeArray(rndNumber).Y) = 2
Case 1
Site(TempNullNumberCubeArray(rndNumber).X, TempNullNumberCubeArray(rndNumber).Y) = 4
Case Else
Throw New Exception("随机数错误") '2的概率是4的概率的2被倍,概率控制
End Select
objGraphics.Clear(Color.Azure) '绘图对象清空,用azure颜色,那么游戏图片的背景色就是azure
For i As Integer = 1 To 4
For j As Integer = 1 To 4
If Site(i, j) <> 0 Then
Select Case Site(i, j) '遍历所有的空格'然后很据他们点的位置的大小确定当前点的图片
Case 2
objGraphics.DrawImage(My.Resources._2, (j - 1) * 100, (i - 1) * 100, 95, 95)
'绘图对象的画图方法,重载方法之一参数是图片,位置,大小
Case 4
objGraphics.DrawImage(My.Resources._4, (j - 1) * 100, (i - 1) * 100, 95, 95)
Case 8
objGraphics.DrawImage(My.Resources._8, (j - 1) * 100, (i - 1) * 100, 95, 95)
Case 16
objGraphics.DrawImage(My.Resources._16, (j - 1) * 100, (i - 1) * 100, 95, 95)
Case 32
objGraphics.DrawImage(My.Resources.a32, (j - 1) * 100, (i - 1) * 100, 95, 95)
Case 64
objGraphics.DrawImage(My.Resources.a64, (j - 1) * 100, (i - 1) * 100, 95, 95)
Case 128
objGraphics.DrawImage(My.Resources.a128, (j - 1) * 100, (i - 1) * 100, 95, 95)
Case 256
objGraphics.DrawImage(My.Resources.a256, (j - 1) * 100, (i - 1) * 100, 95, 95)
Case 512
objGraphics.DrawImage(My.Resources.a512, (j - 1) * 100, (i - 1) * 100, 95, 95)
Case 1024
objGraphics.DrawImage(My.Resources.a1024, (j - 1) * 100, (i - 1) * 100, 95, 95)
Case 2048
objGraphics.DrawImage(My.Resources.a2048, (j - 1) * 100, (i - 1) * 100, 95, 95)
End Select
End If
Next
Next
End Sub
Sub New()
raiseNewCube() '实例化该对象的时候生成一个新的图片
End Sub
Private Event OnKeyUp(ByVal e As KeyEventArgs) '
Public Sub OnKeyUpSub(e As KeyEventArgs) '按键过程,参数是e,类型是key点击事件
Dim doCounter As Integer = 0
If e.KeyCode = Keys.Up Then '如果是按得上键,
For j As Integer = 1 To 4
For i As Integer = 2 To 4
Dim temp As Integer = i
'当没降落到边界,当降落的不是空格,当(它下面是空的或者和它相同的)
Do While temp <> 1 AndAlso Site(temp, j) <> 0 AndAlso ((Site(temp - 1, j) = 0) OrElse Site(temp - 1, j) = Site(temp, j)) 'j=1
doCounter += 1 '计数器,用来累计do循环了多少次
If Site(temp - 1, j) = 0 Then '如果是0就下落
Site(temp - 1, j) = Site(temp, j)
Site(temp, j) = 0 '迭代替换
temp -= 1
ElseIf Site(temp - 1, j) = Site(temp, j) Then
Scores += Site(temp, j)
Site(temp - 1, j) *= 2 '如果和下面的一样就会让它数字翻倍并且下落
Site(temp, j) = 0
Continue For
End If
Loop
Next
Next
ElseIf e.KeyCode = Keys.Down Then
For j As Integer = 1 To 4
For i As Integer = 3 To 1 Step -1
'If i = 1 And j = 4 Then Stop
Dim temp As Integer = i
Do While temp <> 4 AndAlso Site(temp, j) <> 0 AndAlso ((Site(temp + 1, j) = 0) OrElse Site(temp + 1, j) = Site(temp, j)) 'j=1
doCounter += 1
If Site(temp + 1, j) = 0 Then
Site(temp + 1, j) = Site(temp, j)
Site(temp, j) = 0
temp += 1
ElseIf Site(temp + 1, j) = Site(temp, j) Then
Scores += Site(temp, j)
Site(temp + 1, j) *= 2
Site(temp, j) = 0
Continue For
End If
Loop
Next
Next
ElseIf e.KeyCode = Keys.Left Then
For i As Integer = 1 To 4
For j As Integer = 2 To 4
Dim temp As Integer = j
Do While temp <> 1 AndAlso Site(i, temp) <> 0 AndAlso ((Site(i, temp - 1) = 0) OrElse Site(i, temp - 1) = Site(i, temp)) 'j=1
doCounter += 1
If Site(i, temp - 1) = 0 Then
Site(i, temp - 1) = Site(i, temp)
Site(i, temp) = 0
temp -= 1
ElseIf Site(i, temp - 1) = Site(i, temp) Then
Scores += Site(i, temp)
Site(i, temp - 1) *= 2
Site(i, temp) = 0
Continue For
End If
Loop
Next
Next
ElseIf e.KeyCode = Keys.Right Then
For i As Integer = 1 To 4
For j As Integer = 3 To 1 Step -1
Dim temp As Integer = j
Do While temp <> 4 AndAlso Site(i, temp) <> 0 AndAlso ((Site(i, temp + 1) = 0) OrElse Site(i, temp + 1) = Site(i, temp)) 'j=1
doCounter += 1
If Site(i, temp + 1) = 0 Then
Site(i, temp + 1) = Site(i, temp)
Site(i, temp) = 0
temp += 1
ElseIf Site(i, temp + 1) = Site(i, temp) Then
Scores += Site(i, temp)
Site(i, temp + 1) *= 2
Site(i, temp) = 0
Continue For
End If
Loop
Next
Next
End If
If doCounter >= 1 Then raiseNewCube() : sounder.Play() '如果计数器大于1说明下落成功,然后可以声音播放,生成新的图片
If IfEnd() Then MessageBox.Show("游戏结束,您的最终得分为: " & Scores) '调用ifend方法,判断游戏是否结束
End Sub
Public Function IfEnd() As Boolean
Dim i, j As Integer
For i = 1 To 4
For j = 1 To 4
If Site(i, j) = 0 Then Return False
If (i + j) Mod 2 = 0 AndAlso IfEqualNearby(i, j) = True Then
Return False
End If
Next
Next '遍历间隔的方格,然后看有没有相邻相同,做到不重复判断
Return True
End Function
Private Function IfEqualNearby(i As Integer, j As Integer) As Boolean '是否等于周围
If Site(i, j) = 0 Then Return True
If in14(i - 1, j) AndAlso Site(i, j) = Site(i - 1, j) Then
Return True
ElseIf in14(i + 1, j) AndAlso Site(i, j) = Site(i + 1, j) Then
Return True
ElseIf in14(i, j - 1) AndAlso Site(i, j) = Site(i, j - 1) Then
Return True
ElseIf in14(i, j + 1) AndAlso Site(i, j) = Site(i, j + 1) Then
Return True
End If
Return False
End Function
Private Function in14(i As Integer, j As Integer) As Boolean '是否在1和4直接,对应4*4之内
If i >= 1 AndAlso i <= 4 AndAlso j >= 1 AndAlso j <= 4 Then
Return True
End If
Return False
End Function
End Class
程序需要在资源文件中建立几个同名的文件用来显示图片。
使用图片资源的方法，详见我的另一篇博客： vb.net使用图片资源和图片编辑器的方法
代码中需要几个很少的控件
这是界面
欢迎评论和交流哦