| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 3804 人关注过本帖, 8 人收藏
标题:精力过剩 打打飞机
只看楼主 加入收藏
lowxiong
Rank: 12Rank: 12Rank: 12
等 级:贵宾
威 望:27
帖 子:653
专家分:3402
注 册:2008-5-7
结帖率:100%
收藏(8)
 问题点数:0 回复次数:21 
精力过剩 打打飞机
  自从微信将打飞机游戏更换为“全民飞机大战”后,我就再没有下载玩耍了。把玩手机时,有时会想起过去那种手指划过屏幕,指挥小飞机穿插在千军万马中,努力为提高排名而奋战的时光。无聊时偶尔会找电脑版来玩 玩,但电脑版玩起来感觉完全不对,于是决定自己设计一个,一来怀怀旧,二来检验下VB设计简单平面游戏的能力,三来为MH370上的乘客祈福,游戏里飞机没了可以重来,MH370看来永远回不来了,一路走好!(这个有点扯 ,权当提醒各位:珍惜当下,珍爱生命吧)。
  设计该游戏所需的素材还是比较容易找的,大都用于JAVA游戏设计用。素材可以通用,算法才是你自己的。原本打飞机游戏是苹果公司放在自己的平板系统中的,后被唯利是图的腾讯公司山寨进来吸引用户,并被改成苹 果版和安卓版了,电脑版的打法都是类似安卓版的,我用的是苹果手机,当然要按照苹果版来设计了,这两种版本有两处区别:一是出子弹的方式,苹果版每次出一颗子弹,子弹不消失不出子弹,因此此你越抵近打击,子弹 频率越快,安卓版子弹连续出,频率不变;第二个区别是随机出敌机的方式,我觉得苹果敌机出的更谨慎,而安卓一下子就有大飞机出来了(我真不知道狗屎的腾讯公司怎么还把这两种方式放在一起排名,安卓随随便便可打 300万以上,而我在苹果里大都100万左右就挂了)。
  闲话少叙,还是说游戏设计。我这次提供的压缩包里有游戏资源(图片、声音)、我编辑好的游戏所需图元信息文件、一个图元编辑程序和该程序使用说明、一个编译了的打飞机游戏(未完成无敌版)、一个VB工程文件 ,工程文件只有基本控件,代码我打算逐步添加,以供初学者参考(我也是第一次设计即时战斗游戏,望得到有经验者指正,互相学习)。该游戏用到的所有图片单元(以下简称图元)是放在一张shoot.png的图片里,我没找到vb读png文件的相关资料,所以我用ps对该图片进行了处理,形成两个文件,一个是图元集合图片shoot.jpg,一个是图元遮罩图片shootmask.jpg,利用遮罩图片的留白部分完成对应图元不透明的处理,我专门写了个提取各图元信息的程序,并对图元归类命名,这些信息放在pel.dat文件中,各位可以运行“图元编辑.exe”,看看我编辑了哪些图元,怎么命名的。
  显然,我们不能过多妄想用VB来写图形处理代码,否则运行速度直接让你崩溃。其实很多大佬已经用VB调用DX来做游戏了,这个游戏不需要,调用GDI做图形处理就足够。我这里用到了几个API,分别是:StretchBlt剪切缩放拷贝图片,BitBlt剪切拷贝图片(可以比StretchBlt快点),CreateCompatibleDC、CreateCompatibleBitmap、SelectObject、DeleteDC、DeleteObject等内存场景相关调用,用内存场景操作图像比在控件里操作图像要快。我的思路是:首先把所需的图片文件调入相应的内存场景DC中,建立一个缓冲DC,所有缓冲算法是对缓冲DC操作,最后定时把缓冲DC的图形刷到窗口里显示。由于大多用API调用完成,窗口里安排的控件比较少,我的设计窗口如下图:
图片附件: 游客没有浏览图片的权限,请 登录注册

图片附件: 游客没有浏览图片的权限,请 登录注册

  控件说明:一个MMControl控件数组mmc1(0),用来完成声音及音效播放;两个timer控件,分别是FreshDC和Proce,主要用来每20毫秒刷新显示和每半秒产生随机图元;一个picturebox控件pic1,主要调图片的过渡用,因为我没有找到直接把图片调入内存场景方法(GDI+有,但转换、初始化等手续多,懒得弄),该图片过渡完后,一定要使用 set pic1.picture=nothing,语句释放资源。下面是我的变量、数据结构以及函数声明的代码及工程压缩文件,暂时写到这里。
