📄 form1.frm.txt
字号:
VERSION 5.00
Begin VB.Form Form1
Caption = "贪吃蛇（按回车键开始）"
ClientHeight = 7290
ClientLeft = 1560
ClientTop = 780
ClientWidth = 8835
FillColor = &H000000FF&
Icon = "Form1.frx":0000
LinkTopic = "Form1"
ScaleHeight = 7290
ScaleWidth = 8835
Begin VB.Timer Timer2
Interval = 1000
Left = 1920
Top = 720
End
Begin VB.Timer Timer1
Interval = 300
Left = 570
Top = 540
End
Begin VB.Label bq
Alignment = 2 'Center
Caption = "Label1"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 0
Left = 960
TabIndex = 0
Top = 3240
Visible = 0 'False
Width = 615
End
Begin VB.Shape Shape1
BackColor = &H00000000&
BorderColor = &H00000000&
Height = 735
Index = 0
Left = 2280
Shape = 3 'Circle
Top = 1920
Visible = 0 'False
Width = 1335
End
Begin VB.Line Line2
Index = 0
Visible = 0 'False
X1 = 120
X2 = 4200
Y1 = 1560
Y2 = 1560
End
Begin VB.Line Line1
Index = 0
Visible = 0 'False
X1 = 120
X2 = 4080
Y1 = 360
Y2 = 360
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'定义变量，确定方向，圆圈的总数，暂停与否
Private num As Integer
Dim up As Boolean, down As Boolean, zuo As Boolean, you As Boolean
Dim pause As Boolean, fei As Boolean
Private Sub pro(ByVal n As Integer, ByVal m As Integer)
Randomize ' 开始时和中间时产生数字标签的调用过程
If m = 5 And fei = True Then '开始时产生数字标签
For i = 1 To m
Load bq(i)
bq(i).Visible = True
t1: With bq(i)
.BackColor = RGB(i + i * 50, 255 - i * 50, 50 + i * 20) '确定数字标签的状态
.Width = 1
.Height = 1
.Caption = i
.Left = CInt(Rnd * 24)
.Top = Int(Rnd * 24)
For k = 1 To n
'判断数字标签产生时是否与圆圈重合，如果是则重新产生
If Abs(bq(i).Left - Shape1(k).Left) < 1 And Abs(bq(i).Top - Shape1(k).Top) < 1 Then
GoTo t1
End If
Next k
End With
Next i
Else '中间时产生数字标签
Load bq(m)
bq(m).Visible = True
t3: With bq(m)
.BackColor = RGB(m + m * 50, 255 - m * 50, 50 + m * 20)
.Width = 1
.Height = 1
.Caption = m
.Left = (Rnd * 24) \ 1
.Top = (Rnd * 24) \ 1
For k = 1 To n
If bq(m).Left = Shape1(k).Left And bq(m).Top = Shape1(k).Top Then
GoTo t3
End If
Next k
End With
End If
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case 13
pause = Not pause '开始游戏
If pause = False Then
Timer1.Enabled = True
Timer2.Enabled = True
Else '游戏暂停
Timer1.Enabled = False
Timer2.Enabled = False
Form1.Caption = "虫子吃数字（暂停）"
End If
'判断方向，设置变量值
Case 37
If you = True Then Exit Sub
zuo = True
you = False
down = False
up = False
Case 38
If down = True Then Exit Sub
zuo = False
you = False
down = False
up = True
Case 39
If zuo = True Then Exit Sub
zuo = False
you = True
down = False
up = False
Case 40
If up = True Then Exit Sub
zuo = False
you = False
down = True
up = False
End Select
End Sub
Private Sub Form_Load()
'初始化变量值
fei = True
pause = True
Timer1.Enabled = False
Timer2.Enabled = False
up = False
down = False
zuo = False
you = True
Form1.Scale (0, 0)-(25, 25) '给窗体定坐标
For i = 1 To 25 '画方格
Load Line1(i)
Line1(i).Visible = True
Load Line2(i)
Line2(i).Visible = True
With Line1(i)
.X1 = 0
.Y1 = i
.X2 = 25
.Y2 = i
End With
With Line2(i)
.X1 = i
.Y1 = 0
.X2 = i
.Y2 = 25
End With
Next
For i = 1 To 10 '开始时产生圆圈
Load Shape1(i)
Shape1(i).Visible = True
With Shape1(i)
.Left = (i - 1) \ 1
.Top = 0 \ 1
.Width = 1
.Height = 1
.FillColor = vbYellow
.FillStyle = 0
End With
Next i
num = 10
Call pro(num, 5)
Shape1(10).FillColor = vbRed
Shape1(10).FillStyle = 0
End Sub
Private Sub Timer1_Timer()
'定义变量记录最近的5个坐标轨迹，以便虫子增长
Static left1 As Double, top1 As Double, left2 As Double, top2 As Double
Static left3 As Double, top3 As Double, left4 As Double, top4 As Double, left5 As Double, top5 As Double
left5 = left4
top5 = top4
left4 = left3
top4 = top3
left3 = left2
top3 = top2
left2 = left1
top2 = top1
left1 = Shape1(1).Left
top1 = Shape1(1).Top
'根据方向变量值，确定移动方向
If you = True Then
For j = 1 To num - 3
'判断是否撞到自己的身子
If Abs(Shape1(num).Left - Shape1(j).Left) <= 0.3 And Abs(Shape1(num).Top - Shape1(j).Top) < 0.5 Then GoTo t2
Next j
If Shape1(num).Left < 23 Then
' 向前移动
For i = 1 To num - 1
Shape1(i).Left = Shape1(i + 1).Left
Shape1(i).Top = Shape1(i + 1).Top
Next i
Shape1(num).Left = Shape1(num).Left + 1
Else: GoTo t2
End If
End If
If zuo = True Then
For j = 1 To num - 3
If Abs(Shape1(num).Left - Shape1(j).Left) <= 0.3 And Abs(Shape1(num).Top - Shape1(j).Top) < 0.5 Then GoTo t2
Next j
If Shape1(num).Left >= 1 Then
For i = 1 To num - 1
Shape1(i).Left = Shape1(i + 1).Left
Shape1(i).Top = Shape1(i + 1).Top
Next i
Shape1(num).Left = Shape1(num).Left - 1
Else: GoTo t2
End If
End If
If up = True Then
For j = 1 To num - 3
If Abs(Shape1(num).Top - Shape1(j).Top) <= 0.3 And Abs(Shape1(num).Left - Shape1(j).Left) < 0.5 Then GoTo t2
Next j
If Shape1(num).Top > 1 Then
For i = 1 To num - 1
Shape1(i).Left = Shape1(i + 1).Left
Shape1(i).Top = Shape1(i + 1).Top
Next i
Shape1(num).Top = Shape1(num).Top - 1
Else: GoTo t2
End If
End If
If down = True Then
For j = 1 To num - 3
If Abs(Shape1(num).Top - Shape1(j).Top) <= 0.3 And Abs(Shape1(num).Left - Shape1(j).Left) < 0.5 Then GoTo t2
Next j
If Shape1(num).Top < 24 Then
For i = 1 To num - 1
Shape1(i).Left = Shape1(i + 1).Left
Shape1(i).Top = Shape1(i + 1).Top
Next i
Shape1(num).Top = Shape1(num).Top + 1
Else: GoTo t2
End If
End If
'判断是否吃到数字标签
For i = 1 To 5
If Abs(Shape1(num).Left - bq(i).Left) < 0.5 And Abs(Shape1(num).Top - bq(i).Top) < 0.5 Then
Unload bq(i)
For k = num + 1 To num + i '增加圆圈
Load Shape1(k)
Shape1(k).Visible = True
With Shape1(k)
.FillColor = vbYellow
.FillStyle = 0
.Top = Shape1(k - i).Top
.Left = Shape1(k - i).Left
.Width = 1
.Height = 1
End With
Next k
'把圆圈按号码往后移，为新增的圆圈腾位子
For j = num To i + 1 Step -1
Shape1(j).Left = Shape1(j - i).Left
Shape1(j).Top = Shape1(j - i).Top
Next j
If i = 1 Then
Shape1(1).Left = left1
Shape1(1).Top = top1
End If
If i = 2 Then
Shape1(2).Left = left1
Shape1(2).Top = top1
Shape1(1).Left = left2
Shape1(1).Top = top2
End If
If i = 3 Then
Shape1(1).Left = left3
Shape1(1).Top = top3
Shape1(2).Left = left2
Shape1(2).Top = top2
Shape1(3).Left = left1
Shape1(3).Top = top1
End If
If i = 4 Then
Shape1(1).Left = left4
Shape1(1).Top = top4
Shape1(2).Left = left3
Shape1(2).Top = top3
Shape1(3).Left = left2
Shape1(3).Top = top2
Shape1(4).Left = left1
Shape1(4).Top = top1
End If
If i = 5 Then
Shape1(1).Left = left5
Shape1(1).Top = top5
Shape1(2).Left = left4
Shape1(2).Top = top4
Shape1(3).Left = left3
Shape1(3).Top = top3
Shape1(4).Left = left2
Shape1(4).Top = top2
Shape1(5).Left = left1
Shape1(5).Top = top1
End If
Shape1(num).FillColor = vbYellow
num = num + i
Shape1(num).FillColor = vbRed
fei = False
Call pro(num, i) '把吃掉的数字标签再产生出来
End If
Next i
Exit Sub
'撞墙或撞到自己后 出现提示框
t2: MsgBox "GAME OVER", 0, "snake"
For i = 1 To num
Unload Shape1(i)
Next i
For i = 1 To 5
Unload bq(i)
Next i
'重新出现界面
For i = 1 To 10
Load Shape1(i)
Shape1(i).Visible = True
With Shape1(i)
.Left = i - 1
.Top = 0
.Width = 1
.Height = 1
.FillColor = vbYellow
.FillStyle = 0
End With
Next i
num = 10
fei = True
Call pro(num, 5)
Shape1(10).FillColor = vbRed
Shape1(10).FillStyle = 0
'变量重新赋值
pause = True
Timer1.Enabled = False
Timer2.Enabled = False
up = False
down = False
zuo = False
you = True
End Sub
Private Sub Timer2_Timer()
'窗体标题更换
Static n As Integer
n = n + 1
Form1.Caption = "虫子吃数字（运行）：" & n & "秒 " & num & "分"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -