p1.y_way = 1
end if
case else
exit sub
end select
tmrmove.enabled = false '暂停timer事件,等到本次移动操作全部完成后(即sub refreshsnake(...)过程执行完毕),再启动timer
call playermove
end sub
private sub form_keyup(keycode as integer, shift as integer)
blnonkeyevents = true '放开一个键之后,才能接收按键事件
end sub
private sub form_load()
me.keypreview = true
picdisplay.backcolor = empty_color
curlevel = 6 '默认级别:6
hscrlevel.value = curlevel
end sub
'游戏结束
private sub gameover()
dim ans as integer
p1.blngameover = true
tmrmove.enabled = false
if prizeremain > 0 then call showprize(false)
msgbox "游戏结束。你的得分是:" & vbcrlf & p1.score, vbinformation, "game over"
call checkrecord(p1.score) '检查分数能否上榜
call cmdnewgame_click '准备新一轮游戏
end sub
'蛇移动 的处理过程
private sub playermove()
dim temphead as theposition '临时存放蛇头的新坐标
dim blnaddlengh as boolean '是否增加蛇身的长度(t=增加)
'找出蛇头的新坐标
temphead.x = snake_p1(0).x + p1.x_way
temphead.y = snake_p1(0).y + p1.y_way
if blnthroughwall then '如果当前是 穿墙模式(默认)
if temphead.x < 0 then
temphead.x = max_col_index
elseif temphead.x > max_col_index then
temphead.x = 0
elseif temphead.y < 0 then
temphead.y = max_row_index
elseif temphead.y > max_row_index then
temphead.y = 0
end if
else
'非 穿墙模式的移动代码未设置
end if
'判断蛇头新坐标下的 地图属性
select case mapproperty(temphead.x, temphead.y)
case map_empty '空白地
'暂时没有空白地的移动操作
case map_snake '蛇身
'如果蛇头的新坐标 和当前 蛇尾 的坐标重合,就不算gameover--因为随着蛇头的移动,蛇身各个节点都会向前跟进,使得当前 蛇尾 坐标下的网格变成 空白地。
if not (temphead.x = snake_p1(ubound(snake_p1)).x and temphead.y = snake_p1(ubound(snake_p1)).y) then
call gameover
exit sub
end if
case map_food '食物
blnaddlengh = true '增加蛇身长度
p1.food = p1.food + 1 '统计玩家吃进的 食物数量
lblfoodcount.caption = p1.food '显示总共吃进的 食物数量
call changescore(addscoreperfood, true) '加分
call addfood '补充地图上的 食物
case map_bomb '炸弹
p1.bomb = p1.bomb + 1 '统计玩家吃进的 炸弹数量
lblbombcount.caption = p1.bomb '显示总共吃进的 炸弹数量
call changescore(addscoreperbomb, true) '扣分