分享初学者的拼图游戏

leafsoar 2010-04-03 10:07:56
刚学编程,自己写的拼图游戏,实现了简单的功能,按键移动,和鼠标点击移动,打乱顺序,判断成功等基本功能。

在此分享给大家,提供点建议,以后要实现的是,实现一个算法,自动完成游戏,还没有思路

下面是一些代码。
欢迎大家给点意见。原码下载




Public Class PuzzleHelper

Private sourceImage As Bitmap = Nothing '用于拼图的原图像
Private targetImage As Bitmap = Nothing '用于返回的图像
Private sWidth As Integer = 0 '原图像的高度
Private sHeight As Integer = 0 '原图像的宽度
Public Const rowCount As Integer = 3 '图像的行数
Public Const colCount As Integer = 3 '图像的列数
Private dirs As Dictionary(Of Integer, Image) '用于存储片的集合
Private index(rowCount - 1, colCount - 1) As Integer 'Integer数组,用于保存图片的位置

'构造函数,用于指定原图片
Public Sub New(ByVal sImage As Bitmap)
Me.sourceImage = sImage
InitIndex()
End Sub

'用于初始化数据的方法
Private Sub InitIndex()
dirs = New Dictionary(Of Integer, Image)
For i As Integer = 0 To rowCount - 1
For j As Integer = 0 To colCount - 1
index(i, j) = i * colCount + j + 1
'在此保存所有用到的图片,保证所有图片实例存在一份
dirs.Add(index(i, j), SplitImage.RectSplit(sourceImage, colCount, rowCount, index(i, j) - 1))
Next
Next
index(rowCount - 1, colCount - 1) = 0
'初始化源图像的高度和宽度
sWidth = sourceImage.Width
sHeight = sourceImage.Height
targetImage = New Bitmap(sWidth, sHeight)
'用于打乱图片顺序
DisIndex()
End Sub

'用于返回处理后的图像
Public Function GetTarImage() As Bitmap
Dim xW As Integer = 0 '图片到左边点的距离
Dim yH As Integer = 0 '图片到上面点的距离
Dim tRect As Rectangle = New Rectangle(0, 0, sWidth / colCount, sHeight / rowCount) '目标图片的矩形大小
Dim pRect As Rectangle = Nothing '要画图的位置
Try
targetImage.Dispose() : targetImage = Nothing
targetImage = New Bitmap(sWidth, sHeight)
Dim g As Graphics = Graphics.FromImage(targetImage)
For i As Integer = 0 To rowCount - 1
For j As Integer = 0 To colCount - 1
If Not index(i, j) = 0 Then
xW = j * sWidth / colCount
yH = i * sHeight / rowCount
'设置新图片要画的位置
pRect = New Rectangle(xW, yH, sWidth / colCount, sHeight / rowCount)
g.DrawImage(dirs(index(i, j)), pRect, tRect, GraphicsUnit.Pixel)
End If
Next
Next
Catch ex As Exception
Throw ex
End Try
Return targetImage
End Function

'获取当前空白图片的位置
'这里直接用了ByRef,因为Exit sub比跳出两次for要快
Private Sub GetNothingImgIndex(ByRef i As Integer, ByRef j As Integer)
For i = 0 To rowCount - 1
For j = 0 To colCount - 1
If index(i, j) = 0 Then
Exit Sub
End If
Next
Next
End Sub

'判断移动后图片位置的有效性
Private Function GetCheckImageIndex(ByVal i As Integer, ByVal j As Integer)
If i < 0 Or i >= rowCount Then
Return False
End If
If j < 0 Or j >= colCount Then
Return False
End If
Return True
End Function

'检查是否成功
Public Function CheckWin() As Boolean
For i As Integer = 0 To rowCount - 1
For j As Integer = 0 To colCount - 1
If index(i, j) <> 0 And Not index(i, j) = i * colCount + j + 1 Then
Return False
End If
Next
Next
Return True
End Function

'随机打乱图片顺序
Private Sub DisIndex()
Dim i As Integer
Dim r As Random = New Random
For j As Integer = 0 To 100
i = r.Next
Dim k = i \ 4 Mod 4
If k = 0 Then
LeftKey()
ElseIf k = 1 Then
RightKey()
ElseIf k = 2 Then
UpKey()
ElseIf k = 3 Then
DownKey()
End If
Next
End Sub

