共有回帖数 1 个
-
《主窗体 FrmPlay 代码》——Private blnStartGame As Boolean '标记是否已经开始 新游戏（T＝游戏已经开始）
Private blnPause As Boolean '标记当前是否处于暂停状态（T＝暂停）
Private blnThroughWall As Boolean '标记是否为穿墙模式（T＝可以穿墙）
Private blnOnKeyEvents As Boolean '标记是否能够 接收键盘事件（T＝可以接收），此变量可防止 Form_KeyDown()事件重复执行Private Map_Width As Integer '地图宽度（象素）
Private Map_Height As Integer '地图高度（象素）
Private Map_Empty_Color '地图－空白地颜色
Private Map_Bomb_Color '地图－炸弹颜色
Private Map_Food_Color '地图－食物颜色
Private MapProperty() As Integer '记录地图各个网格的属性Private curEatCount As Integer '记录 每次出现奖品之前，一共吃进多少物品（包括食物和炸弹，奖品不计），当奖品出现后，此变量值变为 零"0"，然后进入下一次统计
Private curLevel As Integer '当前级别
Private P1 As thePlayerInfo '记录Player1 的信息Private Snake_P1() As thePosition '记录蛇身坐标
Private PrizePos As thePosition '记录奖品的坐标Private Record(9) As theRecord '存放前十名的 得分记录信息Option ExplicitPrivate Sub cmdHelp_Click()
If blnPause = False Then Call Form_KeyDown(KEY_PAUSE, 0) '如果游戏正在进行，则发送“暂停”按键事件，暂停游戏
frmHelp.Show
End Sub'开始新游戏
Private Sub cmdNewGame_Click()
Dim i As Integer
Randomize '重新生成随机数列
blnStartGame = Not blnStartGame
If blnStartGame Then
cmdNewGame.Caption = "停止"
Else
cmdNewGame.Caption = "新
游戏"
End If
'中止游戏
If blnStartGame = False Then
'如果上一次的奖品还没有消失（以 PrizeRemain 0 为标志），就先清除旧的奖品，然后才显示新的奖品
If PrizeRemain 0 Then Call ShowPrize(False) picDisplay.Cls
P1.Score = 0 '玩家的初始分数
P1.Food = 0
P1.Bomb = 0
curEatCount = 0
PrizeRemain = 0
blnPause = False
lblPause.Visible = False
lblScore.Caption = P1.Score
lblFoodCount.Caption = P1.Food
lblBombCount.Caption = P1.Bomb
P1.blnGameOver = True
HscrLevel.Enabled = True
tmrMove.Enabled = False
Exit Sub
End If
blnThroughWall = True '穿墙模式
blnO
nKeyEvents = True
'暂时使用默认填充色
Map_Bomb_Color = BOMB_COLOR
Map_Empty_Color = EMPTY_COLOR
Map_Food_Color = FOOD_COLOR
P1.BodyColor = BODY_COLOR
P1.HeadColor = HEAD_COLOR
'地图初始化
ReDim MapProperty(MAX_COL_INDEX, MAX_ROW_INDEX)
Map_Width = (MAX_COL_INDEX + 1) * MAP_SCALE
Map_Height = (MAX_ROW_INDEX + 1) * MAP_SCALE
picDisplay.Cls
picDisplay.Width = Map_Width + 2
picDisplay.Height = Map_Height + 2
picDisplay.Line (0, 0)-Step(Map_Width, Map_Height), Map_Empty_Color, BF
FoodCount_AtOneTime = 2 '地图上同时存在的 食物数量
BombCount_AtOneTime = 1 '地图上同时存在的 炸弹数量
EatCountPerShowPrize = 5 '设置 蛇每吃进多少物品（包括食物和炸弹，奖品不计）才显示一次奖品
curLevel = HscrLevel.Value
AddScorePerFood = curLevel '每吃进一个 食物，所增加的分数＝当前的级别值
AddScorePerBomb = -curLevel * 2 '每吃进一个 炸弹，所扣掉的分数
P1.Score = Abs(AddScorePerBomb) + 1 '玩家的初始分数＝'每吃进一个 炸弹，所扣掉的分数＋1
P1.Food = 0
P1.Bomb = 0
楼主 2016-07-15 09:31 回复
-
; PrizeRemain = 0
P1.blnGameOver = False
lblScore.Caption = P1.Score
lblFoodCount.Caption = P1.Food
lblBombCount.Caption = P1.Bomb
'初始化P1蛇身
ReDim Snake_P1(START_SNAKE_LENGTH)
For i = 0 To UBound(Snake_P1)
'设定蛇身各段的起始位置
Snake_P1(i).X = MAX_COL_INDEX - UBound(Snake_P1) + i
Snake_P1(i).Y = MAX_ROW_INDEX
'初始化移动方向
P1.X_Way = -1
P1.Y_Way = 0
MapProperty(Snake_P1(i).X, Snake_P1(i).Y) = MAP_SNAKE
picDisplay.Line (Snake_P1(i).X * MAP_SCALE, Snake_P1(i).Y * MAP_SCALE)-Step(MAP_SCALE, MAP_SCALE), BODY_COLOR, BF
Next
'使用蛇头颜色 重新绘画蛇头
picDisplay.Line (Snake_P1(0).X * MAP_SCALE, Snake_P1(0).Y * MAP_SCALE)-Step(MAP_SCALE, MAP_SCALE), HEAD_COLOR, BF
'放置食物
For i = 1 To FoodCount_AtOneTime
Call AddFood
Next
'放置炸弹
; For i = 1 To BombCount_AtOneTime
Call AddBomb
Next
lblPause.Visible = False
lblScore.Caption = P1.Score
lblFoodCount.Caption = P1.Food
lblBombCount.Caption = P1.Bomb
P1.blnGameOver = False
HscrLevel.Enabled = False '游戏进行期间不能改变级别
tmrMove.Enabled = True
End Sub'显示得分榜
Private Sub cmdShowScoreList_Click()
If blnPause = False Then Call Form_KeyDown(KEY_PAUSE, 0) '如果游戏正在进行，则发送“暂停”按键事件，暂停游戏
frmScoreList.Show
End SubPrivate Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If P1.blnGameOver Or blnStartGame = False Or blnOnKeyEvents = False Then Exit Sub '以下情况（游戏结束、游戏还没有开始、禁用击键事件）不接收按键操作。
'按“Numpad 5”键－－暂停/继续
If KeyCode = KEY_PAUSE Then
blnPause = Not blnPause
lblPause.Visible = blnPause
tmrMove.Enabled = Not blnPause
Exit Sub
End If
If blnPause Then Exit Sub '在暂停状态下不接受&ldqu
o;ESC”外的其它按键
Select Case KeyCode
Case KEY_LFUP
blnOnKeyEvents = False
If P1.X_Way 0 Then
P1.X_Way = 0
P1.Y_Way = -1
ElseIf P1.Y_Way 0 Then
P1.X_Way = -1
P1.Y_Way = 0
End If
Case KEY_LFDN
blnOnKeyEvents = False
If P1.X_Way 0 Then
P1.X_Way = 0
P1.Y_Way = 1
ElseIf P1.Y_Way 0 Then
P1.X_Way = -1
P1.Y_Way = 0
End If
Case KEY_RTUP
blnOnKeyEvents = False
If P1.X_Way 0 Then
P1.X_Way = 0
P1.Y_Way = -1
ElseIf P1.Y_Way 0 Then
P1.X_Way = 1
P1.Y_Way = 0
End If
Case KEY_RTDN
blnOnKeyEvents = False
If P1.X_Way 0 Then
P1.X
_Way = 0
P1.Y_Way = 1
ElseIf P1.Y_Way 0 Then
P1.X_Way = 1
P1.Y_Way = 0
End If
'当蛇以 水平 方向移动时，LF 和 RT 按键无效
Case KEY_LF
blnOnKeyEvents = False
If P1.X_Way = 0 Then
P1.X_Way = -1
P1.Y_Way = 0
End If
Case KEY_RT
blnOnKeyEvents = False
If P1.X_Way = 0 Then
P1.X_Way = 1
&nbs
p; P1.Y_Way = 0
End If
'当蛇以 垂直 方向移动时，UP 和 DN 按键无效
Case KEY_UP
blnOnKeyEvents = False
If P1.Y_Way = 0 Then
P1.X_Way = 0
P1.Y_Way = -1
End If
Case KEY_DN
blnOnKeyEvents = False
If P1.Y_Way = 0 Then
P1.X_Way = 0
P1.Y_Way = 1
End If
Case Else
Exit Sub
End Select
&n
bsp;
tmrMove.Enabled = False '暂停Timer事件，等到本次移动操作全部完成后（即sub RefreshSnake(...)过程执行完毕），再启动Timer
Call PlayerMove
End Sub
1楼 2016-07-15 09:32 回复
Copyright © 2010~2015 直线网 版权所有,All Rights Reserved.沪ICP备10039589号
意见反馈 |
关于直线 |
版权声明 |
会员须知
