(完整版)vb小游戏代码

好玩的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游戏创意编程

任务：你准备用“两个物体的相遇”编写一
个什么样的游戏呢？请写出游戏规则。
接香蕉
。。。。。。
？
相遇
？
？
？
谢谢！
常用的游戏创意方法
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程序代码(简单小程序)

VB程序代码(简单小程序) Option Explicit
Private Sub btnCalculate_Click()
'按钮点击事件，计算两个数的和
'声明变量
Dim num1 As Double
Dim num2 As Double
Dim result As Double
'获取用户输入的数字
num1 = Val(txtNum1.Text)
num2 = Val(txtNum2.Text)
'计算和
result = num1 + num2
'将计算结果展示给用户
lblResult.Caption = "计算结果：" & result
End Sub
Private Sub Form_Load()
'窗体加载事件，初始化窗体
'设置窗体标题
Me.Caption = "简单计算器"
'设置标签的默认文本
lblNum1.Caption = "请输入第一个数："
lblNum2.Caption = "请输入第二个数："
lblResult.Caption = ""
如上所示，这是一个简单的VB程序，包含一个窗体和三个按钮，分别用于计算两个
数的和、清空所有输入框和标签的内容以及退出程序。

用户可以在两个文本框中输入数字，点击计算按钮后，程序会将两个数字相加并将结果展示给用户。

如果用户想重新计算，可
以点击清空按钮清除所有输入框和标签的内容，重新输入参数。

VB小程序代码

VB小程序代码VB小程序是使用Visual Basic语言编写的小型应用程序。

它可以在Windows操作系统上运行，并提供了丰富的图形用户界面和功能。

本文将详细介绍如何编写一个简单的VB小程序代码，并提供一些示例来帮助您更好地理解。

1. 程序结构一个VB小程序通常由以下几个部分组成：a) 引用：您可以引用其他程序集或库来扩展您的程序功能。

b) 命名空间：命名空间用于组织和管理程序中的类和对象。

c) 类：类是VB程序的基本构建块，它包含了变量、属性、方法和事件等成员。

d) 窗体：窗体是用户界面的容器，您可以在窗体上添加控件来实现交互功能。

2. 示例代码下面是一个简单的VB小程序代码示例，演示了如何创建一个窗体，并在窗体上添加一个按钮和一个文本框。

```vbImports System.Windows.FormsNamespace MyProgramPublic Class MainFormInherits FormPrivate WithEvents myButton As ButtonPrivate myTextBox As TextBoxPublic Sub New()myButton = New Button()myButton.Text = "点击我"myButton.Location = New Point(50, 50)myTextBox = New TextBox()myTextBox.Location = New Point(50, 100)Controls.Add(myButton)Controls.Add(myTextBox)End SubPrivate Sub MyButton_Click(sender As Object, e As EventArgs) Handles myButton.ClickmyTextBox.Text = "Hello, World!"End SubPublic Shared Sub Main()Application.Run(New MainForm())End SubEnd ClassEnd Namespace```3. 代码解析上述代码创建了一个名为`MainForm`的窗体类。

扫雷游戏设计代码(VB完善版)

