vb編程小游戲
❶ 用VB怎麼做一個小游戲啊
下面是個程序!希望有用
'定義蛇的運動速度枚舉值
Private Enum tpsSpeed
QUICKLY = 0
SLOWLY = 1
End Enum
'定義蛇的運動方向枚舉值
Private Enum tpsDirection
D_UP = 38
D_DOWN = 40
D_LEFT = 37
D_RIGHT = 39
End Enum
'定義運動區域4個禁區的枚舉值
Private Enum tpsForbiddenZone
FZ_TOP = 30
FZ_BOTTOM = 5330
FZ_LEFT = 30
FZ_RIGHT = 5730
End Enum
'定義蛇頭及身體初始化數枚舉值
Private Enum tpsSnake
SNAKEONE = 1
SNAKETWO = 2
SNAKETHREE = 3
SNAKEFOUR = 4
End Enum
'定義蛇寬度的常量
Private Const SNAKEWIDTH As Integer = 100
'該過程用於顯示游戲信息
Private Sub Form_Load()
Me.Show
Me.lblTitle = "BS貪食蛇 — (版本 " & App.Major & "." & App.Minor & "." & App.Revision & ")"
Me.Caption = Me.lblTitle.Caption
frmSplash.Show 1
End Sub
'該過程用於使窗體恢復原始大小
Private Sub Form_Resize()
If Me.WindowState <> 1 Then
Me.Caption = ""
Me.Height = 6405 '窗體高度為 6405 緹
Me.Width = 8535 '窗體寬度為 8535 緹
Me.Left = (Screen.Width - Width) \ 2
Me.Top = (Screen.Height - Height) \ 2
End If
End Sub
'該過程用於重新開始開始游戲
Private Sub cmdGameStart_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Beep
msg = MsgBox("您確認要重新開始游戲嗎？", 4 + 32, "BS貪食蛇")
If msg = 6 Then Call m_subGameInitialize
End Sub
'該過程用於暫停/運行游戲
Private Sub chkPause_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Me.chkPause.Caption = "暫停游戲(&P)" Then
Me.tmrSnakeMove.Enabled = False
Me.tmrGameTime.Enabled = False
Me.picMoveArea.Enabled = False
Me.lblPauseLab.Visible = True
Me.chkPause.Caption = "繼續游戲(&R)"
Else
Me.tmrSnakeMove.Enabled = True
Me.tmrGameTime.Enabled = True
Me.picMoveArea.Enabled = True
Me.lblPauseLab.Visible = False
Me.chkPause.Caption = "暫停游戲(&P)"
End If
End Sub
'該過程用於顯示游戲規則
Private Sub cmdGameRules_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Beep
MsgBox " BS貪食蛇：一個規則最簡單的趣味游戲，您將用鍵盤" & Chr(13) & _
"上的4個方向鍵來控制蛇的運動方向。在運動過程中蛇" & Chr(13) & _
"不能後退，蛇的頭部也不能接觸到運動區域的邊線以外" & Chr(13) & _
"和蛇自己的身體，否則就游戲失敗。在吃掉隨機出現的" & Chr(13) & _
"果子後，蛇的身體會變長，越長難度越大。祝您好運！！", 0 + 64, "游戲規則"
End Sub
'該過程用於顯示游戲開發信息
Private Sub cmdAbout_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Beep
MsgBox "BS貪食蛇" & "(V-" & App.Major & "." & App.Minor & "版本)" & Chr(13) & Chr(13) & _
"" & Chr(13) & Chr(13) & _
"由PigheadPrince設計製作" & Chr(13) & _
"CopyRight(C)2002,BestSoft.TCG", 0, "關於本游戲"
End Sub
'該過程用於退出遊戲
Private Sub cmdExit_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Beep
msg = MsgBox("您要退出本游戲嗎？", 4 + 32, "BS貪食蛇")
Select Case msg
Case 6
End
Case 7
Me.chkWindowButton(2).Value = 0
Exit Sub
End Select
End Sub
'該過程用於拖動窗體_(點擊圖標)
Private Sub imgWindowTop_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MOVE, 0
End Sub
'該共用過程用於處理窗體控制按鈕組的相關操作_(鎖定、最小化、退出)
Private Sub chkWindowButton_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
Select Case Index
Case 0 '鎖定窗體
If Me.chkWindowButton(0).Value = 1 Then
Me.imgWindowTop.BorderStyle = 0
Me.imgWindowTop.Enabled = False
Else
Me.imgWindowTop.BorderStyle = 1
Me.imgWindowTop.Enabled = True
End If
Case 1 '最小化
Me.WindowState = 1
Me.chkWindowButton(1).Value = 0
Me.Caption = "BS貪食蛇 — (V-" & App.Major & "." & App.Minor & "版本)"
Case 2 '退出
Beep
msg = MsgBox("您要退出本游戲嗎？", 4 + 32, "BS貪食蛇")
Select Case msg
Case 6
End
Case 7
Me.chkWindowButton(2).Value = 0
Exit Sub
End Select
End Select
End Sub
'該過程用於設置蛇運動速度的快慢
Private Sub hsbGameSpeed_Change()
Me.tmrSnakeMove.Interval = Me.hsbGameSpeed.Value
End Sub
'該過程用於通過鍵盤的方向鍵改變蛇的運動方向
Private Sub picMoveArea_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case g_intDirection
Case D_UP
If KeyCode = D_DOWN Then Exit Sub
Case D_DOWN
If KeyCode = D_UP Then Exit Sub
Case D_LEFT
If KeyCode = D_RIGHT Then Exit Sub
Case D_RIGHT
If KeyCode = D_LEFT Then Exit Sub
End Select
g_intDirection = KeyCode
End Sub
'該計時循環過程用於計算游戲耗費的秒數並顯示
Private Sub tmrGameTime_Timer()
g_lngGameTime = g_lngGameTime + 1
Me.lblGameTime.Caption = g_lngGameTime & "秒"
End Sub
'該計時循環過程用於控制蛇的行動軌跡
Private Sub tmrSnakeMove_Timer()
Dim lngSnakeX As Long, lngSnakeY As Long, lngSnakeColor As Long
Dim lngPointX As Long, lngPointY As Long, lngPointColor As Long
Randomize
Me.picMoveArea.SetFocus
Me.picMoveArea.Cls
'確認蛇頭的運動方向並獲取新的位置
Select Case g_intDirection
Case D_UP '向上運動
g_udtSnake(SNAKEONE).Snake_CurX = g_udtSnake(SNAKEONE).Snake_OldX
g_udtSnake(SNAKEONE).Snake_CurY = g_udtSnake(SNAKEONE).Snake_OldY
g_udtSnake(SNAKEONE).Snake_CurY = g_udtSnake(SNAKEONE).Snake_CurY - SNAKEWIDTH
Case D_DOWN '向下運動
g_udtSnake(SNAKEONE).Snake_CurX = g_udtSnake(SNAKEONE).Snake_OldX
g_udtSnake(SNAKEONE).Snake_CurY = g_udtSnake(SNAKEONE).Snake_OldY
g_udtSnake(SNAKEONE).Snake_CurY = g_udtSnake(SNAKEONE).Snake_CurY + SNAKEWIDTH
Case D_LEFT '向左運動
g_udtSnake(SNAKEONE).Snake_CurX = g_udtSnake(SNAKEONE).Snake_OldX
g_udtSnake(SNAKEONE).Snake_CurX = g_udtSnake(SNAKEONE).Snake_CurX - SNAKEWIDTH
g_udtSnake(SNAKEONE).Snake_CurY = g_udtSnake(SNAKEONE).Snake_OldY
Case D_RIGHT '向右運動
g_udtSnake(SNAKEONE).Snake_CurX = g_udtSnake(SNAKEONE).Snake_OldX
g_udtSnake(SNAKEONE).Snake_CurX = g_udtSnake(SNAKEONE).Snake_CurX + SNAKEWIDTH
g_udtSnake(SNAKEONE).Snake_CurY = g_udtSnake(SNAKEONE).Snake_OldY
End Select
'根據新的位置繪制蛇頭
lngSnakeX = g_udtSnake(SNAKEONE).Snake_CurX
lngSnakeY = g_udtSnake(SNAKEONE).Snake_CurY
lngSnakeColor = g_udtSnake(SNAKEONE).Snake_Color
Me.picMoveArea.PSet (lngSnakeX, lngSnakeY), lngSnakeColor
'移動蛇身體其他部分的位置
For i = 2 To g_intSnakeLength
g_udtSnake(i).Snake_CurX = g_udtSnake(i - 1).Snake_OldX
g_udtSnake(i).Snake_CurY = g_udtSnake(i - 1).Snake_OldY
lngSnakeX = g_udtSnake(i).Snake_CurX
lngSnakeY = g_udtSnake(i).Snake_CurY
lngSnakeColor = g_udtSnake(i).Snake_Color
Me.picMoveArea.PSet (lngSnakeX, lngSnakeY), lngSnakeColor
Next i
'更新蛇舊的坐標位置
For j = 1 To g_intSnakeLength
g_udtSnake(j).Snake_OldX = g_udtSnake(j).Snake_CurX
g_udtSnake(j).Snake_OldY = g_udtSnake(j).Snake_CurY
Next j
'判斷蛇在移動中是否到了禁區而導致游戲失敗
If m_funMoveForbiddenZone(g_udtSnake(SNAKEONE).Snake_CurX, g_udtSnake(SNAKEONE).Snake_CurY) Then
Beep
MsgBox "您的蛇移動到了禁區，游戲失敗！", 0 + 16, "BS貪食蛇"
Me.tmrSnakeMove.Enabled = False
Me.tmrGameTime.Enabled = False
Me.picMoveArea.Visible = False
Exit Sub
End If
'判斷蛇在移動中是否碰到了自己的身體而導致游戲失敗
If m_funTouchSnakeBody(g_udtSnake(SNAKEONE).Snake_CurX, g_udtSnake(SNAKEONE).Snake_CurY) Then
Beep
MsgBox "您的蛇在移動中碰到了自己的身體，游戲失敗！", 0 + 16, "BS貪食蛇"
Me.tmrSnakeMove.Enabled = False
Me.tmrGameTime.Enabled = False
Me.picMoveArea.Visible = False
Exit Sub
End If
'判斷蛇是否吃到了果子
If m_funEatPoint(g_udtSnake(SNAKEONE).Snake_CurX, g_udtSnake(SNAKEONE).Snake_CurY) Then
'累加玩家的得分並刷新得分顯示
g_intPlayerScore = g_intPlayerScore + 1
Me.lblYourScore.Caption = g_intPlayerScore & "分"
Call m_subAddSnake '加長蛇的身體
Call m_subGetPoint '獲取下一個果子的位置和顏色
Else
'繪制果子
lngPointX = g_udtPoint.Point_X
lngPointY = g_udtPoint.Point_Y
lngPointColor = g_udtPoint.Point_Color
Me.picMoveArea.PSet (lngPointX, lngPointY), lngPointColor
End If
End Sub
'該私有子過程用於初始化游戲
Private Sub m_subGameInitialize()
Erase g_udtSnake '清空蛇的結構數組
g_intPlayerScore = 0 '清空玩家的得分
g_lngGameTime = 0 '清空游戲耗費的秒數
g_intDirection = D_DOWN '設定蛇的初始運動方向為下
g_intSnakeLength = 4 '設定蛇的初始長度
ReDim g_udtSnake(1 To g_intSnakeLength) '重新定義蛇的長度
'定義蛇頭部的數據
With g_udtSnake(SNAKEONE)
.Snake_OldX = 530
.Snake_OldY = 530
.Snake_Color = vbBlack
End With
'定義蛇身第2節的數據
With g_udtSnake(SNAKETWO)
.Snake_OldX = 530
.Snake_OldY = 430
.Snake_Color = vbGreen
End With
'定義蛇身第3節的數據
With g_udtSnake(SNAKETHREE)
.Snake_OldX = 530
.Snake_OldY = 330
.Snake_Color = vbYellow
End With
'定義蛇身第4節的數據
With g_udtSnake(SNAKEFOUR)
.Snake_OldX = 530
.Snake_OldY = 230
.Snake_Color = vbRed
End With
Me.picMoveArea.Visible = True
Me.lblYourScore.Caption = g_intPlayerScore & "分"
Me.lblGameTime.Caption = g_lngGameTime & "秒"
Me.tmrSnakeMove.Interval = Me.hsbGameSpeed.Value
Me.tmrSnakeMove.Enabled = True
Me.tmrGameTime.Enabled = True
Call m_subGetPoint '獲取第一個果子的位置和顏色
End Sub
'該私有子過程用於返回獲取的果子的位置和顏色信息
Private Sub m_subGetPoint()
Dim lngRedValue As Long, lngGreenValue As Long, lngBlueValue As Long
Dim lngPointX As Long, lngPointY As Long, lngPointColor As Long
'隨機獲取果子的顏色
lngRedValue = Int((255 - 0 + 1) * Rnd + 0)
lngGreenValue = Int((255 - 0 + 1) * Rnd + 0)
lngBlueValue = Int((255 - 0 + 1) * Rnd + 0)
lngPointColor = RGB(lngRedValue, lngGreenValue, lngBlueValue)
'隨機獲取果子的位置
lngPointX = Int((FZ_LEFT - FZ_RIGHT + 1) * Rnd + FZ_RIGHT)
lngPointY = Int((FZ_TOP - FZ_BOTTOM + 1) * Rnd + FZ_BOTTOM)
Me.PSet (lngPointX, lngPointY), lngPointColor
'設置函數返回值
With g_udtPoint
.Point_X = lngPointX
.Point_Y = lngPointY
.Point_Color = lngPointColor
End With
End Sub
'該私有子過程用於加長蛇的身體
Private Sub m_subAddSnake()
Dim udtSnakeTemp() As Snake
Dim lngSnakeX As Long, lngSnakeY As Long, lngSnakeColor As Long
'備份蛇原先身體的數據並使蛇的身體加長
ReDim udtSnakeTemp(1 To g_intSnakeLength)
For k = 1 To g_intSnakeLength
With udtSnakeTemp(k)
.Snake_CurX = g_udtSnake(k).Snake_CurX
.Snake_CurY = g_udtSnake(k).Snake_CurY
.Snake_OldX = g_udtSnake(k).Snake_OldX
.Snake_OldY = g_udtSnake(k).Snake_OldY
.Snake_Color = g_udtSnake(k).Snake_Color
End With
Next k
g_intSnakeLength = g_intSnakeLength + 1
ReDim g_udtSnake(g_intSnakeLength)
'將備份蛇身體的數據返回到加長的蛇身數組中
For l = 1 To g_intSnakeLength - 1
With g_udtSnake(l)
.Snake_CurX = udtSnakeTemp(l).Snake_CurX
.Snake_CurY = udtSnakeTemp(l).Snake_CurY
.Snake_OldX = udtSnakeTemp(l).Snake_OldX
.Snake_OldY = udtSnakeTemp(l).Snake_OldY
.Snake_Color = udtSnakeTemp(l).Snake_Color
End With
Next l
'寫入新加入的身體數據
Select Case g_intDirection
Case D_UP
With g_udtSnake(g_intSnakeLength)
.Snake_OldX = g_udtSnake(g_intSnakeLength - 1).Snake_CurX + SNAKEWIDTH
.Snake_OldY = g_udtSnake(g_intSnakeLength - 1).Snake_CurY
.Snake_Color = g_udtPoint.Point_Color
End With
Case D_DOWN
With g_udtSnake(g_intSnakeLength)
.Snake_OldX = g_udtSnake(g_intSnakeLength - 1).Snake_CurX - SNAKEWIDTH
.Snake_OldY = g_udtSnake(g_intSnakeLength - 1).Snake_CurY
.Snake_Color = g_udtPoint.Point_Color
End With
Case D_LEFT
With g_udtSnake(g_intSnakeLength)
.Snake_OldX = g_udtSnake(g_intSnakeLength - 1).Snake_CurX
.Snake_OldY = g_udtSnake(g_intSnakeLength - 1).Snake_CurY + SNAKEWIDTH
.Snake_Color = g_udtPoint.Point_Color
End With
Case D_RIGHT
With g_udtSnake(g_intSnakeLength)
.Snake_OldX = g_udtSnake(g_intSnakeLength - 1).Snake_CurX
.Snake_OldY = g_udtSnake(g_intSnakeLength - 1).Snake_CurY - SNAKEWIDTH
.Snake_Color = g_udtPoint.Point_Color
End With
End Select
lngSnakeX = g_udtSnake(g_intSnakeLength).Snake_CurX
lngSnakeY = g_udtSnake(g_intSnakeLength).Snake_CurY
lngSnakeColor = g_udtSnake(g_intSnakeLength).Snake_Color
Me.picMoveArea.PSet (lngSnakeX, lngSnakeY), lngSnakeColor
End Sub
'該自定義函數用於返回運動的蛇是否到達禁區而導致游戲失敗
Private Function m_funMoveForbiddenZone(SnakeX As Long, SnakeY As Long) As Boolean
If (SnakeX >= FZ_LEFT And SnakeX <= FZ_RIGHT) And (SnakeY >= FZ_TOP And SnakeY <= FZ_BOTTOM) Then
m_funMoveForbiddenZone = False
Else
m_funMoveForbiddenZone = True
End If
End Function
'該自定義函數用於返回運動的蛇是否碰到自己的身體而導致游戲失敗
Private Function m_funTouchSnakeBody(SnakeX As Long, SnakeY As Long) As Boolean
For m = 2 To g_intSnakeLength
If SnakeX = g_udtSnake(m).Snake_CurX And SnakeY = g_udtSnake(m).Snake_CurY Then
m_funTouchSnakeBody = True
Exit For
Else
m_funTouchSnakeBody = False
End If
Next m
End Function
'該自定義函數用於返回運動的蛇是否吃到了果子
Private Function m_funEatPoint(SnakeX As Long, SnakeY As Long) As Boolean
If Abs(SnakeX - g_udtPoint.Point_X) <= SNAKEWIDTH And Abs(SnakeY - g_udtPoint.Point_Y) <= SNAKEWIDTH Then
m_funEatPoint = True
Else
m_funEatPoint = False
End If
End Function
'（API函數調用過程_用以實現無標題窗體的拖動操作）---------------------------------
'RleaseCapture函數用以釋放滑鼠捕獲
Public Declare Function ReleaseCapture Lib "user32" () As Long
'SendMessage函數用作向Windows發送移動窗體的消息
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As _
Long, ByVal wMsg As Long, ByVal wParam As Long, IParam As Any) As Long
Public Const WM_SYSCOMMAND = &H112 '聲明向Windows發送消息的常量
Public Const SC_MOVE = &HF012 '聲明控制移動窗體常量
'（游戲變數聲明部分）-------------------------------------------------------------
'定義蛇的數據類型結構
Public Type Snake
Snake_OldX As Long
Snake_OldY As Long
Snake_CurX As Long
Snake_CurY As Long
Snake_Color As Long
End Type
'定義果子的數據類型結構
Public Type Point
Point_X As Long
Point_Y As Long
Point_Color As Long
End Type
'定義蛇的動態數組
Public g_udtSnake() As Snake
'定義果子
Public g_udtPoint As Point
'定義蛇的長度
Public g_intSnakeLength As Integer
'定義蛇的顏色
Public g_lngSnakeColor As Long
'定義蛇的運動方向
Public g_intDirection As Integer
'定義玩家的得分
Public g_intPlayerScore As Integer
'定義游戲耗費的秒數
Public g_lngGameTime As Long
❷ 如何用VB程序設計打地鼠游戲
下面是源代碼：
Form1:
Private Sub Form_Load() Dim temp As Integer Randomize
temp = Int(Rnd * 3) + 1
Form1.Picture = LoadPicture("C:\Users\Administrator\Desktop\打地鼠\picture" & temp & ".jpg") WindowsMediaPlayer1.URL = "C:\Users\Administrator\Desktop\打地鼠\Heaven's Devils.wma" End Sub
Private Sub Label1_Click() Form2.Show Form2.num = -1 Form1.Hide
WindowsMediaPlayer1.URL = ""
Open "C:\Users\Administrator\Desktop\打地鼠\primary.dat" For Append As #1 '寫操作 Close #1
Open "C:\Users\Administrator\Desktop\打地鼠\intermediate.dat" For Append As #2 Close #2
Open "C:\Users\Administrator\Desktop\打地鼠\advanced.dat" For Append As #3 Close #3 End Sub
Private Sub Label2_Click() End End Sub
Form2:
Dim allnum As Integer, oknum As Integer '定義變化次數 打中次數 Public num As Integer '判別是否第一次開始游戲 Dim flags1 As Boolean '判別文件是否保存 Public flags As Boolean '判別是否播放聲音 Private Sub countine_Click() pause.Enabled = True Timer1.Enabled = True countine.Enabled = False WLXZ.Enabled = True End Sub
Private Sub exit_Click() Dim X As Integer Dim tt As Integer
X = MsgBox("是否真的退出？", vbYesNo, "退出遊戲框")
If X = 6 Then
tt = MsgBox("退出遊戲之前,是否保存", vbYesNo, "保存提示") If tt = 6 Then
If flags1 = True Then End Else
If Timer1.Interval = 1000 Then
Open "C:\Users\Administrator\Desktop\打地鼠\primary.dat" For Append As #1 '寫操作
Print #1, Text1.Text + " " + Format(Date, "M/d/yy") Close #1
ElseIf Timer1.Interval = 500 Then
Open "C:\Users\Administrator\Desktop\打地鼠\intermediate.dat" For Append As #2
Print #2, Text1.Text + " " + Format(Date, "M/d/yy") Close #2 Else
Open "C:\Users\Administrator\Desktop\打地鼠\advanced.dat" For Append As #3
Print #3, Text1.Text + " " + Format(Date, "M/d/yy") Close #3 End If End If End If End End If End Sub
Private Sub Form_Load() Form4.Check1.Value = 1
WindowsMediaPlayer1.Controls.stop countine.Enabled = False pause.Enabled = False WLXZ.Enabled = False
Form5.Top = Form2.Top + 700 Form5.Left = Form2.Left flags1 = False flags = True End Sub
Private Sub help_Click() Form3.Show End Sub
Private Sub new_game_Click() num = num + 1 Dim t As Integer
If (num > 0) Then
t = MsgBox("新游戲開始之前,是否保存", vbYesNo, "保存提示") If t = 6 Then
flags1 = True
If Timer1.Interval = 1000 Then
Open "C:\Users\Administrator\Desktop\打地鼠\primary.dat" For Append As #1 '寫操作
Print #1, Text1.Text + " " + Format(Date, "M/d/yy") Close #1
ElseIf Timer1.Interval = 500 Then
Open "C:\Users\Administrator\Desktop\打地鼠\intermediate.dat" For Append As #2
Print #2, Text1.Text + " " + Format(Date, "M/d/yy") Close #2 Else
Open "C:\Users\Administrator\Desktop\打地鼠\advanced.dat" For Append As #3
Print #3, Text1.Text + " " + Format(Date, "M/d/yy") Close #3 End If End If End If
Call Form_Load
allnum = 0 '變化次數初始為0 oknum = 0 '打中次數初始為0 Timer1.Enabled = True pause.Enabled = True WLXZ.Enabled = True End Sub
Private Sub options_Click() Timer1.Enabled = False Form4.Show
WLXZ.Enabled = False countine.Enabled = True End Sub
Private Sub pause_Click() Dim r, g, b As Integer Timer1.Enabled = False countine.Enabled = True pause.Enabled = False WLXZ.Enabled = False
Form5.Top = Form2.Top + 700 Form5.Left = Form2.Left Form5.Show
❸ 小游戲vb編程
貪吃蛇
PrivateSubForm_KeyDown(KeyCodeAsInteger,ShiftAsInteger)
DimCAsLong
IfKeyCode=27ThenEnd
IfKeyCode=32Then
IfTimer1.Enabled=TrueThen
Timer1.Enabled=False
Label1.Visible=True
Else
Timer1.Enabled=True
Label1.Visible=False
EndIf
EndIf
C=UBound(She)
IfGFangXiang=TrueThenExitSub
SelectCaseKeyCode
Case37
IfShe(C).F=2ThenExitSub
She(C).F=0
GFangXiang=True
Case38
IfShe(C).F=3ThenExitSub
She(C).F=1
GFangXiang=True
Case39
IfShe(C).F=0ThenExitSub
She(C).F=2
GFangXiang=True
Case40
IfShe(C).F=1ThenExitSub
She(C).F=3
GFangXiang=True
EndSelect
EndSub
PrivateSubForm_Load()
Me.AutoRedraw=True
Me.BackColor=&HC000&
Me.FillColor=255
Me.FillStyle=0
Me.ScaleWidth=24
Me.ScaleHeight=24
Me.WindowState=2
SetTimer1=Controls.Add("VB.Timer","Timer1")
SetLabel1=Controls.Add("VB.Label","Label1")
Label1.AutoSize=True
Label1.BackStyle=0
Label1="暫停"
Label1.ForeColor=RGB(255,255,0)
Label1.FontSize=50
ChuShiHua
EndSub
PrivateSubForm_Resize()
OnErrorGoTo1:
WithMe
If.WindowState<>1Then
.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
EndIf
EndWith
1:
EndSub
PrivateSubTimer1_Timer()
DimCAsLong,IAsLong
OnErrorGoTo2:
QingChu
C=UBound(She)
SelectCaseShe(C).F
Case0
IfZhuangTai(She(C).X-1,She(C).Y)=2Then
C=C+1
ReDimPreserveShe(C)
She(C).F=She(C-1).F
She(C).X=She(C-1).X-1
She(C).Y=She(C-1).Y
ChanShengShiWu
GoTo1:
ElseIfZhuangTai(She(C).X-1,She(C).Y)=1Then
GoTo2:
EndIf
Case1
IfZhuangTai(She(C).X,She(C).Y-1)=2Then
C=C+1
ReDimPreserveShe(C)
She(C).F=She(C-1).F
She(C).X=She(C-1).X
She(C).Y=She(C-1).Y-1
ChanShengShiWu
GoTo1:
ElseIfZhuangTai(She(C).X,She(C).Y-1)=1Then
GoTo2:
EndIf
Case2
IfZhuangTai(She(C).X+1,She(C).Y)=2Then
C=C+1
ReDimPreserveShe(C)
She(C).F=She(C-1).F
She(C).X=She(C-1).X+1
She(C).Y=She(C-1).Y
ChanShengShiWu
GoTo1:
ElseIfZhuangTai(She(C).X+1,She(C).Y)=1Then
GoTo2:
EndIf
Case3
IfZhuangTai(She(C).X,She(C).Y+1)=2Then
C=C+1
ReDimPreserveShe(C)
She(C).F=She(C-1).F
She(C).X=She(C-1).X
She(C).Y=She(C-1).Y+1
ChanShengShiWu
GoTo1:
ElseIfZhuangTai(She(C).X,She(C).Y+1)=1Then
GoTo2:
EndIf
EndSelect
ZhuangTai(She(0).X,She(0).Y)=0
ForI=0ToC
SelectCaseShe(I).F
Case0
She(I).X=She(I).X-1
Case1
She(I).Y=She(I).Y-1
Case2
She(I).X=She(I).X+1
Case3
She(I).Y=She(I).Y+1
EndSelect
Next
TiaoZheng
1:
GFangXiang=False
ZhuangTai(She(C).X,She(C).Y)=1
HuaTu
ExitSub
2:
IfMsgBox("游戲結束，點「是」重新開始游戲，點「否」",vbYesNo,"貪吃蛇")=vbYesThen
ChuShiHua
Else
End
EndIf
EndSub
PrivateSubChuShiHua()
Me.Cls
Timer1.Enabled=True
Timer1.Interval=200
EraseZhuangTai
ReDimShe(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
EndSub
PrivateSubQingChu()
DimIAsLong
ForI=0ToUBound(She)
Me.Line(She(I).X,She(I).Y)-(She(I).X+1,She(I).Y+1),Me.BackColor,BF
Next
EndSub
PrivateSubHuaTu()
DimIAsLong
ForI=0ToUBound(She)
Me.Circle(She(I).X+0.5,She(I).Y+0.5),0.49,RGB(255,255,0),,,HWB
Next
EndSub
PrivateSubTiaoZheng()
DimIAsLong
ForI=0ToUBound(She)-1
She(I).F=She(I+1).F
Next
EndSub
PrivateSubChanShengShiWu()
RandomizeTimer
1:
X=Int(Rnd*24)
Y=Int(Rnd*24)
IfZhuangTai(X,Y)>0ThenGoTo1:
ZhuangTai(X,Y)=2
Me.Line(X,Y)-(X+1,Y+1),RGB(255,255,0),BF
EndSub