您的位置：360文档中心› vb小游戏代码

vb小游戏代码

合集下载

用VB编写一个水果机博彩小游戏教程

用VB编写一个水果机博彩小游戏教程

用VB编写一个苹果机博彩小游戏教程（含源码）首先看一下整体运行效果图：程序实现了投币、下注、运行、计算是否得分的整个过程。

本人原创教程，非专业编程人员，爱好，希望多交流。

程序代码非常简单，难免有的代码不专业，图标资源请自行收集。

本教程适合刚入门的朋友看看，以便提高你学习VB的兴趣！教程开始：首先，本程序是在VB6上编写的。

要编写一个苹果机游戏，首先我们要看看苹果机的运行过程，虽然我们看不到真正街机苹果机的源码，但我们可以通过观察，大概模仿一下他的运行效果。

首先，苹果机的整个过程大致为：投币、下注、启动、象跑马机一样运行几圈、出结果。

当然，苹果机的真机还有更加丰富的功能，比如赚到的点数还可以赌大小，跑到ONCE MORE还可以赌运气这些增加刺激的功能，还有通过内部设定来平衡输赢概率这些都在影响着它的运行。

而我们本次学习，只在模仿一下他的简单运行过程，并不涉及设定输赢概率的制作，但我提供了开发这些功能的一些东西，你接着往下看吧。

有了流程，我们就可以设计了。

一、首先要设计界面。

我们打开VB6，然后新建一个工程，把工程界面的宽度和高度作适当调整，然后按照下图开始制作界面：先来认识一下VB左边菜单中我们本次要用到的控件，一共就5种，简单吧。

相信初学者也知道这些控件用来做什么的，为了顾全大局，我还是说一下吧。

Label标签是用来显示文字提示信息的，用他可以显示文本内容。

按钮不用说了吧，就是用来点击执行命令用的。

Timer控件是用来在设定的周期内循环执行程序用的。

线段在我们这里是用来作边框用的。

Image图片控件是用来显示图片用的。

需要什么控件，只需要在控件菜单中点击这个控件，然后拖动他到程序界面里适当位置放下即可。

开始设计界面了，首先这个工程界面的背景是灰色的，我们需要改变为白色，你觉得白色不好看也可以改其他颜色。

点击工程界面的任何空白位置，右边属性菜单将显示Form1的属性，在里面找到第三项：BackColor，将其值选为白色即可。

好玩的vbs代码

好玩的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小游戏代码

(完整版)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游戏编程

vb游戏编程
Const BT = 3000 '跑道底部的y坐标
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编的编写实例教程大全全!

小时候经典游戏用VB编的编写实例教程大全全!

这些游戏以前玩过吧，快下载看它们是怎么编写的！目录：·编写趣味撞球小游戏·用VB6.0设计简易赛车游戏·Visual Basic小游戏：猜英雄·VB游戏写作技巧（1）秀图篇·VB游戏写作技巧（2）网络篇·VB 贪吃蛇单人版游戏(一)·VB 贪吃蛇单人版游戏(二)·VB 贪吃蛇单人版游戏(三)·VB 贪吃蛇单人版游戏(四)·用VB开发即时战略游戏正文：编写趣味撞球小游戏文章来源：沐风经典文章作者：佚名Visual Basic是一个功能强大的工具，它有一大特点就是易学易用，下面我们就通过写一个“趣味撞球”的程序来初步体会一下。

首先启动VB5，新建一个标准的EXE工程。

此时可以看到，工程包括一个Form1框体。

在Form1边框的右下角按住鼠标左键不放，拖动鼠标把Form1的面积改为适当大小，比如6930×4320。

再在属性框中把Form1的ScaleMode 属性改为3－Pixel，表明我们将以像素为我们的坐标计算单位，把Form1的StartUpPosition 属性设为2－CenterScreen，使运行时窗体出现在屏幕正中。

现在，在控件面板上选取CommandButton（命令按钮）控件，为Form1添加Command1和Command2两个按钮控件，把它们的大小设为121×25，再在属性框中把Command1的Caption填为“＆GO”，把Command2的Caption填为“＆QUIT”，并把Command1放到框体的右上角，把Command2放到框体的右下角。

然后，在控件面板上选取Timer（时钟）控件，为Form1添加一个Timer1时钟控件。

再在属性框中把它的Enabled属性改为False，Interval属性改为50，前一个值表示该时钟控件是否激活，后一个值决定该时钟控件产生Timer事件的间隔时间，我们将用它来控制小球的移动频率。