扫雷游戏VB设计实现最终界面如下：显然只需完成三个窗体的设计即可，具体设计界面和代码如下：一、主窗体（form10）设计界面：主窗体（form10）的代码：Dim d(11, 11) As IntegerDim k As IntegerDim v(100) As Integer '定义全局变量'Private Sub Command1_Click(Index As Integer)Timer1.Enabled = True '当点击任意一个命令按钮时（即开始游戏），则启动计时器' i = Index \ 10 + 1j = Index Mod 10 + 1 '将二维数组的元素与命令按钮一一对应'If d(i, j) = 1 Then '判断是否点到地雷'Timer1.Enabled = False '关闭计时器,游戏结束'For i = 1 To 10For j = 1 To 10n = 10 * (i - 1)m = j - 1If d(i, j) = 1 ThenCommand1.Item(m + n).Picture = LoadPicture(App.Path & "\2.jpg") '在按钮上显示地雷图片'End IfForm1.Show '弹出子窗体1（判断输赢）'Next jNext iElseIf v(Index) = Index + 1 Then '判断是否插上红旗或是问号图片'Command1.Item(Index).Picture = LoadPicture() '清除图片'Command1.Item(Index).Caption = f(i, j) '调用函数，显示周围地雷数'Command1.Item(Index).Enabled = False '将按钮设为不可用'Label7.Caption = Val(Label7.Caption) + 1v(Index) = 0End Ifh = s(i, j) '调用函数，显示周围的情况（边界）'For Y = 0 To 99If v(Y) = Y + 1 ThenCommand1.Item(Y).Enabled = True '如果是按钮插上了红旗则将按钮设置为可用'End IfNext YEnd IfFor k = 0 To 99If Command1.Item(k).Enabled = False Thenp = p + 1 '统计扫过的按钮个数'If p = 90 ThenFor Y = 0 To 100v(Y) = 0Next Y '将数组v的元素重新置0（此步目的为实现重玩而设）'Form2.Show '如果等于90个则结束游戏，弹出子窗体2（赢了）'End IfEnd IfNext kEnd SubPrivate Sub Command1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)If Button = 2 Then '右击鼠标'If v(Index) <> Index + 1 Then '判断是否已插上红旗'Command1.Item(Index).Picture = LoadPicture(App.Path & "\1.jpg") '插上红旗'v(Index) = Index + 1 '给数组元素赋值，以此实现按钮图片的切换或显示状态'Label7.Caption = Val(Label7.Caption) - 1 '在标签7中显示插上的红旗个数'ElseCommand1.Item(Index).Picture = LoadPicture(App.Path & "\3.jpg") '将问号图片替换红旗'Label7.Caption = Val(Label7.Caption) + 1v(Index) = 0End IfEnd IfFor i = 1 To 10For j = 1 To 10If d(i, j) = 1 Thenn = 10 * (i - 1)m = j - 1If v(m + n) = m + n + 1 Then c = c + 1If c = 10 ThenFor Y = 0 To 100v(Y) = 0Next Y '将数组v的元素重新置0（此步目的为实现重玩而设）'Form2.Show '如果等于90个则结束游戏，弹出子窗体2（赢了）'End IfEnd IfNext jNext iEnd SubPrivate Sub Form_Load()k = 0For i = 1 To 10For j = 1 To 10d(i, j) = 0 '将数组元素置0'Next jNext iDo While n <> 10Randomizei = Int(10 * Rnd + 1)j = Int(10 * Rnd + 1)If d(i, j) = 0 Then d(i, j) = 1: n = n + d(i, j) '产生十个随机数，即相当于十个地雷'Loopbel7.Caption = 10bel2.Caption = 0bel3.Caption = 0End SubFunction f(i, j) '定义一个函数求一个区域周围地雷的个数'f = f + d(i - 1, j - 1) + d(i - 1, j) + d(i - 1, j + 1) + d(i, j - 1)f = f + d(i, j + 1) + d(i + 1, j - 1) + d(i + 1, j) + d(i + 1, j + 1)End FunctionFunction s(i, j) '定义一个函数显示点击区域周围的情况（即边界）' For Y = 0 To 100If v(Y) = Y + 1 ThenCommand1.Item(Y).Enabled = False '如插上了红旗，则将按钮先设为不可用'End IfNext YIf f(i, j) <> 0 Then '函数嵌套，调用函数判断周围是否无地雷'n = 10 * (i - 1)m = j - 1Command1.Item(m + n).Picture = LoadPicture()Command1.Item(n + m).Caption = f(i, j)Command1.Item(n + m).Enabled = False '清除图片，显示地雷数，设置按钮不可用'ElseFor a = i - 1 To i + 1For b = j - 1 To j + 1If a <> 0 And b <> 11 And a <> 11 And b <> 0 Thenn = 10 * (a - 1)m = b - 1If Command1.Item(n + m).Enabled = True ThenCommand1.Item(m + n).Picture = LoadPicture()Command1.Item(n + m).Caption = f(a, b)Command1.Item(n + m).Enabled = False '清除图片，显示地雷数，设置按钮不可用'h = s(a, b) '调用函数本身，即实现递归'End IfEnd IfNext bNext aEnd IfEnd FunctionPrivate Sub Timer1_Timer() '设计一个计时器'Label2.Caption = Val(Label2.Caption) + 1Label3.Caption = Val(Label2.Caption) \ 60 + Val(Label3.Caption)Label2.Caption = Val(Label2.Caption) Mod 60End Sub二、子窗体一（form1）界面如下：子窗体一（form1）的代码：Private Sub Command1_Click()Unload Form10Unload form1Form10.ShowEnd SubPrivate Sub Command2_Click()Unload Form10Unload form1End SubPrivate Sub Command3_Click()For i = 0 To 99mand1.Item(i).Picture = LoadPicture() mand1.Item(i).Caption = ""mand1.Item(i).Enabled = TrueNext ibel7.Caption = 10bel2.Caption = 0bel3.Caption = 0Unload form1End Sub三、子窗体（form2）界面如下：子窗体二（form2）的代码：Private Sub Command1_Click()Unload Form10Form10.ShowUnload form2End SubPrivate Sub Command2_Click()Unload Form10Unload form2End SubPrivate Sub Command3_Click()For i = 0 To 99mand1.Item(i).Picture = LoadPicture()mand1.Item(i).Caption = ""mand1.Item(i).Enabled = TrueNext iUnload form2bel7.Caption = 10bel2.Caption = 0bel3.Caption = 0End Sub注释：共三个窗体（这里是form10、form1、form2）、三个标签（这里是label2、label3、label7）设计时，根据具体的情况对应修改即可。

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小程序代码

