四、基本方法
根据游戏特点,设计一个二维数组保存各个小数字方块数据,根据数组进行绘图。
小数字方块设计为一个自定义控件,实现移动效果。
为保存读取数据,单独设计一个模块进行读写,文件扩展名(*.g)。为进行回退操作,
每一步将二维数组写一行数据到listbox中。
定时器(timer)间隔1秒更新时间、得分。
五、详细代码
1.小数字方块控件
添加个自定义控件,并命名为my2048Cell。控件大小为80*80,有x,y方向序号属性,可
显示不同数字,数字不同颜色不一样。方块样式固定为无(可改为FixedSingle)。
代码如下:
Public Class my2048Cell
Private sText As Integer = 0 '显示的数字
Private wh As Integer = 80 '控件的宽高
Public strBcolor As Color = Me.BackColor '数字背景色
Public strFcolor As Color = Me.ForeColor '数字颜色
Private myXindex As Integer = 0 'x方向索引
Private myYindex As Integer = 0 'y方向索引
Public Sub New()
' 此调用是设计器所必需的。
MyBase.Width = wh
MyBase.Height = wh
InitializeComponent()
' 在 InitializeComponent() 调用之后添加任何初始化。
End Sub
Public Property Xindex() As Integer 'x方向索引
Set(ByVal value As Integer)
myXindex = value
End Set
Get
Return myXindex
End Get
End Property
Public Property Yindex() As Integer 'y方向索引
Set(ByVal value As Integer)
myYindex = value
End Set
Get
Return myYindex
End Get
End Property
Public Property ShowText() As Integer '显示的数字
Set(ByVal value As Integer)
sText = value
strBcolor = getBcolor(sText)
strFcolor = getFcolor(sText)
Me.Refresh()
End Set
Get
Return sText
End Get
End Property
Public Overrides Property Font As System.Drawing.Font '字体
Get
Return New Font("宋体", 20)
End Get
Set(ByVal value As System.Drawing.Font)
MyBase.Font = New Font("宋体", 20)
End Set
End Property
Public Overloads Property BorderStyle() As Windows.Forms.FormBorderStyle '边框
Set(ByVal value As Windows.Forms.FormBorderStyle)
MyBase.BorderStyle = FormBorderStyle.None
End Set
Get
Return FormBorderStyle.None
End Get
End Property
Protected Overrides Sub OnResize(ByVal e As System.EventArgs) '改变尺寸
MyBase.OnResize(e)
MyBase.Width = wh
MyBase.Height = wh
End Sub
Protected Overrides Sub OnPaint(ByVal e As System.Windows.Forms.PaintEventArgs) '绘制控件
MyBase.OnPaint(e)
If ShowText <> 0 Then
e.Graphics.FillRectangle(New SolidBrush(getBcolor(ShowText)), 3, 3, wh - 6, wh - 6)
Dim sw As Integer = e.Graphics.MeasureString(ShowText.ToString, Me.Font).Width
Dim sh As Integer = e.Graphics.MeasureString(ShowText.ToString, Me.Font).Height
e.Graphics.DrawString(ShowText.ToString, Me.Font, New SolidBrush(getFcolor(ShowText)), New Point((wh - sw) / 2, (wh - sh) / 2))
End If
End Sub
Private Function getBcolor(ByVal V As Integer) As Color '根据数值返回背景颜色
Dim C As Color = Color.FromArgb(0, 0, 0)
Select Case V
Case 0
C = Color.FromKnownColor(KnownColor.Control)
Case 2
C = Color.FromArgb(222, 222, 222)
Case 4
C = Color.FromArgb(222, 205, 222)
Case 8
C = Color.FromArgb(122, 150, 122)
Case 16
C = Color.FromArgb(222, 105, 122)
Case 32
C = Color.AntiqueWhite
Case 64
C = Color.AliceBlue
Case 128
C = Color.FromArgb(22, 22, 222)
Case 256
C = Color.FromArgb(200, 200, 222)
Case 512
C = Color.FromArgb(128, 128, 222)
Case 1024
C = Color.FromArgb(255, 255, 255)
Case 2048
C = Color.FromArgb(22, 222, 22)
Case 4096
C = Color.FromArgb(222, 22, 22)
Case 8192
C = Color.FromArgb(122, 22, 122)
Case 16384
C = Color.DeepSkyBlue
Case 32768
C = Color.DarkRed
Case 65536
C = Color.LightGoldenrodYellow
Case Else
C = Color.White
End Select
Return C
End Function
Private Function getFcolor(ByVal V As Integer) As Color '根据数值返回字体颜色
Dim C As Color = Color.FromArgb(0, 0, 0)
Select Case V
Case 0
C = Color.Black
Case 2
C = Color.DarkOrange
Case 4
C = Color.FromArgb(122, 10, 22)
Case 8
C = Color.FromArgb(222, 22, 222)
Case 16
C = Color.FromArgb(22, 200, 212)
Case 32
C = Color.Blue
Case 64
C = Color.Red
Case 128
C = Color.FromArgb(222, 222, 22)
Case 256
C = Color.FromArgb(112, 2, 121)
Case 512
C = Color.FromArgb(255, 255, 255)
Case 1024
C = Color.FromArgb(108, 108, 202)
Case 2048
C = Color.FromArgb(222, 22, 222)
Case 4096
C = Color.FromArgb(22, 221, 222)
Case 8192
C = Color.FromArgb(222, 221, 222)
Case 16384
C = Color.Brown
Case 32768
C = Color.DeepPink
Case 65536
C = Color.DarkTurquoise
Case Else
C = Color.Chocolate
End Select
Return C
End Function
End Class
2、游戏主模块(ModulePinShu)
根据合并方式4个方向移动都有两个方法。为实现选择行、列,定义mysz(,)二维数组,定义全局变量存储数组X、Y方向个数。
Module ModulePinShu
Public mySZ(,) As Integer '一个2维数组存储数据
Public Const mySizeWH As Integer = 80 '单位大小
Public szXnum As Integer = 4, szYnum As Integer = 4 '数组X、Y方向个数
Public DeFen As Integer = 0 '记录得分
Public MuBiaoShu As Integer = 1024 '要达到的数字
Public yongShi As Integer = 0 '记录用时
Public gamePaused As Boolean = False '游戏是否暂停
Public hbfs As Integer = 0 '合并方式
Public Sub newGame(ByVal pic As PictureBox) '新游戏
ReDim mySZ(szXnum - 1, szYnum - 1)
pic.Width = szXnum * mySizeWH
pic.Height = szYnum * mySizeWH
For i As Integer = 0 To szXnum - 1
For j As Integer = 0 To szYnum - 1
mySZ(i, j) = 0
Next
Next
DeFen = 0
yongShi = 0
rndNewCell(pic)
rndNewCell(pic)
drawPic(pic)
End Sub
Private Sub rndNewCell(ByVal pic As PictureBox) '随机产生一个坐标并赋值2或4
Randomize()
Dim rndx As Integer = Int(Rnd() * szXnum)
Dim rndy As Integer = Int(Rnd() * szYnum)
If getKouweinum() > 0 Then ''空位数大于零
Do
If mySZ(rndx, rndy) <> 0 Then
rndx = Int(Rnd() * szXnum)
rndy = Int(Rnd() * szYnum)
Else
Dim k As Integer = Int(Rnd() * 10)
If k > 2 Then
mySZ(rndx, rndy) = 2
Else
mySZ(rndx, rndy) = 4
End If
Exit Do
End If
Loop
End If
Dim p As New my2048Cell
p.ShowText = mySZ(rndx, rndy)
p.Xindex = rndx
p.Yindex = rndy
pic.Controls.Add(p)
p.Location = New Point(rndx * mySizeWH, rndy * mySizeWH)
End Sub
Private Function getKouweinum() As Integer '取空位数
Dim k As Integer = 0
For i As Integer = 0 To szXnum - 1
For j As Integer = 0 To szYnum - 1
If mySZ(i, j) = 0 Then k += 1
Next
Next
Return k
End Function
Public Function isDefengou() As Boolean '得分是否达标
Dim r As Boolean = False
For i As Integer = 0 To szXnum - 1
For j As Integer = 0 To szYnum - 1
If mySZ(i, j) >= MuBiaoShu Then
r = True
End If
Next
Next
Return r
End Function
Public Function isGameEnd() As Boolean '游戏是否结束(没有空位及可合并)
Dim r As Boolean = False
If getKouweinum() = 0 Then
r = True
For ix As Integer = 0 To szXnum - 1
For kx As Integer = 0 To szYnum - 2
If mySZ(ix, kx) = mySZ(ix, kx + 1) Then
r = False
End If
Next
Next
For iy As Integer = 0 To szYnum - 1
For ky As Integer = 0 To szXnum - 2
If mySZ(ky, iy) = mySZ(ky + 1, iy) Then
r = False
End If
Next
Next
End If
Return r
End Function
Public Sub drawPic(ByVal pic As PictureBox) '根据数组绘图
pic.Controls.Clear()
For i As Integer = 0 To szXnum - 1
For j As Integer = 0 To szYnum - 1
If mySZ(i, j) <> 0 Then
Dim p As New my2048Cell
p.ShowText = mySZ(i, j)
p.Xindex = i
p.Yindex = j
pic.Controls.Add(p)
p.Location = New Point(i * mySizeWH, j * mySizeWH)
End If
Next
Next
End Sub
Public Sub myMoveLeft(ByVal pic As PictureBox) '左移
Dim canMove As Boolean = False '是否可移动
Dim cishu As Integer = 0 '移动次数
Do '位置左移,一直到不能移动
canMove = False
For Each cell As my2048Cell In pic.Controls
Dim k As Integer = cell.Xindex
If k > 0 Then
If mySZ(k - 1, cell.Yindex) = 0 Then
Dim ox As Integer = cell.Left
For i As Integer = 0 To mySizeWH Step 20
cell.Left = ox - i
Threading.Thread.Sleep(1)
pic.Refresh()
Next
cell.Xindex -= 1
mySZ(k, cell.Yindex) = 0
mySZ(k - 1, cell.Yindex) = cell.ShowText
canMove = True
cishu += 1
End If
End If
Next
Loop Until canMove = False '位置左移,一直到不能移动
Dim szL As Integer = mySZ.GetLength(0) - 1 '数组列数
Dim szH As Integer = mySZ.GetLength(1) - 1 '数组行数
For i As Integer = 0 To szH
For j As Integer = szL To 1 Step -1
For Each cell As my2048Cell In pic.Controls
If cell.Xindex = j And cell.Yindex = i And mySZ(j - 1, i) = cell.ShowText Then
Dim ox As Integer = cell.Left
For iaa As Integer = 0 To mySizeWH Step 20
cell.Left = ox - iaa
Threading.Thread.Sleep(1)
pic.Refresh()
Next
mySZ(j, i) = 0
mySZ(j - 1, i) = cell.ShowText * 2
DeFen += cell.ShowText * 2
cell.ShowText *= 2
For Each c As my2048Cell In pic.Controls
If c.Xindex = j - 1 And c.Yindex = i Then
pic.Controls.Remove(c)
End If
Next
cell.Xindex -= 1
canMove = True
cishu += 1
End If
Next
Next
Next
If cishu > 0 Then
DeFen += 2 * cishu
rndNewCell(pic)
End If
End Sub
Public Sub moveLeft(ByVal pic As PictureBox) '左移
Dim canmove As Boolean
Dim cishu As Integer = 0
Do
canmove = False
For Each cell As my2048Cell In pic.Controls
Dim k As Integer = cell.Xindex
If k > 0 Then
If mySZ(k - 1, cell.Yindex) = 0 Then
Dim ox As Integer = cell.Left
For i As Integer = 0 To mySizeWH Step 20
cell.Left = ox - i
Threading.Thread.Sleep(1)
pic.Refresh()
Next
cell.Xindex -= 1
mySZ(k, cell.Yindex) = 0
mySZ(k - 1, cell.Yindex) = cell.ShowText
canmove = True
cishu += 1
Else
If mySZ(k - 1, cell.Yindex) <> cell.ShowText Then
Else
Dim ox As Integer = cell.Left
For i As Integer = 0 To mySizeWH Step 20
cell.Left = ox - i
Threading.Thread.Sleep(1)
pic.Refresh()
Next
mySZ(k, cell.Yindex) = 0
mySZ(k - 1, cell.Yindex) = cell.ShowText * 2
DeFen += cell.ShowText * 2
cell.ShowText *= 2
For Each c As my2048Cell In pic.Controls
If c.Xindex = k - 1 And c.Yindex = cell.Yindex Then
pic.Controls.Remove(c)
End If
Next
cell.Xindex -= 1
canmove = True
cishu += 1
End If
End If
End If
Next
Loop Until canmove = False
If cishu > 0 Then
rndNewCell(pic)
End If
End Sub
Public Sub moveRight(ByVal pic As PictureBox) '右移
Dim canmove As Boolean
Dim cishu As Integer = 0
Do
canmove = False
For Each cell As my2048Cell In pic.Controls
Dim k As Integer = cell.Xindex
If k < szXnum - 1 Then
If mySZ(k + 1, cell.Yindex) = 0 Then
Dim ox As Integer = cell.Left
For i As Integer = 0 To mySizeWH Step 20
cell.Left = ox + i
Threading.Thread.Sleep(1)
pic.Refresh()
Next
cell.Xindex += 1
mySZ(k, cell.Yindex) = 0
mySZ(k + 1, cell.Yindex) = cell.ShowText
canmove = True
cishu += 1
Else
If mySZ(k + 1, cell.Yindex) <> cell.ShowText Then
Else
Dim ox As Integer = cell.Left
For i As Integer = 0 To mySizeWH Step 20
cell.Left = ox + i
Threading.Thread.Sleep(1)
pic.Refresh()
Next
mySZ(k, cell.Yindex) = 0
mySZ(k + 1, cell.Yindex) = cell.ShowText * 2
DeFen += cell.ShowText * 2
cell.ShowText *= 2
For Each c As my2048Cell In pic.Controls
If c.Xindex = k + 1 And c.Yindex = cell.Yindex Then
pic.Controls.Remove(c)
End If
Next
cell.Xindex += 1
canmove = True
cishu += 1
End If
End If
End If
Next
Loop Until canmove = False
If cishu > 0 Then
rndNewCell(pic)
End If
End Sub
Public Sub myMoveRight(ByVal pic As PictureBox) '右移
Dim canmove As Boolean
Dim cishu As Integer = 0
Do
canmove = False
For Each cell As my2048Cell In pic.Controls
Dim k As Integer = cell.Xindex
If k < szXnum - 1 Then
If mySZ(k + 1, cell.Yindex) = 0 Then
Dim ox As Integer = cell.Left
For i As Integer = 0 To mySizeWH Step 20
cell.Left = ox + i
Threading.Thread.Sleep(1)
pic.Refresh()
Next
cell.Xindex += 1
mySZ(k, cell.Yindex) = 0
mySZ(k + 1, cell.Yindex) = cell.ShowText
canmove = True
cishu += 1
End If
End If
Next
Loop Until canmove = False
Dim szL As Integer = mySZ.GetLength(0) - 1 '数组列数
Dim szH As Integer = mySZ.GetLength(1) - 1 '数组行数
For i As Integer = 0 To szH
For j As Integer = 0 To szL - 1
For Each cell As my2048Cell In pic.Controls
If cell.Xindex = j And cell.Yindex = i And mySZ(j + 1, i) = cell.ShowText Then
Dim ox As Integer = cell.Left
For iaa As Integer = 0 To mySizeWH Step 20
cell.Left = ox + iaa
Threading.Thread.Sleep(1)
pic.Refresh()
Next
mySZ(j, cell.Yindex) = 0
mySZ(j + 1, cell.Yindex) = cell.ShowText * 2
DeFen += cell.ShowText * 2
cell.ShowText *= 2
For Each c As my2048Cell In pic.Controls
If c.Xindex = j + 1 And c.Yindex = i Then
pic.Controls.Remove(c)
End If
Next
cell.Xindex += 1
canmove = True
cishu += 1
End If
Next
Next
Next
If cishu > 0 Then
rndNewCell(pic)
DeFen += 2 * cishu
End If
End Sub
Public Sub moveUp(ByVal pic As PictureBox) '上移
Dim canmove As Boolean
Dim cishu As Integer = 0
Do
canmove = False
For Each cell As my2048Cell In pic.Controls
Dim k As Integer = cell.Yindex
If k > 0 Then
If mySZ(cell.Xindex, k - 1) = 0 Then
Dim oy As Integer = cell.Top
For i As Integer = 0 To mySizeWH Step 20
cell.Top = oy - i
Threading.Thread.Sleep(1)
pic.Refresh()
Next
cell.Yindex -= 1
mySZ(cell.Xindex, k) = 0
mySZ(cell.Xindex, k - 1) = cell.ShowText
canmove = True
cishu += 1
Else
If mySZ(cell.Xindex, k - 1) <> cell.ShowText Then
Else
Dim oy As Integer = cell.Top
For i As Integer = 0 To mySizeWH Step 20
cell.Top = oy - i
Threading.Thread.Sleep(1)
pic.Refresh()
Next
mySZ(cell.Xindex, k) = 0
mySZ(cell.Xindex, k - 1) = cell.ShowText * 2
DeFen += cell.ShowText * 2
cell.ShowText *= 2
For Each c As my2048Cell In pic.Controls
If c.Yindex = k - 1 And c.Xindex = cell.Xindex Then
pic.Controls.Remove(c)
End If
Next
cell.Yindex -= 1
canmove = True
cishu += 1
End If
End If
End If
Next
Loop Until canmove = False
If cishu > 0 Then
rndNewCell(pic)
End If
End Sub
Public Sub MyMoveUp(ByVal pic As PictureBox) '上移
Dim canmove As Boolean
Dim cishu As Integer = 0
Do
canmove = False
For Each cell As my2048Cell In pic.Controls
Dim k As Integer = cell.Yindex
If k > 0 Then
If mySZ(cell.Xindex, k - 1) = 0 Then
Dim oy As Integer = cell.Top
For i As Integer = 0 To mySizeWH Step 20
cell.Top = oy - i
Threading.Thread.Sleep(1)
pic.Refresh()
Next
cell.Yindex -= 1
mySZ(cell.Xindex, k) = 0
mySZ(cell.Xindex, k - 1) = cell.ShowText
canmove = True
cishu += 1
End If
End If
Next
Loop Until canmove = False
Dim szL As Integer = mySZ.GetLength(0) - 1 '数组列数
Dim szH As Integer = mySZ.GetLength(1) - 1 '数组行数
For i As Integer = 0 To szL
For j As Integer = szH To 1 Step -1
For Each cell As my2048Cell In pic.Controls
If mySZ(i, j - 1) = cell.ShowText And cell.Xindex = i And cell.Yindex = j Then
Dim oy As Integer = cell.Top
For iaa As Integer = 0 To mySizeWH Step 20
cell.Top = oy - iaa
Threading.Thread.Sleep(1)
pic.Refresh()
Next
mySZ(i, j) = 0
mySZ(i, j - 1) = cell.ShowText * 2
DeFen += cell.ShowText * 2
cell.ShowText *= 2
For Each c As my2048Cell In pic.Controls
If c.Yindex = j - 1 And c.Xindex = i Then
pic.Controls.Remove(c)
End If
Next
cell.Yindex -= 1
canmove = True
cishu += 1
End If
Next
Next
Next
If cishu > 0 Then
rndNewCell(pic)
DeFen += 2 * cishu
End If
End Sub
Public Sub moveDown(ByVal pic As PictureBox) '下移
Dim canmove As Boolean
Dim cishu As Integer = 0
Do
canmove = False
For Each cell As my2048Cell In pic.Controls
Dim k As Integer = cell.Yindex
If k < szYnum - 1 Then
If mySZ(cell.Xindex, k + 1) = 0 Then
Dim oy As Integer = cell.Top
For i As Integer = 0 To mySizeWH Step 20
cell.Top = oy + i
Threading.Thread.Sleep(1)
pic.Refresh()
Next
cell.Yindex += 1
mySZ(cell.Xindex, k) = 0
mySZ(cell.Xindex, k + 1) = cell.ShowText
canmove = True
cishu += 1
Else
If mySZ(cell.Xindex, k + 1) <> cell.ShowText Then
Else
Dim oy As Integer = cell.Top
For i As Integer = 0 To mySizeWH Step 20
cell.Top = oy + i
Threading.Thread.Sleep(1)
' pic.Refresh()
Next
mySZ(cell.Xindex, k) = 0
mySZ(cell.Xindex, k + 1) = cell.ShowText * 2
DeFen += cell.ShowText * 2
cell.ShowText *= 2
For Each c As my2048Cell In pic.Controls
If c.Yindex = k + 1 And c.Xindex = cell.Xindex Then
pic.Controls.Remove(c)
End If
Next
cell.Yindex += 1
canmove = True
cishu += 1
End If
End If
End If
Next
Loop Until canmove = False
If cishu > 0 Then
rndNewCell(pic)
End If
End Sub
Public Sub myMoveDown(ByVal pic As PictureBox) '下移
Dim canmove As Boolean
Dim cishu As Integer = 0
Do
canmove = False
For Each cell As my2048Cell In pic.Controls
Dim k As Integer = cell.Yindex
If k < szYnum - 1 Then
If mySZ(cell.Xindex, k + 1) = 0 Then
Dim oy As Integer = cell.Top
For i As Integer = 0 To mySizeWH Step 20
cell.Top = oy + i
Threading.Thread.Sleep(1)
pic.Refresh()
Next
cell.Yindex += 1
mySZ(cell.Xindex, k) = 0
mySZ(cell.Xindex, k + 1) = cell.ShowText
canmove = True
cishu += 1
End If
End If
Next
Loop Until canmove = False
Dim szL As Integer = mySZ.GetLength(0) - 1 '数组列数
Dim szH As Integer = mySZ.GetLength(1) - 1 '数组行数
For i As Integer = 0 To szL
For j As Integer = 0 To szH - 1
For Each cell As my2048Cell In pic.Controls
If mySZ(i, j + 1) = cell.ShowText And cell.Xindex = i And cell.Yindex = j Then
Dim oy As Integer = cell.Top
For ia As Integer = 0 To mySizeWH Step 20
cell.Top = oy + ia
Threading.Thread.Sleep(1)
' pic.Refresh()
Next
mySZ(cell.Xindex, j) = 0
mySZ(cell.Xindex, j + 1) = cell.ShowText * 2
DeFen += cell.ShowText * 2
cell.ShowText *= 2
For Each c As my2048Cell In pic.Controls
If c.Yindex = j + 1 And c.Xindex = i Then
pic.Controls.Remove(c)
End If
Next
cell.Yindex += 1
canmove = True
cishu += 1
End If
Next
Next
Next
If cishu > 0 Then
rndNewCell(pic)
DeFen += 2 * cishu
End If
End Sub
End Module
3、数据读写模块(ModuleLSgame)
定义个结构体gamePS(列举各个需存取的变量)。按字节存取。
Imports System.IO
Module ModuleLSgame '对游戏数据进行读写
Public fileStr As String = "" '字符串用于记录文件名
Public Structure gamePS
Dim mydf As Integer '得分
Dim ys As Integer '用时
Dim mbs As Integer '目标数
Dim sx As Integer '数组X数量
Dim sy As Integer '数组Y数量
Dim gp As Boolean '游戏是否暂停
Dim fs As Integer '合并方式
Dim mL As Windows.Forms.ListBox '列表存数组
Dim sz(,) As Integer '数组
End Structure
Public Function saveGame(ByVal mylistbox As Windows.Forms.ListBox, Optional ByVal fileName As String = "") As Integer '保存一个文件
If fileName = "" Then
fileStr = My.Application.Info.DirectoryPath + "/sss.g"
Else
fileStr = fileName
End If
Try
Dim MyStream As New System.IO.FileStream(fileStr, System.IO.FileMode.Create)
Dim MyWriter As New System.IO.BinaryWriter(MyStream, System.Text.Encoding.Unicode)
MyWriter.Write(DeFen) '得分
MyWriter.Write(yongShi) '用时
MyWriter.Write(MuBiaoShu) '目标数
MyWriter.Write(szXnum) '数组X数量
MyWriter.Write(szYnum) '数组Y数量
MyWriter.Write(gamePaused) '游戏是否暂停
MyWriter.Write(hbfs) '合并方式
MyWriter.Write(mylistbox.Items.Count) '列表项数据个数
For i As Integer = 0 To mySZ.GetUpperBound(0) '数组的值
For j As Integer = 0 To mySZ.GetUpperBound(1)
MyWriter.Write(mySZ(i, j))
Next
Next
If mylistbox.Items.Count >= 1 Then
For i As Integer = 0 To mylistbox.Items.Count - 1
Dim s() As String = mylistbox.Items.Item(i).ToString.Split(",")
For k As Integer = 0 To s.Length - 2
If s(k) = "" Then s(k) = "0"
MyWriter.Write(CInt(s(k)))
Next
Next
End If
MyWriter.Close()
MyStream.Close()
Return 0
Catch ex As Exception
MsgBox("error")
Return 1
End Try
End Function
Public Function readGame(ByRef newgameps As gamePS, Optional ByVal fileName As String = "") As Integer '读取一个文件
If fileName = "" Then
fileStr = My.Application.Info.DirectoryPath + "/sss.g"
Else
fileStr = fileName
End If
Try
Dim myStream As New System.IO.FileStream(fileStr, IO.FileMode.Open)
Dim myReader As New System.IO.BinaryReader(myStream, System.Text.Encoding.Unicode)
newgameps.mydf = myReader.ReadInt32()
newgameps.ys = myReader.ReadInt32()
newgameps.mbs = myReader.ReadInt32()
newgameps.sx = myReader.ReadInt32()
newgameps.sy = myReader.ReadInt32()
newgameps.gp = myReader.ReadBoolean
newgameps.fs = myReader.ReadInt32()
Dim ln As Integer = myReader.ReadInt32()
ReDim newgameps.sz(newgameps.sx - 1, newgameps.sy - 1)
For i As Integer = 0 To newgameps.sz.GetUpperBound(0) '数组的值
For j As Integer = 0 To newgameps.sz.GetUpperBound(1)
newgameps.sz(i, j) = myReader.ReadInt32()
Next
Next
Dim lf As Integer = newgameps.sx * newgameps.sy
newgameps.mL = New Windows.Forms.ListBox
newgameps.mL.Items.Clear()
For numL As Integer = 1 To ln
Dim s As String = ""
For i As Integer = 1 To lf
s += myReader.ReadInt32.ToString + ","
Next
newgameps.mL.Items.Add(s)
Next
myReader.Close()
myStream.Close()
Return 0
Catch ex As Exception
MsgBox("error")
Return 1
End Try
End Function
End Module
4、主窗体(FrmMain)
Public Class FrmMain
Private ngameps As New ModuleLSgame.gamePS
Private Sub FrmMain_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
If e.KeyCode = Keys.F3 Then
Dim sdlg As New Windows.Forms.SaveFileDialog
sdlg.InitialDirectory = My.Application.Info.DirectoryPath
sdlg.Title = "保存当前状态"
sdlg.Filter = "*.g|*.g"
If sdlg.ShowDialog = Windows.Forms.DialogResult.OK Then
If sdlg.FileName <> "" Then
If sdlg.FileName.Substring(sdlg.FileName.Length - 2, 2).ToLower = ".g" Then
saveGame(ListBox1, sdlg.FileName)
Else
saveGame(ListBox1, sdlg.FileName + ".g")
End If
End If
Else
saveGame(ListBox1)
End If
End If
If e.KeyCode = Keys.F4 Then
Dim sdlg As New Windows.Forms.OpenFileDialog
sdlg.InitialDirectory = My.Application.Info.DirectoryPath
sdlg.Title = "打开以前的游戏"
sdlg.Filter = "*.g|*.g"
If sdlg.ShowDialog = Windows.Forms.DialogResult.OK Then
If IO.File.Exists(sdlg.FileName) Then
readGame(ngameps, sdlg.FileName)
resetGame()
End If
Else
If IO.File.Exists(My.Application.Info.DirectoryPath + "/sss.g") Then
readGame(ngameps)
resetGame()
End If
End If
End If
If Timer1.Enabled = False Then
If e.KeyCode = Keys.Escape Then
Timer1.Enabled = True
gamePaused = False
ElseIf e.KeyCode = Keys.B Then
backCzuo()
ElseIf e.KeyCode = Keys.Space Then
newGame(PictureBox1)
ListBox1.Items.Clear()
Timer1.Enabled = True
End If
Else
If isGameEnd() Then
Timer1.Enabled = False
gamePaused = False
Dim jg As String = MsgBox("游戏结束了!" + vbCrLf + "得分为:" + DeFen.ToString + vbCrLf + Label5.Text + vbCrLf + "按开始键继续", vbOKOnly, Me.Text)
If jg = vbOK Then
newGame(PictureBox1)
ListBox1.Items.Clear()
Timer1.Enabled = True
End If
Else
Select Case e.KeyCode
Case Keys.Space
newGame(PictureBox1)
ListBox1.Items.Clear()
Timer1.Enabled = True
Case Keys.Escape
gamePaused = Not gamePaused
If gamePaused Then
Timer1.Enabled = False
Else
Timer1.Enabled = True
End If
Case Keys.B
backCzuo()
Case Keys.A
If hbfs = 0 Then
myMoveLeft(PictureBox1)
Else
moveLeft(PictureBox1)
End If
addList()
Case Keys.D
If hbfs = 0 Then
myMoveRight(PictureBox1)
Else
moveRight(PictureBox1)
End If
addList()
Case Keys.W
If hbfs = 0 Then
MyMoveUp(PictureBox1)
Else
moveUp(PictureBox1)
End If
addList()
Case Keys.S
If hbfs = 0 Then
myMoveDown(PictureBox1)
Else
moveDown(PictureBox1)
End If
addList()
End Select
Label1.Text = "得分:" + DeFen.ToString
End If
End If
End Sub
Private Sub backCzuo() '回退一步
If ListBox1.Items.Count > 1 Then
ListBox1.Items.RemoveAt(ListBox1.Items.Count - 1)
Dim k() As String = ListBox1.Items.Item(ListBox1.Items.Count - 1).ToString.Split(",")
Dim indx As Integer = -1
For i As Integer = 0 To mySZ.GetUpperBound(0)
For j As Integer = 0 To mySZ.GetUpperBound(1)
indx += 1
mySZ(i, j) = CType(k(indx), Integer)
Next
Next
drawPic(PictureBox1)
End If
End Sub
Private Sub resetGame() '重置游戏
Timer1.Enabled = False
gamePaused = True
Select Case ngameps.sx
Case 4
ComboBox1.SelectedIndex = 0
Case 5
ComboBox1.SelectedIndex = 1
Case 6
ComboBox1.SelectedIndex = 2
Case Else
End Select
Select Case ngameps.sy
Case 4
ComboBox2.SelectedIndex = 0
Case 5
ComboBox2.SelectedIndex = 1
Case 6
ComboBox2.SelectedIndex = 2
Case Else
End Select
Select Case ngameps.mbs
Case 256
ComboBox3.SelectedIndex = 0
Case 1024
ComboBox3.SelectedIndex = 1
Case 2048
ComboBox3.SelectedIndex = 2
Case 4096
ComboBox3.SelectedIndex = 3
Case 8192
ComboBox3.SelectedIndex = 4
Case 16384
ComboBox3.SelectedIndex = 5
Case 32768
ComboBox3.SelectedIndex = 6
Case 65536
ComboBox3.SelectedIndex = 7
Case Else
End Select
DeFen = ngameps.mydf
Label1.Text = "得分:" + DeFen.ToString
yongShi = ngameps.ys
Label5.Text = "用时:" + yongShi.ToString + "秒"
ReDim mySZ(ngameps.sx - 1, ngameps.sy - 1)
mySZ = ngameps.sz
ComboBox4.SelectedIndex = ngameps.fs
drawPic(PictureBox1)
ListBox1.Items.Clear()
For i As Integer = 0 To ngameps.mL.Items.Count - 1
ListBox1.Items.Add(ngameps.mL.Items.Item(i))
Next
If ngameps.gp Then
Timer1.Enabled = False
gamePaused = True
Else
Timer1.Enabled = True
gamePaused = False
End If
End Sub
Private Sub addList() '向列表中添加一条
Dim s As String = ""
For i As Integer = 0 To mySZ.GetUpperBound(0)
For j As Integer = 0 To mySZ.GetUpperBound(1)
s += mySZ(i, j).ToString + ","
Next
Next
If ListBox1.Items.Count < 21 Then
ListBox1.Items.Add(s)
Else
For i As Integer = 1 To 20
ListBox1.Items.Item(i - 1) = ListBox1.Items.Item(i)
Next
ListBox1.Items.Item(20) = s
End If
End Sub
Private Sub FrmMain_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
ComboBox1.SelectedIndex = 0
ComboBox2.SelectedIndex = 0
ComboBox3.SelectedIndex = 0
ComboBox4.SelectedIndex = 0
szXnum = Val(ComboBox1.SelectedItem)
szYnum = Val(ComboBox2.SelectedItem)
hbfs = 0
newGame(PictureBox1)
' mySZ(0, 0) = 65536
' mySZ(0, 1) = 32768
'mySZ(0, 2) = 16384
'mySZ(0, 3) = 8192
'mySZ(1, 0) = 4096
'mySZ(1, 1) = 2048
'mySZ(1, 2) = 1024
'mySZ(1, 3) = 512
'mySZ(2, 0) = 256
'mySZ(2, 1) = 128
'mySZ(2, 2) = 64
'mySZ(2, 3) = 32
'mySZ(3, 0) = 16
'mySZ(3, 1) = 8
'mySZ(3, 2) = 4
'mySZ(3, 3) = 2
'drawPic(PictureBox1)
ListBox1.Items.Clear()
Timer1.Enabled = True
Label1.Text = "得分:" + DeFen.ToString
End Sub
Private Sub showsz()
Dim s As String = ""
For j As Integer = 0 To szYnum - 1
For i As Integer = 0 To szXnum - 1
s += mySZ(i, j).ToString + "/"
Next
s += vbCrLf
Next
End Sub
Private Sub PictureBox1_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles PictureBox1.Resize
Me.Size = New Size(PictureBox1.Width + 10, PictureBox1.Height + 130)
End Sub
Private Sub ComboBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ComboBox1.SelectedIndexChanged
szXnum = Val(ComboBox1.SelectedItem)
newGame(PictureBox1)
ListBox1.Items.Clear()
Timer1.Enabled = True
Label1.Text = "得分:" + DeFen.ToString
End Sub
Private Sub ComboBox2_SelectedIndexChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles ComboBox2.SelectedIndexChanged
szYnum = Val(ComboBox2.SelectedItem)
newGame(PictureBox1)
ListBox1.Items.Clear()
Timer1.Enabled = True
Label1.Text = "得分:" + DeFen.ToString
End Sub
Private Sub ComboBox3_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ComboBox3.SelectedIndexChanged
MuBiaoShu = Val(ComboBox3.SelectedItem)
End Sub
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
yongShi += 1
If yongShi >= 36000 Then yongShi = 36000
Label5.Text = "用时:" + yongShi.ToString + "秒"
If isDefengou() Then
Timer1.Enabled = False
Dim jguo As String = MsgBox("已经达成目标!" + vbCrLf + "得分为:" + DeFen.ToString + vbCrLf + Label5.Text + vbCrLf + "是否继续?", vbOKCancel, Me.Text)
If jguo = vbOK Then
Timer1.Enabled = True
gamePaused = False
If ComboBox3.SelectedIndex < ComboBox3.Items.Count - 1 Then
ComboBox3.SelectedIndex += 1
Else
Timer1.Enabled = False
gamePaused = True
End If
Else
Timer1.Enabled = False
gamePaused = True
End If
End If
End Sub
Private Sub ComboBox4_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ComboBox4.SelectedIndexChanged
hbfs = ComboBox4.SelectedIndex
End Sub
End Class
六、说明
本程序仅供参考,欢迎讨论。