vb小游戏代码
猜数字游戏的VB代码
猜数字游戏的VB代码本猜数字游戏的方法及规则：系统自动生成一个四位数（四个数字没有重复），玩者需要猜中这个数字。
玩者在四个文本框内输入四个数字，按“ENTER”后，如果猜对，则文本框变绿，本轮结束，按“CLEAR”进入下一轮。
如果不对，则会在下面显示“xAxB”，其中“xA”表示有四个数字中有多少个数字是数字和所在位置都猜对的，“xB”表示有多少个数字猜对但是所在位置不对。
比如，答案是“1234”，玩者猜“5432”，则显示“1A2B”，因为“3”猜对且位置也对，“4”猜对但位置不对，“2”猜对但位置不对。
如果玩者猜“1324”，则显示“2A2B”；如果玩者猜“4567”，则显示“0A1B”；如果玩者猜“4256”，则显示“1A1B”，原因自己推。
（四位数也可能是零开头。
）最多猜错十次，如十次没有猜对，则游戏失败，本轮结束，按“CLEAR”进入下一轮。
按“QUIT”可查看答案，同时本轮结束。
各控件在界面上的布局如下：Option ExplicitPrivate Sub Command1_Click() '此为“确认”按钮。
If Form1.ForeColor <> vbMagenta ThenIf Command2.Enabled = False ThenDim keydig(1 To 4) As Integer, ansdig(1 To 4) As IntegerDim n, m, cnt_A, cnt_B As Integer, isappliable As BooleanStatic count, keynum As Integer 'command按钮事件执行终，必须使变量count仍然残留。
DoIf count = 0 Then '“count”变量计算Command1_Click执行的次数，每执行一次增加1。
Randomizekeynum = Int(Rnd * (9876 - 123 + 1)) + 123 '生成一个四位随机整数。
好玩的vbs代码
好玩的VBScript代码VBScript（Visual Basic Scripting Edition）是一种基于VB语言的脚本语言，它可以用来创建简单的Windows应用程序、网页脚本和系统管理脚本等。
VBScript 是一种通用的脚本语言，可以用来实现各种有趣的功能。
在本文中，我们将介绍一些好玩的VBScript代码，展示其强大的功能和娱乐价值。
1. 电脑妖怪第一个VBScript代码是创建一个电脑妖怪。
该代码将在电脑屏幕上创建一个随机移动的图形，并发出奇怪的声音。
Set wshShell = CreateObject("WScript.Shell")Set objShell = CreateObject("Shell.Application")Set objWMI = GetObject("winmgmts:\\.\root\cimv2")DowshShell.Run "mshta vbscript:CreateObject(""SAPI.SpVoice"").Speak(""Boo!"") (Close)"objShell.MinimizeAllobjShell.UndoMinimizeAllFor Each objDesktop in objWMI.InstancesOf("Win32_Desktop")objDesktop.SetWallpaper "C:\path\to\your\image.jpg"Nextwscript.sleep 100Loop通过运行该代码，将在桌面上创建一个随机移动的图形，并且屏幕上会突然发出吓人的声音。
这个代码可以用作恶作剧或者给你的朋友带来一些惊喜。
2. 无限弹窗第二个VBScript代码是创建一个无限弹窗的例子。
俄罗斯方块游戏VB代码
Private n(3), m(3) As Integer'n(3)记录游戏区的四个活动方块的编号'm(3)记录预览区的四个活动方块的编号Private situation, situation2, linenum, t As Integer'situation记录游戏区的方块样式'situation2记录预览区的方块样式,linenum记录一次消除的行数Private Declare Function sndPlaySound Lib "Winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As LongPrivate Sub hidefang(a As Integer) '定义使方块不可见的过程Select Case aCase 0 'a＝0使游戏区方块不可见Command6(n(0)).Visible = FalseCommand6(n(1)).Visible = FalseCommand6(n(2)).Visible = FalseCommand6(n(3)).Visible = FalseCase 1 'a＝1使预览区方块不可见Command3(m(0)).Visible = FalseCommand3(m(1)).Visible = FalseCommand3(m(2)).Visible = FalseCommand3(m(3)).Visible = FalseEnd SelectEnd SubPrivate Sub showfang(a As Integer) '定义使方块可见的过程Select Case aCase 0 'a＝0使游戏区方块可见Command6(n(0)).Visible = TrueCommand6(n(1)).Visible = TrueCommand6(n(2)).Visible = TrueCommand6(n(3)).Visible = TrueCase 1 'a＝1使预览区方块不可见Command3(m(0)).Visible = TrueCommand3(m(1)).Visible = TrueCommand3(m(2)).Visible = TrueCommand3(m(3)).Visible = TrueEnd SelectEnd SubPrivate Sub clearline() '定义消除整行的过程For i = 190 To 10 Step -10If Command6(i).Visible = True And _Command6(i + 1).Visible = True And _Command6(i + 2).Visible = True And _Command6(i + 3).Visible = True And _Command6(i + 4).Visible = True And _Command6(i + 5).Visible = True And _Command6(i + 8).Visible = True And _Command6(i + 9).Visible = True ThenFor j = i + 4 To i Step -1t = 1Command6(j).Visible = FalseCommand6(2 * i + 9 - j).Visible = FalseFor k = 1 To 4000DoEventsNextt = 0Nextlinenum = linenum + 1For j = i - 1 To 0 Step -1If Command6(j).Visible = True ThenCommand6(j).Visible = FalseCommand6(j + 10).Visible = TrueEnd IfNextclearline '为了实现连消数行，这里使用递归调用End IfNextEnd SubPrivate Function downable() As Boolean'自定义函数，确定方块是否能下降If n(0) < 190 And n(1) < 190 And n(2) < 190 And n(3) < 190 ThenIf Command6(n(0) + 10).Visible = False And _Command6(n(1) + 10).Visible = False And _Command6(n(2) + 10).Visible = False And _Command6(n(3) + 10).Visible = False Thendownable = TrueElsedownable = FalseEnd IfElsedownable = FalseEnd IfEnd FunctionPrivate Function leftable() As Boolean'自定义函数，确定方块是否能左移If n(0) Mod 10 <> 0 And n(1) Mod 10 <> 0 And n(2) Mod 10 <> 0 And n(3) Mod 10 <> 0 Then If Command6(n(0) - 1).Visible = False And _Command6(n(1) - 1).Visible = False And _Command6(n(2) - 1).Visible = False And _Command6(n(3) - 1).Visible = False Thenleftable = TrueEnd IfElseleftable = FalseEnd IfEnd FunctionPrivate Function rightable() As Boolean'自定义函数，确定方块是否能右移If n(0) Mod 10 <> 9 And n(1) Mod 10 <> 9 And n(2) Mod 10 <> 9 And n(3) Mod 10 <> 9 Then If Command6(n(0) + 1).Visible = False And _Command6(n(1) + 1).Visible = False And _Command6(n(2) + 1).Visible = False And _Command6(n(3) + 1).Visible = False Thenrightable = TrueElserightable = FalseEnd IfElserightable = FalseEnd IfEnd FunctionPrivate Sub loadfangkuai() '定义随机产生一种方块的过程Select Case Int(Rnd * 6)'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Case 0 '长条形Select Case Int(Rnd * 2)Case 0m(0) = 3m(1) = 4m(2) = 5m(3) = 6situation2 = 0Case 1m(0) = 5m(1) = 15m(2) = 25m(3) = 35situation2 = 1End Select'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Case 1 '正方形m(0) = 4m(1) = 5m(2) = 14m(3) = 15situation2 = 2Select Case Int(Rnd * 2)Case 0m(0) = 6m(1) = 5m(2) = 15m(3) = 14situation2 = 3Case 1m(0) = 4m(1) = 14m(2) = 15m(3) = 25situation2 = 4End Select''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Case 3 '反S形Select Case Int(Rnd * 2)Case 0m(0) = 4m(1) = 5m(2) = 15m(3) = 16situation2 = 5Case 1m(0) = 5m(1) = 15m(2) = 14m(3) = 24situation2 = 6End Select''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Case 4 'T字形Select Case Int(Rnd * 4)Case 0m(0) = 4m(1) = 5m(2) = 6m(3) = 15situation2 = 7Case 1m(0) = 5m(1) = 15m(2) = 25m(3) = 14situation2 = 8Case 2m(0) = 16situation2 = 9Case 3m(0) = 24m(1) = 14m(2) = 4m(3) = 15situation2 = 10End Select''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Case 5 '正7字形Select Case Int(Rnd * 4)Case 0m(0) = 4m(1) = 5m(2) = 15m(3) = 25situation2 = 11Case 1m(0) = 5m(1) = 15m(2) = 14m(3) = 13situation2 = 12Case 2m(0) = 25m(1) = 24m(2) = 14m(3) = 4situation2 = 13Case 3m(0) = 14m(1) = 4m(2) = 5m(3) = 6situation2 = 14End Select''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Case 6 '反7字形Select Case Int(Rnd * 4)Case 0m(0) = 5m(1) = 4m(2) = 14m(3) = 24situation2 = 15Case 1m(3) = 3situation2 = 16Case 2m(0) = 24m(1) = 25m(2) = 15m(3) = 5situation2 = 17Case 3m(0) = 4m(1) = 14m(2) = 15m(3) = 16situation2 = 18End SelectEnd SelectEnd SubPrivate Sub zhuan() '定义使方块旋转的过程Select Case situation''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Case 0 '长条形If n(0) - 18 >= 2 And n(3) + 9 <= 198 ThenIf Command6(n(0) - 18).Visible = False And _Command6(n(1) - 9).Visible = False And _Command6(n(3) + 9).Visible = False Thenhidefang 0n(0) = n(0) - 18n(1) = n(1) - 9n(3) = n(3) + 9showfang 0situation = 1End IfEnd IfCase 1If (n(0) + 18) Mod 10 < 8 And (n(3) - 9) Mod 10 > 0 Then If Command6(n(0) + 18).Visible = False And _Command6(n(1) + 9).Visible = False And _Command6(n(3) - 9).Visible = False Thenhidefang 0n(0) = n(0) + 18n(1) = n(1) + 9n(3) = n(3) - 9showfang 0situation = 0End IfCase 2 '正方形，无变化形态'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Case 3 '正S形If n(0) - 11 > 1 ThenIf Command6(n(0) - 11).Visible = False And _Command6(n(3) + 2).Visible = False Thenhidefang 0n(0) = n(0) - 11n(2) = n(2) - 9n(3) = n(3) + 2showfang 0situation = 4End IfEnd IfCase 4If (n(3) - 2) Mod 10 < 9 ThenIf Command6(n(2) + 9).Visible = False And _Command6(n(3) - 2).Visible = False Thenhidefang 0n(0) = n(0) + 11n(2) = n(2) + 9n(3) = n(3) - 2showfang 0situation = 3End IfEnd If'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Case 5 '反S形If n(0) - 9 > 1 ThenIf Command6(n(0) - 9).Visible = False And _Command6(n(3) - 2).Visible = False Thenhidefang 0n(0) = n(0) - 9n(2) = n(2) - 11n(3) = n(3) - 2showfang 0situation = 6End IfEnd IfCase 6If (n(3) + 2) Mod 10 > 0 ThenIf Command6(n(2) + 11).Visible = False And _ Command6(n(3) + 2).Visible = False Thenhidefang 0n(0) = n(0) + 9n(2) = n(2) + 11n(3) = n(3) + 2End IfEnd If'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Case 7 'T字形If n(0) - 9 > 0 ThenIf Command6(n(0) - 9).Visible = False Thenhidefang 0n(0) = n(0) - 9n(2) = n(2) + 9n(3) = n(3) - 11showfang 0situation = 8End IfEnd IfCase 8If (n(0) + 11) Mod 10 > 0 ThenIf Command6(n(0) + 11).Visible = False Thenhidefang 0n(0) = n(0) + 11n(2) = n(2) - 11n(3) = n(3) - 9showfang 0situation = 9End IfEnd IfCase 9If n(0) + 9 < 199 ThenIf Command6(n(0) + 9).Visible = False Thenhidefang 0n(0) = n(0) + 9n(2) = n(2) - 9n(3) = n(3) + 11showfang 0situation = 10End IfEnd IfCase 10If (n(0) - 11) Mod 10 < 9 ThenIf Command6(n(0) - 11).Visible = False Thenhidefang 0n(0) = n(0) - 11n(2) = n(2) + 11n(3) = n(3) + 9showfang 0situation = 7End IfEnd IfIf n(0) - 9 > 1 And (n(3) - 22) Mod 10 < 9 ThenIf Command6(n(0) - 9).Visible = False And _Command6(n(3) - 22).Visible = False Thenhidefang 0n(0) = n(0) - 9n(2) = n(2) - 11n(3) = n(3) - 22showfang 0situation = 12End IfEnd IfCase 12If (n(0) + 11) Mod 10 > 0 And n(3) - 18 > 1 Then If Command6(n(0) + 11).Visible = False And _Command6(n(3) - 18).Visible = False Thenhidefang 0n(0) = n(0) + 11n(2) = n(2) - 9n(3) = n(3) - 18showfang 0situation = 13End IfEnd IfCase 13If n(0) + 9 < 198 And (n(3) + 22) Mod 10 > 0 Then If Command6(n(0) + 9).Visible = False And _Command6(n(3) + 22).Visible = False Thenhidefang 0n(0) = n(0) + 9n(2) = n(2) + 11n(3) = n(3) + 22showfang 0situation = 14End IfEnd IfCase 14If (n(0) - 11) Mod 10 < 9 And n(3) + 18 < 198 Then If Command6(n(0) - 11).Visible = False And _Command6(n(3) + 18).Visible = False Thenhidefang 0n(0) = n(0) - 11n(2) = n(2) + 9n(3) = n(3) + 18showfang 0situation = 11End IfEnd IfIf (n(3) - 22) Mod 10 < 8 ThenIf Command6(n(2) - 11).Visible = False And _Command6(n(3) - 22).Visible = False Thenhidefang 0n(0) = n(0) + 9n(2) = n(2) - 11n(3) = n(3) - 22showfang 0situation = 16End IfEnd IfCase 16If n(3) - 18 > 1 ThenIf Command6(n(2) - 9).Visible = False And _Command6(n(3) - 18).Visible = False Thenhidefang 0n(0) = n(0) - 11n(2) = n(2) - 9n(3) = n(3) - 18showfang 0situation = 17End IfEnd IfCase 17If (n(3) + 22) Mod 10 > 1 ThenIf Command6(n(2) + 11).Visible = False And _Command6(n(3) + 22).Visible = False Thenhidefang 0n(0) = n(0) - 9n(2) = n(2) + 11n(3) = n(3) + 22showfang 0situation = 18End IfEnd IfCase 18If n(3) + 18 < 198 ThenIf Command6(n(2) + 9).Visible = False And _Command6(n(3) + 18).Visible = False Thenhidefang 0n(0) = n(0) + 11n(2) = n(2) + 9n(3) = n(3) + 18showfang 0situation = 15End IfEnd IfEnd SubPrivate Sub Command1_Click()Form1.ShowForm2.ShowEnd SubPrivate Sub Command2_Click()Picture1.SetFocusIf Command2.Caption = "开始" ThenPicture1.SetFocus''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Timer1.Interval = 1000 / Val(Text1.Text)'根据关卡系数设置方块下降速度''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''For i = 19 To 20 - Val(Text3.Text) Step -1'根据难度系数产生不同难度的地基For j = i * 10 To i * 10 + 9If Rnd >= 0.5 Then Command6(j).Visible = True NextNext''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''For i = 0 To 3 '引用预览区已经产生的方块n(i) = m(i)Nextshowfang 0situation = situation2''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Timer1.Enabled = True '设置一些控件的可用性Command4.Enabled = TrueCommand1.Enabled = FalseCommand5.Enabled = False''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''hidefang 1 '清空预览区loadfangkuai '继续在预览区产生方块showfang 1''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Command2.Caption = "结束"Else''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Timer1.Enabled = False '设置一些控件的可用性Command4.Enabled = FalseCommand1.Enabled = TrueCommand5.Enabled = True''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''For i = 1 To 199Command6(i).Visible = FalseNextCommand2.Caption = "开始"Text2.Text = "0"linenum = 0End IfEnd SubPrivate Sub Command4_Click()Select Case Command4.CaptionCase "暂停"Command4.Caption = "继续"Timer1.Enabled = FalseCommand1.Enabled = TrueCommand5.Enabled = TrueCase "继续"Command4.Caption = "暂停"Timer1.Enabled = TrueCommand1.Enabled = FalseCommand5.Enabled = FalsePicture1.SetFocusEnd SelectEnd SubPrivate Sub Command5_Click()Form1.ShowForm3.ShowEnd SubPrivate Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If t = 0 Thenhidefang 0Select Case KeyCode''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Case vbKeyLeft '点击向左键If leftable() = True ThenFor j = 0 To 3Command6(n(j) - 1).Visible = Truen(j) = n(j) - 1Next jEnd Ifshowfang 0''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Case vbKeyDown '点击向下键If downable() = True ThenFor j = 0 To 3Command6(n(j) + 10).Visible = Truen(j) = n(j) + 10Next jEnd Ifshowfang 0''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Case vbKeyRight '点击向右键If rightable() = True ThenFor j = 0 To 3Command6(n(j) + 1).Visible = Truen(j) = n(j) + 1Next jEnd Ifshowfang 0''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Case vbKeySpace '点击旋转键（空格键）showfang 0zhuan''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Case Elseshowfang 0End SelectEnd IfEnd SubPrivate Sub Form_Load()WMP1.URL = App.Path & "\1.MP3"Dim SoundFile As String, Result As LongSoundFile = "C:\Users\Administrator\Desktop\新建文件夹\夜的钢琴曲（五）.mp3" '此处为路径Result = sndPlaySound(SoundFile, 1)Form2.HideForm3.HideRandomize '非正序的随机数For i = 1 To 199 '创建游戏区的方块Load Command6(i)Next iFor i = 0 To 199 '在游戏区以10×20排列方块Command6(i).Left = (i Mod 10)Command6(i).Top = i \ 10Command6(i).Visible = FalseNext iFor i = 1 To 39 '创建预览区的方块Load Command3(i)Next iFor i = 0 To 39 '在预览区排列方块Command3(i).Left = (i Mod 10) - 3Command3(i).Top = i \ 10Command3(i).Visible = FalseNext iloadfangkuai '在预览区产生第一个方块showfang 1End SubPrivate Sub Timer1_Timer()hidefang 0If downable() = True Then '能够下降For j = 0 To 3n(j) = n(j) + 10Next jshowfang 0Else '不能继续下降了showfang 0'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''clearline '引用自定义方法，判断是否消除满行'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''For i = 0 To 9 '如果方块叠至最上层，游戏结束If Command6(i).Visible = True Then Exit ForNextIf i < 10 Then Command2_Click: Exit Sub'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''For i = 0 To 3 '引用预览区已经产生的方块n(i) = m(i)Nextshowfang 0situation = situation2''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Text2.Text = Str(Val(Text2.Text) + 100 * (2 ^ linenum - 1))'这段代码控制加分'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''这段代码控制过关升级If Val(Right(Text2.Text, 4)) < Val(Right(Str(Val(Text2.Text) - 100 * (2 ^ linenum - 1)), 4)) Then Text1.Text = Str(Val(Text1.Text) + 1)Timer1.Interval = 1000 / Val(Text1.Text)End If''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''linenum = 0hidefang 1 '清空预览区loadfangkuai '继续在预览区产生方块showfang 1End IfEnd SubPrivate Sub WMP1_PlayStateChange(ByVal NewState As Long)'当播放器的播放状态变为"停止"时,再次播放If NewState = 1 Then '1为停止(一曲播完)WMP1.Controls.play '再播放End IfEnd Sub。
(完整版)vb小游戏代码
数字排序小游戏Option ExplicitDim Label2X As Integer '记录标签控件数组中要移动的标签控件左上角X的位置Dim Label2Y As Integer '记录标签控件数组中要移动的标签控件左上角Y的位置'让标签数组中的每个标签控件上显示的数字是随机的，无重复的Private Sub Init()RandomizeDim a(7) As IntegerDim i As Integer, k As IntegerLabel1.Caption = ""For i = 0 To 7a(i) = iNextFor i = 0 To 7k = Int(Rnd * 8)Do While a(k) = -1 'a(k)=-1表示该数组元素对应的数字已经被使用过了k = Int(Rnd * 8) '重新生成k的值，直到a(k)的值不等于-1LoopLabel2(i).Caption = Trim(Str(a(k)))a(k) = -1 'a(k)的值已经使用了，不能再用，重新赋值为-1与其他的元素值相区别Next iEnd SubPrivate Sub Command1_Click()Dim x As Integer, y As IntegerDim z As IntegerInitPicture1.Enabled = True'让空白标签Label1出现的位置随机Randomize'记录下空白标签Label1的位置x = Label1.Lefty = Label1.Topz = Int(Rnd * 8)'将空白标签Label1和标签控件数组任一控件交换位置Label1.Move Label2(z).Left, Label2(z).TopLabel2(z).Move x, yCommand1.Enabled = FalseEnd SubPrivate Sub Command2_Click()EndEnd SubPrivate Sub Form_Load()Dim i As IntegerPicture1.Enabled = False'在标签中显示游戏说明信息Label3.Caption = "如左图所示，将数字按0-7顺" & vbCrLf & vbCrLf & "序依次排列，即取得胜利。
VB游戏创意编程
任务：你准备用“两个物体的相遇”编写一
个什么样的游戏呢？请写出游戏规则。
接香蕉
。。。。。。
？
相遇
？
？
？
谢 谢！
常用的游戏创意方法
1、变一变
共同点：通过代码改变控件的Visible属性 不同点：控制对象不同，一个是image控件，一个是label控件
2、反一反
共同点：x=x±1
3、扩一扩
一个僵尸扩充为3个不同对象
4、一词双意
点亮星星（点击闪烁的星星得分） 垃圾分类（点击不同垃圾桶代表将垃圾分类）
观察游戏，思考游戏中用到了哪些VB知识？
规则： 用鼠标移动猴子接下落的香蕉，
接到就重新来过。
复习： 1、标出图中控(Left+width,top)
(Left,top+height) (Left+width,top+height)
2、利用坐标判断两个物体是否相遇，并在程序中验证
(Left,top)
(Left+width,top)
(Left,top+height) (Left+width,top+height)
banana在monkey的左边： 判断依据： banana的右边界在monkey左边界的左边
banana.left+banana.width<monkey.left VB表达式：
vb游戏编程
Dim l1(22) As Integer '每层跑道左边有几个方块
Dim l2(22) As Integer '每层跑道右边有几个方块
Dim cx As Single '赛车的在x轴的位置
Private Sub Command1_Click()
a[1]=b[temp1];
b[temp1]=b[temp[2];
b[temp2]=a[1];
}
//输出
ListBox1->Clear();
for(i=1;i<=27;i++)
ListBox1->Items->Add(IntToStr(b[i]));
如上例所示，经过打乱，b[27]数组将不再是旧时容颜。
Select Case KeyAscii
Case Asc("a"), Asc("A")
cx = cx - D
Case Asc("s"), Asc("S")
cx = cx + D
End Select
End Sub
Private Sub Timer1_Timer()
知道了玩法，下面我将介绍程序是如何实现的：
一、猜测的奥妙——推算原理
猜测的原理其实也不复杂，我们来模拟一下猜测的过程大家就清楚了。程序初始化时是把1～27将随机打乱分别放入PageControl控件的三个选项卡中，每个选项卡放9张图片。点击一次按钮后其实不是盲目地将顺序打乱，而是进行了筛选，把有用的图片（就是点选的那组的9张图片）筛选出来平均分配到PageControl控件的三个选项卡中，再把不需要的图片集中起来平均分配到PageControl控件的三个选项卡中，最后在各个选项卡中把有用的、无用的图片随机打乱再次重新排列显示出来，从而完成猜测。用表1来说明：
vb小游戏代码
数字排序小游戏Option ExplicitDim Label2X As Integer '记录标签控件数组中要移动的标签控件左上角X的位置Dim Label2Y As Integer '记录标签控件数组中要移动的标签控件左上角Y的位置'让标签数组中的每个标签控件上显示的数字是随机的，无重复的Private Sub lnit()RandomizeDim a(7) As IntegerDim i As Integer, k As IntegerLabel1.Caption =""Fori = 0 To 7 a(i) = iNextFori = 0 To 7k = Int(Rnd * 8)Do While a(k) = -1 'a(k)=-1表示该数组元素对应的数字已经被使用过了k = Int(Rnd * 8)'重新生成k的值，直到a(k)的值不等于-1LoopLabel2(i).Caption = Trim(Str(a(k)))a(k) = -1 'a(k)的值已经使用了，不能再用，重新赋值为-1与其他的元素值相区别Next iEnd SubPrivate Sub Command1_Click()Dim x As Integer, y As IntegerDim z As IntegerInitPicture1.Enabled = True'让空白标签Label1 出现的位置随机Randomize'记录下空白标签Label1 的位置x = Label1.Lefty = Label1.Topz = Int(Rnd * 8)'将空白标签Label1 和标签控件数组任一控件交换位置Label1.Move Label2(z).Left, Label2(z).TopLabel2(z).Move x, yCommand1.Enabled = FalseEnd SubPrivate Sub Command2_Click()EndEnd SubPrivate Sub Form_Load() Dim i As Integer Picture1.Enabled = False'在标签中显示游戏说明信息Label3.Caption = "如左图所示，将数字按0-7 顺" & vbCrLf & vbCrLf & " 序依次排列，即取得胜利'在标签中显示排列规则后的数字顺序Label1.Caption = 0For i = 0 To 6Label2(i).Caption = i + 1NextEnd SubPrivate 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.LeftLabel1Y = 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) ThenLabel1.Move Label2X, Label2YSource.Move Label1X, Label1YEnd IfWinEnd SubPrivate 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).LeftLabel2Y = Label2(Index).TopLabel2(Index).Drag 1 '启动拖动操作End IfEnd SubPrivate Sub Label2_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) Label2(Index).Drag 2 '结束拖动操作End SubPrivate Sub Win()Dim winner As IntegerDim i As IntegerDim answer As Integer'对于给定的标签控件数组中的任一标签控件，可以落在符合要求( 对应位置应显示对应数字)'的八个位置中的任一位置'利用循环语句对标签控件数组中的每个标签控件进行检查，如果其落在某一符号要求的位置，'则变量winner 的值加1 ，如果所有标签控件都落在符号要求的位置，则变量winner 的值应为8For i = 0 To 7If Label2(i).Left = 0 And Label2(i).Top = 0 And _Label2(i).Caption = 0 Thenwinner = winner + 1ElseIf Label2(i).Left = Label2(i).Width And Label2(i).Top = 0 And _Label2(i).Caption = 1 Thenwinner = winner + 1ElseIf Label2(i).Left = 2 * Label2(i).Width And Label2(i).Top = 0 And _Label2(i).Caption = 2 Thenwinner = winner + 1ElseIf Label2(i).Left = 0 And Label2(i).Top = Label2(i).Height And _Label2(i).Caption = 3 Thenwinner = winner + 1ElseIf Label2(i).Left = Label2(i).Width And Label2(i).Top = Label2(i).Height And _ Label2(i).Caption = 4 Thenwinner = winner + 1ElseIf Label2(i).Left = 2 * Label2(i).Width And Label2(i).Top = Label2(i).Height And _ Label2(i).Caption =5 Then winner = winner + 1ElseIf Label2(i).Left = 0 And Label2(i).Top = 2 * Label2(i).Height And _Label2(i).Caption = 6 Thenwinner = winner + 1ElseIf Label2(i).Left = Label2(i).Width And Label2(i).Top = 2 * Label2(i).Height And _ Label2(i).Caption =7 Thenwinner = winner + 1End IfNext iIf winner = 8 ThenMsgBox " 恭喜您，胜利了！", 0 + 64 + 0, "提示" Picture1.Enabled = Falseanswer = MsgBox(" 还继续吗？", 4 + 32 + 0, " 提示")If answer = vbYes ThenCommandl.Enabled = TrueElseEndEnd IfEnd IfEnd Sub弹球游戏Dim x_step As IntegerDim y_step As IntegerPrivate Sub command1_Click()If Timer1.Enabled = True ThenTimer1.Enabled = FalseElseTimer1.Enabled = TrueEnd IfIf command1.Caption ="暂停"Then command1.Caption ="继续" Else command1.Caption ="暂停End IfEnd SubPrivate Sub Form_Load()x_step = 200y_step = 200End SubPrivate Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 37 ThenIf Line1.X1 < 0 ThenLine1.X1 = 0: Line1.X2 = 2000ElseLine1.X1 = Line1.X1 - 100: Line1.X2 = Line1.X2 - 100End IfEnd IfIf KeyCode = 39 ThenIf Line1.X1 > Picture1.Width ThenLine1.X1 = Picture1.Width - 2000: line2.X2 = Picture.Width ElseLine1.X1 = Line1.X1 + 100: Line1.X2 = Line1.X2 + 100 End IfEnd IfEnd SubPrivate Sub Timer1_Timer()If Shape1.Top < 0 ThenShape1.Top = 0: y_step = -y_stepEnd IfIf Shape1.Left < 0 ThenShape1.Left = 0x_step = -x_stepEnd IfIf Shape1.Left > Picture1.Width - Shape1.Width Then Shape1.Left = Picture1.Width - Shape1.Widthx_step = -x_stepEnd IfIf Shapel.Left >= Linel.XI And Shapel.Left <= Line1.X2 And Shapel.Top >= Linel.YI - Shapel.Height Then Shapel.Top = Linel.YI - Shapel.Height y_step = -y_step * 1.01 x_step = x_step * 1.01Label2.Caption = Label2.Caption + 1End IfShape1.Top = Shape1.Top + y_stepShape1 .Left = Shape1.Left + x_stepIf Shape1.Top >= Picture1.Height - Shape1.Height ThenMsgBox "游戏结束" command1.Caption ="开始Timer1.Enabled = FalseShape1.Top = 1000Label2.Caption = 0End IfEnd Sub打字游戏Dim score As Integer::：：：盯问没宜:竽ifiFF希iS匿述:Dim speed As IntegerDim typetime As IntegerPrivate Sub init()Randomizelblletter1.Caption = Chr(Int(Rnd * 42) + 48) lblletter1.Left = Int(Rnd * 2800) + 1 lblletter1.Top = 0End SubPrivate Sub init1()Randomize lblletter2.Caption = Chr(Int(Rnd * 25) + 97) lblletter2.Left = Int(Rnd * 2800) + 1 lblletter2.Top = 0 End SubPrivate Sub Command1_Click()score = Int(lblscore.Text)initinit1Timer1 = TrueTimer2 = TrueHScroll1.Enabled = FalseCommand1.Enabled = FalseCommand2.Enabled = FalseHScroll1.Enabled = FalseIf lbltime.Text <= 0 ThenTimer1 = FalseTimer2 = Falselblletter1.Caption = "" lblletter2.Caption = ""End IfEnd SubPrivate Sub Command2_Click() typetime = InputBox(" 请输入打字时间。
VB扫雷小游戏编程代码
VB扫雷小游戏一．编程目的二．编程思路1.新建command_up和label_down控件2.用load加载控件3.根据雷区的X、Y、以及难度进行随机布雷。
4.统计每一个label周围雷的数量并作为label的caption。
5.在单击command的时候显示label6.在右击command的时候进行标记7.在label上左右键同时按下的时候检查已标记雷的数量与label显示的数量是否一致。
三．界面设计四.代码设计Dim Start_Time, End_TimeDim Area_X%, Area_Y%, Area%, Area_List()Dim Current_Mine%Dim Difficulty#Dim Continue_Flag%, Success_Flag%, LeftAndRight_Flag%Dim Near_ListDim Mine_CountPrivate Sub Command_End_Click()EndEnd SubPrivate Sub Delete_Item(List(), Index As Integer)Dim i%For i = LBound(List) + Index - 1 To UBound(List) - 1List(i) = List(i + 1)Next i'防止100%的困难度If UBound(List) > LBound(List) Then ReDim Preserve List(LBound(List) To UBound(List) - 1) End SubPrivate Sub Command_retry_Click()'卸载For i = 1 To AreaUnload Label_Down(i)Unload Command_Up(i)Next iCommand_Start.Caption = "开始游戏"Call Command_Start_ClickEnd SubPrivate Sub Command_Up_Click(Index As Integer)Success_Flag = 1If Continue_Flag = 1 ThenIf Timer1.Enabled = False Then Call Command_Start_ClickIf Label_Down(Index).Caption = "X" ThenSuccess_Flag = 0Continue_Flag = 0For i = 1 To AreaIf Command_Up(i).Visible = True And Command_Up(i).Caption = "X" And Label_Down(i).BackColor = vbRed Then'标记雷正确Command_Up(i).Picture = LoadPicture(App.Path + "\pictures\mine_correct.gif", , , Command_Up(i).Width, Command_Up(i).Height)Command_Up(i).Visible = TrueLabel_Down(i).Visible = TrueElseIf Command_Up(i).Visible = True And Command_Up(i).Caption = "X" And Label_Down(i).BackColor = vbGreen Then'标记雷错误Command_Up(i).Picture = LoadPicture(App.Path + "\pictures\mine_wrong.gif", , , Command_Up(i).Width, Command_Up(i).Height)Command_Up(i).Visible = TrueLabel_Down(i).Visible = TrueElseCommand_Up(i).Visible = FalseLabel_Down(i).Visible = TrueEnd IfNext iTimer1.Enabled = Falsetemp = MsgBox("Game Over !", vbOKOnly, "游戏结束")ElseIf Val(Label_Down(Index).Caption) > 0 ThenCommand_Up(Index).Visible = FalseLabel_Down(Index).Visible = TrueElse'如果等于0的话应该将周边的清零Command_Up(Index).Visible = FalseLabel_Down(Index).Visible = Truej = IndexFor i = 1 To 8'判断控件是否存在If j + Near_List(i) > 0 And j + Near_List(i) <= Area Then'判断是否相邻If Abs(Label_Down(j + Near_List(i)).Left -Label_Down(j).Left) <= Label_Down(j).Width And Abs(Label_Down(j + Near_List(i)).Top -Label_Down(j).Top) <= Label_Down(j).Height Then'判断是否有雷If Label_Down(j + Near_List(i)).BackColor = vbGreen And Command_Up(j + Near_List(i)).Visible = True ThenCall Command_Up_Click(j + Near_List(i)) '注意此处循环调用的时候一定要避免陷入死循环End IfEnd IfEnd IfNext iEnd If'检查是否游戏成功For i = 1 To AreaIf Command_Up(i).Visible = True And Label_Down(i).Caption <> "X" ThenSuccess_Flag = 0Exit ForEnd IfNext iIf Success_Flag = 1 ThenIf Continue_Flag = 1 ThenTimer1.Enabled = FalseFor i = 1 To AreaIf Command_Up(i).Visible = True And Command_Up(i).Caption = "X" And Label_Down(i).BackColor = vbRed Then'标记雷正确Command_Up(i).Picture = LoadPicture(App.Path + "\pictures\mine_correct.gif", , , Command_Up(i).Width, Command_Up(i).Height)Command_Up(i).Visible = TrueLabel_Down(i).Visible = TrueElseIf Command_Up(i).Visible = True And Command_Up(i).Caption = "X" And Label_Down(i).BackColor = vbGreen Then'标记雷错误Command_Up(i).Picture = LoadPicture(App.Path + "\pictures\mine_wrong.gif", , , Command_Up(i).Width, Command_Up(i).Height)Command_Up(i).Visible = TrueLabel_Down(i).Visible = TrueElseCommand_Up(i).Visible = FalseLabel_Down(i).Visible = TrueEnd IfNext itemp = MsgBox("恭喜，扫雷成功！" & vbCrLf & "耗时：" & Mid(Label_Time.Caption, 4) & vbCrLf & "鸣谢：平方X O(∩_∩)O~", vbOKOnly, "成功") End IfContinue_Flag = 0 '提示一次后结束，防止在调用Command_Click事件中重复提示End IfEnd IfCommand_Start.SetFocusEnd SubPrivate Sub Command_Start_Click()If Command_Start.Caption = "开始游戏" ThenCommand_Start.Caption = "重新开始"Continue_Flag = 1Timer1.Enabled = TrueDifficulty = Val(Text_Difficulty.Text) / 100Area_X = Val(Text_X.Text)Area_Y = Val(Text_Y.Text)Area = Area_X * Area_Y'初始化这里进行二次初始化的原因是如果在之前的运行中对字体进行了改变，将有可能造成此处的控件大小发生变化With Picture_show.Left = 200.Top = 200.Width = 750 * 10.Height = 750 * 10.Visible = FalseEnd WithWith Command_Up(0).Left = Picture_show.Left.Top = Picture_show.Top.Width = Picture_show.Width / 10.Height = Picture_show.Height / 10.FontSize = 1 '防止自动缩放.Visible = FalseEnd WithWith Label_Down(0).Left = Picture_show.Left.Top = Picture_show.Top.Width = Picture_show.Width / 10.Height = Picture_show.Height / 10.FontSize = 1 '防止自动缩放.Visible = FalseEnd WithWith Label_Down(0).Left = 200.Top = 200.Width = 750 * 10 / IIf(Area_X > Area_Y, Area_X, Area_Y).FontSize = 25 * (.Width / 750) '会自动缩放，必须先设置了.Height = 750 * 10 / IIf(Area_X > Area_Y, Area_X, Area_Y).Visible = FalseEnd WithWith Command_Up(0).Left = 200.Top = 200.Width = Label_Down(0).Width.Height = Label_Down(0).Height.Visible = FalseEnd WithReDim Near_List(1 To 8)Near_List(1) = 0 - 1 - Area_YNear_List(2) = 0 - 0 - Area_YNear_List(3) = 0 + 1 - Area_YNear_List(4) = 0 - 1Near_List(5) = 0 + 1Near_List(6) = 0 - 1 + Area_YNear_List(7) = 0 - 0 + Area_YNear_List(8) = 0 + 1 + Area_Y'如果在列表中有相等的元素将有可能造成统计雷的数目错误For i = 1 To 8For j = i + 1 To 8If Near_List(i) = Near_List(j) Then Near_List(i) = 0Next jNext iArea_temp = 0For Y = 1 To Area_Y'加载labelFor X = 1 To Area_XArea_temp = Area_temp + 1Load Label_Down(Area_temp)With Label_Down(Area_temp).Left = Label_Down(0).Left + Label_Down(0).Width * ((Area_temp -1) Mod Area_Y).Top = Label_Down(0).Top + Label_Down(0).Height * ((Area_temp -1) \ Area_Y).BackColor = vbGreen.Visible = False.Alignment = 2.Font = .FontBoldEnd With'加载commandLoad Command_Up(Area_temp)With Command_Up(Area_temp)'对列数求余的话就是在这一行第几个了.Left = Command_Up(0).Left + Command_Up(0).Width * ((Area_temp - 1) Mod Area_Y)'整除列数的话可以确定第几行.Top = Command_Up(0).Top + Command_Up(0).Height * ((Area_temp - 1) \ Area_Y).Visible = TrueEnd WithNext XNext YReDim Area_List(1 To Area)For i = 1 To AreaArea_List(i) = iNext i' 随即布雷RandomizeMine_Count = Val(Text_Mine_Count.Text)For i = 1 To Mine_CountCurrent_Mine = Int(Rnd * (UBound(Area_List) - LBound(Area_List) + 1) + 1) '在数组中随机一个，注意此处2个+1的必要性和准确性Label_Down(Area_List(Current_Mine)).BackColor = vbRed '将该位置标记为雷Call Delete_Item(Area_List, Current_Mine) '删除该位置，防止再次标记Next i'检查雷的数目For j = 1 To AreaIf Label_Down(j).BackColor = vbRed ThenLabel_Down(j).Caption = "X"ElseMine_Number = 0For i = 1 To 8'判断控件是否存在If j + Near_List(i) > 0 And j + Near_List(i) <= Area Then'判断是否相邻If Abs(Label_Down(j + Near_List(i)).Left -Label_Down(j).Left) <= Label_Down(j).Width And Abs(Label_Down(j + Near_List(i)).Top -Label_Down(j).Top) <= Label_Down(j).Height Then'判断是否有雷If Label_Down(j + Near_List(i)).BackColor = vbRed ThenMine_Number = Mine_Number + 1End IfEnd IfEnd IfNext iLabel_Down(j).Caption = Mine_NumberEnd IfNext jStart_Time = Now()ElseIf Command_Start.Caption = "重新开始" ThenCall Command_retry_ClickEnd IfEnd SubPrivate Sub Command_Up_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)If Button = 2 ThenIf Command_Up(Index).Caption = "" ThenCommand_Up(Index).Caption = "X"Command_Up(Index).Picture = LoadPicture(App.Path + "\pictures\mine.gif", , , Command_Up(Index).Width, Command_Up(Index).Height)ElseIf Command_Up(Index).Caption = "X" ThenCommand_Up(Index).Caption = "?"Command_Up(Index).Picture = LoadPicture(App.Path + "\pictures\Unknown.gif", , , Command_Up(Index).Width, Command_Up(Index).Height)ElseIf Command_Up(Index).Caption = "?" ThenCommand_Up(Index).Caption = ""Command_Up(Index).Picture = LoadPicture("") End IfEnd IfEnd SubPrivate Sub Form_Load()With Picture_show.Left = 200.Top = 200.Width = 750 * 10.Height = 750 * 10.Visible = FalseEnd WithWith Command_Up(0).Left = Picture_show.Left.Top = Picture_show.Top.Width = Picture_show.Width / 10.Height = Picture_show.Height / 10.FontSize = 1 '防止自动缩放.Visible = FalseEnd WithWith Label_Down(0).Left = Picture_show.Left.Top = Picture_show.Top.Width = Picture_show.Width / 10.Height = Picture_show.Height / 10.FontSize = 1 '防止自动缩放.Visible = FalseEnd With'加载计时器Timer1.Enabled = FalseTimer1.Interval = 100'加载滚动条With HScroll_Difficulty.LargeChange = 5.SmallChange = 1.Max = 100.Min = 0.Value = 10End WithWith HScroll_Area_X.LargeChange = 5.SmallChange = 1.Max = 100.Min = 1.Value = 10End WithWith HScroll_Area_Y.LargeChange = 5.SmallChange = 1.Max = 100.Min = 1.Value = 10End WithWith HScroll_Mine_Count.LargeChange = 5.SmallChange = 1.Max = 100.Min = 0.Value = 10End With'由于很多数据不方便处理，索性让其禁用了Text_Difficulty.Enabled = FalseText_Mine_Count.Enabled = FalseText_X.Enabled = FalseText_Y.Enabled = FalseEnd SubPrivate Sub HScroll_Area_X_Change()Text_X.Text = HScroll_Area_X.ValueHScroll_Mine_Count.Max = HScroll_Area_X.Value * HScroll_Area_Y.ValueHScroll_Mine_Count.Value = HScroll_Area_X.Value * HScroll_Area_Y.Value / 100 * HScroll_Difficulty.ValueEnd SubPrivate Sub HScroll_Area_X_Scroll()Text_X.Text = HScroll_Area_X.ValueHScroll_Mine_Count.Max = HScroll_Area_X.Value * HScroll_Area_Y.ValueHScroll_Mine_Count.Value = HScroll_Area_X.Value * HScroll_Area_Y.Value / 100 * HScroll_Difficulty.ValueEnd SubPrivate Sub HScroll_Area_Y_Change()Text_Y.Text = HScroll_Area_Y.ValueHScroll_Mine_Count.Max = HScroll_Area_X.Value * HScroll_Area_Y.ValueHScroll_Mine_Count.Value = HScroll_Area_X.Value * HScroll_Area_Y.Value / 100 * HScroll_Difficulty.ValueEnd SubPrivate Sub HScroll_Area_Y_Scroll()Text_Y.Text = HScroll_Area_Y.ValueHScroll_Mine_Count.Max = HScroll_Area_X.Value * HScroll_Area_Y.ValueHScroll_Mine_Count.Value = HScroll_Area_X.Value * HScroll_Area_Y.Value / 100 * HScroll_Difficulty.ValueEnd SubPrivate Sub HScroll_Difficulty_Change()Text_Difficulty.Text = HScroll_Difficulty.ValueHScroll_Mine_Count.Value = HScroll_Area_X.Value * HScroll_Area_Y.Value / 100 * HScroll_Difficulty.ValueEnd SubPrivate Sub HScroll_Difficulty_Scroll()Text_Difficulty.Text = HScroll_Difficulty.ValueHScroll_Mine_Count.Value = HScroll_Area_X.Value * HScroll_Area_Y.Value / 100 * HScroll_Difficulty.ValueEnd SubPrivate Sub HScroll_Mine_Count_Change()Text_Mine_Count.Text = HScroll_Mine_Count.ValueHScroll_Difficulty.Value = HScroll_Mine_Count.Value / (HScroll_Area_X.Value * HScroll_Area_Y.Value) * 100End SubPrivate Sub HScroll_Mine_Count_Scroll()Text_Mine_Count.Text = HScroll_Mine_Count.ValueHScroll_Difficulty.Value = HScroll_Mine_Count.Value / (HScroll_Area_X.Value * HScroll_Area_Y.Value) * 100End SubPrivate Sub Label_Down_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)For i = 1 To 8'判断控件是否存在If Index + Near_List(i) > 0 And Index + Near_List(i) <= Area Then'判断是否相邻If Abs(Label_Down(Index + Near_List(i)).Left -Label_Down(Index).Left) <= Label_Down(Index).Width And Abs(Label_Down(Index + Near_List(i)).Top -Label_Down(Index).Top) <= Label_Down(Index).Height Then'判断是否有标记雷If Command_Up(Index + Near_List(i)).Caption <> "X" And Command_Up(Index + Near_List(i)).Caption <> "?" ThenCommand_Up(Index + Near_List(i)).Picture = LoadPicture("")End IfEnd IfEnd IfNext iEnd SubPrivate Sub label_down_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)If LeftAndRight_Flag + Button = 3 Then '双击完成Mine_Number = Val(Label_Down(Index).Caption)Mark_mine_number = 0For i = 1 To 8'判断控件是否存在If Index + Near_List(i) > 0 And Index + Near_List(i) <= Area Then'判断是否相邻If Abs(Label_Down(Index + Near_List(i)).Left -Label_Down(Index).Left) <= Label_Down(Index).Width And Abs(Label_Down(Index + Near_List(i)).Top -Label_Down(Index).Top) <= Label_Down(Index).Height Then'判断是否有标记雷If Command_Up(Index + Near_List(i)).Caption = "X" ThenMark_mine_number = Mark_mine_number + 1End IfEnd IfEnd IfNext iIf Val(Label_Down(Index).Caption) - Mark_mine_number <= 0 Then '已全部标出，自动点开For i = 1 To 8'判断控件是否存在If Index + Near_List(i) > 0 And Index + Near_List(i) <= Area Then'判断是否相邻If Abs(Label_Down(Index + Near_List(i)).Left -Label_Down(Index).Left) <= Label_Down(Index).Width And Abs(Label_Down(Index + Near_List(i)).Top -Label_Down(Index).Top) <= Label_Down(Index).Height Then'判断是否有标记雷If Command_Up(Index + Near_List(i)).Caption <> "X" ThenCall Command_Up_Click(Index + Near_List(i))End IfEnd IfEnd IfNext iElse '如果没有全部标注的话应该显示一下嘛For i = 1 To 8'判断控件是否存在If Index + Near_List(i) > 0 And Index + Near_List(i) <= Area Then'判断是否相邻If Abs(Label_Down(Index + Near_List(i)).Left -Label_Down(Index).Left) <= Label_Down(Index).Width And Abs(Label_Down(Index + Near_List(i)).Top -Label_Down(Index).Top) <= Label_Down(Index).Height Then'判断是否有标记雷If Command_Up(Index + Near_List(i)).Caption <> "X" ThenCommand_Up(Index + Near_List(i)).Picture = LoadPicture(App.Path + "\pictures\xia.gif", , , Command_Up(Index).Width, Command_Up(Index).Height)End IfEnd IfEnd IfNext iEnd IfElseLeftAndRight_Flag = Button'Print LeftAndRight_FlagEnd IfEnd SubPrivate Sub Timer1_Timer()LeftAndRight_Flag = 0End_Time = Now()spend_time = (End_Time - Start_Time) * 10 ^ 5Label_Time.Caption = "时间：" & Format(Int(spend_time) \ (60 * 60), "00") & ":" & Format((Int(spend_time) Mod (60 * 60)) \ 60, "00") & ":" & Format(Int(spend_time) Mod 60, "00") & "." & Format(Int((spend_time - Int(spend_time)) * 1000), "000")End Sub五．软件截图1 2 3。
VB扫雷小游戏编程代码
VB扫雷小游戏一．编程目的二．编程思路1.新建command_up和label_down控件2.用load加载控件3.根据雷区的X、Y、以及难度进行随机布雷。
4.统计每一个label周围雷的数量并作为label的caption。
5.在单击command的时候显示label6.在右击command的时候进行标记7.在label上左右键同时按下的时候检查已标记雷的数量与label显示的数量是否一致。
三．界面设计四.代码设计Dim Start_Time, End_TimeDim Area_X%, Area_Y%, Area%, Area_List()Dim Current_Mine%Dim Difficulty#Dim Continue_Flag%, Success_Flag%, LeftAndRight_Flag%Dim Near_ListDim Mine_CountPrivate Sub Command_End_Click()EndEnd SubPrivate Sub Delete_Item(List(), Index As Integer)Dim i%For i = LBound(List) + Index - 1 To UBound(List) - 1List(i) = List(i + 1)Next i'防止100%的困难度If UBound(List) > LBound(List) Then ReDim Preserve List(LBound(List) To UBound(List) - 1) End SubPrivate Sub Command_retry_Click()'卸载For i = 1 To AreaUnload Label_Down(i)Unload Command_Up(i)Next iCommand_Start.Caption = "开始游戏"Call Command_Start_ClickEnd SubPrivate Sub Command_Up_Click(Index As Integer)Success_Flag = 1If Continue_Flag = 1 ThenIf Timer1.Enabled = False Then Call Command_Start_ClickIf Label_Down(Index).Caption = "X" ThenSuccess_Flag = 0Continue_Flag = 0For i = 1 To AreaIf Command_Up(i).Visible = True And Command_Up(i).Caption = "X" And Label_Down(i).BackColor = vbRed Then'标记雷正确Command_Up(i).Picture = LoadPicture(App.Path + "\pictures\mine_correct.gif", , , Command_Up(i).Width, Command_Up(i).Height)Command_Up(i).Visible = TrueLabel_Down(i).Visible = TrueElseIf Command_Up(i).Visible = True And Command_Up(i).Caption = "X" And Label_Down(i).BackColor = vbGreen Then'标记雷错误Command_Up(i).Picture = LoadPicture(App.Path + "\pictures\mine_wrong.gif", , , Command_Up(i).Width, Command_Up(i).Height)Command_Up(i).Visible = TrueLabel_Down(i).Visible = TrueElseCommand_Up(i).Visible = FalseLabel_Down(i).Visible = TrueEnd IfNext iTimer1.Enabled = Falsetemp = MsgBox("Game Over !", vbOKOnly, "游戏结束")ElseIf Val(Label_Down(Index).Caption) > 0 ThenCommand_Up(Index).Visible = FalseLabel_Down(Index).Visible = TrueElse'如果等于0的话应该将周边的清零Command_Up(Index).Visible = FalseLabel_Down(Index).Visible = Truej = IndexFor i = 1 To 8'判断控件是否存在If j + Near_List(i) > 0 And j + Near_List(i) <= Area Then'判断是否相邻If Abs(Label_Down(j + Near_List(i)).Left -Label_Down(j).Left) <= Label_Down(j).Width And Abs(Label_Down(j + Near_List(i)).Top -Label_Down(j).Top) <= Label_Down(j).Height Then'判断是否有雷If Label_Down(j + Near_List(i)).BackColor = vbGreen And Command_Up(j + Near_List(i)).Visible = True ThenCall Command_Up_Click(j + Near_List(i)) '注意此处循环调用的时候一定要避免陷入死循环End IfEnd IfEnd IfNext iEnd If'检查是否游戏成功For i = 1 To AreaIf Command_Up(i).Visible = True And Label_Down(i).Caption <> "X" ThenSuccess_Flag = 0Exit ForEnd IfNext iIf Success_Flag = 1 ThenIf Continue_Flag = 1 ThenTimer1.Enabled = FalseFor i = 1 To AreaIf Command_Up(i).Visible = True And Command_Up(i).Caption = "X" And Label_Down(i).BackColor = vbRed Then'标记雷正确Command_Up(i).Picture = LoadPicture(App.Path + "\pictures\mine_correct.gif", , , Command_Up(i).Width, Command_Up(i).Height)Command_Up(i).Visible = TrueLabel_Down(i).Visible = TrueElseIf Command_Up(i).Visible = True And Command_Up(i).Caption = "X" And Label_Down(i).BackColor = vbGreen Then'标记雷错误Command_Up(i).Picture = LoadPicture(App.Path + "\pictures\mine_wrong.gif", , , Command_Up(i).Width, Command_Up(i).Height)Command_Up(i).Visible = TrueLabel_Down(i).Visible = TrueElseCommand_Up(i).Visible = FalseLabel_Down(i).Visible = TrueEnd IfNext itemp = MsgBox("恭喜，扫雷成功！" & vbCrLf & "耗时：" & Mid(Label_Time.Caption, 4) & vbCrLf & "鸣谢：平方X O(∩_∩)O~", vbOKOnly, "成功") End IfContinue_Flag = 0 '提示一次后结束，防止在调用Command_Click事件中重复提示End IfEnd IfCommand_Start.SetFocusEnd SubPrivate Sub Command_Start_Click()If Command_Start.Caption = "开始游戏" ThenCommand_Start.Caption = "重新开始"Continue_Flag = 1Timer1.Enabled = TrueDifficulty = Val(Text_Difficulty.Text) / 100Area_X = Val(Text_X.Text)Area_Y = Val(Text_Y.Text)Area = Area_X * Area_Y'初始化这里进行二次初始化的原因是如果在之前的运行中对字体进行了改变，将有可能造成此处的控件大小发生变化With Picture_show.Left = 200.Top = 200.Width = 750 * 10.Height = 750 * 10.Visible = FalseEnd WithWith Command_Up(0).Left = Picture_show.Left.Top = Picture_show.Top.Width = Picture_show.Width / 10.Height = Picture_show.Height / 10.FontSize = 1 '防止自动缩放.Visible = FalseEnd WithWith Label_Down(0).Left = Picture_show.Left.Top = Picture_show.Top.Width = Picture_show.Width / 10.Height = Picture_show.Height / 10.FontSize = 1 '防止自动缩放.Visible = FalseEnd WithWith Label_Down(0).Left = 200.Top = 200.Width = 750 * 10 / IIf(Area_X > Area_Y, Area_X, Area_Y).FontSize = 25 * (.Width / 750) '会自动缩放，必须先设置了.Height = 750 * 10 / IIf(Area_X > Area_Y, Area_X, Area_Y).Visible = FalseEnd WithWith Command_Up(0).Left = 200.Top = 200.Width = Label_Down(0).Width.Height = Label_Down(0).Height.Visible = FalseEnd WithReDim Near_List(1 To 8)Near_List(1) = 0 - 1 - Area_YNear_List(2) = 0 - 0 - Area_YNear_List(3) = 0 + 1 - Area_YNear_List(4) = 0 - 1Near_List(5) = 0 + 1Near_List(6) = 0 - 1 + Area_YNear_List(7) = 0 - 0 + Area_YNear_List(8) = 0 + 1 + Area_Y'如果在列表中有相等的元素将有可能造成统计雷的数目错误For i = 1 To 8For j = i + 1 To 8If Near_List(i) = Near_List(j) Then Near_List(i) = 0Next jNext iArea_temp = 0For Y = 1 To Area_Y'加载labelFor X = 1 To Area_XArea_temp = Area_temp + 1Load Label_Down(Area_temp)With Label_Down(Area_temp).Left = Label_Down(0).Left + Label_Down(0).Width * ((Area_temp -1) Mod Area_Y).Top = Label_Down(0).Top + Label_Down(0).Height * ((Area_temp -1) \ Area_Y).BackColor = vbGreen.Visible = False.Alignment = 2.Font = .FontBoldEnd With'加载commandLoad Command_Up(Area_temp)With Command_Up(Area_temp)'对列数求余的话就是在这一行第几个了.Left = Command_Up(0).Left + Command_Up(0).Width * ((Area_temp - 1) Mod Area_Y)'整除列数的话可以确定第几行.Top = Command_Up(0).Top + Command_Up(0).Height * ((Area_temp - 1) \ Area_Y).Visible = TrueEnd WithNext XNext YReDim Area_List(1 To Area)For i = 1 To AreaArea_List(i) = iNext i' 随即布雷RandomizeMine_Count = Val(Text_Mine_Count.Text)For i = 1 To Mine_CountCurrent_Mine = Int(Rnd * (UBound(Area_List) - LBound(Area_List) + 1) + 1) '在数组中随机一个，注意此处2个+1的必要性和准确性Label_Down(Area_List(Current_Mine)).BackColor = vbRed '将该位置标记为雷Call Delete_Item(Area_List, Current_Mine) '删除该位置，防止再次标记Next i'检查雷的数目For j = 1 To AreaIf Label_Down(j).BackColor = vbRed ThenLabel_Down(j).Caption = "X"ElseMine_Number = 0For i = 1 To 8'判断控件是否存在If j + Near_List(i) > 0 And j + Near_List(i) <= Area Then'判断是否相邻If Abs(Label_Down(j + Near_List(i)).Left -Label_Down(j).Left) <= Label_Down(j).Width And Abs(Label_Down(j + Near_List(i)).Top -Label_Down(j).Top) <= Label_Down(j).Height Then'判断是否有雷If Label_Down(j + Near_List(i)).BackColor = vbRed ThenMine_Number = Mine_Number + 1End IfEnd IfEnd IfNext iLabel_Down(j).Caption = Mine_NumberEnd IfNext jStart_Time = Now()ElseIf Command_Start.Caption = "重新开始" ThenCall Command_retry_ClickEnd IfEnd SubPrivate Sub Command_Up_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)If Button = 2 ThenIf Command_Up(Index).Caption = "" ThenCommand_Up(Index).Caption = "X"Command_Up(Index).Picture = LoadPicture(App.Path + "\pictures\mine.gif", , , Command_Up(Index).Width, Command_Up(Index).Height)ElseIf Command_Up(Index).Caption = "X" ThenCommand_Up(Index).Caption = "?"Command_Up(Index).Picture = LoadPicture(App.Path + "\pictures\Unknown.gif", , , Command_Up(Index).Width, Command_Up(Index).Height)ElseIf Command_Up(Index).Caption = "?" ThenCommand_Up(Index).Caption = ""Command_Up(Index).Picture = LoadPicture("") End IfEnd IfEnd SubPrivate Sub Form_Load()With Picture_show.Left = 200.Top = 200.Width = 750 * 10.Height = 750 * 10.Visible = FalseEnd WithWith Command_Up(0).Left = Picture_show.Left.Top = Picture_show.Top.Width = Picture_show.Width / 10.Height = Picture_show.Height / 10.FontSize = 1 '防止自动缩放.Visible = FalseEnd WithWith Label_Down(0).Left = Picture_show.Left.Top = Picture_show.Top.Width = Picture_show.Width / 10.Height = Picture_show.Height / 10.FontSize = 1 '防止自动缩放.Visible = FalseEnd With'加载计时器Timer1.Enabled = FalseTimer1.Interval = 100'加载滚动条With HScroll_Difficulty.LargeChange = 5.SmallChange = 1.Max = 100.Min = 0.Value = 10End WithWith HScroll_Area_X.LargeChange = 5.SmallChange = 1.Max = 100.Min = 1.Value = 10End WithWith HScroll_Area_Y.LargeChange = 5.SmallChange = 1.Max = 100.Min = 1.Value = 10End WithWith HScroll_Mine_Count.LargeChange = 5.SmallChange = 1.Max = 100.Min = 0.Value = 10End With'由于很多数据不方便处理，索性让其禁用了Text_Difficulty.Enabled = FalseText_Mine_Count.Enabled = FalseText_X.Enabled = FalseText_Y.Enabled = FalseEnd SubPrivate Sub HScroll_Area_X_Change()Text_X.Text = HScroll_Area_X.ValueHScroll_Mine_Count.Max = HScroll_Area_X.Value * HScroll_Area_Y.ValueHScroll_Mine_Count.Value = HScroll_Area_X.Value * HScroll_Area_Y.Value / 100 * HScroll_Difficulty.ValueEnd SubPrivate Sub HScroll_Area_X_Scroll()Text_X.Text = HScroll_Area_X.ValueHScroll_Mine_Count.Max = HScroll_Area_X.Value * HScroll_Area_Y.ValueHScroll_Mine_Count.Value = HScroll_Area_X.Value * HScroll_Area_Y.Value / 100 * HScroll_Difficulty.ValueEnd SubPrivate Sub HScroll_Area_Y_Change()Text_Y.Text = HScroll_Area_Y.ValueHScroll_Mine_Count.Max = HScroll_Area_X.Value * HScroll_Area_Y.ValueHScroll_Mine_Count.Value = HScroll_Area_X.Value * HScroll_Area_Y.Value / 100 * HScroll_Difficulty.ValueEnd SubPrivate Sub HScroll_Area_Y_Scroll()Text_Y.Text = HScroll_Area_Y.ValueHScroll_Mine_Count.Max = HScroll_Area_X.Value * HScroll_Area_Y.ValueHScroll_Mine_Count.Value = HScroll_Area_X.Value * HScroll_Area_Y.Value / 100 * HScroll_Difficulty.ValueEnd SubPrivate Sub HScroll_Difficulty_Change()Text_Difficulty.Text = HScroll_Difficulty.ValueHScroll_Mine_Count.Value = HScroll_Area_X.Value * HScroll_Area_Y.Value / 100 * HScroll_Difficulty.ValueEnd SubPrivate Sub HScroll_Difficulty_Scroll()Text_Difficulty.Text = HScroll_Difficulty.ValueHScroll_Mine_Count.Value = HScroll_Area_X.Value * HScroll_Area_Y.Value / 100 * HScroll_Difficulty.ValueEnd SubPrivate Sub HScroll_Mine_Count_Change()Text_Mine_Count.Text = HScroll_Mine_Count.ValueHScroll_Difficulty.Value = HScroll_Mine_Count.Value / (HScroll_Area_X.Value * HScroll_Area_Y.Value) * 100End SubPrivate Sub HScroll_Mine_Count_Scroll()Text_Mine_Count.Text = HScroll_Mine_Count.ValueHScroll_Difficulty.Value = HScroll_Mine_Count.Value / (HScroll_Area_X.Value * HScroll_Area_Y.Value) * 100End SubPrivate Sub Label_Down_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)For i = 1 To 8'判断控件是否存在If Index + Near_List(i) > 0 And Index + Near_List(i) <= Area Then'判断是否相邻If Abs(Label_Down(Index + Near_List(i)).Left -Label_Down(Index).Left) <= Label_Down(Index).Width And Abs(Label_Down(Index + Near_List(i)).Top -Label_Down(Index).Top) <= Label_Down(Index).Height Then'判断是否有标记雷If Command_Up(Index + Near_List(i)).Caption <> "X" And Command_Up(Index + Near_List(i)).Caption <> "?" ThenCommand_Up(Index + Near_List(i)).Picture = LoadPicture("")End IfEnd IfEnd IfNext iEnd SubPrivate Sub label_down_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)If LeftAndRight_Flag + Button = 3 Then '双击完成Mine_Number = Val(Label_Down(Index).Caption)Mark_mine_number = 0For i = 1 To 8'判断控件是否存在If Index + Near_List(i) > 0 And Index + Near_List(i) <= Area Then'判断是否相邻If Abs(Label_Down(Index + Near_List(i)).Left -Label_Down(Index).Left) <= Label_Down(Index).Width And Abs(Label_Down(Index + Near_List(i)).Top -Label_Down(Index).Top) <= Label_Down(Index).Height Then'判断是否有标记雷If Command_Up(Index + Near_List(i)).Caption = "X" ThenMark_mine_number = Mark_mine_number + 1End IfEnd IfEnd IfNext iIf Val(Label_Down(Index).Caption) - Mark_mine_number <= 0 Then '已全部标出，自动点开For i = 1 To 8'判断控件是否存在If Index + Near_List(i) > 0 And Index + Near_List(i) <= Area Then'判断是否相邻If Abs(Label_Down(Index + Near_List(i)).Left -Label_Down(Index).Left) <= Label_Down(Index).Width And Abs(Label_Down(Index + Near_List(i)).Top -Label_Down(Index).Top) <= Label_Down(Index).Height Then'判断是否有标记雷If Command_Up(Index + Near_List(i)).Caption <> "X" ThenCall Command_Up_Click(Index + Near_List(i))End IfEnd IfEnd IfNext iElse '如果没有全部标注的话应该显示一下嘛For i = 1 To 8'判断控件是否存在If Index + Near_List(i) > 0 And Index + Near_List(i) <= Area Then'判断是否相邻If Abs(Label_Down(Index + Near_List(i)).Left -Label_Down(Index).Left) <= Label_Down(Index).Width And Abs(Label_Down(Index + Near_List(i)).Top -Label_Down(Index).Top) <= Label_Down(Index).Height Then'判断是否有标记雷If Command_Up(Index + Near_List(i)).Caption <> "X" ThenCommand_Up(Index + Near_List(i)).Picture = LoadPicture(App.Path + "\pictures\xia.gif", , , Command_Up(Index).Width, Command_Up(Index).Height)End IfEnd IfEnd IfNext iEnd IfElseLeftAndRight_Flag = Button'Print LeftAndRight_FlagEnd IfEnd SubPrivate Sub Timer1_Timer()LeftAndRight_Flag = 0End_Time = Now()spend_time = (End_Time - Start_Time) * 10 ^ 5Label_Time.Caption = "时间：" & Format(Int(spend_time) \ (60 * 60), "00") & ":" & Format((Int(spend_time) Mod (60 * 60)) \ 60, "00") & ":" & Format(Int(spend_time) Mod 60, "00") & "." & Format(Int((spend_time - Int(spend_time)) * 1000), "000")End Sub五．软件截图1 2 3。
vb小游戏代码
vb小游戏代码数字排序小游戏Option ExplicitDim Label2X As Integer '记录标签控件数组中要移动的标签控件左上角X的位置Dim Label2Y As Integer '记录标签控件数组中要移动的标签控件左上角Y的位置'让标签数组中的每个标签控件上显示的数字是随机的，无重复的Private Sub Init()RandomizeDim a(7) As IntegerDim i As Integer, k As IntegerLabel1.Caption = ""For i = 0 To 7a(i) = iNextFor i = 0 To 7k = Int(Rnd * 8)Do While a(k) = -1 'a(k)=-1表示该数组元素对应的数字已经被使用过了k = Int(Rnd * 8) '重新生成k的值，直到a(k)的值不等于-1LoopLabel2(i).Caption = Trim(Str(a(k)))a(k) = -1 'a(k)的值已经使用了，不能再用，重新赋值为-1与其他的元素值相区别 to West rear, to County Shen Liqun report guerrillas breakout Hou of action situation, boat via Zhejiang wuxing daughter town Shi, six people has a NI surname "spies" (enemy) midway tuogu landing tipsters, away from small town three in Xu, was day Elves Li Taishan Department captured, five people all killed, broken corpse sank Yu River in the. On January 18, 1943, when the Japanese army militiamen arrested 53 peoplein Wuzhen, transferred to the tomb of the former Japanese militarypolice command (in the "Tai" Jiang Yuan), the 28th in Shenyang North of jade bang massacred them. Hu Maosheng knife wounds woke up in the middle of them, crawling out from the dead, in the tomb of Gao Changhai residents, saved by bing. Such as Hu Maosheng, Gao Changhai is a witness to this tragedy. (B) in memory of "massacre" Xu Youyong yan tomb is the copper law. Copper originally was called Luo yan Tomb, because Eastern Han dynasty distinguished prose poems my father yan Tan bogey was buried in the town's water. Has a long history here, cultural atmosphere, and there are many old houses, and left many people with lofty ideals. Business flourished here, is the hub of four townships of agriculturaland sideline products, wine culture has a long history. The outskirts of the town has left, "Huang Chi", originally Yue water hides Next iEnd SubPrivate Sub Command1_Click()Dim x As Integer, y As IntegerDim z As IntegerInitPicture1.Enabled = True'让空白标签Label1出现的位置随机Randomize'记录下空白标签Label1的位置x = Label1.Lefty = Label1.Topz = Int(Rnd * 8)'将空白标签Label1和标签控件数组任一控件交换位置Label1.Move Label2(z).Left, Label2(z).TopLabel2(z).Move x, yCommand1.Enabled = FalseEnd SubPrivate Sub Command2_Click()EndEnd SubPrivate Sub Form_Load()Dim i As IntegerPicture1.Enabled = False'在标签中显示游戏说明信息Label3.Caption = "如左图所示，将数字按0-7顺" & vbCrLf & vbCrLf & "序依次排列，即取得胜利。
VB编写猜数字小游戏教程
VB编写猜数字小游戏傻瓜教程本人原创，只在百度文库发布，希望对想学习VB的朋友有所帮助，提高学习VB的兴趣。
本文以VB6为例介绍编写一个最简单的猜数字小游戏过程，VB6在百度上很容易搜索到，本文所需要控件极少，安装一个大小只有6MB的VB6精简版就可以体验了。
不敢说“抛砖引玉”，只怕抛个小砖换来个板儿砖。
总之，本文重点不是从零开始学VB，主要是介绍编写这个小游戏的过程。
首先，启动VB，然后点击文件菜单，点击新建一个工程，即可出现如下界面。
按照下图红色箭头的指向，鼠标在左侧工具条上拖一个文本标签、一个文本输入框、一个按钮到工程界面里边来，然后调整大小和位置大概跟下图比例差不多就行了。
接着，点击label标签，在右边属性窗口里调整字体大小为三号字，因为默认的字体太小了，不爽。
什么？三号字还小？那你自己看着办吧，但我可要告诉你哦，等下显示的内容超出显示区域可别怪我。
改好了吗？本次编程就这三个控件，菜吧？现在双击工程界面的空白区域，不要点在控件上了哦。
双击空白区域后，就弹出了代码编写窗口。
按照下图把代码一个一个给我打上去。
都好几分钟了，打上去了吗？哦，忘了告诉你，复制下面的代码也是一样的。
代码：Dim cai As Integer '定义一个变量用来存储欲猜的数字Private Sub Form_Load()Randomize '重设随机因子Label1.Caption = "请填入你猜测的数字" '让label1显示为空Text1.Text = "" '让text1文本显示为空Command1.Caption = "确定" '让command1显示为"确定"cai = Int(Rnd * 899) + 100 '随机选择一个三位数作为欲猜的数字End Sub以上代码都做了注释，就不需要过多说明了。
(完整)VB实现贪吃蛇小游戏
VB实现贪吃蛇小游戏——比较适合VB初学者,属原创作品图1图2图3如图1所示，布置控件，其中有4个timer控件，1个picture控件（底图），4个command控件（上下左右)，10个label控件.其他功能都在程序里实现，其中贪吃蛇都是由点来组成的，初学者主要学习一下timer控件的应用，还有贪吃蛇拐弯怎么实现的.图2、图3是游戏视图.主程序：Public a, b, f As Double: Public i, j, c， d， e， g， h, z As IntegerDim aa（100) As Double： Dim bb(100） As DoublePrivate Sub Form_Load()a = 100:b = 300:c = 4 'a、b定义第一个点(红点)位置，c能控制蓝点数量g = 2000: h = 2000Timer1.Interval = （200 — z * 30) ’定义每个定时器间隔时间 0.2STimer2。
Interval = (200 - z * 30）Timer3。
Interval = (200 — z ＊ 30）Timer4.Interval = （200 - z * 30）Timer5。
Interval = 300Timer1。
Enabled = True '初设一开始向右走Timer2.Enabled = FalseTimer3.Enabled = FalseTimer4。
Enabled = FalseEnd SubPrivate Sub Timer1_Timer（） '向右走Picture1.Cls '没循环一次就清除上一次画的图像，要不就看不出运动了Picture1.DrawWidth = 10 '定义画图粗细b = b + 100 ’b每次都加100,画图后坐标就变了aa（i） = abb（j） = bPicture1.PSet (b, a）, vbRed ’绘制第一个点（红）For k = 1 To c '此k-for循环从1到c,绘制c个蓝色点If aa(99） = 0 Then '如果游戏刚开始，以下绘制方法，一开始j=0,j—k为负,bb（j—k)与aa（j-k）数组无效,因此在j〈=c时单独绘制If j <= c And i <= c Thenf = 400 - 100 ＊ (k - j)Picture1.PSet （f, 100）， vbBlueElsePicture1。
人人都会用的VB游戏小程序代码
人人都会用的VB游戏小程序代码人人都会用的 VB 游戏小程序代码3. 球来回弹在窗体上添加一shape 空间, shape 为circle ,计时器空间inteval=10 通用Dim bzPrivate Sub Timer1_Timer(If Shape1.Left >= Form1.ScaleWidth - Shape1.Width Then bz = 1 If Shape1.Left <= 0 Then bz = 0If bz = 0 Then Shape1.Left = Shape1.Left + 10If bz = 1 Then Shape1.Left = Shape1.Left - 10End Sub注意:bz 的使用(bz 为一临时标志,用于判断移动方向2. 六角星Dim i%, j%, k%For i = 1 To 10If i < 4 Or i > 6 ThenPrint Space(20 - i;For j = 1 To iPrint "○ ";Next jElsePrint Space(6 + i;For k = 14 - i To 1 Step -1 Print "○ ";Next kEnd IfPrintNext iFor i = 3 To 1 Step -1 Print Space(20 - i;For j = 1 To iPrint "○ ";Next jPrintNext i1. 空心三角形Dim i%, j%Print Space(20; "*"For i = 2 To 9Print Space(21 - i; "*"; Space(2 * i - 3; "*"NextPrint Space(10;For i = 1 To 10Print Space(1; "*";Next扩展程序Const n = 15Dim a(1 To n As IntegerDim i%, j%, t%RandomizeFor i = 1 To na(i = Int(100 * Rnd ' 生成 15个 0~100的随机整数存入数组 Next Print "排序前:"For i = 1 To nPrint a(i;NextPrintFor i = 1 To n - 1For j = i + 1 To nIf a(j < a(i Then t = a(j: a(j = a(i: a(i = tNextNextPrint "排序后:"For i = 1 To nPrint a(i;Next3. 球来回弹在窗体上添加一shape 空间, shape 为circle ,计时器空间inteval=10 通用Dim bzPrivate Sub Timer1_Timer(If Shape1.Left >= Form1.ScaleWidth - Shape1.Width Then bz = 1 If Shape1.Left <= 0 Then bz = 0If bz = 0 Then Shape1.Left = Shape1.Left + 10If bz = 1 Then Shape1.Left = Shape1.Left - 10End Sub注意:bz 的使用(bz 为一临时标志,用于判断移动方向4. 从大到小再从小到大变化在窗体添加一标签label1, autosize=true, caption="★ ", 添加一计时器空间timer1, inteval=100 通用:Dim bzPrivate Sub Timer1_Timer(If Label1.FontSize >= 72 Then bz = 1If Label1.FontSize <= 8 Then bz = 0If bz = 0 Then Label1.FontSize = Label1.FontSize + 2If bz = 1 Then Label1.FontSize = Label1.FontSize - 2End Sub5. 在 VB 中用画圆Dim x, y, i As SingleClsScale (-15, 15-(15, -15 ' 定义笛卡儿坐标系For i = 0 To 6.28 Step 0.05y = 10 * Sin(ix = 10 * Cos(iCurrentX = xCurrentY = yPrint "*"Next6. 四周循环移动创建一个窗体,在上面添加“开始”和“停止”两个按钮,添加一个计时器控件timer1 在窗体上添加一个 shape 控件,设置背景不透明,红色,调整大小程序代码如下:Option ExplicitDim bz%Private Sub Command1_Click( '开始按钮Timer1 = TrueEnd SubPrivate Sub Command2_Click( ' 停止按钮Timer1 = FalseEnd SubPrivate Sub Form_Load(Shape1.Left = 0Shape1.Top = 0Timer1 = FalseTimer1.Interval = 10End SubPrivate Sub Timer1_Timer(If Shape1.Left >= Form1.ScaleWidth - Shape1.Width And Shape1.Top <= 0 Then bz = 1If Shape1.Top >= Form1.ScaleHeight - Shape1.Height Then bz = 2If Shape1.Left <= 0 Then bz = 3If Shape1.Top <= 0 And Shape1.Left <= 0 Then bz = 0Select Case bzCase 0Shape1.Left = Shape1.Left + 10Case 1Shape1.Top = Shape1.Top + 10Case 2Shape1.Left = Shape1.Left - 10Case 3Shape1.Top = Shape1.Top - 10End SelectEnd Sub。
vb打字游戏代码
vb打字游戏代码1、双击Form1窗口，并选择“通用”对象，输入下面的通用代码: Option ExplicitDim score As Integer /定义变量Dim speed As Integer /定义变量2、编写init子程序(用于设置第一个出现的字母)Sub init()Label1.Caption = Chr(Int(Rnd * 26) + 49) /设定Label1随机显示的字母speed = Int(Rnd * 100 + 100) /设定Label1随机显示字母的速度 Label1.Left = Int(Rnd * Frame1.Width) /设定Label1代表字母出现的左边位置 Label1.Top = Frame1.Top /设定Label1代表字母出现的顶部位置 End Sub3、编写init1子程序(用于第二个出现的字母)Sub init1()Label6.Caption = Chr(Int(Rnd * 26) + 97) /设定Label2随机显示的字母speed = Int(Rnd * 100 + 100) /设定Label2随机显示字母的速度 Label6.Left = Int(Rnd * Frame1.Width) /设定Label2代表字母出现的左边位置 Label6.Top = Frame1.Top /设定Label2代表字母出现的顶部位置 End Sub4、双击“开始”按钮并输入下列代码:Private Sub Command1_Click()init /调用init子程序Timer1.Enabled = True /激活Time1控件Timer2.Enabled = True /激活Time2控件Command1.Visible = FalseLabel5.Caption = 200Label4.Caption = 0End Sub5、双击Form1窗口，并选择“KeyPress”对象，输入下面的用代码: Private Sub Form_KeyPress(KeyAscii As Integer)If Chr(KeyAscii) = Label1.Caption Then /校验键盘输入字符和Label1显示的字符initscore = score + 1 /得分加1Label4.Caption = scoreEnd IfIf Chr(KeyAscii) = Label6.Caption Then /校验键盘输入字符和Label2显示的字符init1score = score + 1Label4.Caption = score /Label4控件显示得分情况 End IfEnd Sub6、双击Form1窗口，并选择“Load”对象，输入下面的用代码: Private Sub Form_Load()RandomizeTimer1.Enabled = False /Time1控件失效 Timer2.Enabled = False /Time2控件失效 End Sub7、双击Timer1控件并输入下列代码:Private Sub Timer1_Timer()Label1.Top = Label1.Top + speedIf Label1.Top > Frame1.Height Then /第一个字母超出屏幕范围的时候调用init子程序重新出现一个字母initEnd IfLabel6.Top = Label6.Top + speedIf Label6.Top > Frame1.Height Then /第二个字母超出屏幕范围的时候调用init1子程序重新出现一个字母init1End IfEnd Sub8、双击Timer2控件并输入下列代码:Private Sub Timer2_Timer()Label5.Caption = Val(Label5.Caption) - 1 /扣除剩余个数中的一个If Val(Label5.Caption) <= 0 ThenTimer1.Enabled = False /剩余个数小于等于0的时候结束练习Label1.Caption = "" /不显示字母Label6.Caption = ""Select Case scoreCase Is <= 80MsgBox vbCrLf + "别放弃，再来一次～" /显示信息框Case Is < 120MsgBox vbCrLf + "成绩不错，加油～"Case Is < 150MsgBox vbCrLf + "再努力做的更好一些～"Case Is > 180MsgBox vbCrLf + "好厉害～最高分呀～"End SelectCommand1.Visible = TrueLabel4.Caption = 0Label5.Caption = 200Timer1.Enabled = FalseTimer2.Enabled = FalseEnd IfEnd Sub2、添加一个Frame控件，将它的Caption属性设置为空，并且将BorderStyle 属性设置为“0-None”，然后在这个Frame中添加1个Label控件，将Visible设为False。
VB实现贪吃蛇小游戏
VB实现贪吃蛇小游戏以下为VB实现贪吃蛇小游戏的代码及其详细说明。
```'主程序模块Option ExplicitPrivate WithEvents Snake As SnakeGamePrivate FrameRate As IntegerPrivate FoodColor As LongPrivate SnakeColor As LongPrivate GameOver As BooleanPrivate Sub Form_LoadFrameRate = 100FoodColor = vbGreenSnakeColor = vbBlueGameOver = FalseSet Snake = New SnakeGameSnake.CreateGame FrameRate, FoodColor, SnakeColor Me.ScaleMode = vbPixelsMe.AutoRedraw = TrueEnd SubPrivate Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)If Not GameOver ThenSelect Case KeyCodeCase vbKeyUpSnake.ChangeDirection SnakeDirection.UpCase vbKeyDownSnake.ChangeDirection SnakeDirection.DownCase vbKeyLeftSnake.ChangeDirection SnakeDirection.LeftCase vbKeyRightSnake.ChangeDirection SnakeDirection.RightEnd SelectElseMsgBox "Game Over!"Unload MeEnd IfEnd SubPrivate Sub Form_Paint Snake.DrawGame MeIf GameOver ThenMe.Print "Game Over!"End IfEnd SubPrivate Sub Snake_GameOver GameOver = TrueMe.RefreshEnd SubPrivate Sub Snake_Move Me.RefreshEnd Sub``````'蛇游戏类模块Option ExplicitPublic Enum SnakeDirection Up=0Down = 1Left = 2Right = 3End EnumPrivate Type SnakeSegmentX As LongY As LongEnd TypePrivate Type SnakeFoodX As LongY As LongEnd TypePrivate snake( As SnakeSegmentPrivate food As SnakeFoodPublic Event MovePublic Event GameOverPublic Sub CreateGame(frameRate As Integer, foodColor As Long, snakeColor As Long)ReDim snake(10)snake(0).X = 10snake(0).Y = 10snake(1).X = 10snake(1).Y = 11snake(2).X = 10snake(2).Y = 12food.X = 30food.Y = 20Timer1.Interval = frameRateTimer1.Enabled = TrueMe.BackColor = vbBlackMe.ForeColor = snakeColorMe.ScaleMode = vbPixelsMe.AutoRedraw = FalseDrawGame MeEnd SubPublic Sub ChangeDirection(direction As SnakeDirection) Dim newSegment As SnakeSegmentSelect Case directionCase SnakeDirection.UpIf snake(0).Y > 0 ThennewSegment.X = snake(0).X newSegment.Y = snake(0).Y - 1ElseRaiseEvent GameOverTimer1.Enabled = FalseExit SubEnd IfCase SnakeDirection.DownIf snake(0).Y < Me.ScaleHeight - 1 Then newSegment.X = snake(0).X newSegment.Y = snake(0).Y + 1ElseRaiseEvent GameOverTimer1.Enabled = FalseExit SubEnd IfCase SnakeDirection.LeftIf snake(0).X > 0 ThennewSegment.X = snake(0).X - 1 newSegment.Y = snake(0).YElseRaiseEvent GameOverTimer1.Enabled = FalseExit SubEnd IfCase SnakeDirection.RightIf snake(0).X < Me.ScaleWidth - 1 Then newSegment.X = snake(0).X + 1 newSegment.Y = snake(0).YElseRaiseEvent GameOverTimer1.Enabled = FalseExit SubEnd IfEnd SelectReDim Preserve snake(UBound(snake) + 1)For i = UBound(snake) - 1 To 1 Step -1snake(i) = snake(i - 1)Next isnake(0) = newSegmentCheckCollisionRaiseEvent MoveEnd SubPrivate Sub Timer1_TimerChangeDirection GetRandomDirectionEnd SubPrivate Sub CheckCollisionFor i = 1 To UBound(snake)If snake(0).X = snake(i).X And snake(0).Y = snake(i).Y Then RaiseEvent GameOverTimer1.Enabled = FalseExit SubEnd IfNext iIf snake(0).X = food.X And snake(0).Y = food.Y ThenGenerateFoodEnd IfEnd SubPrivate Sub GenerateFoodDim occupied As BooleanDooccupied = Falsefood.X = Int(Rnd * Me.ScaleWidth)food.Y = Int(Rnd * Me.ScaleHeight)For i = 0 To UBound(snake)If food.X = snake(i).X And food.Y = snake(i).Y Then occupied = TrueExit ForEnd IfNext iLoop Until Not occupiedEnd SubPrivate Function GetRandomDirection( As SnakeDirection Dim rndNum As IntegerrndNum = Int((3 + 1 - 0) * Rnd + 0) Select Case rndNumCase 0GetRandomDirection = SnakeDirection.Up Case 1GetRandomDirection = SnakeDirection.Down Case 2GetRandomDirection = SnakeDirection.Left Case 3GetRandomDirection = SnakeDirection.Right End SelectEnd FunctionPublic Sub DrawGame(Form As Object) Form.ClsFor i = 0 To UBound(snake)Form.PSet (snake(i).X, snake(i).Y)Next i' Draw foodForm.ForeColor = vbGreenForm.PSet (food.X, food.Y)End Sub```以上是使用VB实现贪吃蛇小游戏的代码。
用VB做游戏的源代码
' Label1 的Name=LabSnake，Index=0' Label2 的Name=LabTai，Index=0' Shape1 的Name=ShaFoot，Index=0Enum enMenuIndexm_Startm_Autom_Fastm_Bar1m_ShowNom_ShowTom_ShowNumm_ShowWenm_Bar2m_ShowRectm_Line '此常数必须在最后End EnumEnum enToto_Upto_Downto_Leftto_RightEnd EnumDim ctTo As enTo, ctZong As Long, ctFoot As Long, ctHead As LongDim ctB As Long, ctSize As Long, ctH As Long, ctL As Long, ctEsc As BooleanDim ctDown As Long, ctRight As LongDim ctFen As Long, ctMaxFen As Long, ctAutoFen As Long, ctAutoMax As Long, ctAuto As BooleanPrivate Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)Select Case KeyCodeCase vbKeyUp: If ctTo <> to_Down Then ctTo = to_UpCase vbKeyDown: If ctTo <> to_Up Then ctTo = to_DownCase vbKeyLeft: If ctTo <> to_Right Then ctTo = to_LeftCase vbKeyRight: If ctTo <> to_Left Then ctTo = to_RightEnd SelectEnd SubPrivate Sub ShowBack(Optional AutoSize As Boolean)Dim W As Single, H As Single, W1 As Single, H1 As SingleIf Not AutoSize Then GoTo Back1W1 = Me.Width - Me.ScaleX(Me.ScaleWidth, Me.ScaleMode, vbTwips) '窗口边框宽度：缇H1 = Me.Height - Me.ScaleY(Me.ScaleHeight, Me.ScaleMode, vbTwips) '窗口标题栏高度：缇W = ctL * ctSize + ctB * 2: H = ctH * ctSize + ctB * 2W = W + Me.TextWidth("A") * 14 '留出14 个字符的空白区，显示成绩For I = 0 To Labtai.Count - 1Labtai(I).Move ctRight + ctB * 0.5, ctB + ctSize * 1.2 * (I + 1)NextW = W1 + Me.ScaleX(W, Me.ScaleMode, vbTwips)H = H1 + Me.ScaleY(H, Me.ScaleMode, vbTwips)Me.Move (Screen.Width - W) * 0.5, (Screen.Height - H) * 0.5, W, HBack1:Me.ClsMe.Line (ctB, ctB)-(ctRight, ctDown), RGB(0, 155, 0), BFIf Not mmfast(m_Line).Checked Then Exit SubDim nStr As StringMe.Font.Size = 9W1 = Me.TextWidth("A"): H1 = (ctSize - Me.TextHeight("A")) * 0.5For H = 0 To ctH '横线Me.Line (ctB, ctB + H * ctSize)-Step(ctRight - ctB, 0)nStr = H + 1Me.CurrentX = ctB - Me.TextWidth(nStr)Me.CurrentY = ctB + H * ctSize + H1If H < ctH Then Me.Print nStrNextH1 = Me.TextHeight("A")For H = 0 To ctL '纵线Me.Line (ctB + H * ctSize, ctB)-Step(0, ctDown - ctB)nStr = H + 1Me.CurrentX = ctB + H * ctSize + (ctSize - Me.TextWidth(nStr)) * 0.5 Me.CurrentY = ctB - H1If H < ctL Then Me.Print nStrNextEnd SubPrivate Sub KjInit()'初始化Dim I As Long, nEnd As Long, S As Long, H As LongctFoot = 2 '同时出现的食物数ctZong = 10:ctTo = to_Right '初始长度、方向ctHead = 0: ctFen = 0 '蛇头序号，得分ctSize = 15 '蛇身宽度（控件大小）：像素ctB = 20 '边框空白区：像素ctH = 25: ctL = 30 '活动区行列数ctDown = ctB + ctH * ctSize '活动区底部位置ctRight = ctB + ctL * ctSize '活动区右部位置Call ShowFenIf mmfast(m_ShowRect).Checked Then Labsnake(0).BorderStyle = 1 Else Labsnake(0).BorderStyle = 0Labsnake(0).Alignment = 2: Labsnake(0).BackColor = 255Randomize: H = 1 + Int((ctH - 1) * Rnd) '初始出发行nEnd = Labsnake.Count - 1 '当前末尾序号S = ctZongIf S < nEnd Then S = nEndFor I = 0 To SIf I > ctZong ThenUnload Labsnake(I)ElseIf I > nEnd Then Load Labsnake(I): Labsnake(I).V isible = TrueLabsnake(I).Move ctB, ctB + ctSize * H, ctSize, ctSizeIf mmfast(m_ShowNum).Checked Then Labsnake(I).Caption = I Else Labsnake(I).Caption = ""End IfNextShafoot(0).Shape = 3: Shafoot(0).FillStyle = 0: Shafoot(0).FillColor = RGB(0, 0, 255)Shafoot(0).Move -ctB - ctSize, 0, ctSize, ctSizenEnd = Shafoot.Count - 1 '当前末尾序号S = ctFoot - 1If S < nEnd Then S = nEndFor I = 0 To SIf I > ctFoot - 1 ThenUnload Shafoot(I)ElseIf I > nEnd Then Load Shafoot(I): Shafoot(I).V isible = TrueCall RndFoot(I)End IfNextEnd SubPrivate Sub Form_Unload(Cancel As Integer)ctEsc = TrueIf ctAutoMax < ctAutoFen Then ctAutoMax = ctAutoFenIf ctMaxFen < ctFen Then ctMaxFen = ctFenSaveSetting "Snake", "Opt", "AutoMax", ctAutoMaxSaveSetting "Snake", "Opt", "MaxFen", ctMaxFenEnd SubPrivate Function KjIndex(Index As Long, AddNum As Long)KjIndex = Index + AddNumIf AddNum > 0 ThenIf KjIndex > ctZong Then KjIndex = KjIndex - ctZong - 1ElseIf KjIndex < 0 Then KjIndex = KjIndex + ctZong + 1End IfEnd FunctionPrivate Sub LabTai_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)If Index = 0 And Button = 1 Then Me.PopupMenu mfast, , Labtai(Index).Left, Labtai(Index).Top + Labtai(Index).HeightEnd SubPrivate Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 2 Then Me.PopupMenu mfastEnd SubPrivate Sub Form_Load()Dim I As LongMe.Caption = "贪吃蛇" 'SnakeMe.KeyPreview = True: Me.AutoRedraw = TrueTimer1.Interval = 100 '速度Me.ScaleMode = vbPixels ' 3 像素Timer1.Enabled = Falsemfast.V isible = FalseFor I = 1 To m_LineLoad mmfast(I)Nextmmfast(m_Bar1).Caption = "-": mmfast(m_Bar2).Caption = "-"mmfast(m_Start).Caption = "开始/停止"mmfast(m_Auto).Caption = "自动游戏"mmfast(m_Fast).Caption = "快速"mmfast(m_ShowNo).Caption = "空白蛇身"mmfast(m_ShowTo).Caption = "显示前进方向"mmfast(m_ShowNum).Caption = "显示数字"mmfast(m_ShowWen).Caption = "显示花纹"mmfast(m_ShowRect).Caption = "显示方格"mmfast(m_Line).Caption = "显示网格线"Labtai(0).AutoSize = TrueFor I = 1 To 3Load Labtai(I): Labtai(I).Visible = TrueNextLabtai(0).Caption = "选项": Labtai(1).Caption = "双击开始游戏"ctAutoMax = GetSetting("Snake", "Opt", "AutoMax", 0)ctMaxFen = GetSetting("Snake", "Opt", "MaxFen", 0)Call KjInitCall ShowBack(True)End SubPrivate Sub Form_DblClick()Timer1.Enabled = TrueIf ctAutoMax < ctAutoFen Then ctAutoMax = ctAutoFenIf ctMaxFen < ctFen Then ctMaxFen = ctFenCall KjInit: Call ShowBackctAutoFen = 0: ctFen = 0Call ShowFenIf ctAuto Then Labtai(1).Caption = "游戏中（自动）" Else Labtai(1).Caption = "游戏中" End SubPrivate Sub mmFast_Click(Index As Integer)Dim I As LongIf ctAutoMax < ctAutoFen Then ctAutoMax = ctAutoFenIf ctMaxFen < ctFen Then ctMaxFen = ctFenSelect Case IndexCase m_StartTimer1.Enabled = Not Timer1.EnabledIf Timer1.Enabled Then Call KjInit: Call ShowBackCase m_AutoctAuto = Not ctAuto: mmfast(Index).Checked = ctAutoTimer1.Enabled = ctAutoIf Timer1.Enabled Then Call KjInit: Call ShowBackCase m_Fastmmfast(Index).Checked = Not mmfast(Index).CheckedIf mmfast(Index).Checked Then Timer1.Interval = 50 Else Timer1.Interval = 100Case m_Linemmfast(Index).Checked = Not mmfast(Index).Checked: Call ShowBackCase m_ShowNo, m_ShowTo, m_ShowNum, m_ShowWenmmfast(m_ShowNo).Checked = False: mmfast(m_ShowTo).Checked = Falsemmfast(m_ShowNum).Checked = False: mmfast(m_ShowWen).Checked = Falsemmfast(Index).Checked = TrueCase m_ShowRectmmfast(Index).Checked = Not mmfast(Index).CheckedFor I = 0 To Labsnake.Count - 1If mmfast(Index).Checked Then Labsnake(I).BorderStyle = 1 Else Labsnake(I).BorderStyle = 0NextEnd SelectIf Timer1.Enabled ThenIf ctAuto Then Labtai(1).Caption = "游戏中（自动）" Else Labtai(1).Caption = "游戏中"ctAutoFen = 0: ctFen = 0ElseLabtai(1).Caption = "游戏已停止"End IfCall ShowFenEnd SubPrivate Sub Timer1_Timer()Dim nHead As Long, nEnd As Long, X As Long, Y As Long, I As LongDim H As Long, L As Long, H1 As Long, L1 As LongIf ctSize = 0 Then Exit SubnHead = ctHead: nEnd = KjIndex(ctHead, 1) '当前蛇头、蛇尾序号MoveHL:Call GetHL(Labsnake(nHead).Left, Labsnake(nHead).Top, H, L) '获得当前蛇头行列号Select Case ctToCase to_Up: H = H - 1Case to_Down: H = H + 1Case to_Left: L = L - 1Case to_Right: L = L + 1End SelectIf L > ctL Or L < 1 ThenIf H < ctH * 0.5 Then ctTo = to_Down Else ctTo = to_UpGoTo MoveHLEnd IfIf H > ctH Or H < 1 ThenIf L < ctL * 0.5 Then ctTo = to_Right Else ctTo = to_LeftGoTo MoveHLEnd IfnHead = nEnd '新蛇头Call MoveTo(Labsnake(nHead), H, L) '蛇尾移到蛇头前If ctAuto Then Call AutoPlay(nHead, H, L) '自动避免碰到身体，会修改H, LIf InBody(nHead, H, L) > -1 ThenLabsnake(nHead).ZOrderTimer1.Enabled = FalseLabtai(1).Caption = "游戏结束"Call ShowStr("Game Over", 36)GoTo SetNewHeadEnd If'是否吃到食物For I = 0 To ctFoot - 1Call GetHL(Shafoot(I).Left, Shafoot(I).Top, H1, L1) '获得食物行列号If H = H1 And L = L1 ThenctZong = ctZong + 1 '蛇身增加一节Load Labsnake(ctZong): Labsnake(ctZong).V isible = TrueIf mmfast(m_ShowNum).Checked Then Labsnake(ctZong).Caption = ctZong Else Labsnake(I).Caption = ""Labsnake(ctZong).Move Labsnake(0).Left, Labsnake(0).Top '新控件与序号0重叠' LabSnake(ctZong).ZOrder 0Call ShowFen(True)Call RndFoot(I) '重新设置食物的位置Exit ForEnd IfNextSetNewHead:'新蛇头Labsnake(nHead).BackColor = 255If mmfast(m_ShowWen).Checked ThenIf Labsnake(ctHead).Caption = "●" Then Labsnake(nHead).Caption = "◎" Else Labsnake(nHead).Caption = "●"End If'原蛇头变蛇身Labsnake(ctHead).BackColor = RGB(0, 0, 255)If mmfast(m_ShowNo).Checked Then Labsnake(ctHead).Caption = ""If mmfast(m_ShowTo).Checked Then Labsnake(ctHead).Caption = ToStr(ctTo)If mmfast(m_ShowNum).Checked Then Labsnake(ctHead).Caption = ctHeadctHead = nHeadIf ctAuto Then FindFoot Labsnake(ctHead).Left, Labsnake(ctHead).Top '自动查找食物，修改运动方向。
猜数字游戏的VB程序代码
猜数字游戏的VB程序代码（改进版）本猜数字游戏的方法及规则：系统自动生成一个四位数（四个数字没有重复），玩者需要猜中这个数字。
玩者在四个文本框内输入四个数字，按“ENTER”后，如果猜对，则文本框变绿，本轮结束，按“CLEAR”进入下一轮。
如果不对，则会在下面显示“xAxB”，其中“xA”表示有四个数字中有多少个数字是数字和所在位置都猜对的，“xB”表示有多少个数字猜对但是所在位置不对。
比如，答案是“1234”，玩者猜“5432”，则显示“1A2B”，因为“3”猜对且位置也对，“4”猜对但位置不对，“2”猜对但位置不对。
如果玩者猜“1324”，则显示“2A2B”；如果玩者猜“4567”则显示“0A1B”；如果玩者猜“4256”，则显示“1A1B”，原因自己推。
（四位数也可能是零开头。
）最多猜错十次，如十次没有猜对，则游戏失败，本轮结束，按“CLEAR”进入下一轮。
按“QUIT”可查看答案，同时本轮结束。
各控件在界面上的布局如下：程序代码：Option ExplicitDim key_num, count_enter As IntegerDim key_dig(1 To 4) As IntegerPrivate Sub Command1_Click()Dim i, j, count_A, count_B As IntegerDim ans_dig(1 To 4) As Integercount_enter = count_enter + 1ans_dig(1) = Val(Text1.Text): ans_dig(2) = Val(Text2.Text): ans_dig(3) = Val(Text3.Text): ans_dig(4) = Val(Text4.Text)For i = 1 To 4 Step 1For j = 1 To 4 Step 1If ans_dig(i) = key_dig(j) ThenIf i = j Then count_A = count_A + 1 Else count_B = count_B+ 1 '最主要的步骤End IfNextNextIf count_A < 4 And count_enter < 10 ThenFor i = 1 To 25 Step 1Print " ";NextPrint Str(count_enter) + ":";For i = 1 To 4 Step 1Print Str(ans_dig(i));NextPrint " " + Str(count_A) + "A" + Str(count_B) + "B"ElseFor i = 1 To 25 Step 1Print " ";NextIf count_A = 4 ThenText1.BackColor = vbGreen: Text2.BackColor = vbGreen: Text3.BackColor = vbGreen: Text4.BackColor = vbGreen Text5.ForeColor = vbBlack: Text5.BackColor = vbGreenIf key_num \ 1000 = 0 Then Text5.Text = "0" + Str(key_num)Else Text5.Text = Str(key_num)Form1.FontSize = "40": Form1.ForeColor = vbGreen: Print "BINGO!"Command2.Enabled = True: Command3.Enabled = Falsecount_enter = 0Command1.Enabled = FalseElseForm1.FontSize = "40": Form1.ForeColor = vbRed: Print "你输了！"Text5.ForeColor = vbRedIf key_num \ 1000 = 0 Then Text5.Text = "0" + Str(key_num) Else Text5.Text = Str(key_num)Command2.Enabled = True: Command3.Enabled = Falsecount_enter = 0Command1.Enabled = FalseEnd IfEnd IfEnd SubPrivate Sub Command2_Click()Call FormInitializationCommand2.Enabled = FalseCommand1.Enabled = True: Command3.Enabled = TrueEnd SubPrivate Sub Command3_Click()Dim i As IntegerFor i = 1 To 25 Step 1Print " ";NextForm1.FontSize = "40": Form1.ForeColor = vbRed: Print "QUITTED"Text5.ForeColor = vbRed: Text5.Text = Str(key_num) Command2.Enabled = Truecount_enter = 0Command1.Enabled = FalseCommand3.Enabled = FalseEnd SubPrivate Sub Form_Load()Call FormInitializationEnd SubPrivate Function FormInitialization()ClsWith Form1.ForeColor = vbBlack: .Font = "黑体": .FontSize = "18" End WithDim n, i, j As Integer, is_appliable As BooleanFor n = 1 To 7 Step 1Print " "NextDois_appliable = TrueRandomizekey_num = Int(Rnd * (9876 - 123 + 1)) + 123For i = 1 To 4 Step 1key_dig(i) = key_num \ 10 ^ (4 - i) Mod 10NextFor i = 1 To 3 Step 1For j = i + 1 To 4 Step 1If key_dig(i) = key_dig(j) Then is_appliable = False NextNextLoop Until is_appliableWith Command1.Font = "Times New Roman": .FontSize = "15": .Caption = "ENTER":End WithWith Command2.Font = "Times New Roman": .FontSize = "12": .Caption = "Next Round": .Enabled = FalseEnd WithWith Command3.Font = "Times New Roman": .FontSize = "9": .Caption = "QUIT" End WithWith Label1.Font = "宋体": .FontSize = "9": .Caption = "正确答案：": .ForeColor = vbBlackEnd WithWith Label2.Font = "宋体": .FontSize = "20": .Caption = "“bingo”游戏": .ForeColor = vbBlackEnd WithWith Label3.Font = "宋体": .FontSize = "9": .ForeColor = vbBlack .Caption = "系统自动生成一个四位数（四个数字没有重复），玩者需要猜中这个数字。
VB编写各种趣味小程序(附代码)
VB编写各种趣味小程序（附代码）一、鸟巢绘制二、加密三、解密四、蝴蝶飞舞五、文本编辑六、统计七、小球跳动八、计算器（彩票摇奖）九、学生信息录入十、矩阵转置十一、带有进度条的倒计时程序十二、加减乘除随机数题十三、计算器十四、抽奖一、鸟巢绘制Private Sub Form_Click()ClsDim r, xi, yi, xj, yj, x0, y0, aif As Singler = Form10.ScaleHeight / 2x0 = Form10.ScaleWidth / 2y0 = Form10.ScaleHeight / 2n = 16aif = 3.14159 * 2 / nFor i = 1 To nxi = r * Cos(i * aif) + x0yi = r * Sin(i * aif) + y0For j = i To nxj = r * Cos(j * aif) + x0yj = r * Sin(j * aif) + y0Line (xi, yi)-(xj, yj), QBColor(i - 1)PSet (xi, yi)Print i - 1Next jNext iEnd SubPrivate Sub Form_Load()Print "要求：";Print "1.将圆周等分成16份；"Print "2.每个等分点要标记成0-16的数字；" Print "3.按样本图的图案画图。
"End Sub附图：二、加密Function code(ByVal s$, ByVal key%) Dim c As String * 1, iAsc%code = ""For i = 1 To Len(s)c = Mid$(s, i, 1)Select Case cCase "A" To "Z"iAsc = Asc(c) + keyIf iAsc > Asc("Z") Then iAsc = iAsc - 26 code = code + Chr(iAsc)Case "a" To "z"iAsc = Asc(c) + keyIf iAsc > Asc("z") Then iAsc = iAsc - 26 code = code + Chr(iAsc)Case Elsecode = code + cEnd SelectNext iEnd FunctionPrivate Sub close_Click()Form11.HideForm1.ShowEnd SubPrivate Sub Jiami_Click()Text2 = code(Text1, 2)End SubPrivate Sub open_Click()CommonDialog1.Action = 1Text1.Text = ""Open CommonDialog1.FileName For Input As #1Dim counter As IntegerDim workarea(25000) As StringProgressBar1.min = LBound(workarea)ProgressBar1.max = UBound(workarea)ProgressBar1.Visible = TrueProgressBar1.Value = ProgressBar1.minFor counter = LBound(workarea) To UBound(workarea) workarea(counter) = "initial value " & counter ProgressBar1.Value = counterNext counterDo While Not EOF(1)Line Input #1, inputdataText1.Text = Text1.Text + inputdata + vbCrLfLoopClose #1End SubPrivate Sub save_Click()CommonDialog1.FileName = "a1.txt"CommonDialog1.DefaultExt = "txt"CommonDialog1.Action = 2Open CommonDialog1.FileName For Output As #1Print #1, Text2.TextClose #1End Sub三、解密Function UnCode(ByVal s$, ByVal key%)Dim c As String * 1, iAsc%UnCode = ""For i = 1 To Len(s)c = Mid$(s, i, 1)Select Case cCase "A" To "Z"iAsc = Asc("c") - keyIf iAsc < Asc("A") Then iAsc = iAsc + 26UnCode = UnCode + Chr(iAsc)Case "a" To "z"iAsc = Asc(c) - keyIf iAsc < Asc("a") Then iAsc = iAsc + 26UnCode = UnCode + Chr(iAsc)Case ElseUnCode = UnCode + cEnd SelectNext iEnd FunctionPrivate Sub close_Click()Form2.HideForm1.ShowEnd SubPrivate Sub Jiemi_Click()Text2 = UnCode(Text1, 2)End SubPrivate Sub open_Click()CommonDialog1.Action = 1Text1.Text = ""Open CommonDialog1.FileName For Input As #1Dim counter As IntegerDim workarea(25000) As StringProgressBar1.min = LBound(workarea) ProgressBar1.max = UBound(workarea) ProgressBar1.Visible = TrueProgressBar1.Value = ProgressBar1.minFor counter = LBound(workarea) To UBound(workarea) workarea(counter) = "initial value " & counter ProgressBar1.Value = counterNext counterDo While Not EOF(1)Line Input #1, inputdataText1.Text = Text1.Text + inputdata + vbCrLfLoopClose #1End SubPrivate Sub save_Click()CommonDialog1.FileName = "a.txt" CommonDialog1.DefaultExt = "txt" CommonDialog1.Action = 2Open CommonDialog1.FileName For Output As #1 Print #1, Text2.TextClose #1End Sub四、蝴蝶飞舞Private Sub Form_Load()Print "蝴蝶飞出窗体后重新定位到左下方再向右上方飞" End SubPrivate Sub Timer1_Timer()Static PickBmp As IntegerIf PickBmp = 0 ThenImage1.Picture = Image2.PicturePickBmp = 1ElseImage1.Picture = Image3.PicturePickBmp = 0End IfCall mymoveEnd SubSub mymove()Image1.Move Image1.Left + 40, Image1.Top - 25If Image1.Top <= 0 ThenImage1.Left = 0Image1.Top = 2325End IfEnd Sub图：五、文本编辑Private Sub Copy_Click()Clipboard.ClearClipboard.SetText RichTextBox1.SelTextEnd SubPrivate Sub Cut_Click()Clipboard.ClearClipboard.SetText RichTextBox1.SelTextRichTextBox1.SelText = ""End SubPrivate Sub Exit_Click()Form3.HideForm1.ShowEnd SubPrivate Sub Font_Click()CommonDialog1.Flags = cdlCFBoth Or cdlCFEffects CommonDialog1.Action = 4RichTextBox1.FontName = CommonDialog1.FontName RichTextBox1.FontSize = CommonDialog1.FontSize RichTextBox1.FontBold = CommonDialog1.FontBold RichTextBox1.FontItalic = CommonDialog1.FontItalic RichTextBox1.FontStrikethru = CommonDialog1.FontStrikethru RichTextBox1.FontUnderline = CommonDialog1.FontUnderline RichTextBox1.ForeColor = CommonDialog1.ColorEnd SubPrivate Sub Form_Load()Print "注："Print "1.'打开'对话框的初始文件夹应是所要打开文件所在的" Print "文件夹，将提供的xz.txt文件打开；"Print "2.要实现将选定的内容格式化，必须在工具箱中添加" Print "RichTextBox控件（Microsoft Rich Textbox Comtrol 6.0）" Print "并在帮助菜单中查阅其字体设置的相关属性。
vb小游戏制作
vb小游戏制作Vb制作小游戏一、射击游戏Option ExplicitDim RandX As SingleDim RandY As SingleDim Score As SingleDim Thisscore As SingleDim Average As SingleDim Shot As IntegerDim Appear As BooleanDim Distance As SinglePrivate Sub Command1_Click()Timer1.Enabled = TrueCommand3.Enabled = TrueIf Command1.Enabled = True Then Command3.Caption = "暂停"End IfCommand4.Enabled = TrueEnd SubPrivate Sub Command2_Click()If Command4.Enabled = True ThenMsgBox "请先结束游戏", 48, "警告"ElseEndEnd IfEnd SubPrivate Sub Command3_Click() Command1.Enabled = False Command3.Caption = "继续"Timer1.Enabled = Not Timer1.Enabled If Timer1.Enabled =True Then Command3.Caption = "暂停"End IfEnd SubPrivate Sub Command4_Click() Timer1.Enabled = FalseCommand3.Enabled = False Command1.Enabled = TruePicture1.ClsLabel1.Caption = "射击："Label2.Caption = "平均得分："Label3.Caption = "环数："Label4.Caption = "总分：" Command4.Enabled = FalseCommand3.Caption = "暂停"End SubPrivate Sub Form_Load()Appear = FalseTimer1.Enabled = FalseThisscore = 0Score = 0Shot = 0End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) BeepShot = Shot + 1Picture1.DrawWidth = 4Picture1.PSet (X, Y), RGB(255, 0, 0)Distance = Sqr((X - RandX) * (X - RandX) + (Y - RandY) * (Y - RandY))If Appear And Timer1.Enabled ThenThisscore = 5 - Int(Distance / 10)If Thisscore <= 0 ThenThisscore = 0End IfScore = Score + ThisscoreAverage = Int((Score / Shot) * 100) / 100Label1.Caption = "射击：" + Str(Shot) + "发"Label2.Caption = "平均得分：" & Format(Average, "0.00") & "环" Label3.Caption = "环数：" + Str(Thisscore) + "环"Label4.Caption = "总分：" + Str(Score) + "环"End IfEnd SubPrivate Sub Timer1_Timer()Dim i As IntegerAppear = Appear Xor TrueRandX = 500 * Rnd()RandY = 370 * Rnd()If Appear ThenForm1.Picture1.AutoRedraw = TruePicture1.DrawWidth = 1Picture1.DrawStyle = 0For i = 10 To 50 Step 10Picture1.Circle (RandX, RandY), i, RGB(0, 0, 255)Next iPicture1.Line (RandX - 60, RandY)-(RandX + 60, RandY) Picture1.Line (RandX, RandY - 60)-(RandX, RandY + 60) ElsePicture1.ClsEnd IfEnd Sub二、打飞机游戏从作一个小游戏开始指针本文从制作一个简单的小游戏开始，通过扩展这游戏，讲解VB多媒体，键盘控制与一些相关技术。
VB编程开发游戏的全过程！
VB编程开发游戏的全过程！大家好，今天我们共同来学习如何用VB编程来开发游戏。
VB编程，简单实用，功能强大，非常容易上手！贪吃蛇游戏贪吃蛇是一款经典的休闲游戏。
同时也是一款经典的益智游戏，有PC和手机等多平台版本。
既简单又耐玩。
该游戏通过控制蛇头方向吃蛋，从而使得蛇变得越来越长。
游戏运行图贪吃蛇游戏程序代码Option ExplicitOption Base 1Dim intEat As IntegerDim intNum As Integer '节数Dim intDirect() As Integer ' 每一节的运动方向Const GRID As Integer = 20Const GRID_NUM As Integer = 20Dim AppleX(5) As Integer, AppleY(5) As IntegerDim time_past As IntegerPublic restart As BooleanPrivate Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)Select Case KeyCodeCase 37 'leftIf intDirect(1) <> 0 Then intDirect(1) = enmLeftCase 38 'upIf intDirect(1) <> 1 Then intDirect(1) = enmUpCase 39 'rightIf intDirect(1) <> 2 Then intDirect(1) = enmRightCase 40 'downIf intDirect(1) <> 3 Then intDirect(1) = enmDownCase 13 '回车可以暂停Timer1.Enabled = Not Timer1.EnabledIf Not Timer1.Enabled ThenMe.Caption = '贪吃蛇（暂停）'Timer2.Enabled = FalseElseMe.Caption = '贪吃蛇（运行）'Timer2.Enabled = TrueEnd IfCase 33Timer1.Interval = Timer1.Interval - 20Case 34Timer1.Interval = Timer1.Interval + 20End SelectCall DrawEye '显示眼睛转弯'Print Height, WidthEnd SubPrivate Sub Form_Load()Dim i As IntegerCall OpenMazeCall OpenRecordPic.BackColor = lngBackColor'调整大小与位置Pic.Left = 20Pic.Top = 20Pic.Width = GRID * GRID_NUM + 6Pic.Height = GRID * GRID_NUM + 6Me.Width = (Pic.Left + Pic.Width + 20) * (Screen.TwipsPerPixelX)Me.Height = (Pic.Top + Pic.Height + 20 + 40) * (Screen.TwipsPerPixelY)'绘制格线linHor(1).X1 = 0linHor(1).X2 = GRID * GRID_NUMlinHor(1).Y1 = 0linHor(1).Y2 = 0linVer(1).X1 = 0linVer(1).X2 = 0linVer(1).Y1 = 0linVer(1).Y2 = GRID * GRID_NUMFor i = 2 To 21Load linHor(i)linHor(i).Y1 = (i - 1) * GRIDlinHor(i).Y2 = (i - 1) * GRIDLoad linVer(i)linVer(i).X1 = (i - 1) * GRIDlinVer(i).X2 = (i - 1) * GRIDlinHor(i).Visible = TruelinVer(i).Visible = TrueNextCall DrawMazeCall DrawSnakeCall ShowNumberAllEnd SubPrivate Sub mnuAbout_Click()MsgBox '贪吃蛇 Ver2.0' & Chr(13) & 'CopyRight By ABC.' & Chr(13) & '2003-07', 64, '版本说明'End SubPrivate Sub mnuExit_Click()Unload MeEnd SubPrivate Sub mnuHelphelp_Click()frmHelp.Show 1End SubPrivate Sub mnuNew_Click()Dim i As IntegerTimer1.Enabled = FalseTimer2.Enabled = FalseMe.Caption = '贪吃蛇（按回车键开始）'Pic.ClsPic.BackColor = lngBackColor'初始化，为新一轮作准备For i = intNum To 2 Step -1Unload shp(i)NextCall DrawMazeCall DrawSnakeCall ShowNumberAlltime_past = 0intNum = 5End SubPrivate Sub mnuPlayPause_Click() SendKeys '{ENTER}'End SubPrivate Sub mnuRecord_Click() frmRecord.Show 1End SubPrivate Sub mnuSetup_Click()Dim i As Integerrestart = FalsefrmSetup.Show 1, MeIf restart Then '如果改变设置,则重新开始Timer1.Enabled = FalseTimer2.Enabled = FalseMe.Caption = '贪吃蛇（按回车键开始）' Pic.ClsPic.BackColor = lngBackColor'初始化，为新一轮作准备For i = intNum To 2 Step -1Unload shp(i)NextCall DrawMazeCall DrawSnakeCall ShowNumberAlltime_past = 0intNum = 5End IfEnd SubPrivate Sub Timer1_Timer()Dim i As IntegerDim m As IntegerDim d As IntegerDim game_over As BooleanDim LastLeft As IntegerDim LastTop As IntegerDim LastDirect As DirectFor m = 1 To 5If Int(shp(1).Left / GRID) = AppleX(m) And Int(shp(1).Top / GRID) = AppleY(m) Then '如果吃到了数字intEat = intEat + mCall ShowNumber(m) '移动已吃数字Exit ForEnd IfNextLastLeft = shp(intNum).LeftLastTop = shp(intNum).TopLastDirect = intDirect(intNum)For i = 1 To intNum '蛇移动Select Case intDirect(i)Case 0shp(i).Left = shp(i).Left + GRIDIf shp(i).Left > 19 * GRID Then shp(i).Left = 0Case 1shp(i).Top = shp(i).Top + GRIDIf shp(i).T op > 19 * GRID Then shp(i).T op = 0Case 2shp(i).Left = shp(i).Left - GRIDIf shp(i).Left < 0 Then shp(i).Left = 19 * GRIDCase 3shp(i).Top = shp(i).Top - GRIDIf shp(i).T op < 0 Then shp(i).T op = 19 * GRIDEnd SelectNextDrawEye'传递运动方向For i = intNum To 2 Step -1intDirect(i) = intDirect(i - 1)NextIf intEat > 0 ThenintEat = intEat - 1intNum = intNum + 1Load shp(intNum)ReDim Preserve intDirect(intNum)shp(intNum).FillColor = vbYellowshp(intNum).Left = LastLeftshp(intNum).T op = LastTopshp(intNum).Visible = TrueintDirect(intNum) = LastDirectEnd IfIf Maze(shp(1).T op \ GRID + 1, shp(1).Left \ GRID + 1, curMaze) = 1 Then ' 如果遇到了障碍物,撞死game_over = TrueEnd IfIf Not game_over ThenFor i = 2 To intNumIf shp(1).Left = shp(i).Left And shp(1).Top = shp(i).Top Then '如果撞到自已，撞死game_over = TrueEnd IfNextEnd IfIf game_over Then '如果已撞死Timer1.Enabled = FalseTimer2.Enabled = FalseIf intNum > MazeInfo(4, curMaze) Then '如果超过程记录MazeName(2, curMaze) = InputBox('GAME OVER！' & Chr(10) & Chr(13) & '你的成绩为' & intNum & '分,用时' & time_past & '秒。
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
数字排序小游戏Option ExplicitDim Label2X As Integer '记录标签控件数组中要移动的标签控件左上角X的位置Dim Label2Y As Integer '记录标签控件数组中要移动的标签控件左上角Y的位置'让标签数组中的每个标签控件上显示的数字是随机的，无重复的Private Sub Init()RandomizeDim a(7) As IntegerDim i As Integer, k As IntegerLabel1.Caption = ""For i = 0 To 7a(i) = iNextFor i = 0 To 7k = Int(Rnd * 8)Do While a(k) = -1 'a(k)=-1表示该数组元素对应的数字已经被使用过了k = Int(Rnd * 8) '重新生成k的值，直到a(k)的值不等于-1LoopLabel2(i).Caption = Trim(Str(a(k)))a(k) = -1 'a(k)的值已经使用了，不能再用，重新赋值为-1与其他的元素值相区别Next iEnd SubPrivate Sub Command1_Click()Dim x As Integer, y As IntegerDim z As IntegerInitPicture1.Enabled = True'让空白标签Label1出现的位置随机Randomize'记录下空白标签Label1的位置x = Label1.Lefty = Label1.Topz = Int(Rnd * 8)'将空白标签Label1和标签控件数组任一控件交换位置Label1.Move Label2(z).Left, Label2(z).TopLabel2(z).Move x, yCommand1.Enabled = FalseEnd SubPrivate Sub Command2_Click()EndEnd SubPrivate Sub Form_Load()Dim i As IntegerPicture1.Enabled = False'在标签中显示游戏说明信息Label3.Caption = "如左图所示，将数字按0-7顺" & vbCrLf & vbCrLf & "序依次排列，即取得胜利。
"'在标签中显示排列规则后的数字顺序Label1.Caption = 0For i = 0 To 6Label2(i).Caption = i + 1NextEnd SubPrivate 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.LeftLabel1Y = 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) ThenLabel1.Move Label2X, Label2YSource.Move Label1X, Label1YEnd IfWinEnd SubPrivate 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).LeftLabel2Y = Label2(Index).TopLabel2(Index).Drag 1 '启动拖动操作End IfEnd SubPrivate Sub Label2_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) Label2(Index).Drag 2 '结束拖动操作End SubPrivate Sub Win()Dim winner As IntegerDim i As IntegerDim answer As Integer'对于给定的标签控件数组中的任一标签控件，可以落在符合要求(对应位置应显示对应数字）'的八个位置中的任一位置'利用循环语句对标签控件数组中的每个标签控件进行检查，如果其落在某一符号要求的位置，'则变量winner的值加1，如果所有标签控件都落在符号要求的位置，则变量winner的值应为8For i = 0 To 7If Label2(i).Left = 0 And Label2(i).Top = 0 And _Label2(i).Caption = 0 Thenwinner = winner + 1ElseIf Label2(i).Left = Label2(i).Width And Label2(i).Top = 0 And _Label2(i).Caption = 1 Thenwinner = winner + 1ElseIf Label2(i).Left = 2 * Label2(i).Width And Label2(i).Top = 0 And _Label2(i).Caption = 2 Thenwinner = winner + 1ElseIf Label2(i).Left = 0 And Label2(i).Top = Label2(i).Height And _Label2(i).Caption = 3 Thenwinner = winner + 1ElseIf Label2(i).Left = Label2(i).Width And Label2(i).Top = Label2(i).Height And _Label2(i).Caption = 4 Thenwinner = winner + 1ElseIf Label2(i).Left = 2 * Label2(i).Width And Label2(i).Top = Label2(i).Height And _Label2(i).Caption = 5 Thenwinner = winner + 1ElseIf Label2(i).Left = 0 And Label2(i).Top = 2 * Label2(i).Height And _Label2(i).Caption = 6 Thenwinner = winner + 1ElseIf Label2(i).Left = Label2(i).Width And Label2(i).Top = 2 * Label2(i).Height And _Label2(i).Caption = 7 Thenwinner = winner + 1End IfNext iIf winner = 8 ThenMsgBox " 恭喜您，胜利了！", 0 + 64 + 0, "提示"Picture1.Enabled = Falseanswer = MsgBox("还继续吗？", 4 + 32 + 0, "提示")If answer = vbYes ThenCommand1.Enabled = True ElseEndEnd IfEnd IfEnd Sub弹球游戏Dim x_step As IntegerDim y_step As IntegerPrivate Sub command1_Click()If Timer1.Enabled = True ThenTimer1.Enabled = FalseElseTimer1.Enabled = TrueEnd IfIf command1.Caption = "暂停" Thencommand1.Caption = "继续"Elsecommand1.Caption = "暂停"End IfEnd SubPrivate Sub Form_Load()x_step = 200y_step = 200End SubPrivate Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 37 ThenIf Line1.X1 < 0 ThenLine1.X1 = 0: Line1.X2 = 2000ElseLine1.X1 = Line1.X1 - 100: Line1.X2 = Line1.X2 - 100End IfEnd IfIf KeyCode = 39 ThenIf Line1.X1 > Picture1.Width ThenLine1.X1 = Picture1.Width - 2000: line2.X2 = Picture.WidthElseLine1.X1 = Line1.X1 + 100: Line1.X2 = Line1.X2 + 100End IfEnd IfEnd SubPrivate Sub Timer1_Timer()If Shape1.Top < 0 ThenShape1.Top = 0: y_step = -y_stepEnd IfIf Shape1.Left < 0 ThenShape1.Left = 0x_step = -x_stepEnd IfIf Shape1.Left > Picture1.Width - Shape1.Width ThenShape1.Left = Picture1.Width - Shape1.Widthx_step = -x_stepEnd IfIf Shape1.Left >= Line1.X1 And Shape1.Left <= Line1.X2 And Shape1.Top >= Line1.Y1 - Shape1.Height Then Shape1.Top = Line1.Y1 - Shape1.Heighty_step = -y_step * 1.01x_step = x_step * 1.01Label2.Caption = Label2.Caption + 1End IfShape1.Top = Shape1.Top + y_stepShape1.Left = Shape1.Left + x_stepIf Shape1.Top >= Picture1.Height - Shape1.Height ThenMsgBox "游戏结束"command1.Caption = "开始"Timer1.Enabled = FalseShape1.Top = 1000Label2.Caption = 0End IfEnd Sub打字游戏Dim score As IntegerDim speed As IntegerDim typetime As IntegerPrivate Sub init()Randomizelblletter1.Caption = Chr(Int(Rnd * 42) + 48) lblletter1.Left = Int(Rnd * 2800) + 1 lblletter1.Top = 0End SubPrivate Sub init1()Randomizelblletter2.Caption = Chr(Int(Rnd * 25) + 97) lblletter2.Left = Int(Rnd * 2800) + 1 lblletter2.Top = 0End SubPrivate Sub Command1_Click()score = Int(lblscore.Text)initinit1Timer1 = TrueTimer2 = TrueHScroll1.Enabled = FalseCommand1.Enabled = FalseCommand2.Enabled = FalseHScroll1.Enabled = FalseIf lbltime.Text <= 0 ThenTimer1 = FalseTimer2 = Falselblletter1.Caption = ""lblletter2.Caption = ""End IfEnd SubPrivate Sub Command2_Click()typetime = InputBox("请输入打字时间。