s = Round(Sqr(x * (x - a) * (x - b) * (x - c)), 2)
'round()返回一个数值，该数值是按照指定的小数位数进行四舍五入运算的结果。
'否则的话，结果是一大串的
S3 = s
End If
End Function
�
谢谢大家，明天早上7。50前要的！
2/
Dim a(1 To 20), b(1 To 20), c(1 To 20)
x = 0: y = 0
Show
For i = 1 To 20
Randomize
a(i) = Int(90 * Rnd + 10)
Next i
For i = 1 To 20
Next i
For i = 1 To y
Label2.Caption = Label2.Caption + Str(c(i)) + " "
Next i
3.编写一个由三角形三边求三角形面积S的过程（特别是编写的内容）谢谢。
'已经三边，计算三角形面积
Function S3(a Double
If a = 0 Or b = 0 Or c = 0 Then
check = False
ElseIf a + b < c Or a + c < b Or b + c < a Then
check = False
Else
check = True
End If
If check = True Then
'参数:a,b,c 三角形的三条边

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制作小游戏一、射击游戏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初学者,属原创作品图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小程序源代码

Private Sub Command1_Click()Clipboard.SetText Text1.SelTextEnd SubPrivate Sub Command2_Click()Text2.SelText = Clipboard.GetTextEnd Sub上海问题Private Sub Command1_Click()If Option3.Value = True ThenText1 = "You are right"ElseText1 = "You are wrong"End IfEnd Sub中心问题Private Sub Form_Resize()Command1.Left = (Form1.ScaleWidth - Command1.Width) / 2 Command1.Top = (Form1.ScaleHeight - Command1.Height) / 2 Command1.Width = 0.2 * Form1.ScaleWidthEnd Sub曲线问题Private Sub Form_Paint()Scale (0, 0)-(3000, 3000)Form1.DrawWidth = 5Form1.ForeColor = RGB(255, 0, 0)Line (0, 1500)-(3000, 1500)Line (1500, 0)-(1500, 3000)Circle (1500, 1500), 35For x = 0 To 3000y = 1500 - 200 * (Sin((x - 1500) * 3.1415926 / 180)) PSet (x, y)Next xEnd Sub查找Private Sub Command1_Click()a = InStr(1, Text1, Text2)Text1.SelStart = a - 1Text1.SelLength = Len(Text2)Text1.SetFocusPrivate Sub Text1_Change() End Sub改变字体Private Sub Check1_Click() If Check1.Value = 1 Then = "隶书" Else = "宋体" End IfEnd SubPrivate Sub Check2_Click() If Check2.Value = 1 ThenText1.Font.Bold = True ElseText1.Font.Bold = FalseEnd IfEnd SubPrivate Sub Check3_Click() If Check3.Value = 1 ThenText1.Font.Italic = True ElseText1.Font.Italic = False End IfEnd SubPrivate Sub Check4_Click() If Check4.Value = 1 ThenText1.ForeColor = vbRed ElseText1.ForeColor = vbBlueEnd IfEnd Sub同步Private Sub Text1_Change() Text2 = Text1.TextEnd SubPrivate Sub Text2_Change() Text1 = Text2.TextEnd SubSin函数Private Sub Form_Paint()Scale (0, 0)-(2000, 2000)PSet (1000, 1000)Line (1000, 0)-(950, 50)Line (1050, 50)-(1000, 0)Line (1950, 950)-(2000, 1000)Line (1950, 1050)-(2000, 1000)Line (0, 1000)-(2000, 1000)Line (1000, 0)-(1000, 2000)Circle (1000, 1000), 50For x = 0 To 2000y = 1000 - 300 * (Sin((x - 1000) * 3.1415926 / 180)) PSet (x, y)Next xEnd Sub考试程序Private Sub Command1_Click()If Option3.Value = True ThenText1 = "正确"ElseText1 = "错误"End IfEnd SubPrivate Sub Form_Load()End Sub复制粘贴查找替换Private Sub Command1_Click()Clipboard.SetText Text1.SelTextEnd SubPrivate Sub Command2_Click()Text2.SelText = Clipboard.GetTextEnd SubPrivate Sub Command3_Click()a = InStr(1, Text1, Text3)Text1.SelStart = a - 1Text1.SelLength = Len(Text3)Text1.SetFocusEnd SubPrivate Sub Command4_Click()Text1.SelText = Text4End Sub图片路径Private Sub Dir1_Change()File1.Path = Dir1.PathEnd SubPrivate Sub Drive1_Change()Dir1.Path = Drive1.DriveEnd SubPrivate Sub File1_Click()Picture1.Picture = LoadPicture(File1.Path + File1.FileName) End SubPrivate Sub Form_Load()End Sub改变字体颜色Private Sub Check1_Click()If Check1.Value = 1 Then = "隶书"Else = "宋体"End IfEnd SubPrivate Sub Check2_Click()If Check2.Value = 1 ThenText1.Font.Bold = TrueElseText1.Font.Bold = FalseEnd IfEnd SubPrivate Sub Check3_Click()If Check3.Value = 1 ThenText1.Font.Italic = TrueElseText1.Font.Italic = FalseEnd IfEnd SubPrivate Sub Check4_Click()If Check4.Value = 1 ThenText1.ForeColor = vbRedElseText1.ForeColor = vbBlackEnd IfEnd SubPrivate Sub Form_Load()End SubPrivate Sub Text1_Change()End Sub兴趣选择Private Sub Command1_Click()Text1 = ""If Check1.Value = 1 ThenText1 = Text1 & Check1.CaptionEnd IfIf Check2.Value = 1 ThenText1 = Text1 & Check2.CaptionEnd IfIf Check3.Value = 1 ThenText1 = Text1 & Check3.CaptionEnd IfIf Check4.Value = 1 ThenText1 = Text1 & Check4.CaptionEnd IfEnd SubPrivate Sub Form_Load()End Sub1.求三角形的面积代码：Option ExplicitDim a!,b!,c!r,!,s!Private Sub Command1_Click()a = InputBox("a=", "请输入a的数值")b = InputBox("b=", "请输入b的数值")c = InputBox("c=", "请输入c的数值")If a + b > c And a + c > b And b + c > a And a > 0 And b > 0 And c > 0 Then r = 1 / 2 * (a + b + c)s = Sqr(r * (r - a) * (r - b) * (r - c))Label1.Caption = "三角形的面积为" & sElseLabel2.Caption = "输入的数据不能构成三角形"End IfEnd 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编写各种趣味小程序（附代码）一、鸟巢绘制二、加密三、解密四、蝴蝶飞舞五、文本编辑六、统计七、小球跳动八、计算器（彩票摇奖）九、学生信息录入十、矩阵转置十一、带有进度条的倒计时程序十二、加减乘除随机数题十三、计算器十四、抽奖一、鸟巢绘制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小程序是一种基于Visual Basic语言开辟的应用程序，它可以在Windows 操作系统上运行。

本文将为您提供一个VB小程序代码实例，匡助您了解如何编写和运行一个简单的VB小程序。

代码实例如下：```vbImports SystemPublic Class HelloWorldPublic Shared Sub Main()Console.WriteLine("Hello, World!")Console.ReadLine()End SubEnd Class```上述代码是一个经典的“Hello, World!”程序，它会在控制台输出一条问候语，并等待用户按下回车键。

下面是代码解释：- `Imports System`：这个语句告诉编译器我们将使用System命名空间中的类和方法。

- `Public Class HelloWorld`：这是一个公共类的声明，类名为HelloWorld。

- `Public Shared Sub Main()`：这是程序的入口点，它是一个公共静态方法，程序从这里开始执行。

- `Console.WriteLine("Hello, World!")`：这行代码会在控制台输出一条问候语。

- `Console.ReadLine()`：这行代码会等待用户按下回车键，以便程序暂停执行。

您可以将上述代码复制到一个文本编辑器中，并将文件保存为`.vb`扩展名。

然后，使用VB编译器将其编译为可执行文件，并在Windows操作系统上运行。

这个简单的VB小程序只是一个入门示例，您可以根据自己的需求和兴趣编写更复杂的VB小程序。

VB语言具有丰富的特性和功能，可以用于开辟各种类型的应用程序，包括图形用户界面（GUI）应用程序、数据库应用程序、Web应用程序等。

希翼这个VB小程序代码实例能够匡助您入门VB编程，并为您今后的学习和开辟提供一些参考。