Option Explicit
Private Type sf
x As Single
y As Single
End Type
Dim s() As sf '数组组成蛇体,下标为身长
Dim f As sf '食物
Dim fx As Integer '方向,1234对应左上右下
Dim Score As Integer '积分
Private Sub Form_Load()
Move 1000, 1000, 10000, 10000
init
End Sub
Private Sub Form_Resize() '调整窗体大小
Me.Scale (0, 0)-(51, 51)
With Me
.AutoRedraw = True
.DrawWidth = 1
.KeyPreview = True
.FillColor = vbGreen
.FillStyle = 0
End With
End Sub
Private Sub Timer1_Timer()
Smove '蛇移动
eat '检测吃
eatself '检测吃到自己
Cls '清屏
Print Score '显示分数
Me.Circle (f.x, f.y), 0.5, vbRed '画食物
PaintSnake '画蛇
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) '按键
If KeyCode > 40 Or KeyCode < 37 Then Exit Sub
If Abs(fx + 36 - KeyCode) <> 2 Then fx = KeyCode - 36 '移动方向(不能倒退)
End Sub
Private Sub init() '初始化
fx = 1 '初始方向左
Score = 0 '分数0
ReDim s(2) '初始化蛇身3节
Dim i As Integer
For i = 0 To 2
s(i).x = 25 + i
s(i).y = 25
Next i
Food
Timer1.Interval = 100 '移动速度,越小越快
Timer1.Enabled = True
End Sub
Private Sub Food() '产生食物
Dim i As Integer
Dim c As Boolean
Do
c = False
Randomize
f.x = Int(Rnd * 50 + 1)
f.y = Int(Rnd * 50 + 1)
For i = LBound(s) To UBound(s) '不让食物生成在蛇的身上
If s(i).x = f.x And s(i).y = f.y Then
c = True
Exit For
End If
Next i
Loop While c
End Sub
Private Sub eat() '吃食物
Dim x As Single, y As Single
If s(0).x = f.x And s(0).y = f.y Then
ReDim Preserve s(UBound(s) + 1) '添加一节身体
x = s(UBound(s) - 1).x '记录老身体最后一节的位置
y = s(UBound(s) - 1).y
Smove '身体移动一下把最后的位置让给新的身体
s(UBound(s)).x = x '新的身体=老身体最后一节之前的位置
s(UBound(s)).y = y
Score = Score + 1 '积分+1
Food '产生新食物
End If
End Sub
Private Sub Smove() '蛇移动
Dim i As Integer
For i = UBound(s) To 1 Step -1 '蛇尾跟着蛇头移动
s(i).x = s(i - 1).x
s(i).y = s(i - 1).y
Next i
Select Case fx '蛇头朝着按键方向移动
Case 1 '左
s(0).x = s(0).x - 1
If s(0).x < 1 Then s(0).x = 50
Case 2 '上
s(0).y = s(0).y - 1
If s(0).y < 1 Then s(0).y = 50
Case 3 '右
s(0).x = s(0).x + 1
If s(0).x > 50 Then s(0).x = 1
Case 4 '下
s(0).y = s(0).y + 1
If s(0).y > 50 Then s(0).y = 1
End Select
End Sub
Private Sub PaintSnake() '画蛇
Dim i As Integer
For i = LBound(s) To UBound(s)
Me.Circle (s(i).x, s(i).y), 0.5, vbBlue
Next i
End Sub
Private Sub eatself() '吃到自己
Dim i As Integer
For i = 1 To UBound(s)
If s(0).x = s(i).x And s(0).y = s(i).y Then
Timer1.Enabled = False
If MsgBox("游戏结束!您的得分:" & Score & vbCrLf & "是否重新开始?", vbYesNo, "贪吃蛇") = vbYes Then
init
Exit Sub
Else
End
End If
End If
Next
End Sub
Private Type sf
x As Single
y As Single
End Type
Dim s() As sf '数组组成蛇体,下标为身长
Dim f As sf '食物
Dim fx As Integer '方向,1234对应左上右下
Dim Score As Integer '积分
Private Sub Form_Load()
Move 1000, 1000, 10000, 10000
init
End Sub
Private Sub Form_Resize() '调整窗体大小
Me.Scale (0, 0)-(51, 51)
With Me
.AutoRedraw = True
.DrawWidth = 1
.KeyPreview = True
.FillColor = vbGreen
.FillStyle = 0
End With
End Sub
Private Sub Timer1_Timer()
Smove '蛇移动
eat '检测吃
eatself '检测吃到自己
Cls '清屏
Print Score '显示分数
Me.Circle (f.x, f.y), 0.5, vbRed '画食物
PaintSnake '画蛇
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) '按键
If KeyCode > 40 Or KeyCode < 37 Then Exit Sub
If Abs(fx + 36 - KeyCode) <> 2 Then fx = KeyCode - 36 '移动方向(不能倒退)
End Sub
Private Sub init() '初始化
fx = 1 '初始方向左
Score = 0 '分数0
ReDim s(2) '初始化蛇身3节
Dim i As Integer
For i = 0 To 2
s(i).x = 25 + i
s(i).y = 25
Next i
Food
Timer1.Interval = 100 '移动速度,越小越快
Timer1.Enabled = True
End Sub
Private Sub Food() '产生食物
Dim i As Integer
Dim c As Boolean
Do
c = False
Randomize
f.x = Int(Rnd * 50 + 1)
f.y = Int(Rnd * 50 + 1)
For i = LBound(s) To UBound(s) '不让食物生成在蛇的身上
If s(i).x = f.x And s(i).y = f.y Then
c = True
Exit For
End If
Next i
Loop While c
End Sub
Private Sub eat() '吃食物
Dim x As Single, y As Single
If s(0).x = f.x And s(0).y = f.y Then
ReDim Preserve s(UBound(s) + 1) '添加一节身体
x = s(UBound(s) - 1).x '记录老身体最后一节的位置
y = s(UBound(s) - 1).y
Smove '身体移动一下把最后的位置让给新的身体
s(UBound(s)).x = x '新的身体=老身体最后一节之前的位置
s(UBound(s)).y = y
Score = Score + 1 '积分+1
Food '产生新食物
End If
End Sub
Private Sub Smove() '蛇移动
Dim i As Integer
For i = UBound(s) To 1 Step -1 '蛇尾跟着蛇头移动
s(i).x = s(i - 1).x
s(i).y = s(i - 1).y
Next i
Select Case fx '蛇头朝着按键方向移动
Case 1 '左
s(0).x = s(0).x - 1
If s(0).x < 1 Then s(0).x = 50
Case 2 '上
s(0).y = s(0).y - 1
If s(0).y < 1 Then s(0).y = 50
Case 3 '右
s(0).x = s(0).x + 1
If s(0).x > 50 Then s(0).x = 1
Case 4 '下
s(0).y = s(0).y + 1
If s(0).y > 50 Then s(0).y = 1
End Select
End Sub
Private Sub PaintSnake() '画蛇
Dim i As Integer
For i = LBound(s) To UBound(s)
Me.Circle (s(i).x, s(i).y), 0.5, vbBlue
Next i
End Sub
Private Sub eatself() '吃到自己
Dim i As Integer
For i = 1 To UBound(s)
If s(0).x = s(i).x And s(0).y = s(i).y Then
Timer1.Enabled = False
If MsgBox("游戏结束!您的得分:" & Score & vbCrLf & "是否重新开始?", vbYesNo, "贪吃蛇") = vbYes Then
init
Exit Sub
Else
End
End If
End If
Next
End Sub