摸鱼神器用EXCEL做拼图游戏

摸鱼神器用EXCEL做拼图游戏

首页休闲益智拼图生存更新时间:2024-04-30

为了向孩子说明游戏只是简单的逻辑代码,自制拼图游戏。由于条件有限,只能用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