VB编写猜数字小游戏教程

VB编写猜数字小游戏教程

VB编写猜数字小游戏傻瓜教程本人原创，只在百度文库发布，希望对想学习VB的朋友有所帮助，提高学习VB的兴趣。

本文以VB6为例介绍编写一个最简单的猜数字小游戏过程，VB6在百度上很容易搜索到，本文所需要控件极少，安装一个大小只有6MB的VB6精简版就可以体验了。

不敢说“抛砖引玉”，只怕抛个小砖换来个板儿砖。

总之，本文重点不是从零开始学VB，主要是介绍编写这个小游戏的过程。

首先，启动VB，然后点击文件菜单，点击新建一个工程，即可出现如下界面。

按照下图红色箭头的指向，鼠标在左侧工具条上拖一个文本标签、一个文本输入框、一个按钮到工程界面里边来，然后调整大小和位置大概跟下图比例差不多就行了。

接着，点击label标签，在右边属性窗口里调整字体大小为三号字，因为默认的字体太小了，不爽。

什么？三号字还小？那你自己看着办吧，但我可要告诉你哦，等下显示的内容超出显示区域可别怪我。

改好了吗？本次编程就这三个控件，菜吧？现在双击工程界面的空白区域，不要点在控件上了哦。

双击空白区域后，就弹出了代码编写窗口。

按照下图把代码一个一个给我打上去。

都好几分钟了，打上去了吗？哦，忘了告诉你，复制下面的代码也是一样的。

代码：Dim cai As Integer '定义一个变量用来存储欲猜的数字Private Sub Form_Load()Randomize '重设随机因子Label1.Caption = "请填入你猜测的数字" '让label1显示为空Text1.T ext = "" '让text1文本显示为空Command1.Caption = "确定" '让command1显示为"确定"cai = Int(Rnd * 899) + 100 '随机选择一个三位数作为欲猜的数字End Sub以上代码都做了注释，就不需要过多说明了。

VB扫雷小游戏编程代码

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编写的课堂随机点名小程序代码

随机点名系统。

综合网上各类小程序，自己修改定制了一款新的小程序。

学生名单.txt 放在同一个目录中。

使用截图如下Private Declare Sub SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)'定义常量Const HWND_TOPMOST = -1 'On TopConst HWND_NOTOPMOST = -2 'No TopConst SWP_NOACTIV A TE = &H10 'Const SWP_SHOWWINDOW = &H40 ''Dim TopOn As IntegerDim ss, mm, nnDim num(1 To 300) As IntegerDim j, k As IntegerDim A(500) As String, r As IntegerDim filename As StringPrivate Sub Command1_Click()Dim b As StringDim t, i As Integerfilename = App.Path & "\" & "学生名单.txt" Open filename For Input As #1'产生记录总数以内的随机数xi = 1While Not EOF(1)Line Input #1, A(i)i = i + 1Wendc = iClose #1Start:Randomizet = Int(c * Rnd + 1)For j = 1 To cIf t = num(j) ThenGoTo StartEnd IfNextLabel1.Caption = A(t)k = k + 1num(k) = tIf k = c ThenMsgBox "所有人员均已点过！", vbSystemModal Command1.Enabled = FalseCommand3.Enabled = TrueEnd IfEnd SubPrivate Sub Command2_Click()Unload Form1End SubPrivate Sub Command3_Click()j = 0k = 0For i = 1 To 300num(i) = 0NextCommand3.Enabled = FalseCommand1.Enabled = TrueLabel1.Caption = "Name"End SubPrivate Sub Command4_Click()Timer1.Enabled = TrueCommand4.Enabled = FalseEnd SubPrivate Sub Data1_Validate(Action As Integer, Save As Integer) End SubPrivate Sub Form_load()Form1.Height = 500Form1.Width = 8550Command3.Enabled = FalseTimer1.Enabled = Falsemm = 45: ss = 0Timer1.Interval = 1000End SubPrivate Sub Timer1_Timer()Dim M As IntegerSetWindowPos Me.hwnd, HWND_TOPMOST, Me.Left / 15, _Me.Top / 15, Me.Width / 15, _Me.Height / 15, SWP_NOACTIV ATE Or SWP_SHOWWINDOW Line1:If ss < 10 Thens = "0" & ssElses = ssEnd IfIf mm < 10 Thenmmm = "0" & mmElsemmm = mmEnd Ift = mmm & ":" & sLabel2.Caption = tss = ss - 1If nn = 3 Thenss = 88End IfIf mm = 0 And ss = -1 And nn = 0 ThenMsgBox "休息时间已到，五分钟后继续", vbSystemModalnn = 1mm = 5: ss = 0GoTo Line1End IfIf mm = 0 And ss = -1 And nn = 1 ThenMsgBox "继续上课", vbSystemModalnn = 2mm = 45: ss = 0GoTo Line1End IfIf mm = 0 And ss = -1 And nn = 2 ThenMsgBox "放学咯！", vbSystemModalCommand1.Enabled = Falsenn = 3mm = 88: ss = 88End IfIf ss = -1 And mm > 0 Then mm = mm - 1: ss = 59If mm = 0 And hh > 0 Then hh = hh - 1: mm = 59 End Sub。

