急求一个vb小游戏，小工具，高手
百度里就有的
直接复制下面代码到代码框中后运行程序即可：
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
Priva...全部
百度里就有的
直接复制下面代码到代码框中后运行程序即可：
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。ScaleWidth = 24
Me。
ScaleHeight = 24
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。收起