'根据一个索引,移动索引位置的图片,用于鼠标点击移动
Public Sub ByIndexKey(ByVal indexNum As Integer)
Dim i, j As Integer
i = indexNum Mod colCount '图像的X位置
j = indexNum \ colCount '图像的Y位置
If GetCheckImageIndex(j - 1, i) Then '图片上移的可能
If index(j - 1, i) = 0 Then
UpKey()
End If
End If
If GetCheckImageIndex(j + 1, i) Then '图片下移的可能
If index(j + 1, i) = 0 Then
DownKey()
End If
End If
If GetCheckImageIndex(j, i - 1) Then '图片左移的可能
If index(j, i - 1) = 0 Then
LeftKey()
End If
End If
If GetCheckImageIndex(j, i + 1) Then '图片右移的可能
If index(j, i + 1) = 0 Then
RightKey()
End If
End If
End Sub

'图片向上移动的方法
Public Sub UpKey()
Dim i, j As Integer
GetNothingImgIndex(i, j)
'因为要向上移动,所以判断下面的图片时候有效,即i+1
If (GetCheckImageIndex(i + 1, j)) Then
index(i, j) = index(i + 1, j)
index(i + 1, j) = 0
End If
End Sub

'图片向下移动的方法
Public Sub DownKey()
Dim i, j As Integer
GetNothingImgIndex(i, j)
'因为要向下移动,所以判断上面的图片时候有效,即i-1
If (GetCheckImageIndex(i - 1, j)) Then
index(i, j) = index(i - 1, j)
index(i - 1, j) = 0
End If
End Sub

'图片向左移动的方法
Public Sub LeftKey()
Dim i, j As Integer
GetNothingImgIndex(i, j)
'因为要向左移动,所以判断右面的图片时候有效,即j+1
If (GetCheckImageIndex(i, j + 1)) Then
index(i, j) = index(i, j + 1)
index(i, j + 1) = 0
End If
End Sub

'图片向右移动的方法
Public Sub RightKey()
Dim i, j As Integer
GetNothingImgIndex(i, j)
'因为要向右移动,所以判断左面的图片时候有效,即j-1
If (GetCheckImageIndex(i, j - 1)) Then
index(i, j) = index(i, j - 1)
index(i, j - 1) = 0
End If
End Sub

End Class
Enum KeyDir
Up = 0
Down = 1
Left = 2
Right = 3
End Enum

...全文
442 18 打赏 收藏 转发到动态 举报
写回复
用AI写文章
18 条回复
切换为时间正序
请发表友善的回复…
发表回复
sunylf 2012-02-13
  • 打赏
  • 举报
回复
不規則切圖,能實現么?
xlh0053 2010-04-30
  • 打赏
  • 举报
回复
我调试的时候显示未定义类型Dictionary是怎么回事?
leafsoar 2010-04-30
  • 打赏
  • 举报
回复
ls的,你没有导入相关的命名空间吧
yuanhuiqiao 2010-04-06
  • 打赏
  • 举报
回复
路过~~~
lkhoji 2010-04-06
  • 打赏
  • 举报
回复
路过,支持一下
leafsoar 2010-04-04
  • 打赏
  • 举报
回复
[Quote=引用 12 楼 panderpeople 的回复:]
能否用C#写一个程序呀?vb我们没学
[/Quote]
C#.net和VB.net都一样,用同一个类库,你把写好的程序集反编译一下就能看到C# 代码了.
用Reflector这个工具吧.源代码都能看到的,不过这个工具最近好像开始收费了.郁闷
PanderPeople 2010-04-04
  • 打赏
  • 举报
回复
能否用C#写一个程序呀?vb我们没学
wl_zero 2010-04-03
  • 打赏
  • 举报
回复
[Quote=引用 4 楼 xingyuebuyu 的回复:]
1.所有的And改为AndAlso,所有Or改为OrElse,这样判断可以减少一些运算.

2. '设置新图片要画的位置
pRect = New Rectangle(xW, yH, sWidth / colCount, sHeight / rowCount)

这个放在循环外面New一次就可以了,在循环里面直接赋值.

3 Dim k = i \ 4 Mod 4
直接取余就好了……
[/Quote]
xingyuebuyu 2010-04-03
  • 打赏
  • 举报
回复
1.所有的And改为AndAlso,所有Or改为OrElse,这样判断可以减少一些运算.

2. '设置新图片要画的位置
pRect = New Rectangle(xW, yH, sWidth / colCount, sHeight / rowCount)

这个放在循环外面New一次就可以了,在循环里面直接赋值.

3 Dim k = i \ 4 Mod 4
直接取余就好了Dim k = i Mod 4

wuyq11 2010-04-03
  • 打赏
  • 举报
回复
先看看
古今多少事 2010-04-03
  • 打赏
  • 举报
回复
没弄个,所以谈不上啥思路……支持!!!
leafsoar 2010-04-03
  • 打赏
  • 举报
回复
第一次上传资源,写的不好。还有自动完成游戏的算法,希望大家能给点思路。谢过大家
leafsoar 2010-04-03
  • 打赏
  • 举报