VB编写猜数字小游戏教程

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游戏小程序代码人人都会用的 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编的编写实例教程大全全!

这些游戏以前玩过吧，快下载看它们是怎么编写的！目录：·编写趣味撞球小游戏·用VB6.0设计简易赛车游戏·Visual Basic小游戏：猜英雄·VB游戏写作技巧（1）秀图篇·VB游戏写作技巧（2）网络篇·VB 贪吃蛇单人版游戏(一)·VB 贪吃蛇单人版游戏(二)·VB 贪吃蛇单人版游戏(三)·VB 贪吃蛇单人版游戏(四)·用VB开发即时战略游戏正文：编写趣味撞球小游戏文章来源：沐风经典文章作者：佚名Visual Basic是一个功能强大的工具，它有一大特点就是易学易用，下面我们就通过写一个“趣味撞球”的程序来初步体会一下。

首先启动VB5，新建一个标准的EXE工程。

此时可以看到，工程包括一个Form1框体。

在Form1边框的右下角按住鼠标左键不放，拖动鼠标把Form1的面积改为适当大小，比如6930×4320。

再在属性框中把Form1的ScaleMode 属性改为3－Pixel，表明我们将以像素为我们的坐标计算单位，把Form1的StartUpPosition 属性设为2－CenterScreen，使运行时窗体出现在屏幕正中。

现在，在控件面板上选取CommandButton（命令按钮）控件，为Form1添加Command1和Command2两个按钮控件，把它们的大小设为121×25，再在属性框中把Command1的Caption填为“＆GO”，把Command2的Caption填为“＆QUIT”，并把Command1放到框体的右上角，把Command2放到框体的右下角。

然后，在控件面板上选取Timer（时钟）控件，为Form1添加一个Timer1时钟控件。

再在属性框中把它的Enabled属性改为False，Interval属性改为50，前一个值表示该时钟控件是否激活，后一个值决定该时钟控件产生Timer事件的间隔时间，我们将用它来控制小球的移动频率。

VB实现贪吃蛇小游戏

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代码解析

打地鼠类小游戏VB代码解析
窗体的美术效果很重要我在网上找到一个很好看的游戏窗体form1背景图1我们说一下窗体form1的属性设置属性中的picture设为已经找好的背景图片窗体form1的大小应当和背景图一样大才好其它的取默认值就可以了2现在我们开始在form1窗体的相应位置放置花瓶图像在窗体上放置图像框控件image1然后拷贝粘贴变成一个控件组包括十二个图像框控件image10image111image10image111控件的picture的属性为
Private Sub Image1_Click(Index As Integer)
For i = 0 To 11
If Image1(i) = Image2 Then
Image1(i) = Image3
f = f + 10
Call Image2_Click
Else
Call Image3_Click
Call Image2_Click
End If
i = i + 1
Next i
= hp
= a
= f
End Sub
Private Sub Image2_Click()
a = 10
= True
i = Int(Rnd * 12)
If i = 0 Then Image1(0) = Image2
If i = 1 Then Image1(1) = Image2
二、此刻咱们开始在Form1窗体的相应位置放置花瓶图像，在窗体上放置图像框控件Image1，然后拷贝、粘贴变成一个控件组，包括十二个图像框控件Image1(0)-----------Image1(11)，
Image1(0)-------------------Image1(11)控件的picture的属性为：

vb代码大全

vb代码大全

