急!VB高手请进!求VB贪吃蛇代码(分由你说:只要够!)

游戏结束要现出成绩的!
不要是全屏最好!
谢谢……

给个100分就行了。
把代码复制到空窗体中按F5运行即可。

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
温馨提示:内容为网友见解,仅供参考
第1个回答  2008-11-23
分数最多可能只能追加50分。。~~呵呵~
不过我可以给出你思路。:
在窗体上随机坐标出现图形A,程序不停的检测方向键上下左右 来控制由图形A累加起来的图形B。timer控件控制图形B的移动速度(游戏难度),当图形B碰到图形A时,图形B长度+1,图形A消失,然后再次在下一个随机坐标点出现图形A,如此反复进行。当图形B碰到窗体边缘时,~~ Game Over.. 同时出现图形B由多少个图形A组成(也就是成绩)本回答被提问者采纳

急!VB高手请进!求VB贪吃蛇代码(分由你说:只要够!)
给个100分就行了。把代码复制到空窗体中按F5运行即可。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 S...

vb高手请进
1 var y,m,d,t:longint;function day(k:longint):longint;var days:longint;begin case m of 1,3,5,7,8,10,12:days:=31;4,6,9,11:days:=30;2:if ((y mod 4=0) and (y mod 100<>0)) or ((y mod 100=0) and (y mod 400=0)) then days:=29 else days:=28;end...

vb的小问题。高手请进
要解决VB的小问题,首先在菜单中找到“工程\/引用\/Microsoft Script Control 1。0”,确保前面有勾,然后点击OK,你将获得满意的答案,并且得到高分。在代码中,我们定义了几个变量。`Dim objScript As New ScriptControl` 创建了一个新的ScriptControl对象。`a As Double, x As Double, y As String`...

VB高手请进,真的很急啊!谢谢了!
mod后少a没?a(3) = 8 a(7) = 4 a(3)\\a(7) = 2 (整除)2 mod 8 = 2 '取余 a(2)= 9 打印 9

VB高手请进!!急急急急!分数不是问题只要你能帮我解决!!!
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long Private Sub Form_Load()URLDownloadToFile 0, "http:\/\/down....

vb高手请进(有高分)
我试验过了,你把For n = 1 To 6改成For n = 1 To 1000,然后下面加上一局C=0,则会打印出6,28,496这三个数字了 问题解决了,最后看你能加多少高分咯~最后再提醒下,记得把你的form的autoredraw属性设置成true,否则无法在屏幕打印的,你就看不到结果了 ...

十万火急!vb高手请进
你看前面有这么一句:Dim workarea(250) As String 这句话定义了一个叫workarea,大小是250的字符串数组。知道了上面一句话的意思,下面这个应该不难理解:workarea(counter) = "initial value" & counter 这一句的意思是workarea的第counter个元素的值是initial value加上counter的值(其实这一句没有什么...

VB高手快来拿分(只要把代码复制过来就好了,不要具体操作步骤,如果正确...
这个应该不太难吧,多看看课本的例子不难实现的

vb高手请进!!!1
criteria = "姓名=" & """&findname&"""改为:criteria = "姓名=" & Chr(34) & findname & Chr(34)双引号用chr(34) 代替。连着写三个双引号像"""会报错.还有变量链接时两边加空格 &findname& 变为 & findname & 奥,没看到后面的查询,抱歉啊。criteria = "姓名='" & findname & ...

高手请进!EXCEL用VB自动显示和隐藏行或列
C:D").Hidden = False Columns("E:K").Hidden = True End If If Target = 2 And Target.Row = 3 And Target.Column = 1 Then Rows("4:5").Hidden = False Rows("6:10").Hidden = True End If End Sub代码放在工作表代码框中 ...

相似回答
大家正在搜