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