回复
[Quote=引用 10 楼 xingyuebuyu 的回复:]
怎么会改变不了?
pRect = New Rectangle(xW, yH, sWidth / colCount, sHeight / rowCount)
等同于下面的四个赋值
pRect.X= xW
pRect.Y=yH
pRect.Width=sWidth / colCount
pRect.Height= sHeight / rowCount


不过做出来的效果图不错![/Quote]
可以了.非常感谢.呵呵,对这个类不是很熟,也就看别人这样用.就照葫芦画瓢,写得图片切割组装的方法
被pRect的Location属性搞混了.
xingyuebuyu 2010-04-03
  • 打赏
  • 举报
回复
[Quote=引用 6 楼 kltwjt 的回复:]
引用 4 楼 xingyuebuyu 的回复:
1.所有的And改为AndAlso,所有Or改为OrElse,这样判断可以减少一些运算.

2. '设置新图片要画的位置
pRect = New Rectangle(xW, yH, sWidth / colCount, sHeight / rowCount)

这个放在循环外面New一次就可以了,在循环里面直接赋值.

3 Dim k……
[/Quote]

怎么会改变不了?
pRect = New Rectangle(xW, yH, sWidth / colCount, sHeight / rowCount)
等同于下面的四个赋值
pRect.X= xW
pRect.Y=yH
pRect.Width=sWidth / colCount
pRect.Height= sHeight / rowCount


不过做出来的效果图不错!
leafsoar 2010-04-03
  • 打赏
  • 举报
回复
这时封装切割图片的类.

''' <summary>
''' 封装用于图片分割的类
''' </summary>
''' <remarks></remarks>
Public Class SplitImage

''' <summary>
''' 横向分割图片的方法
''' </summary>
''' <param name="sourceImage">将原始图片</param>
''' <param name="count">将横向分割成count张图片</param>
''' <param name="index">返回分割过图片的索引,要小于count-1</param>
''' <returns>返回一个当前索引的图片</returns>
''' <remarks></remarks>
Public Shared Function RowSplit(ByVal sourceImage As Bitmap, ByVal count As Integer, ByVal index As Integer) As Bitmap
If sourceImage Is Nothing Then Throw New Exception("内部异常:未指定要切割的原始图片。")
If Not index < count Then
index = count - 1
End If
If index < 0 Then
index = 0
End If
Dim tWidth As Integer = sourceImage.Width / count '目标文件的宽度
Dim tHeight As Integer = sourceImage.Height '目标文件的高度
Dim targetImage As New Bitmap(tWidth, tHeight) '目标图片
Dim tRect As Rectangle = New Rectangle(0, 0, tWidth, tHeight) '目标图片最终裁剪后的大小
Dim pRect As Rectangle = New Rectangle(tWidth * index, 0, tWidth, tHeight) '目标图片的位置
Try
Dim g As Graphics = Graphics.FromImage(targetImage)
g.DrawImage(sourceImage, tRect, pRect, GraphicsUnit.Pixel)
Catch ex As Exception
Throw ex
End Try
Return targetImage
End Function

''' <summary>
''' 纵向切割图片的方法
''' </summary>
''' <param name="sourceImage">将原始图片</param>
''' <param name="count">将纵向分割成count张图片</param>
''' <param name="index">返回分割过图片的索引,要小于count-1</param>
''' <returns>返回一个当前索引的图片</returns>
''' <remarks></remarks>
Public Shared Function ColSplit(ByVal sourceImage As Bitmap, ByVal count As Integer, ByVal index As Integer) As Bitmap
If sourceImage Is Nothing Then Throw New Exception("内部异常:未指定要切割的原始图片。")
If Not index < count Then
index = count - 1
End If
If index < 0 Then
index = 0
End If
Dim tWidth As Integer = sourceImage.Width '目标文件的宽度
Dim tHeight As Integer = sourceImage.Height / count '目标文件的高度
Dim targetImage As New Bitmap(tWidth, tHeight) '目标图片
Dim tRect As Rectangle = New Rectangle(0, 0, tWidth, tHeight) '目标图片最终裁剪后的大小
Dim pRect As Rectangle = New Rectangle(0, tHeight * index, tWidth, tHeight) '目标图片的位置
Try
Dim g As Graphics = Graphics.FromImage(targetImage)
g.DrawImage(sourceImage, tRect, pRect, GraphicsUnit.Pixel)
Catch ex As Exception
Throw ex
End Try
Return targetImage
End Function

''' <summary>
''' 割图片的方法
''' </summary>
''' <param name="sourceImage">将原始图片</param>
''' <param name="rowCount">将横向分割成count张图片</param>
''' <param name="colCount">将纵向分割成count张图片</param>
''' <param name="index">返回一个当前索引的图片,要小于rowCount*colCount-1</param>
''' <returns>返回一个当前索引的图片</returns>
''' <remarks></remarks>
Public Shared Function RectSplit(ByVal sourceImage As Bitmap, ByVal rowCount As Integer, ByVal colCount As Integer, ByVal index As Integer) As Bitmap
If sourceImage Is Nothing Then Throw New Exception("内部异常:未指定要切割的原始图片。")
If Not index < rowCount * colCount Then
index = rowCount * colCount - 1
End If
If index < 0 Then
index = 0
End If
Dim tWidth As Integer = sourceImage.Width / rowCount '目标文件的宽度
Dim tHeight As Integer = sourceImage.Height / colCount '目标文件的高度
Dim targetImage As New Bitmap(tWidth, tHeight) '目标图片
Dim tRect As Rectangle = New Rectangle(0, 0, tWidth, tHeight) '目标图片最终裁剪后的大小
Dim pRect As Rectangle = New Rectangle(tWidth * (index Mod rowCount), tHeight * (index \ rowCount), tWidth, tHeight) '目标图片的位置
Try
Dim g As Graphics = Graphics.FromImage(targetImage)
g.DrawImage(sourceImage, tRect, pRect, GraphicsUnit.Pixel)
Catch ex As Exception
Throw ex
End Try
Return targetImage
End Function
End Class



这是主窗体调用的方法了
窗体很简单.


Public Class Main



Private Sub btnOfd_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnOfd.Click
ofdMain.ShowDialog()
txtPath.Text = ofdMain.FileName.Trim
End Sub
Dim ph As PuzzleHelper = Nothing
Private Sub btnTest_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnTest.Click
If Me.txtPath.Text.Trim.Length = 0 Then
MessageBox.Show("请选择一张图片")
Exit Sub
End If
ph = New PuzzleHelper(Bitmap.FromFile(Me.txtPath.Text))
Me.picMain.Image = ph.GetTarImage
Me.txtPath.Select()
End Sub


Private Sub Main_KeyDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyDown
Dim kd As KeyDir = Nothing
Select Case e.KeyCode
Case Keys.Up
kd = KeyDir.Up
Case Keys.Down
kd = KeyDir.Down
Case Keys.Left
kd = KeyDir.Left
Case Keys.Right
kd = KeyDir.Right
End Select
If (Key(kd)) Then
MessageBox.Show("成功")
End If
End Sub

Private Function Key(ByVal keyd As KeyDir) As Boolean
If Me.picMain.Image Is Nothing Then
Exit Function
End If

Select Case keyd
Case KeyDir.Up
ph.UpKey()
Case KeyDir.Down
ph.DownKey()
Case KeyDir.Left
ph.LeftKey()
Case KeyDir.Right
ph.RightKey()
End Select
Me.picMain.Image = ph.GetTarImage
Return ph.CheckWin()
End Function

Private Sub picMain_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles picMain.MouseDown
If Me.picMain.Image Is Nothing Then
Exit Sub
End If
Dim rowIndex, colIndex, index As Integer
rowIndex = e.X \ (picMain.Width / PuzzleHelper.colCount)
colIndex = e.Y \ (picMain.Height / PuzzleHelper.rowCount)
index = (colIndex) * PuzzleHelper.colCount + rowIndex
ph.ByIndexKey(index) '用于获取图片的索引
Me.picMain.Image = ph.GetTarImage
If ph.CheckWin() Then
MessageBox.Show("成功")
End If
End Sub
End Class

xlh0053 2010-04-03
  • 打赏
  • 举报
回复
把程序源文件贴上来啊
yanlongwuhui 2010-04-03
  • 打赏
  • 举报
回复
支持下
leafsoar 2010-04-03
  • 打赏
  • 举报
回复
[Quote=引用 4 楼 xingyuebuyu 的回复:]
1.所有的And改为AndAlso,所有Or改为OrElse,这样判断可以减少一些运算.

2. '设置新图片要画的位置
pRect = New Rectangle(xW, yH, sWidth / colCount, sHeight / rowCount)

这个放在循环外面New一次就可以了,在循环里面直接赋值.

3 Dim k = i \ 4 Mod 4
直接取余就好了……
[/Quote]
说的不错..
语法不太熟....
第二个问题吗.我也想只New一次.但 "3 Dim k = i \ 4 Mod 4"
之后.pRect里面的值改变不了,不得已New这么多次.
我改变了xW,xY值。却没能改变pRect的值。。不知道为什么

16,550

社区成员

发帖
与我相关
我的任务
社区描述
VB技术相关讨论,主要为经典vb,即VB6.0
社区管理员
  • VB.NET
  • 水哥阿乐
  • 无·法
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