经典飞机大战.zip (2.82 MB)

程序代码:
Private Type CutPelInfo
  '图元剪裁信息
  Name As String            '图元名称
  Index As Integer          '动画系列号
  X As Single
  Y As Single               '剪裁左上角坐标
  w As Single
  h As Single               '剪裁大小(宽高)
End Type

Private Type DefPel
  '自定义绘制图元的数据结构
  State As Integer          '图形性质0:无图元,1:无害图元(如爆炸残骸) 2:敌机图元 3:我方图元
  Name As String            '对应声音文件名
  AniIndex As Single        '图元动画编号索引
  AniStep As Single         '图元动画步进速率
  AniCir As Boolean         '动画循环标志,True时循环显示,否则显示完该图元即消失(爆炸动画即如此)
  Strength As Integer       '抗击打力,敌机每中弹一次该数据减1,为0即爆炸消失。敌小机1,敌中机5,敌大机12
  Score As Integer          '击毙得分,敌机设置该项,敌小机1000,敌中机6000,敌大机30000
  X As Single
  Y As Single               'XY是图元中心点位于显示场景坐标,
  xStep As Single
  yStep As Single           '图元运动方向和速率,如xStep<0则向左运动,0不运动,>0则向右运动,数越大则越快
  w As Single               '图元宽
  h As Single               '图元高,每次在场景中显示时获取,主要用于判断该图元是否跑出边界
End Type

Private Declare Function StretchBlt Lib "gdi32" (ByVal hDc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function SetStretchBltMode Lib "gdi32" (ByVal hDc As Long, ByVal nStretchMode As Long) As Long
Private Declare Function 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) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDc As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDc As Long, ByVal nWidth As Long, _
  ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Dim Zoom As Single              '缩放比例
Dim BgDc As Long                '背景内存场景
Dim BgMove As Integer           '背景移动计数,用于循环移动背景
Dim ShootDc As Long             '源图像内存场景
Dim MaskDc As Long              '源图像掩码内存场景
Dim BuffDc As Long              '内存缓冲场景,防止图像显示闪烁
Dim CutPel(100) As CutPelInfo   '存储图元剪裁信息数组
Dim DispPel(100) As DefPel      '显示图元,0、1子弹,2-4保留,5-85随机,86我方战机,87暂停,88保险,89-90保险数,91-100显示得分
Dim PlayTime As Long            '游戏时间计数(每半秒计数一次)
Dim DifftyData As Integer       '难易程度,最高为100
Dim CanMove As Boolean          '能否移动我方战机标志
Dim AmmoState As Integer        '弹药状态,不为0时为双弹(蓝弹)
Dim UnconTime As Integer        '无敌计时,0:我战机常态 >0则无敌
Dim Score As Long               '成绩
Dim PauseFlg As Boolean         '暂停标志
Dim BombNum As Integer          '保险数量
Dim MyNum As Integer            '我战机数量,数量为0时GameOver


[ 本帖最后由 lowxiong 于 2014-4-6 06:37 编辑 ]
搜索更多相关主题的帖子: JAVA游戏 珍爱生命 能力 平面 
2014-04-04 11:35
owenlu1981
Rank: 9Rank: 9Rank: 9
等 级:贵宾
威 望:13
帖 子:211
专家分:1130
注 册:2013-5-17
收藏
得分:0 
厉害!
2014-04-04 12:45
zhengang1026
Rank: 6Rank: 6
等 级:侠之大者
威 望:1
帖 子:136
专家分:409
注 册:2013-2-6
收藏
得分:0 
呵呵,lowxiong老师又要出新作了!期待中...
2014-04-04 21:35
lowxiong
Rank: 12Rank: 12Rank: 12
等 级:贵宾
威 望:27
帖 子:653
专家分:3402
注 册:2008-5-7
收藏
得分:0 
钓鱼一天,忘了接下来要说什么,直接贴代码,看注释即可知道是做什么的,把下列代码黏贴后与昨天代码合并,运行工程即可看到窗口变化,并且出现背景音乐。
程序代码:
Private Function CopyImg(sDc As Long, w As Integer, h As Integer) As Long
  '建立并拷贝sdc场景图像,返回该场景DC
  Dim mDC As Long
  Dim mBmp As Long
  Dim l As Long
  mDC = CreateCompatibleDC(sDc)
  mBmp = CreateCompatibleBitmap(sDc, w, h)
  SelectObject mDC, mBmp
  l = BitBlt(mDC, 0, 0, w, h, sDc, 0, 0, vbSrcCopy)
  CopyImg = mDC
  DeleteObject mBmp
