为了向孩子说明游戏只是简单的逻辑代码,自制拼图游戏。由于条件有限,只能用EXCEL来做了。水平不高,直接上干货。
打开EXCEL,双击出现游戏界面,开始摸鱼[嘘]
我认真的打开EXCEL,开始拼图游戏
似乎在努力工作,实则摸鱼
玩的过程,长象太丑,保密
VBA的设计窗口
长的太丑,就不多上图了,上原始代码[害羞]
Public GameDate(10) As Integer
Public Function InitGameDate() As Boolean
Dim i As Integer
For i = 1 To 10
GameDate(i) = i
Next i
InitGameDate = True
End Function
Public Function InitGamePicName() As Boolean '装载图片,并设计游戏按钮状态
ReDrawPic
InitGamePicName = True
End Function
Public Function RdnGameDate() As Boolean '随机设计图片位置,使游戏处理开始设置
Dim i, j, Rn, temp As Integer
Dim flag As Boolean
'对游戏数据进行随机的排列
GameDate(10) = 9
GameDate(9) = 10
'保证9号图片位于空位,以确保游戏可以正确完成
Randomize
For i = 1 To 9
Rn = Int(9 * Rnd 1)
flag = False
For j = 1 To i - 1
If Rn = GameDate(i) Then
i = i - 1
flag = True
Exit For
End If
Next j
If flag = False Then '找到与前列不重复的随机数,更换游戏数据顺序
temp = GameDate(i)
GameDate(i) = GameDate(Rn)
GameDate(Rn) = temp
End If
Next i
'根据重新生成的游戏数据,装载图片
ReDrawPic
RdnGameDate = True
End Function
Public Function MovePic(ByVal index As Integer) As Boolean '根据手标返回的序号,进行元素的移动
Dim temp, Ctemp As Integer
temp = 0
Ctemp = 0
Select Case index '判断是否能移动游戏元素
Case 1
If GameDate(2) = 10 Then
temp = 2
End If
If GameDate(4) = 10 Then
temp = 4
End If
Case 2
If GameDate(1) = 10 Then
temp = 1
End If
If GameDate(5) = 10 Then
temp = 5
End If
If GameDate(3) = 10 Then
temp = 3
End If
Case 3
If GameDate(2) = 10 Then
temp = 2
End If
If GameDate(6) = 10 Then
temp = 6
End If
Case 4
If GameDate(1) = 10 Then
temp = 1
End If
If GameDate(5) = 10 Then
temp = 5
End If
If GameDate(7) = 10 Then
temp = 7
End If
Case 5
If GameDate(2) = 10 Then
temp = 2
End If
If GameDate(4) = 10 Then
temp = 4
End If
If GameDate(6) = 10 Then
temp = 6
End If
If GameDate(8) = 10 Then
temp = 8
End If
Case 6
If GameDate(5) = 10 Then
temp = 5
End If
If GameDate(3) = 10 Then
temp = 3
End If
If GameDate(9) = 10 Then
temp = 9
End If
Case 7
If GameDate(4) = 10 Then
temp = 4
End If
If GameDate(8) = 10 Then
temp = 8
End If
Case 8
If GameDate(5) = 10 Then
temp = 5
End If
If GameDate(7) = 10 Then
temp = 7
End If
If GameDate(9) = 10 Then
temp = 9
End If
Case 9
If GameDate(6) = 10 Then
temp = 6
End If
If GameDate(8) = 10 Then
temp = 8
End If
If GameDate(10) = 10 Then
temp = 10
End If
Case 10
If GameDate(9) = 10 Then
temp = 9
End If
End Select
If temp <> 0 Then '可以移动时,再进行游戏元素移动
Ctemp = GameDate(index)
GameDate(index) = 10
GameDate(temp) = Ctemp
ReDrawPic
End If
End Function
Public Function GameWin() As Boolean '判断游戏是否胜利
Dim i As Integer
Dim flag As Boolean
flag = False
For i = 1 To 10
If (GameDate(i) = i) Then
flag = True
Else
flag = False
Exit For
End If
Next i
GameWin = flag
End Function
Public Function ReDrawPic() As Boolean '重绘游戏元素
Dim GamePath As String
Dim PicName(10) As String
Dim i As Integer
GamePath = ActiveWorkbook.Path
For i = 1 To 10
PicName(i) = GamePath "\Picture\" Trim(GameDate(i)) ".bmp"
Next i
BeiGameFrm.Image1.Picture = LoadPicture(PicName(1))
BeiGameFrm.Image2.Picture = LoadPicture(PicName(2))
BeiGameFrm.Image3.Picture = LoadPicture(PicName(3))
BeiGameFrm.Image4.Picture = LoadPicture(PicName(4))
BeiGameFrm.Image5.Picture = LoadPicture(PicName(5))
BeiGameFrm.Image6.Picture = LoadPicture(PicName(6))
BeiGameFrm.Image7.Picture = LoadPicture(PicName(7))
BeiGameFrm.Image8.Picture = LoadPicture(PicName(8))
BeiGameFrm.Image9.Picture = LoadPicture(PicName(9))
BeiGameFrm.Image10.Picture = LoadPicture(PicName(10))
BeiGameFrm.Repaint
ReDrawPic = True
End Function
什么,不知道怎么让它运行,好吧!我错了[擦汗][奸笑]这不是来自于火星人的技术,属于OUT的VBA[呲牙]
代码分享了,如果你引用了,请在注释行写上,引自摘叶飞花的代码,谢谢啦[谢谢]
Copyright © 2024 妖气游戏网 www.17u1u.com All Rights Reserved