请问谁有用 VB 编的贪食蛇游戏程序啊？给我好吗？好急啊！我邮箱是yjyscxm@163.com无限感激啊！

1. 请问谁有用 VB 编的贪食蛇游戏程序啊？给我好吗？好急啊！我邮箱是yjyscxm@163.com无限感激啊！

'不用添加控件 把代码复制粘贴即可
Option Explicit 

Private WithEvents Timer1 As Timer 
Private WithEvents Label1 As Label 
Dim GFangXiang As Boolean 
Dim HWB As Single 
Dim She() As ShenTi 
Dim X As Long, Y As Long 
Dim ZhuangTai(23, 23) As Long 
Private Type ShenTi 
   F As Long 
   X As Long 
   Y As Long 
End Type 

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) 
Dim C As Long 
If KeyCode = 27 Then End 
If KeyCode = 32 Then 
   If Timer1.Enabled = True Then 
      Timer1.Enabled = False 
      Label1.Visible = True 
   Else 
      Timer1.Enabled = True 
      Label1.Visible = False 
   End If 
End If 
C = UBound(She) 
If GFangXiang = True Then Exit Sub 
Select Case KeyCode 
Case 37 
   If She(C).F = 2 Then Exit Sub 
   She(C).F = 0 
   GFangXiang = True 
Case 38 
   If She(C).F = 3 Then Exit Sub 
   She(C).F = 1 
   GFangXiang = True 
Case 39 
   If She(C).F = 0 Then Exit Sub 
   She(C).F = 2 
   GFangXiang = True 
Case 40 
   If She(C).F = 1 Then Exit Sub 
   She(C).F = 3 
   GFangXiang = True 
End Select 
End Sub 

Private Sub Form_Load() 
Me.AutoRedraw = True 
Me.BackColor = &HC000& 
Me.FillColor = 255 
Me.FillStyle = 0 
Me.WindowState = 2 
Set Timer1 = Controls.Add("VB.Timer", "Timer1") 
Set Label1 = Controls.Add("VB.Label", "Label1") 
Label1.AutoSize = True 
Label1.BackStyle = 0 
Label1 = "暂停" 
Label1.ForeColor = RGB(255, 255, 0) 
Label1.FontSize = 50 
ChuShiHua 
End Sub 

Private Sub Form_Resize() 
On Error GoTo 1: 
With Me 
   If .WindowState  1 Then 
      .Cls 
      .ScaleMode = 3 
      HWB = .ScaleHeight / .ScaleWidth 
      .ScaleWidth = 24 
      .ScaleHeight = 24 
      Label1.Move (Me.ScaleWidth - Label1.Width) / 2, (Me.ScaleHeight - Label1.Height) / 2 
      HuaTu 
      Me.Line (X, Y)-(X + 1, Y + 1), RGB(255, 255, 0), BF 
   End If 
End With 
1: 
End Sub 

Private Sub Timer1_Timer() 
Dim C As Long, I As Long 
On Error GoTo 2: 
QingChu 
C = UBound(She) 
Select Case She(C).F 
Case 0 
   If ZhuangTai(She(C).X - 1, She(C).Y) = 2 Then 
      C = C + 1 
      ReDim Preserve She(C) 
      She(C).F = She(C - 1).F 
      She(C).X = She(C - 1).X - 1 
      She(C).Y = She(C - 1).Y 
      ChanShengShiWu 
      GoTo 1: 
   ElseIf ZhuangTai(She(C).X - 1, She(C).Y) = 1 Then 
      GoTo 2: 
   End If 
Case 1 
   If ZhuangTai(She(C).X, She(C).Y - 1) = 2 Then 
      C = C + 1 
      ReDim Preserve She(C) 
      She(C).F = She(C - 1).F 
      She(C).X = She(C - 1).X 
      She(C).Y = She(C - 1).Y - 1 
      ChanShengShiWu 
      GoTo 1: 
   ElseIf ZhuangTai(She(C).X, She(C).Y - 1) = 1 Then 
      GoTo 2: 
   End If 
