水果拼盘游戏
触摸到触摸图片数组(请自行添加):image1(0)-image1(9)
当前图片:image2(0) (=image1(0))
当前网关:lblLevel(标签)
此外，标签控件还包括:lblLink、lblMsg、lblNextScore、lblNowScore、lblScore。
将下面的代码复制到窗体中。
选项显式
将行作为整数变暗
将列显示为整数
变暗等级为长
Dim分数一样长
模糊图片作为图像
Dim pic()为Long '图片对应的序号。
Dim sel() As Boolean '图片选择状态
选中图片后，相应的序列号变暗。
变暗高()一样长
“选择为布尔型”当前选择状态。
暗淡的颜色一样长
Dim CountLink一样长
私有子窗体_Load()
行数= 10 '总行数
Cols = 10 '总列数
Drawboximage2，4，92，rows，cols的绘制控制数组。
末端接头
开始游戏
私有子图像3_Click()
自动提款= 0
图3。可见=假
初始化
末端接头
初始化随机排列的对象。
子初始化()
级别= 0
分数= 0
lblNowScore =分数
新生活
末端接头
规划表单，对象数组从上到下，从左到右。
参数调用:ImageBox-图像控件数组(必须定义image(0)，Mleft-起点坐标x；Mtop-起点坐标y；
Mrows-银行总数；Mcols-总列数
子drawbox(ImageBox作为对象，Mleft作为整数，Mtop作为整数，Mrows作为整数，Mcols作为整数)
-初始化数组
ReDim pic(Mrows * Mcols - 1)
ReDim sel(Mrows * Mcols - 1)
ReDim高(Mcols - 1)
-绘制控件数组
暗淡我一样长
For i = ImageBox。UBound到1步骤-1
卸载图像盒(I)
然后
对于i = 1到Mrows * Mcols - 1
加载图像框(I)
图像框(一)。left = m left+(I \ Mrows)* ImageBox(0)。宽度
图像框(一)。top = Mtop+(I Mod Mrows)* ImageBox(0)。高度
然后
显示帮助
末端接头
显示帮助
Sub showhelp()
创造信息。
LblMsg = "的简要说明" &；vbNewLine & ampvbNewLine _
& ampvbNewLine & ampvbNewLine & amp"●用鼠标点击任意对象，自动选择相同的连接对象。再次单击所选对象以消除它。_
& ampvbNewLine & ampvbNewLine & amp“●聚集更多对象，一次性消除后获得更多积分。”_
& ampvbNewLine & ampvbNewLine & amp"消除时，上面的物体会向下填补空缺."_
& ampvbNewLine & ampvbNewLine & amp●当所有行都为空时，右边的对象将整体向左移动以填充它们_
& ampvbNewLine & ampvbNewLine & amp“●当物体不再连接时，会根据剩余数量考虑是否加分。剩余越少，加分越多。”_
& ampvbNewLine & ampvbNewLine & amp如果当前分数不低于通关分数，游戏将在下一关继续
末端接头
进入新的海关。
Sub NewLever()
暗淡我一样长
lblMsg。可见=假
级别=级别+ 1
使不规则化
对于i = 0到Image2。UBound
pic(i) = Int(Rnd * 5)
图像2(i) =图像1(图片(I))
图2(一)。可见=真
然后
col = Cols - 1
对于i = 0至Cols - 1
高(i) =行数- 1
然后
CountLink = 0
LBL level = " level " &；vbCrLf & amp；水平
LblNowScore = "当前分数:" &；格式(分数，“@@@@@@”)
LblNextScore = "及格分数:" &；格式(级别*(级别+ 4) * 500，“@@@@@@”)
选定=假
末端接头
选择对象并相应地处理它们。
私有子图像2_Click(索引为整数)
如果pic (index) =-1那么退出sub '如果你点击已经消除的空格，你将不会被处理并退出。
ReDim NowLink(0)
CountLink = 0
链接索引
选定=真
如果sel(Index ),则删除，否则重置索引
末端接头
消除对象
子删除()
暗淡我一样长
Dim j As Long
Dim k As Long
如果CountLink = 1，那么Exit Sub '如果只选择了一个项目，那么它是无效的，并且不做任何处理就退出。
对于i = 0到UBound(NowLink)
Sel(NowLink(i)) = False '清除复选标记。
Pic(NowLink(i)) = -1 '图片对应的序号设置为无。
然后
对于i = 0到col '清空图片后，上图就倒了。
对于j =(行数- 1) -高(I)到(行数- 1)
如果pic(i * Rows + j) = -1，则
对于k = j到行-高(I)步-1
pic(i *行+ k) = pic(i *行+ k - 1)
然后
pic(I * Rows+(Rows-1)-High(I))=-1
高(i) =高(i) - 1
如果…就会结束
然后
然后
对于i = col To 0 Step -1 '图片清除后，右边的图片向左移动。
如果高(i) = -1，则
对于j = i至col - 1
对于k = 0到(行- 1)
pic(j *行+ k) = pic(j *行+ k +行)
然后
高(j) =高(j + 1)
然后
for j = col * Rows To col * Rows+(Rows-1)
pic(j) = -1
然后
col = col - 1
如果…就会结束
然后
对于i = 0到(Rows * Cols-1)'刷新调整后的图片。
如果pic(i) = -1，则
Image2(i) = picNothing
其他
图像2(i) =图像1(图片(I))
如果…就会结束
然后
分数=分数+计数链接*(计数链接+ 2) * 5
LblNowScore = "当前分数:" &；格式(分数，“@@@@@@”)
选定=假
LblLink = "连接:"
LblScore = "Score:"
isLink
末端接头
重新选择对象
子复位(索引为整数)
暗淡我一样长
对于i = 0到UBound(NowLink)
sel(NowLink(i)) = False
image2(now link(I))= image 1(pic(now link(I)))
然后
ReDim NowLink(0)
CountLink = 0
链接索引
末端接头
标记连接的对象。
子链接(索引为整数)
image2(index)= image 1(PIC(index)+5)'当前图片背景为灰色。
sel(Index) = True
NowLink(UBound(NowLink)) = Index
CountLink = CountLink + 1
If Index \ Rows & gt“0 Then”从第二列开始。
如果pic (index-rows) = pic (index)而not sel (index-rows ),则'与左边的相邻模式相同，并且不被选择。
ReDim Preserve now link(UBound(now link)+1)
链接的索引行
如果…就会结束
如果…就会结束
If Index \ Rows & lt(COLS-1)从第1列到倒数第二列。
如果pic (index+rows) = pic (index)而not sel (index+rows ),那么'与右边相邻的模式相同，不被选中。
ReDim Preserve now link(UBound(now link)+1)
链接索引+行
如果…就会结束
如果…就会结束
If Index Mod Rows & gt“0 Then”从第2行开始
如果pic (index-1) = pic (index)而not sel (index-1)则‘与上相邻模式相同，不选择。
ReDim Preserve now link(UBound(now link)+1)
链接指数- 1
如果…就会结束
如果…就会结束
如果索引模行数& lt(rows-1)从第1行到倒数第二行。
如果pic (index+1) = pic (index)而not sel (index+1)则'与下面的相邻模式相同，不选择。
ReDim Preserve now link(UBound(now link)+1)
链接指数+ 1
如果…就会结束
如果…就会结束
LBL link = " Connection:" &；格式(CountLink，" @@@@ ")
LblScore = " Score:" &；format(count link *(count link+2)* 5-IIf(count link & gt；1，0，Cols)，" @@@@ ")
末端接头
有什么联系的对象吗？
子链接()
暗淡我一样长
Dim j As Long
暗淡奖金一样长
将y标注为单个
对于i = 0至col
对于j =(行数- 1) -高(I)到(行数- 2)
如果pic(I * Rows+j)= pic(I * Rows+j+1)，则退出Sub
然后
然后
对于i = 1到col步骤2
对于j =(行数- 1) -高(I)到(行数- 1)
如果pic(I * Rows+j)= pic(I * Rows+j-Rows)，则退出Sub
如果pic(I * Rows+j)= pic(I * Rows+j+Rows)，则退出Sub
然后
然后
j = 0
对于i = 0至col
j = j +高(i) + 1
然后
bonus = IIf(j & lt；25，(25 - j) * (25 - j) * 25，0)
LblMsg = "剩余数量:" &；格式(j，" @ @ @ " & amp；“个”&；"奖励积分:" &；格式(奖金，“@ @ @ @”& amp；“分”
LblMsg。'设置字体大小。
lblMsg。Left = (ScaleWidth - lblMsg。宽度)/ 2
lblMsg。BackStyle = 1
lblMsg。可见=真
分数=分数+奖金
LblNowScore = "当前分数:" &；得分
ys =计时器
在Timer-ys & lt；2
多项活动
环
如果得分& lt等级*(等级+ 4) * 500然后
LblMsg = "游戏失败，再来一次！"
lblMsg。Left = (ScaleWidth - lblMsg。宽度)/ 2
ys =计时器
在Timer-ys & lt；2
多项活动
环
初始化
其他
LblMsg = "恭喜你进入下一关！"
lblMsg。Left = (ScaleWidth - lblMsg。宽度)/ 2
ys =计时器
在Timer-ys & lt；2
多项活动
环
新生活
如果…就会结束
末端接头