End Function

Private Function MakeOnePel(pNum As Integer, pName As String, pState As Integer, pX As Integer, pY As Integer, _
  xSp As Integer, ySp As Integer) As Integer
  '根据条件在图元显示数组中设置一个新的图元
  'pNum为指定数组编号,-1时则在5-85中寻找一个空闲的数组,pName为图元名称,pState表名敌我属性0:无图 1:无害 2:敌方 3:我方
  'pX、pY为指定图元所在位置,小于0时则x位置随机生成,y位置确保图元初始位置在屏幕外,xSp、ySp为上下左右移动速率
  Dim pPos As Integer, pX1 As Single, pY1 As Single, i As Integer
  Dim pW As Integer, pH As Integer
  MakeOnePel = -1
  pPos = pNum                                                       '默认给出了图元位置
  If pNum < 0 Then
    For i = 5 To 84
      If DispPel(i).State = 0 Then Exit For                         '找一个空闲的填写图元信息
    Next
    pPos = i
  End If
  pW = -1: pH = -1
  For i = 0 To 100
    If CutPel(i).Name = "" Then Exit For
    If CutPel(i).Name = pName And CutPel(i).Index = 0 Then
      pW = CutPel(i).w * Zoom: pH = CutPel(i).h * Zoom              '获取图元宽高
      Exit For
    End If
  Next
  If pW < 0 And pH < 0 Then Exit Function                           '没找到对应图元信息退出
  pX1 = pX: pY1 = pY
  If pX1 < 0 Then
    pX1 = Rnd * (Me.ScaleWidth - pW) + pW * 0.5                     '产生随机坐标X位置
    pY1 = -pH * 0.5                                                 '确保产生的图元在屏幕外
  End If
  With DispPel(pPos)                                                '填写新图元信息
    .AniCir = True
    .AniIndex = 0
    .AniStep = 0.5
    .h = pH
    .Name = pName
    If pName = "敌小机" Then .Score = 1000: .Strength = 1
    If pName = "敌中机" Then .Score = 6000: .Strength = 5
    If pName = "敌大机" Then .Score = 30000: .Strength = 12
    .State = pState
    .w = pW
    .X = pX1
    .xStep = xSp
    .Y = pY1
    .yStep = ySp
  End With
  MakeOnePel = pPos