Case 2 
   If ZhuangTai(She(C).X + 1, She(C).Y) = 2 Then 
      C = C + 1 
      ReDim Preserve She(C) 
      She(C).F = She(C - 1).F 
      She(C).X = She(C - 1).X + 1 
      She(C).Y = She(C - 1).Y 
      ChanShengShiWu 
      GoTo 1: 
   ElseIf ZhuangTai(She(C).X + 1, She(C).Y) = 1 Then 
      GoTo 2: 
   End If 
Case 3 
   If ZhuangTai(She(C).X, She(C).Y + 1) = 2 Then 
      C = C + 1 
      ReDim Preserve She(C) 
      She(C).F = She(C - 1).F 
      She(C).X = She(C - 1).X 
      She(C).Y = She(C - 1).Y + 1 
      ChanShengShiWu 
      GoTo 1: 
   ElseIf ZhuangTai(She(C).X, She(C).Y + 1) = 1 Then 
      GoTo 2: 
   End If 
End Select 
ZhuangTai(She(0).X, She(0).Y) = 0 
For I = 0 To C 
   Select Case She(I).F 
   Case 0 
      She(I).X = She(I).X - 1 
   Case 1 
      She(I).Y = She(I).Y - 1 
   Case 2 
      She(I).X = She(I).X + 1 
   Case 3 
      She(I).Y = She(I).Y + 1 
   End Select 
Next 
TiaoZheng 
1: 
GFangXiang = False 
ZhuangTai(She(C).X, She(C).Y) = 1 
HuaTu 
Exit Sub 
2: 
If MsgBox("游戏结束，点“是”重新开始游戏，点“否”", vbYesNo, "贪吃蛇") = vbYes Then 
   ChuShiHua 
Else 
   End 
End If 
End Sub 

Private Sub ChuShiHua() 
Me.Cls 
Timer1.Enabled = True 
Timer1.Interval = 200 
Erase ZhuangTai 
ReDim She(2) 
She(0).F = 2 
She(0).X = 9 
She(0).Y = 11 
ZhuangTai(9, 11) = 1 
She(1).F = 2 
She(1).X = 10 
She(1).Y = 11 
ZhuangTai(10, 11) = 1 
She(2).F = 2 
She(2).X = 11 
She(2).Y = 11 
ZhuangTai(11, 11) = 1 
HuaTu 
ChanShengShiWu 
End Sub 

Private Sub QingChu() 
Dim I As Long 
For I = 0 To UBound(She) 
   Me.Line (She(I).X, She(I).Y)-(She(I).X + 1, She(I).Y + 1), Me.BackColor, BF 
Next 
End Sub 

Private Sub HuaTu() 
Dim I As Long 
For I = 0 To UBound(She) 
   Me.Circle (She(I).X + 0.5, She(I).Y + 0.5), 0.49, RGB(255, 255, 0), , , HWB 
Next 
End Sub 

Private Sub TiaoZheng() 
Dim I As Long 
For I = 0 To UBound(She) - 1 
   She(I).F = She(I + 1).F 
Next 
End Sub 

Private Sub ChanShengShiWu() 
Randomize Timer 
1: 
X = Int(Rnd * 24) 
Y = Int(Rnd * 24) 
If ZhuangTai(X, Y) > 0 Then GoTo 1: 
ZhuangTai(X, Y) = 2 
Me.Line (X, Y)-(X + 1, Y + 1), RGB(255, 255, 0), BF 
End Sub

2. 如何用VB制作163邮箱群发软件

群发邮件会被查封IP的

3. VB那里的邮件(163)下面怎么写?

Option Explicit

Private Sub cmdCommand1_Click()
    SendMail "主题", "正文", ""       '如果如果要发附件，最后一个填路径
End Sub

