VB小程序代码实例
- 格式:doc
- 大小:93.50 KB
- 文档页数:19
1、VB定时器'*************************************************************'新建一个窗体,放两个控件:label和timer'*************************************************************Public hor As LongPublic minu, sec As IntegerPrivate Sub Form_Load()'设置计时器时间间隔为1秒。
'考虑到Sub Timer1_Timer()中判断等操作要花时间,所以Timer1.Interval设为994 Timer1.Interval = 994Dim longTime, tmp As Long'********************************longTime = 65'时间值,要你自己从数据库取,我就不写了!'********************************'初始化显示时间hor = CLng(longTime / 3600 - 0.5)'小时数tmp = longTime - 3600 * hor '剩余秒数minu = CLng(tmp / 60 - 0.5) '分钟数tmp = tmp - 60 * minu'剩余秒数sec = tmp'秒数Label1.Caption = CStr(hor) + ":" + Format(CStr(minu), "##00") + ":" + Format(CStr(sec), "##00") End SubPrivate Sub Timer1_Timer()If sec = 0 ThenIf minu = 0 ThenIf hor = 0 ThenExit SubElsehor = hor - 1End Ifminu = 59Elseminu = minu - 1sec = 59End IfElsesec = sec - 1End IfLabel1.Caption = CStr(hor) + ":" + Format(CStr(minu), "##00") + ":" + Format(CStr(sec), "##00") End Sub2、VB倒计时Dim h, m, s As IntegerPrivate Sub Command1_Click()Label1.Visible = FalseText1.Visible = TrueIf Command1.Caption = "倒计时" Then Timer1.Enabled = TrueCommand1.Caption = "停止"Command2.Enabled = FalseElseTimer1.Enabled = FalseCommand1.Caption = "倒计时"Command2.Caption = "重设倒计时" Command2.Enabled = TrueEnd IfEnd SubPrivate Sub Command2_Click()If Command2.Caption = "重设倒计时" Then Call againCommand1.Enabled = TrueEnd IfEnd SubPrivate Sub Command3_Click()a = MsgBox("你确定要退出嗎")EndEnd SubPrivate Sub Form_Load()ClsText1.Text = ""a = MsgBox("以下是一個倒計時程序,請按以下要求輸入你要倒计的时间")h = Val(InputBox("请输入倒计时的,小時数,若无填0", "小時/输入", 0))m = Val(InputBox("请输入倒计时的,分钟数,若无填0", "小時/输入", 0))s = Val(InputBox("请输入倒计时的,秒数,若无填0", "小時/输入", 0))Label1.Caption = "你输入的时间是:" & Format(h, "00") & ":" & Format(m, "00") & ":" & Format(s, "00") & "如果沒有错误请点击倒计时按纽"Text1.Visible = FalseEnd SubPrivate Sub Timer1_Timer()If s > 0 Thens = s - 1End IfIf s < 1 And m > 0 Thenm = m - 1s = 60End IfIf m < 1 And s = 0 And h > 0 Thenh = h - 1m = 60End IfIf h < 0 Thenh = 0End IfIf m < 0 Thenm = 0End IfText1.Text = Format(h, "00") & ":" & Format(m, "00") & ":" & Format(s, "00")If h = 0 And m = 0 And s = 0 ThenText1.Text = "時間到了"Command1.Caption = "倒计时"Command1.Enabled = FalseTimer1.Enabled = FalseCommand2.Enabled = TrueEnd IfEnd SubSub again()ClsText1.Text = ""a = MsgBox("以下是一個倒計時程序,請按以下要求輸入你要倒计的时间")h = Val(InputBox("请输入倒计时的,小時数,若无填0", "小時/输入", 0))m = Val(InputBox("请输入倒计时的,分钟数,若无填0", "小時/输入", 0))s = Val(InputBox("请输入倒计时的,秒数,若无填0", "小時/输入", 0))Label1.Caption = "你输入的时间是:" & Format(h, "00") & ":" & Format(m, "00") & ":" & Format(s, "00") & "如果沒有错误请点击倒计时按纽"Text1.Visible = FalseLabel1.Visible = TrueEnd Sub3、VB应该怎样取得本机上网用的动态IP应该是电信局动态分配给宽带用户的那种动态IP。
VB小程序代码实例1.打印负数并分别计算正负数只和:有如下10个数:-2,73,82,-76,-1,24,321,-25,89,-20(也可以定位其他数值) 打印出其中的每个负数,分别计算并输出正数和负数的和。
程序如下:Sub Form_Click()Dim number AS IntegerNegativeSum=0:PostiveSum=0For i=1 To 10number=InputBox("Enter data: ")If number<0 ThenPrint number;NegativeSum=NegativeSum+numberElsePostiveSum=PostiveSum+numberEnd IfNext iprintprint "NegativeSum=";NegativeSumPrint "PostiveSum=";PostiveSumEnd Sub2.打印九九表:在窗体上打印九九表:程序如下:Print Sub Form_Click()FontSize=12Print Tab(30);"9*9 T able"Print:Print '输出两个空行Print "* ";For i=1 To 9Print Tab(i*6);i; '打印横行序号Next iFor j=1 To 9Print j;" "; '打印竖行序号For k=1 To jtemp=j*kPrint Tab(k*6);temp;" "; '打印乘积Next kPrint '输出一个空行Next jEnd Sub3.打印人员名册打印人员名册:Private Sub Form_Click()Print:PrintFontName="魏碑"FontSize=16Print "姓名";Tab(8);"年龄";Tab(16);"职务";Tab(24);"单位";Tab(32);"籍贯"PrintPrint "张得功";Tab(8);"25";Tab(16);"科长";Tab(24);"劳动科";Tab(32);"北京"Print "李德生";Tab(8);"32";Tab(16);"处长";Tab(24);"科研处";Tab(32);"上海" End Sub4.单选按钮设置字体类型和大小单选按钮设置字体类型和大小:在窗体上画出两个框架,每个框架内分别画两个单选按钮,然后画两个命令按钮和一个文本框。
数字排序小游戏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(Visual Basic)是一种广泛应用于Windows平台的编程语言,它具有简单易学的特点,因此非常适合初学者入门。
本文将以一个实际的VB小程序设计实例为例,介绍如何使用VB语言进行简单的程序开发。
项目背景我们的目标是创建一个简单的VB小程序,用于管理学生信息。
该程序将允许用户添加、删除和修改学生的基本信息,例如姓名、年龄和班级。
此外,用户还可以根据特定条件检索学生信息,并显示学生列表。
设计步骤1. 创建VB项目首先,打开Visual Studio并选择“创建新项目”,然后选择“Visual Basic”作为项目类型。
接下来,选择“Windows Forms应用程序”作为模板,并给项目命名。
点击“确定”按钮以创建新的VB项目。
2. 设计用户界面在VB中,用户界面是通过拖放控件来创建的。
在“工具箱”中选择所需的控件,例如按钮、文本框和标签,并将它们放置在窗体上。
使用控件的属性面板可以更改它们的外观和行为。
3. 编写代码现在,我们需要为各个控件添加相应的事件处理程序。
例如,当用户点击一个按钮时,我们需要执行特定的操作。
首先,选择要添加事件处理程序的控件,然后在属性面板中找到“事件”部分。
在相应的事件上双击以创建并打开处理程序。
4. 实现学生信息管理功能在代码中,我们需要定义学生类和学生信息管理类。
学生类包含学生的属性,例如姓名、年龄和班级。
学生信息管理类包含对学生信息进行增删改查的方法。
我们可以使用集合类来存储学生对象,并使用LINQ进行查询操作。
在事件处理程序中调用适当的方法以实现相应的功能。
5. 运行和测试程序在完成代码的编写之后,我们可以点击“运行”按钮来启动程序。
通过与程序交互,测试各个功能是否按预期工作。
如果发现问题,可以调试程序并对代码进行调整。
6. 部署和发布程序一旦我们满意了程序的功能和性能,我们可以将程序部署和发布给其他人使用。
在Visual Studio中,选择“生成”菜单并点击“发布”选项。
实验一:(带有进度条的倒计时程序)Public Class Form1Dim timers As IntegerDim temp As IntegerPrivate Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.TickIf (ProgressBar1.Value + ProgressBar1.Maximum / timers < ProgressBar1.Maximum) Then ProgressBar1.Value += ProgressBar1.Maximum / timersElseTimer1.Enabled = FalseProgressBar1.Value = ProgressBar1.MaximumMessageBox.Show("进度完成!")End Iftemp += 1Label1.Text = temp.ToString()End SubPrivate Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Loadtimers = 30End SubPrivate Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Clicktimers = Val(InputBox("输入", "请输入总时间。
", 30, 0, 0))End SubPrivate Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.ClickTimer1.Enabled = TrueEnd SubEnd Class实验二(定时器控制蝴蝶飞舞)Public Class Form1Dim t As IntegerPrivate Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick’Dim t As Boolean' If t = True Then' PictureBox3.Image = PictureBox2.Image' t = False'Else' PictureBox3.Image = PictureBox1.Image' t = True'End IfSelect Case tCase 0PictureBox3.Image = PictureBox1.Imaget = 1Case 1PictureBox3.Image = PictureBox2.Imaget = 2Case 2PictureBox3.Image = PictureBox1.Imaget = 3Case 3PictureBox3.Image = PictureBox1.Imaget = 0End SelectEnd SubEnd Class实验三(递推法迭代法--猴子吃桃)Public Class Form1Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.ClickDim n, y As Integern = Val(TextBox1.Text)y = Val(TextBox2.Text)Dim xi As Doublexi = yTextBox3.Text = "第" + n.ToString() + "天的桃子为:" + y.ToString() + "个。
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小程序:摄像头视频图像的监控、截图、录像(改进:第二页)Private Sub SetDir()Dim nStr As StringIf Trim(ctDir) = "" Then ctDir = App.Path & "\videos" '如果路径不存在,用默认文件名 C:\CAPTURE.AVInStr = "设置录像保存的文件夹。
" & vbCrLf & "输入“<>”表示使用默认文件夹:" & vbCrLf & App.Path &"\videos"nStr = Trim(InputBox(nStr, "录像保存的文件夹", ctDir))If nStr = "" Then Exit SubctDir = nStrIf ctDir = "<>" Or ctDir = "<默认>" Then ctDir =""End SubPrivate Sub SetFile()Dim nStr As String, nF As StringnF = String(255, " ")SendMessage ctCapWin, WM_Cap_File_Get_File, Len(nF), ByVal nFnF = GetStrLeft(nF, vbNullChar)If Trim(ctF) = "" Then ctF = "<默认>" '如果路径不存在,用默认文件名 C:\CAPTURE.AVInStr = "设置录像保存的文件名(不带路径)。
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设计一个简单的小程序——计算圆的面积
1、窗体设计
计算圆的面积的应用程序窗体上的控件
类(控件)对象用途
TextBox
Text1供用户输入圆的半径
Text2供应用程序输出圆的面积
Label
Label1用来向用户说明文本框Text1的用途
Label2用来向用户说明文本框Text1的用途CommandButton Command1
用户通过该按钮通知应用程序:数据输入完毕,
开始计算
各对象的属性值
类(控件)对象属性设置的属性值
TextBox Text1
Text空串
BackColor黄色Text2
Text空串
BackColor天蓝色
Label
Label1Caption输入圆的半径
Label2Caption圆的面积
2、代码设计
Private Sub Command1_Click()
r = Val
= Str * r * r)
End Sub
3、问题
应用程序如果改为“计算扇形面积”的话,该应用程序的窗体和代码应做如何修改。
人人都会用的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小程序是一种基于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编程,并为您今后的学习和开发提供一些参考。
目录实验题目1:设计窗体。
参考界面如下: (2)实验题目2: 设计一个计算器。
参考界面如下: (3)实验题目3:设计一个能够统计某学生三门课程成绩总分和平均分的程序。
参考界面如下: (4)实验题目4:设计界面,编写程序计算圆的周长和面积。
参考界面如下: (4)实验题目5:设计界面,编写程序验证算术运算符的功能。
参考界面如下: (5)实验题目6:设计界面,编写程序分离出一个三位数的个位、十位、百位上的数字。
参考界面如下: (6)实验题目7:输入一个三位数,将它按逆序输出。
参考界面如下: (7)实验题目8:输入两个数,将这两个数交换。
(8)实验题目9:设计文本编辑窗体。
(8)实验题目10:编写程序计算某个学生三门课程的平均成绩。
(10)实验题目12:编写程序计算长方体的体积。
(10)实验题目13:编写程序求出四个数中的最小数。
(11)实验题目14:编写程序判断某个数是否是水仙花数。
(11)实验题目15:编写程序,实现数字和英文单词的对应。
(12)实验题目16:设计程序,判断从键盘上输入的某个字符为哪类字符。
(大写字母、小写字母、数字字符或其他字符) (12)实验题目17:设计一个简单的文本编辑器,可以实现文本的简单格式化操作。
(13)实验题目18:编写程序输出图形,运行界面如下: (15)实验题目19:编写程序求n!。
(15)实验题目20:编写程序,求出某班所有同学某门课程的平均成绩。
(16)实验题目21:编写程序输出1-100之间所有能被3整除的整数,要求每行输出5个。
并输出这些整数的和。
(用for语句实现) (16)实验题目21:编写程序,统计输入的一个字符串中各类字符的个数。
(用for语句实现).17 实验题目22:编写程序,定义包含10个数组元素的一维数组,给该数组中的数组元素赋值为3,6,9,12......数字,并以顺序和逆序两种方式输出各元素值。
. (17)实验题目23:随机生成20个100以内的正整数,将其中的奇数和偶数分两行显示在窗体上,并分别统计奇数和偶数的个数。
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。
办公室实用VBA小程序之代码(2)摘要:本部分是办公室实用VBA小程序(一)的各项功能的具体代码,现分享给大家。
2、常用功能区代码:Sub一键打印()ProgressBar1.Visible = TrueApplication.ScreenUpdating = FalseApplication.DisplayAlerts = FalseProgressBar1.Min = 0ProgressBar1.Max = Sheets.CountIf MsgBox("是否已经全部调整好打印格式?", vbYesNo, "警告") =vbYes ThenFor Each Mysht In WorksheetsMysht.PrintOut ActivePrinter:="Ricoh Aficio MP 2550B PCL 在Ne00:"cot = cot + 1ProgressBar1.Value = cotNextApplication.ScreenUpdating = TrueElseExit SubEnd IfLabel2.Caption = "打印完毕,共打印" & cot & "张。
"cot = 0End Sub'显示被隐藏的工作表Sub 显示隐藏表()Application.ScreenUpdating = FalseFor Each Mysht In ActiveWorkbook.WorksheetsIf Mysht.Visible <> xlSheetVisible ThenMysht.Visible = xlSheetVisiblecot = cot + 1End IfNextIf cot > 0 ThenLabel2.Caption = "已显示" & cot & "张被隐藏的工作表。
VB整人小程序代码Private Sub Command1_Click()MsgBox "进行测试前,请一定要照着提示上说的回答,可不要乱写,不然的话会让测试不准的!切记!现在放松一下,记住,写的时候应该完全是你的第一直觉!!!"MsgBox "这个测试源于印度的一个神秘的密教经典,当时发现它的人按照它说的做了,结果他的愿望在10分钟内就实现了!" MsgBox "这是一个非常奇妙的测试,不知道你做过没有,最好没有旁观者!我做了,非常准确,想不信邪都难!"t1 = "1.请输入你一个异性朋友的名字"t2 = "2.请再输入你一个异性朋友的名字"t3 = "3.输入你一个同性朋友的名字"t4 = "4.输入你第二个同性朋友的名字"t5 = "5.再输入你一个同性朋友的名字"t6 = "6.输入一首你喜欢的歌的名字"t7 = "7.输入另外一首歌的名字"t8 = "8.再输入一首歌的名字,请不要急噪,保持轻松的心态"t9 = "9.最后输入一首喜欢的歌名字"t10 = "10.输入一个你喜欢的幸运数字"t11 = "11.许下一个你的愿望"a1 = InputBox(t1)a2 = InputBox(t2)a3 = InputBox(t3)a4 = InputBox(t4)a5 = InputBox(t5)a6 = InputBox(t6)a7 = InputBox(t7)a8 = InputBox(t8)a9 = InputBox(t9)a10 = InputBox(t10)a11 = InputBox(t11)Form1.Print "在你心中"; a1; "占据着最重要的位置,你对"; a1; "的感觉用"; a6; "这首歌来形容再好不过了。
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应用程序是很简单的事。
有多简单?为回答这个问题,试着创建下面的Hello ,vb和Firstapp 应用程序。
你好,Visual Basic创建vb应用程序有三个主要步骤:1. 创建应用程序界面2. 设置属性3. 编写代码为了说明这一实现过程,按照以下步骤创建一个简单应用程序,该应用程序由一个文本框和一个命令按钮组成。
单击命令按钮,文本框中会出现"Hello , world!" 消息。
创建应用程序界面窗体是创建应用程序的基础。
通过使用窗体可将窗口和对话框添加到应用程序中。
也可把窗体作为项的容器,这些项是应用程序界面中的不可视部分。
例如,应用程序中可能有一个作为图形容器的窗体,而这些图形是打算在其它窗体中显示的。
建造vb应用程序的第一步是创建窗体,这些窗体将是应用程序界面的基础。
然后在创建的窗体上绘制构成界面的对象。
对于目前的第一个应用程序,你可使用工具箱中的两个控件。
用工具箱绘制控件1. 单击要绘制的控件的工具——此时是“文本框”。
2. 将指针移到窗体上。
该指针变成十字线,如图2.3 所示。
3. 将十字线放在控件的左上角所在处。
4. 拖动十字线画出适合您要的控件大小的方框(拖动的意思是按住鼠标左键用鼠标指针移动对象)。
5. 释放鼠标按钮。
控件出现在窗体上。
在窗体上添加控件的另一个简单方法是双击工具箱中的控件按钮。
这样会在窗体中央创建一个尺寸为缺省值的控件;然后再将该控件移到窗体中的其它位置。
调整大小、移动和锁定控件注意出现在控件四周的小矩形框称作尺寸句柄;下一步可用这些尺寸句柄调节控件尺寸。
也可用鼠标、键盘和菜单命令移动控件、锁定和解锁控件位置以及调节控件位置。
调整控件的尺寸,请按照以下步骤执行:1. 用鼠标单击要调整尺寸的控件。
选定的控件上出现尺寸句柄。
2. 将鼠标指针定位到尺寸柄上,拖动该尺寸柄直到控件达到所希望的大小为止。
角上的尺寸柄可以调整控件水平和垂直方向的大小,而边上的尺寸柄调整控件一个方向的大小。
用VB编写一个密码解锁界面我也是刚开始学VB语言,VB语言很强大,有别于其它语言,操作性很强,是很富有创造性的电脑语言。
下面是我看了两天书后编写的一个小程序:功能是能建立两个窗口,一个密码窗口,一个为修改密码窗口。
当密码输入正确后才能打开或者做一些事情,点击修改密码跳往第二个界面,修改成功后以修改的密码为解锁密码。
中间有错误提示和误操作提示。
①先建立一个小窗口,如下图:帐号一的“textbox”编号为“text1”,后面一次类推,command指令为1。
②程序的编写Text1:初始帐号为“07823”,如果可以的话可以给加入更多的功能,比如记忆多个账户和多对密码之类的等等。
2、text23、command1初始密码为“1234”,open函数可以打开文件,自己可以设置文件路径。
4、command2跳往第二个界面,隐藏第一界面。
5、初始指令6、全局变量全局变量本界面可以修改、其它界面可以调用的变量。
②建立第二个窗口Text的序号从上到下依次顺序排列,command的命令一次从左到右排列③第二个窗口的程序编写1、Text1:Private Sub Text1_LostFocus()Dim b As IntegerDim pw_1 As String, pw_2 As Stringpw_2 = Form1.mpw_1 = Text1.TextIf pw_1 <> pw_2 Thenb = MsgBox("密码错误", 5 + vbExclamation, "错误提示")End IfEnd Sub2、text2:Private Sub Text2_LostFocus()If Text2.Text = "" ThenMsgBox "新密码不能为空"End IfEnd Sub3、text3:Private Sub Text3_LostFocus()If Text2.Text <> Text3.Text ThenMsgBox "两次输入密码不一样"Text2.Text = ""Text3.Text = ""Text2.SetFocusEnd IfEnd Sub4、command1:Private Sub Command1_Click() If Text2.Text = Text3.Text Then n = Text2.TextEnd IfText1.Text = ""Text2.Text = ""Text3.Text = ""Form1.ShowForm2.HideEnd Sub5、command2:Private Sub Command2_Click() Text1.Text = ""Text2.Text = ""Text3.Text = ""Form1.ShowForm2.HideEnd Sub初始设置(Form)Private Sub Form_Load()Text1.PasswordChar = "*" Text1.Text = ""Text2.PasswordChar = "*" Text2.Text = ""Text3.PasswordChar = "*" Text3.Text = ""End Sub全局变量申明Public n As String。
1.打印负数并分别计算正负数只和:有如下10个数:-2,73,82,-76,-1,24,321,-25,89,-20(也可以定位其他数值) 打印出其中的每个负数,分别计算并输出正数和负数的和。
程序如下:Sub Form_Click()Dim number AS IntegerNegativeSum=0:PostiveSum=0For i=1 To 10number=InputBox("Enter data: ")If number<0 ThenPrint number;NegativeSum=NegativeSum+numberElsePostiveSum=PostiveSum+numberEnd IfNext iprintprint "NegativeSum=";NegativeSumPrint "PostiveSum=";PostiveSumEnd Sub2.打印九九表:在窗体上打印九九表:程序如下:Print Sub Form_Click()FontSize=12Print Tab(30);"9*9 Table"Print:Print '输出两个空行Print "* ";For i=1 To 9Print Tab(i*6);i; '打印横行序号Next iFor j=1 To 9Print j;" "; '打印竖行序号For k=1 To jtemp=j*kPrint Tab(k*6);temp;" "; '打印乘积Next kPrint '输出一个空行Next jEnd Sub3.打印人员名册打印人员名册:Private Sub Form_Click()Print:PrintFontName="魏碑"FontSize=16Print "姓名";Tab(8);"年龄";Tab(16);"职务";Tab(24);"单位";Tab(32);"籍贯"PrintPrint "张得功";Tab(8);"25";Tab(16);"科长";Tab(24);"劳动科";Tab(32);"北京"Print "李德生";Tab(8);"32";Tab(16);"处长";Tab(24);"科研处";Tab(32);"上海" End Sub4.单选按钮设置字体类型和大小单选按钮设置字体类型和大小:在窗体上画出两个框架,每个框架内分别画两个单选按钮,然后画两个命令按钮和一个文本框。
编写时间过程如下:Ptivate Sub Form_Load()Form1.Caption="框架用法示例"Command1.Caption="确定"Command2.Caption="结束"Frame1.Caption="字体类型"Frame2.Caption="字体大小"Option1.Caption="魏碑"Option2.Caption="幼圆"Option3.Caption="16"Option4.Caption="24"Text1.Text="Visual Basic 程序设计"End SubPrivate Sub Command1.Click_()If Optoion1 ThenText1.FontName="魏碑"ElseText1.FontName="幼圆"End IFIf Option3 ThenText1.FontSize=16ElseText1.FontSize=24End IfEnd SubPrivate Sub Command2.Click_()EndEnd Sub5.计算存款利息计算存款利息:本金p为10000,年利率为0.125,每年计息一次,求10年的本利和是多少。
Sub Form_Click()Dim p As Currencyp=10000:r=0.125t=1AgainIf t>10 Then GoTo 100i=p*rp=p+it=t+1GoTo Again100Print pEnd Sub说明:这里的“Again:”是标号,“100”是行号。
6.交换两个列表框的项目交换两个列表框的项目。
其中一个列表框的项目按字母升序排列,另一个列表框的项目按项目加入的先后顺序排列。
当双击某个项目时,该项目从列表框中消失,并出现在在另一个列表框中:Private Sub Form_Load()List1.FontSize=14List2.FontSize=14List1.AddItem "IBM"List1.AddItem "Compad"List1.AddItem "HP"List1.AddItem "FUJI"List1.AddItem "Digital"List1.AddItem "长城"List1.AddItem "联想"List1.AddItem "Canon"List1.AddItem "四通"List1.AddItem "Acer"List1.AddItem "Nec"List1.AddItem "NCR"End SubPrivate Sub List1_DbClick()List2.AddItem List1.TextList1.RemoveItem List1.ListIndexEnd SubPrivate Sub List2_DbClick()List1.AddItem List2.TextList2.RemoveItem List2.ListIndexEnd Sub7.交换图片交换两个图片框中的图形:在窗体上建立三个图片框Picture1、Picture2、Picture3,其中两个在上,一个在下。
Private Sub Form_Click()'交换位图Picture3.Picture=Picture1.PicturePicture1.Picture=Picture2.PicturePicture2.Picture=Picture3.Picture'把第三个图片框设置为空Picture3.Picture=LoadPicture()End SubPrivate Sub Form_Load'装入位图Picture1.Picture=LoadPicture _("C:\Documents and Settings\All Users\Documents\My Pictures\1.jpg") '可自行改变路径Picture2.Picture=LoadPicture _("C:\Documents and Settings\All Users\Documents\My Pictures\2.jpd") '可自行改变路径End Sub8.冒泡排序从键盘上输入10个整数,用冒泡法排序(Bubble Sort)法对这十个数从小到大排序:在窗体上建立一个命令按钮,并把Caption属性设置为“Click Here to Start”编写程序如下:Sub Command1_Click()Static number(1 To 10) AS Integer '定义数组number为整形 Msg$="Enter Number for Sort:"MsgStile$="Sort Demo"For i%=1 To 10number(i%)=InputBox(Msg$,MsgTile$)Next i%For i%=10 To 2 Step -1For j%=1 To i%-1If number(j%)=number(j%+1) Thent=number(j%+1)number(j%+1)=number(j%)number(j%)=tEnd IfNext j%Next i%For i%=1 To 10Print number(i%)Next i%End Sub9.判断0~9数据类型--奇数或偶数判断字母大小写及0~9数据类型--奇数或偶数:Sub Form_Click()Dim Msg,UserInputMsg="Please enter a letter or number from 0 though 9." UserInput=InputBox(Msg)If Len(UserInput)<>0 ThenSelect Case Asc(UserInput) '返回ASCII码Case 65 To 90 '大写字母Msg="You entered the uppercase letter"Msg=Msg&Chr(Asc(UserInput))&"!"Case 97 To 122 '小写字母Msg="You entered the lowercase letter"Msg=Msg&Chr(Asc(UserInput))&"!"Case ElseMsg="You did not enter a letter or a number."End SelectElseSelect Case CDbl(UserInput) '转换为双精度数值Case 1,3,5,7,9Msg=UserInput&"is an odd number" '奇数Case 0,2,4,6,8Msg=UserInput&"is an odd number" '偶数Case Else '出界Msg="You entered a number ouside"Msg=Msg&"the requested range"End SelectEnd IfMsgBox MsgEnd Sub10.判断100~200的所有偶数可以分解为两个素数之和判断100~200的所有偶数可以分解为两个素数之和。