【VB开源代码栏目提醒】：本文主要为网学会员提供“我的朋友编写的VB游戏源代码 - 综合课件”，希望对需要我的朋友编写的VB游戏源代码 - 综合课件网友有所帮助，学习一下!

我的朋友编写的VB游戏源代码 Option Explicit by tempfish Private Declare Function sndPlaySoundFromMemory Libwinmm.dllAliassndPlaySoundAlpszSoundName As AnyByVal uFlags As LongAs Long Private Const SND_ASYNCH1 Private Const SND_MEMORYH4 Private mapAs Byte棋盘格子 Private Const WH241格子宽/高度 Private Const MWWH23格盘宽度px Private Const MHWH15格盘高度px Private Const PHWH10灰/白泡泡资源图片的高度px Private Const T120每局时间2分钟吧 Private timeout As Integer剩余时间 Private score As Byte分数 Private SelX As Byte鼠标所在的格子列 Private SelY As Byte鼠标所在的格子行 Private Const TW400时间条长度px Private Type pao要被和谐掉的泡泡s结构 type As Byte XAs Byte YAs Byte End Type Private rAs pao要被和谐掉的泡泡s Private ti As Byte在timer里循环用的.放这里.不用每次都dim了. Private pAs Byte和谐掉泡泡时动画效果的帧数 Private Sub Form_Load Pic.Move 2450MWMH tbar1.Move 2420TW6 Label1.Move 4606 Check1.Move 53015 Randomize init初始化游戏 End Sub Private Sub Form_MouseMoveButton As IntegerShift As IntegerX As SingleY As Single I fS.Visible Then S.VisibleFalseSelX99SelY99 End Sub Private Sub Pic_MouseMoveButton As IntegerShift As IntegerX As SingleY As Single If XWHSelX And YWHSelY Then Exit Sub当鼠标一直在一个泡泡里徘徊的时候.先退出再说 SelXXWH SelYYWH If mapSelXSelY0 Then S.VisibleFalseExit Sub当鼠标所在的格子是一个泡泡.退出 S.LeftSelXWH S.TopSelYWH S.VisibleTrue显示红色框 End Sub Private Sub init初始化游戏 SelX99鼠标所在的列.意思是.没有格子被鼠标选中. SelY99 S.VisibleFalse隐藏红色框 Pic.Cls刷新一下棋盘画面 score0成绩 Label1.Caption0成绩显示 timeoutT剩余时间 tbar2.Move 2420TW6 ReDim r3先给将要被和谐掉的泡泡s订好棺材一次最多4个 ReDim map2214设置/清空棋盘 Dim color As Byte Dim iAs Byte Dim jAs Byte Dim kAs Byte 填充泡泡 For color1 To 1010种颜色的泡泡 k0 While k20每种颜色20个 iInt23Rnd jInt15Rnd If mapij0 Then mapijcolor kk1 Pic.PaintPicture Pic2iWHjWHWHWH0color-1WHijMod 2PHWHWH画泡泡 End If Wend Next color 填充棋盘空白灰色部分棋盘本身白色 For i0 To 14 For jAbsi Mod 2-1To 22 Step 2 If mapji0 Then Pic.LinejWHiWH-jWHWH-1iWHWH-1RGB237237237BF Next j Next i Timer1.EnabledTrue开始 End Sub Private Sub check检查是否有泡泡要被和谐 Dim XAs Byte Dim YAs Byte Dim iAs Integer Dim jAs Byte Dim c3As pao XSelX YSelY 4个方向的泡泡 上 For iY To 0Step-1 If mapXi0 Then c0.typemapXi c0.XX c0.Yi Exit For End If Next i 左 For iX To 0Step-1 If mapiY0 Then c1.typemapiY c1.Xi c1.YY Exit For End If Next i 下 For iY To 14 If mapXi0 Then c2.typemapXi c2.XX c2.Yi Exit For End If Next i 右 For iX To 22 If mapiY0 Then c3.typemapiY c3.Xi c3.YY Exit For End If Next i 依次以每个泡泡为中心按顺序跟另外三个对比 如果相同就加入被和谐的泡泡队伍中 每次比较依次减少一次因为在上个循环中跟上面的泡泡已经比较过 Dim sc As Byte For i0 To 2 For ji1 To 3 If ci.typecj.type And ci.type 0Then If ri.type0 Then因为有时候出会现3或4个相同的所以先判断是否已经添加到和谐队伍中避免分数叠加下同 ri.typeci.type ri.Xci.X ri.Yci.Y scsc1 mapri.Xri.Y0 End If If rj.type0 Then scsc1 rj.typecj.type rj.Xcj.X rj.Ycj.Y maprj.Xrj.Y0 End If End If Next j Next i If sc 0Then scorescoresc Label1.Captionscore If Check1.Value1 Then播放声音 Dim bArrAs Byte bArrLoadResDataInt101custom DoEvents sndPlaySoundFromMemory bArr0SND_MEMORY Or SND_ASYNC End If Timer.EnabledTrue Else 乱错了随便扣就你5秒时间吧 timeouttimeout-5 End If End Sub Private Sub S_MouseDownButton As IntegerShift As IntegerX As SingleY As Single If Timer.Enabled Then Exit Sub check End Sub Private Sub Timer_Timer泡泡被和谐时痛苦挣扎的动画效果 pp1 If p5 Then共4帧 For ti0 To 3 If rti.type 0Then Pic.PaintPicture Pic2rti.XWHrti.YWHWHWHpWHrti.type-1WHrti.Xrti.YMod 2PHWHWH画泡泡 End If Next Else ReDim r3 End If If p5 Then p0Timer.EnabledFalse End Sub Private Sub Timer1_Timer万恶的计时器 If timeout1 Then tbar2.Width1 Timer1.EnabledFalse msg Exit Sub End If timeouttimeout-1 tbar2.Widthtimeout/Ttbar1.Width End Sub Public Sub msg Dim aAs Byte If MsgBox得分scorevbCrLfvbCrLf点击确定重新开始游戏点击取消退出vbOKCancel时间到1 Then init Else End End If End Sub