Sub SendMail(Optional ByVal sSubject As String, _
        Optional ByVal sBody As String, _
        Optional ByVal sFileName As String)
    On Error GoTo ToExit '打开错误陷阱
    '------------------------------------------------

    Dim Jmail
    Set Jmail = CreateObject("jmail.Message")
    If sFileName  "" Then Jmail.AddAttachment sFileName

    Jmail.Charset = "gb2312"
    Jmail.Silent = False
    Jmail.Priority = 3  '邮件状态,1-5 1为最高
    Jmail.MailServerUserName = "apple"        '你的Email帐号，自己改
    Jmail.MailServerPassWord = "123456"         '你的Email密码，自己改

    Jmail.FromName = "邮件"            '发信人姓名，自己改
    Jmail.From = "apple@163.com"     '发邮件地址地址，自己改

    Jmail.Subject = sSubject                  '主题
    Jmail.AddRecipient "banana@163.com"        '收信人地址，自己改
    Jmail.Body = sBody                      '信件正文

    Jmail.Send ("smtp.163.com")      'SMTP服务器，如smtp.sohu.com

    Set Jmail = Nothing
    MsgBox "OK"

    '------------------------------------------------
    Exit Sub
    '----------------
ToExit:
    Select Case Jmail.ErrorCode
    Case 550
        MsgBox "该邮件地址不存在，请更改后再发", , "提示"
    Case 535
        MsgBox "发件人的用户名或密码错误，请改正后再发", , "提示"
    Case Else
        MsgBox Jmail.ErrorMessage, , "提示"
    End Select
End Sub



================================= 
修改过的，开始用的不是我自己的，现在把自己的发上来

4. 求VB企业版，邮箱：m15261250263@163.com,万分感谢

http://zhidao.baidu.com/question/292542852.html

5. 你好，请问你那里有VB的入门教程吗？能否发我一份呢？多谢 zimu1993@163.com

你说的是VB.NET的教程还是VB的教程？VB.NET入门教程的话，我这边有，我找一下给你。

6. vb阻止163邮箱弹出的广告

Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean) 
Cancel = True 
End Sub

7. 你可以教我怎么用VB去编这样一个软件吗？我的邮箱是：princeteng2009@163.com

可以。我只会编简单的软件，应该叫插件。

8. 求编一段VB代码 邮箱：jwymomo@163.com

看看下面这个,刚刚赶出来的,还可进一步完善
Option Explicit
Dim a As Integer
Dim b As Integer
Dim c As Integer

Private Sub Command1_Click()
    Randomize
    Text1.Text = ""
    Text1.SetFocus
    
    a = Int(10 * Rnd + 1)
    b = Int(10 * Rnd + 1)
    c = Fix(Rnd() * 4 + 1)
    
    If c = 2 Then '减法检验a-b<0
        Do While a - b < 0
            a = Int(10 * Rnd + 1)
            b = Int(10 * Rnd + 1)
        Loop
    End If
    If c = 4 Then '除法检验是否能整除
        Do While a / b  a \ b
            a = Int(10 * Rnd + 1)
            b = Int(10 * Rnd + 1)
        Loop
    End If
    Label1.Caption = a & Mid("＋－×÷", c, 1) & b & " = "
    Command1.Enabled = False
    Command2.Enabled = True
End Sub

Private Sub Command2_Click()
Dim d As Boolean
    Select Case c
        Case 1
            If a + b = Val(Text1.Text) Then d = True
        Case 2
            If a - b = Val(Text1.Text) Then d = True
        Case 3
            If a * b = Val(Text1.Text) Then d = True
        Case 4
            If a / b = Val(Text1.Text) Then d = True
    End Select
    Picture1.ForeColor = vbBlack
    Picture1.Print Label1.Caption & Text1.Text;
    Picture1.ForeColor = vbRed
    Picture1.Print " " & IIf(d, "√", "×")
    Command1.Enabled = True
    Command2.Enabled = False
End Sub

Private Sub Command3_Click() '清Picture
    Picture1.Cls
End Sub