趣味撞球
首先启动VB5,新建一个标准的EXE工程。此时可以看到,工程包括一个Form1框体。在Form1边框的右下角按住鼠标左键不放,拖动鼠标把Form1的面积改为适当大小,比如6930×4320。再在属性框中把Form1的ScaleMode 属性改为3-Pixel,表明我们将以像素为我们的坐标计算单位,把Form1的StartUpPosition 属性设为2-CenterScreen,使运行时窗体出现在屏幕正中。
现在,在控件面板上选取CommandButton(命令按钮)控件,为Form1添加Command1和Command2两个按钮控件,把它们的大小设为121×25,再在属性框中把Command1的Caption填为“&GO”,把Command2的Caption填为“&QUIT”,并把Command1放到框体的右上角,把Command2放到框体的右下角。
然后,在控件面板上选取Timer(时钟)控件,为Form1添加一个Timer1时钟控件。再在属性框中把它的Enabled属性改为False,Interval属性改为50,前一个值表示该时钟控件是否激活,后一个值决定该时钟控件产生Timer事件的间隔时间,我们将用它来控制小球的移动频率。
到此为止,我们已经完成了全部的界面设计工作。接下来要做的全部工作就是填入程序代码了。
Dim BallX As Integer
Dim BallY As Integer
Dim AddX As Integer
Dim AddY As Integer
Dim HitX As Integer
Dim W As Integer
Dim H As Integer
Private Sub Command1_Click()
BallX=Int(Rnd(1)*Form1.ScaleWidth/10)*5+25
BallY=Int((Form1.ScaleHeight)/10)*5
AddX=-5
AddY=-5
Form_Paint
Timer1.Enabled=True
End Sub
Private Sub Command2_Click()
End
End Sub
Private Sub Form_MouseMove(Button As Integer,Shift As Integer,X As Single,Y As Single) X=X-50
If X<15 Then X=15
If X>W-105 Then X=W-105
HitX=X
If Timer1.Enabled=True Then
Line(16,H-5)-(W-6,H),&HC0C0C0,BF
Line(HitX,H)-(HitX+100,H-5),0,BF
End If
End Sub
Private Sub Form_Paint()
Cls
W=Int((ScaleWidth-140)/5)*5
H=Int((ScaleHeight-10)/5)*5
BackColor=&HC0C0C0
Line(10,10)-(15,H),0,BF
Line(W-5,10)-(W,H),0,BF
Line(10,10)-(W,15),0,BF
End Sub
Private Sub Timer1_Timer()
Form1.Circle(BallX,BallY),4,&HC0C0C0
BallX=BallX+AddX
BallY=BallY+AddY
Form1.Circle(BallX,BallY),4,0
If BallX<=20 Then AddX=-AddX
If BallY<=20 Then AddY=-AddY
If BallX>=W-10 Then AddX=-AddX
If BallY>=H-10 Then
If BallXHitX+100 Then
Timer1.Enabled=False
Form_Paint
End If
AddY=-AddY
End If
End Sub
一旦程序代码输入完毕,你就可以按F5开始执行它,或是在File菜单里选取Make来生成EXE执行文件了,瞧,小球已经在你的屏幕上蹦来蹦去了。
用VB6.0设计简易赛车游戏
简单的游戏往往更耐玩,就比如伴我度过高考的赛车游戏:一切都是方块,所谓的赛车也只是四个方块。
第一步,绘制对象:用函数drawcar()画赛车,drawway(n)画跑道的第n层。
第二步,接受控制:Form的KeyPreview属性要设为true,在Form_KeyPress函数中通过改变全局变量cx来控制赛车的位置。
第三步,游戏循环:作为即时游戏,必须要有一个Timer,并在其事件Timer1_Timer()中绘制所有对象和进行碰撞检测。本例中,绘图部分写在了Timer1_Timer()中,碰撞测试放在了test()中。
……这也是所有即时游戏所共通的框架。当然,我们往往还是根据具体的设计作一些变通,发挥一些技巧……比如这里设计的跑道是随机产生的的,这就要通过一点技巧以便既让玩家感到挑战,又不至于出现不可逾越的难关……
下面是全部源代码,窗体上只需放个按钮Command1就行了!
Const D = 100 '方格的宽度
Const BT = 3000 '跑道底部的y坐标
Dim l1(22) As Integer '每层跑道左边有几个方块
Dim l2(22) As Integer '每层跑道右边有几个方块
Dim cx As Single '赛车的在x轴的位置
Private Sub Command1_Click()
cx = Width / 2 - 3 * D / 2
cy = Height - D
drawcar
For i = 1 To 20
l1(i) = 0
l2(i) = 0
drawway (i)
Next i
Timer1.Enabled = True
End Sub
Private Sub drawcar()
Line (cx, BT - 100)-Step(3 * D, D), BackColor, BF
Line (cx + D, BT - 200)-Step(D, D), BackColor, BF '先擦
Line (cx, BT - 100)-Step(3 * D, D), RGB(225, 0, 0), BF
Line (cx + D, BT - 200)-Step(D, D), RGB(225, 0, 0), BF
End Sub
Private Sub drawway(n)
Line (Width/2-3*D/2-2*D,BT-n*D)-Step(7*D,D),BackColor, BF '先擦后画
Line (Width/2-3*D/2-2*D,BT-n*D)-Step(l1(n)*D, D), ,BF
Line (Width/2-3*D/2+5*D,BT-n*D)-Step(-l2(n)*D,D), ,BF
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case Asc("a"), Asc("A")
cx = cx - D
Case Asc("s"), Asc("S")
cx = cx + D
End Select
End Sub
Private Sub Timer1_Timer()
Randomize
For i = 1 To 19
l1(i) = l1(i + 1)
l2(i) = l2(i + 1)
drawway (i)
Next i
Do
l1(20) = Int(Rnd * 5)
l2(20) = Int(Rnd * 5)
Loop Until ((l1(20) + l2(20) <= 4) And (l1(20) - l1(19) <= 1) And _ (l2(20) - l2(19) <= 1) And (l1(19) + l2(20) <= 4) And _
(l1(20) + l2(19) <= 4)) '这里生成新一层跑道,
'注意要筛去玩家不可能通过的情况!
drawway (20)
'以上画出跑道
drawcar
test
End Sub
Private Sub test()
If 3.5*D-Width/2+cx If 3.5*D-Width/2+cx+D If 3.5*D-(cx+3*D-Width/2) If 3.5*D-(cx+2*D-Width/2) End Sub 108将中你最喜欢谁,让电脑猜测你的心思为了简化问题,我选择了其中的27将,将他们分成3组,每组9人。如果你最喜欢其中的一个(比如史进),他在第一组出现了,那么就按下按钮“第一组”。然后这27将会重新排列顺序,你再找史进在哪一组,比如发现他在第二组,就按下按钮“第二组”,画面中的人物次序会再次打乱,再找史进所在组别……最多3次,电脑将会猜出你心中的英雄! 知道了玩法,下面我将介绍程序是如何实现的: 一、猜测的奥妙——推算原理 猜测的原理其实也不复杂,我们来模拟一下猜测的过程大家就清楚了。程序初始化时是把1~27将随机打乱分别放入PageControl控件的三个选项卡中,每个选项卡放9张图片。点击一次按钮后其实不是盲目地将顺序打乱,而是进行了筛选,把有用的图片(就是点选的那组的9张图片)筛选出来平均分配到PageControl控件的三个选项卡中,再把不需要的图片集中起来平均分配到PageControl控件的三个选项卡中,最后在各个选项卡中把有用的、无用的图片随机打乱再次重新排列显示出来,从而完成猜测。用表1来说明: 点击按钮的次数选项卡1 选项卡2 选项卡3 1 3 3 3 2 1 1 1 3 0 0 0 具体讲,当第一次按下按钮时,表示你相中的图片在其中一个选项卡的9张图片内。于是把这9张图片均分成3份,每份3张,分别送入3个选项卡,其余的图片就不做考虑了。当第二次按下按钮时,表示你相中的图片在其中一个选项卡的3张图片内,于是把这3张图片均分成3份,每份1张,分别送入3个选项卡,当第三次按下按钮时,表示你相中的图片在其中一个选项卡的1张图片内,毫无疑问,这张图片就是你相中的图片,于是程序把这张 图片显示出来。 打乱重排的算法 在程序中的很多地方要涉及打乱顺序重排的问题,下面我们就来先简单介绍一下打乱是如何实现的。 这里要实现的方法是比较简单的,也就是多次把数组的不同位置的值互换,就像读小学时老师让两个同学互换位置一样,老师不断随机抽两个同学互换位置,最后同学们的座位就都重新排了一遍。 举个例子: int I,temp1,temp2,a[2],b[27] for(i=1;i<=27;i++)//先对数组赋初值 b[i]=I; randomize(); for(i=1;i<=500;i++)//i的大小决定打乱的程度,循环次数越多,打乱程度越高 { temp1=random(27)+1; temp2=random(27)+1; a[1]=b[temp1]; b[temp1]=b[temp[2]; b[temp2]=a[1]; } //输出 ListBox1->Clear(); for(i=1;i<=27;i++) ListBox1->Items->Add(IntToStr(b[i])); 如上例所示,经过打乱,b[27]数组将不再是旧时容颜。 二、实现的关键——筛选算法的介绍 在整个实现的过程中,如何在每一次打乱后对人物进行筛选是程序的关键所在,处理不好,程序就不会有结果。而且筛选很容易把你搅得头晕脑胀,所以涉及的各个数组之间的关系一定要先理顺,先用一个例子来解释如何进行筛选。以点击按钮的次数是第一次并且点击的按钮是Button1为例加以介绍,其思路如下: 初始: 第一次执行按钮事件并且按下的是Button1时(表a的数组就是关键数组): 把表a打乱后平均拆分为3组分别送入内存缓冲区 把表b和表c打乱后也平均拆分为3组分别送入内存缓冲区(非重要的数组),然后将它们进行组合,分别把有用的和无用的搭配重新组合为三张表并显示出来: 把全部的筛选过程表述出来: 1.初始化: 把a[1-27]打乱并将 a[1-9] 赋给first[1-9] a[10-18] 赋给second[1-9] a[19-27] 赋给third[1-9] 2.第一次按钮事件(假设选中的是第二个选项卡) second[1-9]打乱后赋给temp1[1-3]、temp2[1-3]、temp3[1-3] a[1-9]+a[19-27]赋给temp4[1-18] 并打乱 temp1[1-3]+temp4[1-6]赋给first[1-9]并打乱 temp2[1-3]+temp4[7-12]赋给second[1-9] 并打乱 temp3[1-3]+temp4[13-18]赋给third[1-9] 并打乱 3.第二次按钮事件(假设选中的是第二个选项卡) temp2[1-3]打乱后赋给temp5[1]、temp6[1] 、temp7[1] temp1[1-3]+temp3[1-3]+temp4[1-18]赋给temp8[1-24]并打乱 temp5[1]+temp8[1-8]赋给first[1-9] 并打乱 temp5[2]+temp8[9-16]赋给second[1-9] 并打乱 temp5[3]+temp8[17-24]赋给third[1-9] 并打乱 4.第三次按钮事件(如果选中的是第二个选项卡) 把temp5[2]所对应的图片显示出来即可。 最后分别把表a—表c打乱后显示出来即可。进行二次、多次筛选的方法都一样,只是要注意相中的好汉在哪个数组里面,千万别搞错就行了。 三、小结 最后的工作就比较简单了。可以设计一个友好的界面,然后在程序启动的时候对数组赋初值,并显示出来;对每个按钮分别先进行次数判断,然后进行前面讲述的处理,不断筛选直到剩下惟一的好汉后就可以显示在界面的正下方了。 VB游戏写作技巧 一开始,我想先从游戏的图形先讲起好了,毕竟游戏最重要的就是画面,一个没有漂亮图形的游戏,我连碰都不想去碰。那该怎么处理游戏的图形呢?VB提供了一个非常好用的控制项--PictureBox,有了这个控制项我们才能轻松的在程式中秀出图形,现在就来看看PictureBox有那些特性可以让我们在游戏中使用。 Picture 属性:只要将这个属性填入正常的图形档名,VB就会自动帮我们载入图形档。 Visible 属性:这个属性可以让图形消失或让图形出现在画面上。 用法:Form1.Picture1.Visible = False '消失 Form1.Picture1.Visible = True '出现 Left 属性:表示图形的位置的X座标。 Top 属性:表示图形的位置的Y座标。 用法:改变这两个属性就可以改变图形的位置。 ScaleMode 属性:设定PictureBox所使用的座标单位,一般都设为"3-像素" 知道了PictureBox的特性後,要怎么样把它应用到游戏中呢?举个例子好了,我现在要做一个打砖块的游戏,需要用到那些图片呢?砖块、球、击球的板子,一共有三张图,所以我们就使用三个PictureBox,将图片载入到PictureBox里面,如下面所示: Picture1 砖块的图片 Picture2 球的图片 Picture3 板子的图片 接著我就可以写,当我按下方向键的右键时,Picture3的left属性+1,按下左键则-1,这样一来不就可以控制板子的左右移动了吗?球也是一样,只要每隔一段时间更改一次Picture2的left和top 属性,就可以做出球移动的效果了。 或许有人会觉得奇怪,一张图就要用到一个PictureBox,小游戏的图不多还没关系,如果是RPG的话不就要动用到几千个甚至几万个PictureBox?岂不是麻烦死了?所以如果图片很多的时候,我通常都是把图全部都放在同一个图形档里面,这样就只要用到一个PictureBox了,要用图片时从里面把它抓出来就好了,不过要怎么抓呢?我建议使用函数BitBlt()来做图形的搬移。 使用BitBlt函数前要先宣告: Declare Sub BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) hDestDC 目的地的DC x 目的地的座标x y 目的地的座标y nWidth 来源图片的宽度 nHight 来源图片的高度 hSrcDC 来源图片的DC xsrc 来源图片的座标x ysrc 来源图片的座标y dwrop 运算方法:&HCC0020 PUT &H8800C6 AND &HEE0086 OR &H660046 XOR 现在有两个PictureBox Picture1 AutoRedRaw 属性设为Ture ScaleMode 属性设为"3-像素" Picture2 AutoRedRaw 属性设为Ture ScaleMode 属性设为"3-像素" 若想将Picture2里(10,10)-(100,100)区域内的图形拷贝到Picture1的(0,0) 可以这样写: BitBlt Picture1.hdc,0,0,90,90,Picture2.hdc,10,10,&HCC0020 这样子平常写游戏时就只要设两个PictureBox,一个专门用来显示,另一个则用来放图形资料,需要时再用BitBlt函数覆制过去就好了,不是很方便吗? VB游戏写作技巧 这一次写的是如何用VB来写网路程式的方法,你可不要以为这是什么深奥的程式,其实只要一个Winsock 控制项就可以了,现在就来介绍一下Winsock 的用法: 步骤一:首先要先把控制项给叫出来,你只要按下Ctrl+T後选取Winsock Control 5.0若是用VB6 的就选Winsock Control 6.0,这样就可以使用Winsock元件。 步骤二:再来我们必须先确定程式是作Server端还是Client端的,要先设定一些属性: Server写法:winsock1.localPort = 5400 (数字可以随便设) winsock1.Listen (等待连线) Client写法:winsock1.RemoteHost = "对方IP" winsock1.RemoteProt = 5400 (必须要和Server端相同) winsock1.LocalProt = 0 winsock1.Connect (连线) 连线之前Client端要先知道Server端的IP,接著等到Server端等待连线时,Client端就可以呼叫Connect方法,双方连线成功後就可以传输资料。 步骤三:当Client连线的时候Server端会引发ConnectionRequest事件,Server的程式要这样子写: Private Sub Winsock1_ConnectionRequest(ByVal requestID As long) winsock1.Close winsock1.Accept requestID End Sub 步骤四:这样一来就可以传送资料了,传送和接受资料的方法如下: 传送资料:mydata = "你好吗?" winsock1.sendData mydata 这样就会把mydata给传到对方那里。 接受资料:当有资料送到的时候会引发DataArrival事件。 Privata Sub Winsock1_DtatArrival(ByVal bytesTotal As long) Dim mydata As String winsock1.GetData mydata会把送到的资料给mydata End Sub Winsock 控制项就那么简单,只要会这些就可以写网路游戏了 贪吃蛇游戏 设计思路: (一)开始新游戏 1.1 获取并应用各个参数(当前级别,控制键等),初始化随机数(Randomize)。 1.2 清除地图上的所有物品,各个统计数值置零。 1.3 初始化地图:布置食物,炸弹,蛇身位置以及蛇头的移动方向——在PictureBox上绘画图像并修改对应的地图格属性值(MapProperty()数组)。 1.4 启动Timer定时器,游戏开始。 (二)游戏操作 2.1 暂停\恢复—— 修改表示游戏状态的Boolean型变量值; 显示\隐藏表示游戏状态的Label; 暂停\恢复Timer定时器。 2.2 控制方向(根据Nokia贪吃蛇的操作方式)—— 由于蛇头只能朝上下左右4个方向移动,但是方向键有8个,所以“斜线方向”的控制键和水平,垂直方向的控制键编码上有点不同 2.2.1 斜线方向键(以“右上”方向键为例)—— 如果当前蛇头朝着左边(水平方向)运动,则将水平方向的分量变为0,再将垂直方向的分量变为-1(向上运动); 如果当前蛇头朝着上方(垂直方向)运动,则将垂直方向的分量变为0,再将水平方向的分量变为1(向右运动)。 其余“左上,左下,右下”的方向键编码与上述雷同。 2.2.2“水平,垂直”方向键—— 当蛇以水平方向移动时,“左”和“右”的按键无效;(即不处理按键事件) 当蛇以垂直方向移动时,“上”和“下”的按键无效。 (三)移动蛇身 3.1 根据运动方向,找出蛇头的新坐标; 3.2 判断蛇头新坐标下的地图属性—— (1)如果蛇头的新坐标和当前蛇尾的坐标重合,那不算GameOver--因为随着蛇头的移动,蛇身各个节点都会向前跟进,使得当前蛇尾坐标下的网格在移动之后会变成空白地。 (2)如果当前蛇头位置的地图属性是“食物”——增加蛇身长度,统计玩家吃进的食物数量,增加分数,补充地图上的食物,记录(累加)当前吃进的物品,如果吃进的物品(curEatCount)达到一定数量(EatCountPerShowPrize)就在地图上显示奖品。 (3)如果当前蛇头位置的地图属性是“炸弹“(陷阱)——统计玩家吃进的炸弹数量,扣分(如果分数小于0,就GameOver),补充地图上的炸弹,记录(累加)当前吃进的物品,如果吃进的物品达到一定数量就显示奖品。 (4)如果当前蛇头位置的地图属性是“奖品”——加分,重新累计吃进的物品数(curEatCount = 0) 3.3 刷新蛇身坐标,更新地图网格属性以及画面 (1)在更新蛇身坐标之前,保存原来的蛇尾坐标; (2)先在地图上擦除旧的的蛇头,然后在地图上绘画出新的蛇头; (3)修改变量值,标记蛇头新坐标下的地图格属性为:蛇身; (4)要先更新蛇身除了蛇头外其余部分的坐标; (5)之后才更新蛇头的坐标; (6)判断是否需要增加蛇身长度——如果要增加长度:旧蛇尾的坐标不变,蛇身长度+ 1;否则(无需增加蛇身长度):如果蛇头的新坐标与旧蛇尾的坐标重合,就不用在旧蛇尾的坐标下绘画空白地的图案(因为该网格属性已经是蛇头,而不是空白地) (7)在地图上擦除旧蛇尾,绘画空白地; (8)在地图上把旧蛇尾坐标下的地图格的属性设置为空白地; 《标准模块Module1 代码》—— Option Explicit '全局常量 Public Enum MAP_PROPERTY '地图属性 MAP_EMPTY = 0 '空白地 MAP_FOOD '食物 MAP_BOMB '炸弹,陷阱 MAP_PRIZE '加分奖品 MAP_SNAKE '蛇身 End Enum Public Const MAP_SCALE As Integer = 15 '地图放大倍数 '地图网格数(Index值,首值为0) Public Const MAX_COL_INDEX As Integer = 19 Public Const MAX_ROW_INDEX As Integer = 10 Public Const START_SNAKE_LENGTH As Integer = 8 '蛇身初始长度 Public Const SPEED_LV1 As Integer = 200 '第一级(最慢)的速度(Timer.Interval,最快第9级=40) Public Const SPEED_CHANGE As Integer = 20 '前后2个等级之间的Interval差值(毫秒) '定义控制键 Public Const KEY_PAUSE As Integer = vbKeyNumpad5 Public Const KEY_UP As Integer = vbKeyNumpad8 Public Const KEY_DN As Integer = vbKeyNumpad2 Public Const KEY_LF As Integer = vbKeyNumpad4 Public Const KEY_RT As Integer = vbKeyNumpad6 Public Const KEY_LFUP As Integer = vbKeyNumpad7 Public Const KEY_LFDN As Integer = vbKeyNumpad1 Public Const KEY_RTUP As Integer = vbKeyNumpad9 Public Const KEY_RTDN As Integer = vbKeyNumpad3 '定义填充色 Public Const HEAD_COLOR As Long = &H80FF '蛇头颜色 Public Const BODY_COLOR As Long = vbGreen '蛇身颜色 Public Const EMPTY_COLOR As Long = &HE0E0E0 '空白地颜色 Public Const FOOD_COLOR As Long = vbBlue '食物颜色 Public Const BOMB_COLOR As Long = vbRed '炸弹颜色 Public Const FULL_COLOR As Long = 255 ^ 3 Public Const RECORD_FILE_NAME As String = "\record.dat" '记录得分榜的文件名 Public Const MAX_PRIZE As Integer = 50 '起始奖励分数的上限 Public Const MIN_PRIZE As Integer = 20 '起始奖励分数的下限 '全局变量 '记录玩家的相关信息和设置值: Public Type thePlayerInfo Score As Integer '记录得分 HeadColor As Long '蛇头填充色 BodyColor As Long '蛇身填充色 Food As Integer '记录吃进的食物数量 Bomb As Integer '记录吃进的炸弹数量 blnGameOver As Boolean '标记该玩家是否已经game over ' SnakeColor As Long '绘画蛇身使用的填充色……暂时省略…… SnakeLength As Integer '蛇身长度 '蛇头移动方向(值为-1,0,1) X_Way As Integer Y_Way As Integer '控制键(8个)……暂时省略(采用默认控制键) End Type '记录玩家的得分和名字 Type theRecord Name As String * 15 Score As Integer End Type '用于表示二维坐标值 Public Type thePosition X As Integer Y As Integer End Type Public FoodCount_AtOneTime As Integer '地图上同时出现的食物数量 Public BombCount_AtOneTime As Integer '地图上同时出现的炸弹数量 Public PrizeRemain As Integer '当前剩余的奖励分数 Public EatCountPerShowPrize '记录蛇每吃进多少物品(包括食物和炸弹,奖品不计)才显示一次奖品 Public AddScorePerFood As Integer '每吃进一个食物,所增加的分数 Public AddScorePerBomb As Integer '每吃进一个炸弹,所扣掉的分数 Sub Main() frmPlay.Show frmScoreList.Show '第一次运行时先显示得分榜 End Sub 本文来自编程入门网(https://www.doczj.com/doc/ad16366546.html,):https://www.doczj.com/doc/ad16366546.html,/VBjc/vbyx/yx6.htm VB 贪吃蛇单人版游戏(二) 文章来源:CSDN 文章作者:Bugs1984 《主窗体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 Explicit Private 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 '穿墙模式 blnOnKeyEvents = 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 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 Sub Private 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 '在暂停状态下不接受“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