frmsna0.frm

VB编写的疯狂贪吃蛇小游戏,有声音的~

      BackColor       =   &H80000012&
      Caption         =   "得分:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FFFF&
      Height          =   240
      Left            =   120
      TabIndex        =   1
      Top             =   3720
      Width           =   660
   End
End
Attribute VB_Name = "FrmSna"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim X(280) As Integer   '声明界面X坐标
Dim Y(280) As Integer   '声明界面Y坐标
Dim SX(20) As Integer   '蛇的X坐标
Dim SY(20) As Integer   '蛇的Y坐标
Dim EAT As Integer      '是否生长
Dim SDIR(4) As Integer     '蛇的方向
Dim FX As Integer       '食物的X坐标
Dim FY As Integer       '食物的Y坐标
Dim SCO As Integer      '得分
Dim GMGS As Integer     '游戏关数
Dim GMSD As Integer     '游戏速度
Dim GMWAX(50) As Integer '墙的X坐标
Dim GMWAY(50) As Integer '墙的Y坐标
Dim GMCO As Integer     '接关次数
Private Sub Form_Load()
  SCO = 0
  GMCO = 4
  Dim i As Integer
  GMSD = 150
  Init
  '设定界面坐标
  X(1) = 5
  Y(1) = 5
  '加载280个坐标
  For i = 2 To 20
    X(i) = X(i - 1) + 10
    Y(i) = 5
  Next i
  For i = 21 To 280
    X(i) = X(i - 20)
    Y(i) = Y(i - 20) + 10
  Next i
  SDIR(1) = 1
     FX = X(50) + 5
     FY = Y(50) + 5
    '加载五十个墙以及分布位置和图片
    For i = 1 To 50
    Load ImgWall(i)
    ImgWall(i).Visible = True
    ImgWall(i).Width = 10
    ImgWall(i).Height = 10
    Dim BMP As Integer
    Randomize
    BMP = Int(4 * Rnd(1) + 1)
    If BMP = 1 Then ImgWall(i).Picture = LoadPicture(App.Path + "\bmp\wallcoffe.bmp")
    If BMP = 2 Then ImgWall(i).Picture = LoadPicture(App.Path + "\bmp\wallred.bmp")
    If BMP = 3 Then ImgWall(i).Picture = LoadPicture(App.Path + "\bmp\wallgreen.bmp")
    If BMP = 4 Then ImgWall(i).Picture = LoadPicture(App.Path + "\bmp\wallbule.bmp")
  Next i
    For i = 0 To 50
    ImgWall(i).Left = GMWAX(i)
    ImgWall(i).Top = GMWAY(i)
    GMWAX(i) = -10
    GMWAY(i) = -10
  Next i
End Sub
 '键盘事件
Private Sub PicMain_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyRight Then SDIR(1) = 1: SDIR(2) = 0: SDIR(3) = 0: SDIR(4) = 0: ImgHead.Picture = LoadPicture(App.Path + "\bmp\eright.bmp")
If KeyCode = vbKeyLeft Then SDIR(2) = 2: SDIR(1) = 0: SDIR(3) = 0: SDIR(4) = 0: ImgHead.Picture = LoadPicture(App.Path + "\bmp\eleft.bmp")
If KeyCode = vbKeyUp Then SDIR(3) = 3: SDIR(1) = 0: SDIR(2) = 0: SDIR(4) = 0: ImgHead.Picture = LoadPicture(App.Path + "\bmp\eup.bmp")
If KeyCode = vbKeyDown Then SDIR(4) = 4: SDIR(1) = 0: SDIR(3) = 0: SDIR(2) = 0: ImgHead.Picture = LoadPicture(App.Path + "\bmp\edown.bmp")
If KeyCode = vbKeyEscape Then PStop = PStop + 1: LabStop.Visible = True
If PStop = 2 Then PStop = 0: LabStop.Visible = False
End Sub



Private Sub Timer1_Timer()
    '游戏主体
  Do While PStop = 0
  Randomize
    Dim i As Integer
    '当吃到豆子时
    If SX(1) = FX And SY(1) = FY Then
     SUCCESS = sndPlaySound(App.Path + "\sound\eat.WAV", &H1)
     EAT = EAT + 1
     '再随机分布豆子的位置
     Dim SNRND As Integer
1     SNRND = 260 * Rnd + 1
     FX = X(SNRND) + 5
     FY = Y(SNRND) + 5
     '如果豆子覆盖在墙上时则重新分布防止吃到豆子却死了的情况发生
     For i = 0 To 50
       If FX = GMWAX(i) And FY = GMWAY(i) Then GoTo 1
     Next i
     SCO = SCO + 10
  End If
       For i = 0 To 50
       If FX = GMWAX(i) And FY = GMWAY(i) Then GoTo 1
     Next i
  DoEvents '控制权交给玩家
  If SDIR(1) = 1 Then SX(1) = SX(1) + 10
  If SDIR(2) = 2 Then SX(1) = SX(1) - 10
  If SDIR(3) = 3 Then SY(1) = SY(1) - 10
  If SDIR(4) = 4 Then SY(1) = SY(1) + 10
  '将墙、豆子、头赋予新的变量便于操作
  For i = 0 To 50
    ImgWall(i).Left = GMWAX(i)
    ImgWall(i).Top = GMWAY(i)
  Next i
  ImgFood.Left = FX
  ImgFood.Top = FY
  ImgHead.Left = SX(1)
  ImgHead.Top = SY(1)
  '实现蛇行走的轨迹
  '通过互相转变变量的值来实现
  '如:让身子的坐标等于头的坐标再改变头的坐标即可
  If EAT > 1 Then
  ImgBody(0).Left = SX(2)
  ImgBody(0).Top = SY(2)
  End If
  If EAT > 2 Then
  ImgBody(1).Left = SX(3)
  ImgBody(1).Top = SY(3)
  End If
  If EAT > 3 Then
  ImgBody(2).Left = SX(4)
  ImgBody(2).Top = SY(4)
  End If
  If EAT > 4 Then
  ImgBody(3).Left = SX(5)
  ImgBody(3).Top = SY(5)
  End If
  If EAT > 5 Then
  ImgBody(4).Left = SX(6)
  ImgBody(4).Top = SY(6)
  End If
  If EAT > 6 Then
  ImgBody(5).Left = SX(7)
  ImgBody(5).Top = SY(7)
  End If
  If EAT > 7 Then
  ImgBody(6).Left = SX(8)
  ImgBody(6).Top = SY(8)
  End If
  If EAT > 8 Then
  ImgBody(7).Left = SX(9)
  ImgBody(7).Top = SY(9)
  End If
  If EAT > 9 Then
  ImgBody(8).Left = SX(10)
  ImgBody(8).Top = SY(10)
  End If
  If EAT > 10 Then
  ImgBody(9).Left = SX(11)
  ImgBody(9).Top = SY(11)
  End If
  If EAT > 11 Then
  ImgBody(10).Left = SX(12)
  ImgBody(10).Top = SY(12)
  End If
  If EAT > 12 Then
  ImgBody(11).Left = SX(13)
  ImgBody(11).Top = SY(13)
  End If
  If EAT > 13 Then
  ImgBody(12).Left = SX(14)
  ImgBody(12).Top = SY(14)
  End If
  If EAT > 14 Then
  ImgBody(13).Left = SX(15)
  ImgBody(13).Top = SY(15)
  End If
  If EAT > 15 Then
  ImgBody(14).Left = SX(16)
  ImgBody(14).Top = SY(16)
  End If
  SX(16) = SX(15)
  SY(16) = SY(15)
  
  SX(15) = SX(14)
  SY(15) = SY(14)
  
  SX(14) = SX(13)
  SY(14) = SY(13)

  SX(13) = SX(12)
  SY(13) = SY(12)
  
  SX(12) = SX(11)
  SY(12) = SY(11)
  
  SX(11) = SX(10)
  SY(11) = SY(10)
 
  SX(10) = SX(9)
  SY(10) = SY(9)
  
  SX(9) = SX(8)
  SY(9) = SY(8)
  
  SX(8) = SX(7)
  SY(8) = SY(7)
  
  SX(7) = SX(6)
  SY(7) = SY(6)
  
  SX(6) = SX(5)
  SY(6) = SY(5)
  
  SX(5) = SX(4)
  SY(5) = SY(4)
  
  SX(4) = SX(3)
  SY(4) = SY(3)
  
  SX(3) = SX(2)
  SY(3) = SY(2)

  SX(2) = SX(1)
  SY(2) = SY(1)
  '撞到边界上时
  If SX(1) < PicMain.Left Or SY(1) < PicMain.Top Or SX(1) + ImgHead.Width > 211 Or SY(1) + ImgHead.Height > 152 Then
  SUCCESS = sndPlaySound(App.Path + "\sound\dead.WAV", &H1)
  MsgBox "撞晕了": GMRECORD
  End If
  '撞到墙上时
  For i = 0 To 50
    If SY(1) = GMWAY(i) And SX(1) = GMWAX(i) Then
    SUCCESS = sndPlaySound(App.Path + "\sound\dead.WAV", &H1)
    MsgBox "撞晕了": GMRECORD
    End If
  Next i

  LabSCO = SCO
  '每吃够16个豆子时升一等级
  If EAT = 16 Then
    SUCCESS = sndPlaySound(App.Path + "\sound\lev.WAV", &H1)
    MsgBox "厉害!请接着玩吧!"
    ImgHead.Picture = LoadPicture(App.Path + "\bmp\eright.bmp")
    SDIR(1) = 1: SDIR(2) = 0: SDIR(3) = 0: SDIR(4) = 0
    GMGS = GMGS + 1
    SX(1) = 0
    SY(1) = 0
    EAT = 1
    For i = 0 To 16
        ImgBody(i).Left = -10
    Next i
    GMSD = GMSD - 10
    GMSTAGE
  End If
  LabLev = GMGS
  Sleep (GMSD) '用于延缓循环时间的API函数,GMSD越大游戏速度越慢
  Loop

End Sub
Sub GMSTAGE() '设置关数
  Dim i As Integer

  Randomize
  If GMGS = 0 Then
      For i = 0 To 50
      GMWAX(i) = -100
      GMWAY(i) = -100
      Next i
  End If
     
     If GMGS = 1 Then
      For i = 0 To 5
      GMWAX(i) = X(260 * Rnd + 20) + 5
      GMWAY(i) = Y(260 * Rnd + 20) + 5
      Next i
  End If
  If GMGS = 2 Then
    For i = 0 To 10
      GMWAX(i) = X(260 * Rnd + 20) + 5
      GMWAY(i) = Y(260 * Rnd + 20) + 5
    Next i
  End If
  If GMGS = 3 Then
    For i = 0 To 15
      GMWAX(i) = X(260 * Rnd(1) + 20) + 5
      GMWAY(i) = Y(260 * Rnd(1) + 20) + 5
    Next i
  End If
  If GMGS = 4 Then
    For i = 0 To 20
      GMWAX(i) = X(260 * Rnd(1) + 20) + 5
      GMWAY(i) = Y(260 * Rnd(1) + 20) + 5
    Next i
  End If
  If GMGS = 5 Then
    For i = 0 To 25
      GMWAX(i) = X(260 * Rnd(1) + 20) + 5
      GMWAY(i) = Y(260 * Rnd(1) + 20) + 5
    Next i
  End If

End Sub
Sub GMRECORD() '记录分数
  Dim a As String, b As String, c As Integer
    a = InputBox("请输入您的大名", "疯狂贪吃蛇")
    Open App.Path + "\ok.dat" For Input As #1
      Input #1, b, c
    Close #1
    
    If SCO > c Then
     Open App.Path + "\ok.dat" For Output As #1
      Write #1, a, SCO
     Close #1
    End If
    MsgBox "玩家:" & a & Chr(13) & "得分:" & SCO
   
    If SCO > c Then
      MsgBox "最高记录" & Chr(13) & "玩家:" & a & Chr(13) & "得分:" & SCO
    End If
    If SCO < c Then
       MsgBox "最高记录" & Chr(13) & "玩家:" & b & Chr(13) & "得分:" & c
    End If
    Dim Button As Integer
    Button = MsgBox("还想玩么?", vbYesNo)
      If Button = 6 Then GMCO = GMCO - 1: Init
      If Button = 7 Then End
End Sub
Sub Init() '初史化
  If GMCO = 3 Then Image1.Visible = False
  If GMCO = 2 Then Image2.Visible = False
  If GMCO = 1 Then Image3.Visible = False
  If GMCO = 0 Then MsgBox "游戏结束!": End
  Dim i As Integer
  Dim SNRND As Integer
    ImgHead.Picture = LoadPicture(App.Path + "\bmp\eright.bmp")
    SDIR(1) = 1: SDIR(2) = 0: SDIR(3) = 0: SDIR(4) = 0
    GMSTAGE
    SX(1) = 0
    SY(1) = 0
    EAT = 1
    SNRND = 260 * Rnd + 1
    FX = X(SNRND) + 5
    FY = Y(SNRND) + 5
    For i = 0 To 16
        ImgBody(i).Left = -10
    Next i
End Sub