End Function
Private Sub GetAllConst()
  '加载一次性变量,如DC、音乐、缩放比例等,这些量一经计算不再改变。
  Dim a As String, i As Integer, j As Integer
  On Error GoTo err_Lp
  Me.Width = 6000                                                    '修改这个数可以改变游戏窗口大小
  Me.ScaleMode = 3: Me.AutoRedraw = False: FreshDC.Interval = 20: Proce.Interval = 500: MMC1(0).Visible = False
  Pic1.ScaleMode = 3: Pic1.Visible = False: Pic1.AutoRedraw = True: Pic1.AutoSize = True
  Pic1.Picture = LoadPicture(App.Path & "\image\background.jpg")     '装载背景图片
  Zoom = Me.ScaleWidth / Pic1.ScaleWidth                             '根据背景图片宽度和窗口宽度获取缩放比例
  Me.Height = Pic1.Height * Zoom * 15                                '根据背景图片高度按比例得到窗口高度
  Me.Top = 0                                                         '设置窗口显示位置
  BgDc = CopyImg(Pic1.hDc, Pic1.ScaleWidth, Pic1.ScaleHeight)        '把背景图片放到内存DC中
  BuffDc = CopyImg(Me.hDc, Me.ScaleWidth, Me.ScaleHeight)            '创建一个和显示窗口相同的内存缓冲DC
  Pic1.Picture = LoadPicture(App.Path & "\image\shoot.jpg")          '装载图元集合图片
  ShootDc = CopyImg(Pic1.hDc, Pic1.ScaleWidth, Pic1.ScaleHeight)     '把图元集合图片拷贝到内存DC中
  Pic1.Picture = LoadPicture(App.Path & "\image\shootmask.jpg")      '装载图元掩码集合图片
  MaskDc = CopyImg(Pic1.hDc, Pic1.ScaleWidth, Pic1.ScaleHeight)      '把图元掩码集合图片拷贝到内存DC中
  Set Pic1.Picture = Nothing                                         '所有需要的图片已拷贝到内存DC中,释放pic1占用的资源
  a = Dir(App.Path & "\sound\")
  i = 0
  While a <> ""
    '为加强声音的同步效果,把所有声音预先加载进mmc控件数组
    If i > 0 Then Load MMC1(i)
    MMC1(i).FileName = App.Path & "\sound\" & a
    MMC1(i).Command = "open"
    a = Dir
    i = i + 1
  Wend
  a = App.Path & "\image\pel.dat"
  If Dir(a) = "" Then Error 13                                       '如果没有pel.dat文件将无法游戏,启动错误陷阱
  Open a For Binary Access Read As #1
    Get #1, , CutPel                                                 '读取图元剪切信息文件
  Close #1
  Exit Sub
err_Lp:
  MsgBox "可能缺少支持文件,游戏不能继续!"
  End
End Sub
Private Sub DispScore()
  '显示分数
  Dim i As Integer, j As Integer, p As Integer, a As String
  a = Left(Trim(Str(Score)), 8)
  For i = 91 To 100
    DispPel(i).State = 0
  Next
  j = 90: p = DispPel(87).X + DispPel(87).w
  For i = 1 To Len(a)
    MakeOnePel j + i, Mid(a, i, 1), 1, p, Int(DispPel(87).Y), 0, 0
    p = p + DispPel(j + i).w - 5 * Zoom
  Next
End Sub
Private Sub DispBomb()
  '显示保险
  Dim i As Integer, j As Integer, p As Integer, a As String
  For i = 88 To 90
    DispPel(i).State = 0
  Next
  If BombNum = 0 Then Exit Sub
  a = Left(Trim(Str(BombNum)), 2)
  MakeOnePel 88, "保险标记", 1, 30 * Zoom, Me.ScaleHeight - 30 * Zoom, 0, 0
  j = 88: p = DispPel(88).X + DispPel(88).w
  For i = 1 To 2
    MakeOnePel j + i, Mid(a, i, 1), 1, p, Int(DispPel(88).Y), 0, 0
    p = p + DispPel(j + i).w - 5 * Zoom
  Next
End Sub
Private Sub Init()
  '初始化部分数据
  Dim i As Integer
  PlayTime = 0                                                        '游戏时间计数清零
  BgMove = 0                                                          '背景初始位置
  AmmoState = 120                                                     '初始弹药为红色单弹,大于0则为蓝色双弹,每半分钟减至0
  DifftyData = 10                                                     '初始难度为10(即10个敌机用于随机抽取)
  CanMove = False                                                     '不能移动我战机,只有鼠标点击到我战机图像上才为True
  Score = 0                                                           '当前成绩为0
  PauseFlg = False                                                    '运行状态
  BombNum = 10                                                        '保险个数为0
  MyNum = 5                                                           '默认5架我战机,为0即GAME OVER
  For i = 0 To 100
    DispPel(i).State = 0                                              '清空所有显示的图元
  Next
  MakeOnePel 86, "我战机", 3, Me.ScaleWidth * 0.5, Me.ScaleHeight - 65 * Zoom, 0, 0  '我战机初始数据
  UnconTime = 6                                                       '3秒无敌状态
  MakeOnePel 87, "暂停", 1, 30 * Zoom, 30 * Zoom, 0, 0                '暂停位置
  DispScore
  DispBomb
  PlaySnd "背景音乐"
End Sub

Private Function PlaySnd(sndName As String) As Integer
  '播放sndName指定的声音
  Dim o As Object, a As String
  For Each o In MMC1
    a = Left(Right(o.FileName, Len(sndName) + 5), Len(sndName) + 1)
    If a = "\" & sndName Then
      o.From = 0
       = "play"
      PlaySnd = o.Index
      Exit For
    End If
  Next
End Function

Private Sub Form_Load()
  GetAllConst
  Init
End Sub
2014-04-05 16:14
VB丶小宇
Rank: 3Rank: 3
来 自:河北省石家庄市
等 级:论坛游侠
帖 子:172
专家分:142
注 册:2013-3-11
收藏
得分:0 
lowxiong大神给力之作!强烈支持!

编程最蛋疼的事:不是编程多么累,而是编完后,一点运行,出现四个字:程序错误。。。
2014-04-06 12:19
lowxiong
Rank: 12Rank: 12Rank: 12
等 级:贵宾
威 望:27
帖 子:653
专家分:3402
注 册:2008-5-7
收藏
得分:0 
  继续贴代码,合并本次代码后,已经可以看到移动的背景、不同速度的敌机和我战机不断发射子弹了。在4楼的代码里已经创建了各种所需要的画图场景,却忘了贴注销这些场景的代码,这是不应该的,在程序中对任何资源的申请和注销应该是程序员的基本素质,这部分代码在Form_Unload里。细心的坛友一定会发现我贴一个空的子程序TestCollide,该子程序完成的功能是碰撞检测,也就是首先判断子弹是否击中敌机,如击中则做击毙、加分、中弹等处理;其次做我战机是否被敌机撞击的判断。碰撞检测算法很多,简单的是矩形碰撞检测和圆形碰撞检测,比较复杂的是椭圆形碰撞检测,最合理的就是多边形碰撞检测了,我希望有兴趣的坛友添加这部分代码,彻底完成这款游戏。
程序代码:
Private Sub DispShot()
  '显示子弹
  Dim i As Integer, j As Integer, X As Integer, Y As Integer, o As Object, k As Single
  If DispPel(0).State = 3 Then Exit Sub
  If AmmoState = 0 Then
    '单弹
    MakeOnePel 0, "红弹", 3, Int(DispPel(86).X), Int(DispPel(86).Y - 10 * Zoom), 0, -80 * Zoom
    DispPel(1).State = 0
  Else
    '双弹
    MakeOnePel 1, "蓝弹", 3, Int(DispPel(86).X - 30 * Zoom), Int(DispPel(86).Y + 10 * Zoom), 0, -80 * Zoom
    MakeOnePel 0, "蓝弹", 3, Int(DispPel(86).X + 30 * Zoom), Int(DispPel(86).Y + 10 * Zoom), 0, -80 * Zoom
  End If
  For Each o In MMC1
    a = Left(Right(o.FileName, 7), 3)
    If a = "\开枪" Then
      k = MMC1(o.Index).Position
    End If
  Next
  If k > 40 Or k = 0 Then PlaySnd "开枪"
End Sub

Private Function DrawOnePel(pPel As DefPel, hDc As Long) As Boolean
  '在场景hDc中画一个图元
  Dim i As Integer, X As Integer, Y As Integer
  DrawOnePel = False
  With pPel
    If .State = 0 Then Exit Function
    For i = 0 To 100
      If CutPel(i).Name = "" Then Exit For
      If CutPel(i).Name = .Name And CutPel(i).Index = Int(.AniIndex) Then
        .w = CutPel(i).w * Zoom: .h = CutPel(i).h * Zoom
        X = .X - .w * 0.5: Y = .Y - .h * 0.5
        StretchBlt hDc, X, Y, .w, .h, MaskDc, CutPel(i).X, CutPel(i).Y, CutPel(i).w, CutPel(i).h, vbSrcPaint      '首先画遮罩
        StretchBlt hDc, X, Y, .w, .h, ShootDc, CutPel(i).X, CutPel(i).Y, CutPel(i).w, CutPel(i).h, vbSrcAnd       '再画图元
        DrawOnePel = True
        Exit Function
      End If
    Next
  End With
End Function

Private Sub TestCollide()
  '碰撞检测
 
End Sub

Private Sub DrawDc()
  '绘制场景
  Dim i As Integer
  Dim x1 As Integer, y1 As Integer, w1 As Integer, h1 As Integer
  Dim x2 As Integer, y2 As Integer, w2 As Integer, h2 As Integer
  x1 = 0: y1 = 0: w1 = Me.ScaleWidth: h1 = BgMove - 1
  x2 = 0: y2 = BgMove: w2 = Me.ScaleWidth: h2 = Me.ScaleHeight - BgMove
  SetStretchBltMode BuffDc, 3
  StretchBlt BuffDc, x2, y2, w2, h2, BgDc, 0, 0, w2 / Zoom, h2 / Zoom, vbSrcCopy                          '画背景下半截
  If h1 > 0 Then StretchBlt BuffDc, x1, y1, w1, h1, BgDc, x1, h2 / Zoom, w1 / Zoom, h1 / Zoom, vbSrcCopy  '画背景上半截
  BgMove = BgMove + 1
  If BgMove > Me.ScaleHeight Then BgMove = 0                                                              '背景循环下移
  TestCollide                                                                  '先做碰撞处理
  For i = 0 To 100
    With DispPel(i)
    If DrawOnePel(DispPel(i), BuffDc) Then
      .AniIndex = .AniIndex + .AniStep                                         '准备播放下一帧动画
      .X = .X + .xStep                                                         '下一次x坐标
      .Y = .Y + .yStep                                                         '下一次y坐标
      If .yStep > 0 And (.Y - .h * 0.5) > Me.ScaleHeight Then .State = 0       '该图元属下移目标,应判断它是否出下边界
      If .yStep < 0 And (.Y + .h * 0.5) < 0 Then .State = 0                    '该图元属上移目标,应判断其是否出上边界
    Else
      '图元绘制失败,一般是动画系列大于该图元最大动画帧数
      If .AniCir Then
        If Right(.Name, 2) = "中弹" Then .Name = Left(.Name, Len(.Name) - 2)   '如果是中弹图元则还原原图元
        .AniIndex = 0
        If Not DrawOnePel(DispPel(i), BuffDc) Then .State = 0                  '如果是循环动画则从第一帧显示,否则该图元不存在
      Else
        .State = 0                                                             '不循环则该图元从场景中消失
      End If
    End If
    End With
  Next
  BitBlt Me.hDc, 0, 0, Me.ScaleWidth, Me.ScaleHeight, BuffDc, 0, 0, vbSrcCopy  '显示缓冲场景
End Sub
Private Sub Form_Unload(Cancel As Integer)
  Dim o As Object
  For Each o In MMC1
     = "close"
  Next
  DeleteDC BgDc
  DeleteDC BuffDc
  DeleteDC ShootDc
  DeleteDC MaskDc
End Sub

Private Sub FreshDC_Timer()
  If PauseFlg Then Exit Sub
  DrawDc
  DispShot
  DispScore
  DispBomb
End Sub

Private Sub Proce_Timer()
  Dim a As String, b As String, iMin As Integer, iMid As Integer, iLag As Integer
  Dim i As Integer, iStart As Integer, iRnd As Integer, iNum As Integer
  If MyNum <= 0 Then Exit Sub
  If PauseFlg Then Exit Sub
  Randomize                                           '启动随机数
  If AmmoState > 0 Then AmmoState = AmmoState - 1     '双弹延时-1
  If UnconTime > 0 Then UnconTime = UnconTime - 1     '无敌延时-1
  If PlayTime > 0 And (PlayTime Mod 60 = 0) Then
    a = "保险"
    If Int(Rnd * 2) = 1 Then a = "弹药"
    MakeOnePel -1, a, 1, -1, -1, 0, 15 * Zoom         '每间隔30秒钟随机产生一个保险或弹药
    PlaySnd "出物资"
  End If
  If PlayTime > 0 And (PlayTime Mod 240 = 0) And DifftyData < 100 Then DifftyData = DifftyData + 10
  iNum = Rnd * 3
  iMid = Int(DifftyData * 0.2): iLag = Int(DifftyData * 0.1): iMin = DifftyData - iMid - iLag
  iStart = 100 - DifftyData
  iMin = iStart + iMin: iMid = iMin + iMid: iLag = iLag + iMid
  For i = 0 To iNum
    iRnd = Rnd * 100
    a = "": b = ""
    If iRnd >= iStart And iRnd < iMin Then a = "敌小机"
    If iRnd >= iMin And iRnd < iMid Then a = "敌中机"
    If iRnd >= iMid And iRnd < iLag Then a = "敌大机": b = a
    If a <> "" Then
      MakeOnePel -1, a, 2, -1, -1, 0, Int(DifftyData / 10 + Rnd * 10 * Zoom)
      If b <> "" Then PlaySnd b
    End If
  Next
  PlayTime = PlayTime + 1
End Sub

2014-04-06 16:14
lowxiong
Rank: 12Rank: 12Rank: 12
等 级:贵宾
威 望:27
帖 子:653
专家分:3402
注 册:2008-5-7
收藏
得分:0 
今天的代码可让我方战机接受控制,按鼠标右键可释放保险,清空屏幕上所有敌机,还可让背景音乐循环播放。至此,打飞机的关键代码已全部发放,有兴趣的可以填充撞击检测处理代码,添加欢迎屏幕,完善各项功能,使这款游戏更像微信打飞机的游戏!
程序代码:
Private Sub MMC1_Done(Index As Integer, NotifyCode As Integer)
  Dim o As Object
  If NotifyCode = 1 Then
    For Each o In MMC1
      a = Left(Right(o.FileName, 9), 5)
      If a = "\背景音乐" And o.Index = Index Then
        '循环播放背景音乐
        PlaySnd "背景音乐"
        Exit Sub
      End If
    Next
  End If
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim hx As Single, hy As Single, i As Integer
  If Button = 1 Then
    hx = DispPel(86).w * 0.5
    hy = DispPel(86).h * 0.5
    If Abs(DispPel(86).X - X) < hx And Abs(DispPel(86).Y - Y) < hy Then CanMove = True And Not (PauseFlg) '设置可移动我战机标志
    hx = DispPel(87).w * 0.5
    hy = DispPel(87).h * 0.5
    If Abs(DispPel(87).X - X) < hx And Abs(DispPel(87).Y - Y) < hy Then
      '点击暂停的处理
      PauseFlg = PauseFlg Xor True
      If PauseFlg Then
        Me.AutoRedraw = True
        DrawDc
        Me.Refresh
      Else
        Me.AutoRedraw = False
      End If
    End If
  End If
  If Button = 2 And BombNum > 0 Then
    '使用保险,屏幕上的敌机爆炸
    For i = 0 To 100
      With DispPel(i)
        If .State = 2 Then
          .State = 1
          .AniCir = False
          .AniIndex = 0
          .Name = .Name & "爆炸"
          Score = Score + .Score
        End If
      End With
    Next
    BombNum = BombNum - 1
    PlaySnd "用保险"          '播放使用保险的声音
  End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim hx As Single, hy As Single
  If Button = 1 And CanMove Then
    '移动我方飞机
    hx = DispPel(86).w * 0.5
    hy = DispPel(86).h * 0.5
    If X - hx > 0 And X + hx < Me.ScaleWidth Then DispPel(86).X = X
    If Y - hy > 0 And Y + hy < Me.ScaleHeight Then DispPel(86).Y = Y
  End If

End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = 1 Then CanMove = False    '鼠标左键抬起则不能移动我方飞机
End Sub

2014-04-07 14:31
jxyga111
Rank: 8Rank: 8
来 自:中華人民共和國
等 级:贵宾
威 望:33
帖 子:6015
专家分:895
注 册:2008-3-21
收藏
得分:0 
牛B啊,大神

烈焰照耀世界,斌凍凍千萬裏
2014-04-07 14:46
vbvcr51
Rank: 10Rank: 10Rank: 10
等 级:贵宾
威 望:18
帖 子:364
专家分:1724
注 册:2013-11-3
收藏
得分:0 
顶一下。
2014-04-08 10:41
ufopsdc
Rank: 1
等 级:新手上路
帖 子:8
专家分:0
注 册:2013-11-10
收藏
得分:0 
老东东,楼主高手
2014-04-08 20:36
快速回复:精力过剩 打打飞机
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.054513 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved