vb小游戲
『壹』 用VB幫忙做一個小游戲
'添加一個名為label1的標簽控制項，並將其index設為0；再添加一個名為command1的按鈕控制項
Dima(1To9)AsBoolean
DimwinAsBoolean,beginAsBoolean,haveloadAsBoolean,startAsBoolean
PrivateSubCommand1_Click()
start=True:begin=False
Fori=1To9
a(i)=False
Nexti
Form_Load
EndSub
PrivateSubForm_Load()
a(9)=True
Label1(0).Visible=False
Me.Height=4400
Me.Width=4000
Scale(0,0)-(3,3.3)
Ifhaveload=FalseThen
haveload=True:start=True
Command1.Top=3:Command1.Left=2
Command1.Width=1:Command1.Height=0.3
Command1.Caption="開始"
Fori=1To9
LoadLabel1(i)
Nexti
EndIf
Fori=1To9
Label1(i).Height=1
Label1(i).Width=1
Label1(i).Visible=True
Label1(i).Top=(i-1)3
Label1(i).Left=(i-1)Mod3
Label1(i).Caption=Str(i)
Label1(i).BackColor=QBColor(i)
Label1(i).FontBold=True
Label1(i).FontSize=40
Nexti
Label1(9).Caption="":Label1(9).BackColor=vbWhite
Randomize
Fori=1To500
r%=Int(9*Rnd)+1
CallLabel1_Click(r)
Nexti
begin=True
EndSub
PrivateSubLabel1_Click(indexAsInteger)
Dimx1AsInteger,y1AsInteger
Ifstart=TrueThen
Ifa(index)=FalseThen
x1=(index-1)Mod3:y1=(index-1)3
Ifx1-1>-0.2Then
Ifa(x1+y1*3)=TrueThenCallyidong(x1+y1*3,index)
EndIf
Ifx1+1<2.2Then
Ifa(x1+y1*3+2)=TrueThenCallyidong(x1+y1*3+2,index)
EndIf
Ify1-1>-0.2Then
Ifa(x1+1+(y1-1)*3)=TrueThenCallyidong(x1+(y1-1)*3+1,index)
EndIf
Ify1+1<2.2Then
Ifa(x1+1+(y1+1)*3)=TrueThenCallyidong(x1+1+(y1+1)*3,index)
EndIf
EndIf
win=True
Fori=1To8
IfVal(Label1(i).Caption)<>iThenwin=False
Nexti
Ifwin=TrueAndbegin=TrueThenMsgBox("恭喜你成功了"):begin=False:start=False
EndIf
EndSub
Subyidong(x,index)
Label1(0).Caption=Label1(index).Caption
Label1(index).Caption=Label1(x).Caption
Label1(x).Caption=Label1(0).Caption
a(index)=True:a(x)=False
Label1(0).BackColor=Label1(index).BackColor
Label1(index).BackColor=Label1(x).BackColor
Label1(x).BackColor=Label1(0).BackColor
EndSub
『貳』 用vb做一個小游戲 希望每一步有詳細解釋
做個貪吃蛇，flppy bird，縱向像素賽車，推箱子，水果機
這些都不難，運用到一些特殊游戲演算法，
貪吃蛇：創建pictureBox控制項數組, 然後加身子就load picture1(picture1.UBound+1)
在聲明一個動態數2d數組，每個身子都有一個X，Y值每移動一次貪吃蛇，頭部先走一步後面的身子就向前一個身子的位置X,Y移動
flppy bird：運用到加速度，重力物理學，以及柱子的碰撞檢測
縱向賽車：隨機下來幾個pictureBox，如果有方塊的縱坐標超過了一定量，那就再從頂部開始下滑（呈現賽車相對幾個障礙物向上走的視覺效應）
推箱子：這個實現起來不容易，要把每一次箱子的位置映像成2D數組，然後根據2d數組坐標判斷對的箱子，箱子和箱子，箱子和牆，箱子和目標，hero和箱子的幾種關系要搞清，誰是主動，誰是被動，誰碰到誰再碰到誰就不能再碰哈哈
水果機：相對沒什麼技術含量，計數器累加再弄一個小球在屏幕上轉圈滾動，滾動到事先生成的隨機數等於累加的數字時，停止小球的滾動，停在了那裡就用計數變數mod加分類別，最終該得多少分，輸出在text裡面。。
『叄』 用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
『肆』 VB編寫小游戲
窗體放兩個Label控制項，一個Timer控制項：
Dim n As Integer
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyUp
If Label1.Top > 0 Then Label1.Top = Label1.Top - 50
Case vbKeyDown
If Label1.Top < ScaleHeight - Label1.Height Then Label1.Top = Label1.Top + 50
Case vbKeyLeft
If Label1.Left > 0 Then Label1.Left = Label1.Left - 50
Case vbKeyRight
If Label1.Left < ScaleWidth - Label1.Width Then Label1.Left = Label1.Left + 50
End Select
Call check
End Sub
Private Sub check()
If Abs(Label1.Top - Label2.Top) <= 50 And Abs(Label1.Left - Label2.Left) <= 50 Then
n = n + 1
Label2.Move Rnd * ScaleWidth, Rnd * ScaleHeight
End If
End Sub
Private Sub Form_Load()
KeyPreview = True
Randomize
With Label1
.Caption = ""
.BackColor = vbWhite
.Move (ScaleWidth - .Width) / 2, (ScaleHeight - .Height) / 2, 500, 500
End With
With Label2
.Caption = ""
.BackColor = vbYellow
.Move Rnd * ScaleWidth, Rnd * ScaleHeight, 500, 500
End With
Timer1.Interval = 60000
Timer1.Enabled = True
End Sub
Private Sub Timer1_Timer()
MsgBox "這局對准了" & n & "次黃方塊"
Unload Me
End Sub
『伍』 vb小游戲源代碼
Rem 窗體創建三個單選框按鈕，Option1、Option2、Option3。
小游戲是一個較模糊的概念，它是相對於體積龐大的單機游戲及網路游戲而言的，泛指所有體積較小、玩法簡單的游戲，通常這類游戲以休閑益智類為主，有單機版有網頁版，在網頁上嵌入的多為FLASH格式。
當下小游戲主要是指在線玩的flash版本游戲，統稱小游戲，其實小游戲還包含單機游戲，小型游戲機等。一般游戲大小小於10m的游戲都統稱為小游戲，一些街機類小游戲。因其游戲安裝簡便，耐玩性強，無依賴性而廣受白領及小朋友的喜愛。
小游戲」這個詞的型含義其實很簡單，它不是一些大的游戲，不必花費更多的時間和精力。
小游戲是原始的游戲娛樂方式，小游戲本身是為了叫人們在工作，學習後的一種娛樂、休閑的一種方式，不是為了叫玩家為之花費金錢、花費精力，更不是叫玩家為他痴迷。
小游戲也可以理解為「Flash游戲」，是以SWF為後綴的游戲的總稱.這些游戲是通過Flash軟體和 Flash 編程語言 Flash ActionScript 製作而成。
由於Flash是矢量軟體，所以小游戲放大後幾乎不影響畫面效果。Flash小游戲是一種新興起的游戲形式，以游戲簡單，操作方便，綠色，無需安裝，文件體積小等優點漸漸被廣大網友喜愛。
『陸』 如何用vb寫一個這樣的小游戲
把代碼復制到空窗體中按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 lt;; 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
應該就是這個了
『柒』 求VB小游戲，簡單一點，越簡單越好
數字排序小游戲
Option Explicit
Dim Label2X As Integer '記錄標簽控制項數組中要移動的標簽控制項左上角X的位置
Dim Label2Y As Integer '記錄標簽控制項數組中要移動的標簽控制項左上角Y的位置
'讓標簽數組中的每個標簽控制項上顯示的數字是隨機的，無重復的
Private Sub Init()
Randomize
Dim a(7) As Integer
Dim i As Integer, k As Integer
Label1.Caption = ""
For i = 0 To 7
a(i) = i
Next
For i = 0 To 7
k = Int(Rnd * 8)
Do While a(k) = -1 'a(k)=-1表示該數組元素對應的數字已經被使用過了
k = Int(Rnd * 8) '重新生成k的值，直到a(k)的值不等於-1
Loop
Label2(i).Caption = Trim(Str(a(k)))
a(k) = -1 'a(k)的值已經使用了，不能再用，重新賦值為-1與其他的元素值相區別
Next i
End Sub
Private Sub Command1_Click()
Dim x As Integer, y As Integer
Dim z As Integer
Init
Picture1.Enabled = True
'讓空白標簽Label1出現的位置隨機
Randomize
'記錄下空白標簽Label1的位置
x = Label1.Left
y = Label1.Top
z = Int(Rnd * 8)
'將空白標簽Label1和標簽控制項數組任一控制項交換位置
Label1.Move Label2(z).Left, Label2(z).Top
Label2(z).Move x, y
Command1.Enabled = False
End Sub
Private Sub Command2_Click()
End
End Sub
Private Sub Form_Load()
Dim i As Integer
Picture1.Enabled = False
'在標簽中顯示游戲說明信息
Label3.Caption = "如左圖所示，將數字按0-7順" & vbCrLf & vbCrLf & "序依次排列，即取得勝利。"
'在標簽中顯示排列規則後的數字順序
Label1.Caption = 0
For i = 0 To 6
Label2(i).Caption = i + 1
Next
End Sub
Private Sub Label1_DragDrop(Source As Control, x As Single, y As Single)
Dim Label1X As Integer '記錄空白控制項Label1左上角X的位置
Dim Label1Y As Integer '記錄空白控制項Label1左上角Y的位置
Dim flag(3) As Boolean
'獲取空白控制項Label1的位置
Label1X = Label1.Left
Label1Y = Label1.Top
'要移動的控制項位於空白控制項Label1的正左側
flag(0) = (Label2X = Label1X - Source.Width) And (Label2Y = Label1Y)
'要移動的控制項位於空白控制項Label1的正右側
flag(1) = (Label2X = Label1X + Source.Width) And (Label2Y = Label1Y)
'要移動的控制項位於空白控制項Label1的正上方
flag(2) = (Label2X = Label1X) And (Label2Y = Label1Y - Source.Height)
'要移動的控制項位於空白控制項Label1的正下方
flag(3) = (Label2X = Label1X) And (Label2Y = Label1Y + Source.Height)
If flag(0) Or flag(1) Or flag(2) Or flag(3) Then
Label1.Move Label2X, Label2Y
Source.Move Label1X, Label1Y
End If
Win
End Sub
Private Sub Label2_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbLeftButton Then '如果按下滑鼠左鍵
'記錄下要拖動控制項的位置
Label2X = Label2(Index).Left
Label2Y = Label2(Index).Top
Label2(Index).Drag 1 '啟動拖動操作
End If
End Sub
Private Sub Label2_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
Label2(Index).Drag 2 '結束拖動操作
End Sub
Private Sub Win()
Dim winner As Integer
Dim i As Integer
Dim answer As Integer
'對於給定的標簽控制項數組中的任一標簽控制項，可以落在符合要求(對應位置應顯示對應數字）
'的八個位置中的任一位置
'利用循環語句對標簽控制項數組中的每個標簽控制項進行檢查，如果其落在某一符號要求的位置，
'則變數winner的值加1，如果所有標簽控制項都落在符號要求的位置，則變數winner的值應為8
For i = 0 To 7
If Label2(i).Left = 0 And Label2(i).Top = 0 And _
Label2(i).Caption = 0 Then
winner = winner + 1
ElseIf Label2(i).Left = Label2(i).Width And Label2(i).Top = 0 And _
Label2(i).Caption = 1 Then
winner = winner + 1
ElseIf Label2(i).Left = 2 * Label2(i).Width And Label2(i).Top = 0 And _
Label2(i).Caption = 2 Then
winner = winner + 1
ElseIf Label2(i).Left = 0 And Label2(i).Top = Label2(i).Height And _
Label2(i).Caption = 3 Then
winner = winner + 1
ElseIf Label2(i).Left = Label2(i).Width And Label2(i).Top = Label2(i).Height And _
Label2(i).Caption = 4 Then
winner = winner + 1
ElseIf Label2(i).Left = 2 * Label2(i).Width And Label2(i).Top = Label2(i).Height And _
Label2(i).Caption = 5 Then
winner = winner + 1
ElseIf Label2(i).Left = 0 And Label2(i).Top = 2 * Label2(i).Height And _
Label2(i).Caption = 6 Then
winner = winner + 1
ElseIf Label2(i).Left = Label2(i).Width And Label2(i).Top = 2 * Label2(i).Height And _
Label2(i).Caption = 7 Then
winner = winner + 1
End If
Next i
If winner = 8 Then
MsgBox " 恭喜您，勝利了！", 0 + 64 + 0, "提示"
Picture1.Enabled = False
answer = MsgBox("還繼續嗎？", 4 + 32 + 0, "提示")
If answer = vbYes Then
Command1.Enabled = True
Else
End
End If
End If
End Sub
彈球游戲
Dim x_step As Integer
Dim y_step As Integer
Private Sub command1_Click()
If Timer1.Enabled = True Then
Timer1.Enabled = False
Else
Timer1.Enabled = True
End If
If command1.Caption = "暫停" Then
command1.Caption = "繼續"
Else
command1.Caption = "暫停"
End If
End Sub
Private Sub Form_Load()
x_step = 200
y_step = 200
End Sub
Private Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 37 Then
If Line1.X1 < 0 Then
Line1.X1 = 0: Line1.X2 = 2000
Else
Line1.X1 = Line1.X1 - 100: Line1.X2 = Line1.X2 - 100
End If
End If
If KeyCode = 39 Then
If Line1.X1 > Picture1.Width Then
Line1.X1 = Picture1.Width - 2000: line2.X2 = Picture.Width
Else
Line1.X1 = Line1.X1 + 100: Line1.X2 = Line1.X2 + 100
End If
End If
End Sub
Private Sub Timer1_Timer()
If Shape1.Top < 0 Then
Shape1.Top = 0: y_step = -y_step
End If
If Shape1.Left < 0 Then
Shape1.Left = 0
x_step = -x_step
End If
If Shape1.Left > Picture1.Width - Shape1.Width Then
Shape1.Left = Picture1.Width - Shape1.Width
x_step = -x_step
End If
If Shape1.Left >= Line1.X1 And Shape1.Left <= Line1.X2 And Shape1.Top >= Line1.Y1 - Shape1.Height Then
Shape1.Top = Line1.Y1 - Shape1.Height
y_step = -y_step * 1.01
x_step = x_step * 1.01
Label2.Caption = Label2.Caption + 1
End If
Shape1.Top = Shape1.Top + y_step
Shape1.Left = Shape1.Left + x_step
If Shape1.Top >= Picture1.Height - Shape1.Height Then
MsgBox "游戲結束"
command1.Caption = "開始"
Timer1.Enabled = False
Shape1.Top = 1000
Label2.Caption = 0
End If
End Sub
打字游戲
Dim score As Integer
Dim speed As Integer
Dim typetime As Integer
Private Sub init()
Randomize
lblletter1.Caption = Chr(Int(Rnd * 42) + 48)
lblletter1.Left = Int(Rnd * 2800) + 1
lblletter1.Top = 0
End Sub
Private Sub init1()
Randomize
lblletter2.Caption = Chr(Int(Rnd * 25) + 97)
lblletter2.Left = Int(Rnd * 2800) + 1
lblletter2.Top = 0
End Sub
Private Sub Command1_Click()
score = Int(lblscore.Text)
init
init1
Timer1 = True
Timer2 = True
HScroll1.Enabled = False
Command1.Enabled = False
Command2.Enabled = False
HScroll1.Enabled = False
If lbltime.Text <= 0 Then
Timer1 = False
Timer2 = False
lblletter1.Caption = ""
lblletter2.Caption = ""
End If
End Sub
Private Sub Command2_Click()
typetime = InputBox("請輸入打字時間。", "時間設置")
If typetime <= 0 Then
lbltime.Text = 60
End If
lbltime.Text = typetime
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If Chr(KeyAscii) = lblletter1.Caption Then
score = score + 1
lblscore.Text = score
init
End If
If Chr(KeyAscii) = lblletter2.Caption Then
score = score + 1
lblscore.Text = score
init1
End If
End Sub
Private Sub Form_Load()
Timer1.Enabled = False
Timer2.Enabled = False
lblletter1.AutoSize = True
lblletter2.AutoSize = True
lblletter1.Caption = ""
lblletter2.Caption = ""
lblscore.Text = 0
lblspeed.Caption = 100
lbltime.Text = 60
HScroll1.Max = 200
HScroll1.Min = 20
HScroll1.SmallChange = 5
HScroll1.LargeChange = 20
HScroll1.Value = 100
End Sub
Private Sub HScroll1_Change()
lblspeed.Caption = HScroll1.Value
End Sub
Private Sub Timer1_Timer()
lblletter1.Top = lblletter1.Top + lblspeed.Caption
If lblletter1.Top >= 4335 Then
Call init
End If
lblletter2.Top = lblletter2.Top + lblspeed.Caption
If lblletter2.Top >= 4335 Then
Call init1
End If
End Sub
Private Sub Timer2_Timer()
If lbltime.Text > 0 Then
lbltime.Text = lbltime.Text - 1
Else: Select Case score / (typetime / 60)
Case Is <= 40
MsgBox ("不要放棄再試一次！")
Case 40 To 80
MsgBox ("太棒了，繼續努力！")
Case 80 To 120
MsgBox ("堅持下去，你將成為一個打字高手！")
Case Is > 120
MsgBox ("祝賀你！你已經是一個打字高手！")
End Select
Timer1 = False
Timer2 = False
HScroll1.Enabled = True
Command1.Enabled = True
Command2.Enabled = True
HScroll1.Enabled = True
init
init1
End If
End Sub
點燈游戲
Private Sub Form_Load()
Form1.Scale (0, 12)-(12, 0)
For i = 1 To 11
Line (1, i)-(11, i)
Line (i, 1)-(i, 11)
Next i
End Sub
Sub fill_color(X, Y)
If Point(X, Y) = vbWhite Then
Line (Int(X), Int(Y))-(Int(X + 1), Int(Y + 1)), vbBlack, BF
Else
Line (Int(X), Int(Y))-(Int(X + 1), Int(Y + 1)), vbWhite, BF
End If
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If X >= 1 And X <= 11 And Y >= 1 And Y <= 11 Then
Call fill_color(X, Y)
If X >= 1 And X <= 11 And Y + 1 >= 1 And Y + 1 <= 11 Then
Call fill_color(X, Y + 1)
End If
If X >= 1 And X <= 11 And Y - 1 >= 1 And Y - 1 <= 11 Then
Call fill_color(X, Y - 1)
End If
If X + 1 >= 1 And X + 1 <= 11 And Y >= 1 And Y <= 11 Then
Call fill_color(X + 1, Y)
End If
If X - 1 >= 1 And X - 1 <= 11 And Y >= 1 And Y <= 11 Then
Call fill_color(X - 1, Y)
End If
End If
Call Form_Load
End Sub
猜數字
Dim number As Integer
Private Sub Command1_Click()
Dim guess As Integer, diff As Integer
guess = Val(Text1.Text)
If guess = -1 Then
MsgBox ("要猜的數是" & number)
Text1.Text = ""
Text1.SetFocus
Exit Sub
End If
diff = Abs(number - guess)
Select Case diff
Case 0
MsgBox ("恭喜你猜對了！")
Case 2, Is < 2
MsgBox ("接近了，再努力！")
Case 10, Is < 12
MsgBox ("有些遠，再努力！")
Case Else
MsgBox ("太遠了，繼續努力！")
End Select
Select Case diff
Case Is <> 0
Text1.Text = ""
Text1.SetFocus
End Select
End Sub
Private Sub Form_Load()
MsgBox ("計算機產生了一個1~100之間的整數，" & Chr(10) & "請您猜出這個數是多少。" & Chr(10) & "如果輸入-1，則停止猜數，並輸出要猜的數。")
number = Int(100 * Rnd) + 1
End Sub
Private Sub Label1_Click()
End Sub
猜笑臉
Private Sub Command1_Click(Index As Integer)
Dim a As Integer, i As Integer
Randomize
a = Int(Rnd * 4)
Command1(a).Enabled = False
Command1(a).DisabledPicture = LoadPicture("267.gif")
If a = Index Then
Label1.Caption = "你猜對啦，真棒！"
Else
Label1.Caption = "你猜錯啦，我在這哩！"
End If
For i = 0 To 3
Command1(i).Enabled = False
Next i
End Sub
Private Sub Command2_Click()
Dim i As Integer
For i = 0 To 3
Command1(i).Enabled = True
Command1(i).DisabledPicture = LoadPicture("")
Next i
Label1.Caption = "猜猜我在哪兒？"
End Sub
Private Sub Command3_Click()
End
End Sub
『捌』 用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
『玖』 用vb做一個益智小游戲
對不起，上午顧著吃飯作錯了，現在更改！
功能實現了細節自己設置！
Dim intI As Integer
Dim intJ As Integer
Dim intH As Integer
Dim intS(0 To 11) As Integer
Private Sub Command1_Click()
'尋找：
Dim intG As Integer
If intH + 6 > 11 Then
intG = intH - 6
Else
intG = intH + 6
End If
For intI = 0 To 11
If intI = intS(intG) Then
Image1(intI).Picture = LoadPicture(App.Path & "\" & intG & ".jpg")
End If
Next
End Sub
'在該工程同一級目錄下命名0到11個圖片（6張不同的圖片各兩份以0-5，6-11按順序命名），且添加一個背景圖片
Private Sub Form_Load()
Dim bln As Boolean
Randomize
intI = 0
Do While intI < 12
bln = False
Image1(intI).Picture = LoadPicture(App.Path & "\背景.gif")
intJ = Int(11 + 1) * Rnd
For intH = 0 To intI
If intJ = intS(intH) Then
bln = True
intI = intI - 1
Exit For
End If
Next
If bln = False Then
intS(intI) = intJ
End If
intI = intI + 1
Loop
End Sub
Private Sub Image1_Click(Index As Integer)
intH = intS(Index)
Image1(Index).Picture = LoadPicture(App.Path & "\" & intS(Index) & ".jpg")
End Sub
『拾』 VB編寫小游戲的全過程誰告訴我
開始學vb時,並不知道vb可以做出動畫,後來知道通過自編的子函數delay(c的庫函數中的該函數)和cls可以做出許多動畫,但有一個缺點就是太耗內存,就我個人認為構思應該比編程重要，因為一旦有了一個很好的構思剩下的問題都是技術問題，而我就是喜歡發現新的問題然後再想方設法解決它，通過發現問題和解決問題我可以學到許多很有用的知識和技巧。好了，現在有了一個好的構思就開始進入程序的編制。
第一步，要做成這個游戲的話必須能使小球有一個判斷性的運動，然而如何處理小球的運動呢，很顯然delay&cls的方法不再適用，因為整個程序運行時不停的清屏效果將很差，所以我想到了用shape控制項來替代用circle命令畫的小球，接著要使小球運動起來，這個問題很簡單，因為 shape控制項有left和top的屬性，可以通過對這兩個屬性的控制可以很輕松的解決小球運動問題。
第二步，將對小球進行角度控制，角度可以通過shape的屬性left和top來反映，通過timer控制項使小球的left和top值不斷加上一個值或減去一個值，小球的left和top同時改變之後就可以對小球的角度進行控制。到這里已經可以使小球運動起來，接下來的問題就是使小球能進行判斷性運動。
第三步，可以這樣對小球進行判斷性控制，當小球的left大於窗體的scaleleft時小球的left改變成減去一個值,以此類推,小球的高度也可以進行類似的控制,現在已經很方便的對小球進行判斷性運動，到這一步程序已經算是完成了一半。
第四步，既然小球可以自由的運動了，那就可以產生這樣一個想法，當小球的top和left的磚塊的top和left值接近到一定的范圍的條件成立時使磚塊的visible為false，然後小球的top和left加上接觸前相應相反的值，就可以使磚塊消失同時小球改變運動軌跡，這一步的實現需要解決很多技術性問題，可以在form的load事件里定義兩個變數Dwd和Dhd以及兩個Boolean量為Dw和Dh，通過Dwd和Dhd來控制小球向左和向上運動，當小球和窗體的邊界或和磚塊的的邊界接觸時使Dw和Dh的值進行相應的變化，通過對該兩個值的控制可以使小球進行合乎反彈角度的運動，現在程序已經初步成型。
第五步，要做成這樣的一個游戲，必須有一個良好的用戶界面，為了使小球能接受用戶的控制，我在窗體的下邊界放置了一個命令按鈕，該命令按鈕可以通過方向鍵來控制，然後再加上一些判斷語句使得小球command接觸時產生相應的運動，這樣一個用戶界面就解決了。
第六步，現在只剩下程序的最後一步，就是生成磚塊的排列，磚塊可以用命令按鈕來替代，然後用循環語句將設置好的command控制項數組在程序運行時載入進來，好了，現在已經一切完成.