'贪吃蛇游戏全代码，创建个新工程直接复制到代码编辑窗口就行'按F5看看效果如何'要Exe文件，就点文件->生成工程1.exeOption ExplicitPrivate WithEvents Timer1 As TimerPrivate WithEvents Label1 As LabelDim GFangXiang As BooleanDim HWB As SingleDim She() As ShenTiDim X As Long, Y As LongDim ZhuangTai(23, 23) As LongPrivate Type ShenTiF As LongX As LongY As LongEnd TypePrivate Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Dim C As LongIf KeyCode = 27 Then EndIf KeyCode = 32 ThenIf Timer1.Enabled = True ThenTimer1.Enabled = FalseLabel1.Visible = TrueElseTimer1.Enabled = TrueLabel1.Visible = FalseEnd IfEnd IfC = UBound(She)If GFangXiang = True Then Exit Sub Select Case KeyCodeCase 37If She(C).F = 2 Then Exit SubShe(C).F = 0GFangXiang = TrueCase 38If She(C).F = 3 Then Exit SubShe(C).F = 1GFangXiang = TrueCase 39If She(C).F = 0 Then Exit SubShe(C).F = 2GFangXiang = TrueCase 40If She(C).F = 1 Then Exit SubShe(C).F = 3GFangXiang = TrueEnd SelectEnd SubPrivate Sub Form_Load()Me.AutoRedraw = TrueMe.BackColor = &HC000&Me.FillColor = 255Me.FillStyle = 0Me.ScaleWidth = 24Me.ScaleHeight = 24Me.WindowState = 2Set Timer1 = Controls.Add("VB.Timer", "Timer1")Set Label1 = Controls.Add("bel", "Label1")Label1.AutoSize = TrueLabel1.BackStyle = 0Label1 = "暂停"Label1.ForeColor = RGB(255, 255, 0)Label1.FontSize = 50ChuShiHuaEnd SubPrivate Sub Form_Resize()On Error GoTo 1:With MeIf .WindowState <> 1 Then.Cls.ScaleMode = 3HWB = .ScaleHeight / .ScaleWidth.ScaleWidth = 24.ScaleHeight = 24Label1.Move (Me.ScaleWidth - Label1.Width) / 2, (Me.ScaleHeight - Label1.Height) / 2 HuaTuMe.Line (X, Y)-(X + 1, Y + 1), RGB(255, 255, 0), BFEnd IfEnd With1:End SubPrivate Sub Timer1_Timer()Dim C As Long, I As LongOn Error GoTo 2:QingChuC = UBound(She)Select Case She(C).FCase 0If ZhuangTai(She(C).X - 1, She(C).Y) = 2 ThenC = C + 1ReDim Preserve She(C)She(C).F = She(C - 1).FShe(C).X = She(C - 1).X - 1She(C).Y = She(C - 1).YChanShengShiWuGoTo 1:ElseIf ZhuangTai(She(C).X - 1, She(C).Y) = 1 Then GoTo 2:End IfCase 1If ZhuangTai(She(C).X, She(C).Y - 1) = 2 ThenC = C + 1ReDim Preserve She(C)She(C).F = She(C - 1).FShe(C).X = She(C - 1).XShe(C).Y = She(C - 1).Y - 1ChanShengShiWuGoTo 1:ElseIf ZhuangTai(She(C).X, She(C).Y - 1) = 1 Then GoTo 2:Case 2If ZhuangTai(She(C).X + 1, She(C).Y) = 2 ThenC = C + 1ReDim Preserve She(C)She(C).F = She(C - 1).FShe(C).X = She(C - 1).X + 1She(C).Y = She(C - 1).YChanShengShiWuGoTo 1:ElseIf ZhuangTai(She(C).X + 1, She(C).Y) = 1 Then GoTo 2:End IfCase 3If ZhuangTai(She(C).X, She(C).Y + 1) = 2 ThenC = C + 1ReDim Preserve She(C)She(C).F = She(C - 1).FShe(C).X = She(C - 1).XShe(C).Y = She(C - 1).Y + 1ChanShengShiWuGoTo 1:ElseIf ZhuangTai(She(C).X, She(C).Y + 1) = 1 Then GoTo 2:End IfEnd SelectZhuangTai(She(0).X, She(0).Y) = 0For I = 0 To CSelect Case She(I).FShe(I).X = She(I).X - 1Case 1She(I).Y = She(I).Y - 1Case 2She(I).X = She(I).X + 1Case 3She(I).Y = She(I).Y + 1End SelectNextTiaoZheng1:GFangXiang = FalseZhuangTai(She(C).X, She(C).Y) = 1HuaTuExit Sub2:If MsgBox("游戏结束，点“是”重新开始游戏，点“否”", vbYesNo, "贪吃蛇") = vbYes Then ChuShiHuaElseEndEnd IfEnd SubPrivate Sub ChuShiHua()Me.ClsTimer1.Enabled = TrueTimer1.Interval = 200Erase ZhuangTaiReDim She(2)She(0).F = 2She(0).X = 9She(0).Y = 11ZhuangTai(9, 11) = 1She(1).F = 2She(1).X = 10She(1).Y = 11ZhuangTai(10, 11) = 1She(2).F = 2She(2).X = 11She(2).Y = 11ZhuangTai(11, 11) = 1HuaTuChanShengShiWuEnd SubPrivate Sub QingChu()Dim I As LongFor I = 0 To UBound(She)Me.Line (She(I).X, She(I).Y)-(She(I).X + 1, She(I).Y + 1), Me.BackColor, BF NextEnd SubPrivate Sub HuaTu()Dim I As LongFor I = 0 To UBound(She)Me.Circle (She(I).X + 0.5, She(I).Y + 0.5), 0.49, RGB(255, 255, 0), , , HWB NextEnd SubPrivate Sub TiaoZheng()Dim I As LongFor I = 0 To UBound(She) - 1She(I).F = She(I + 1).FNextEnd SubPrivate Sub ChanShengShiWu()Randomize Timer1:X = Int(Rnd * 24)Y = Int(Rnd * 24)If ZhuangTai(X, Y) > 0 Then GoT o 1:ZhuangTai(X, Y) = 2Me.Line (X, Y)-(X + 1, Y + 1), RGB(255, 255, 0), BF End Sub。

猜数字游戏的VB程序代码

猜数字游戏的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编写各种趣味小程序(附代码)

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编程详解1

贪吃蛇VB编程详解1

VB编程有点象搭积木，一个游戏可以由几个小程序组成，然后通过特定的方式联系在一起。

玩贪吃蛇游戏时，注意到游戏主要由以下几部分做法组成：1．随机出现的食物的做法食物的颜色是随机出现，食物为一个小圆，外面的外框线是黑色的2．食物吃掉的做法3．蛇死时的闪动的做法4．蛇身加长的做法5．键盘控制按钮控制蛇运行的做法6．蛇头和蛇身的画法蛇头为圆形，有外框线，蛇身为方形，颜色是随机的，有外框线我找到了一个贪吃蛇的VB代码，仔细的把这个贪吃蛇代码根据以上几部分分解开来，就象把一个搭好的积木城堡又重新拆解成一块块的积木。

1．1课程设计该小游戏的描述1．2课程设计小游戏要求随机出现的食物的做法食物的颜色是随机出现，食物为一个小圆，外面的外框线是黑色的要在对游戏的原理进行深入分析的基础上，利用图形控件（shape & Line）设计该款游戏2．课程作业报告内容2．1 在VB应用程序里设计好小游戏（VB动画）窗口，共有控件如下：2．2控件的属性Form1：默认值，宽度和高度尺寸适中Shape1：表示食物，设为一个带颜色和轮廓线的圆形物体，BorderColor即轮廓线设为黑色，FillColor为填充的颜色，在调色板中选择一种颜色即可。

FillStyle填充样式设为0-Solid，Shape形状设为3-Circle。

Line1：为水平线，X1为0，X2和Form1的宽度一样，高度Y1和Y2可设为0或其它值Line2：为垂直线，Y1和Y2一个设为0，另一个和Form1的高度一样，而X1和X2在这里可设为0，也可设为其他值，如果Line1和Line2设为斜线或其他值，也可以，但食物Shape只能出现在一个很小的范围内Timer：默认值Command1：Caption设为：出现食物设计界面如下图所示2．2设计好界面后，打开“代码”窗口，编写如下代码：Dim sabby As IntegerPrivate Sub Command1_Click()Timer1.Interval = 600sabby = 0 ‘试试看，如果sabby不设为零，会有什么结果End SubPrivate Sub Timer1_Timer()Dim pointx As IntegerDim pointy As IntegerRandomizepointx = Rnd * (Line1.X2 - Line1.X1 + 5) + Line1.X1 pointy = Rnd * (Line2.Y2 - Line2.Y1 + 5) + Line2.Y1 Shape1.Left = pointxShape1.Top = pointyShape1.FillColor = RGB(Rnd * 255, Rnd * 255, Rnd * 255) Shape1.Visible = Truesabby = sabby + 1If sabby = 20 ThenTimer1.Interval = 0End IfEnd Sub2.3编写好代码后，执行操作，结果如下：3．总结通过对VB这一课程的自学，了解并掌握了其基本操作。

  1. 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
  2. 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
  3. 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 = TrueElseEndEnd IfEnd 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) + 1lblletter2.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("请输入打字时间。

相关文档
最新文档