当前位置：文档之家 › VB代码

VB代码

  • 格式：doc
  • 大小：123.70 KB
  • 文档页数：19

VB代码*概述（将文本框移动到右上角）Private Sub Command1_Click()Text1.Left = Form1.Width - Text1.WidthText1.Top = 0End Sub*控件1（登录窗口的设置登录名：admin 密码：123456）Private Sub cmdLogin_Click()If txtID.Text = "admin" And txtPsw.Text = "123456" Then MsgBox "登录成功", vbOKOnly + vbInformation ElseMsgBox "登录失败", vbOKOnly + vbCritical End IfEnd SubPrivate Sub cmdReset_Click()txtID.Text = ""txtPsw.Text = ""End SubPrivate Sub cmdClose_Click()EndEnd SubPrivate Sub txtID_Change()End Sub*控件2（改变字体字形和字号）Private Sub cmdSet_Click()If optST.Value = True ThenlblCaption.FontName = "宋体"ElseIf optLS.Value = True ThenlblCaption.FontName = "隶书"ElselblCaption.FontName = "楷体"End IfIf optFont16.Value = True ThenlblCaption.FontSize = 16ElseIf optFont18.Value = True ThenlblCaption.FontSize = 18ElselblCaption.FontSize = 20End IflblCaption.FontBold = ChkBold.ValuelblCaption.FontItalic = ChkItalic.ValueEnd Sub*控件3（对列表框进行选项添加，删除，清空）Option ExplicitPrivate Sub Form_Load()List1.AddItem "蚕豆"List1.AddItem "扁豆"List1.AddItem "绿豆"List1.AddItem "红豆"List1.AddItem "刀豆"End SubPrivate Sub Command1_Click()List1.AddItem Text1Text1 = ""End SubPrivate Sub Command2_Click()List1.RemoveItem List1.ListIndexEnd SubPrivate Sub Command3_Click()List1.ClearEnd SubPrivate Sub Command4_Click()EndEnd Sub*菜单（菜单操作文本框的显示和隐藏）Private Sub Mhide_Click()Text1.Visible = FalseEnd SubPrivate Sub Mshow_Click()Text1.Visible = TrueEnd Sub*图形（改变图形颜色和大小/位置）Private Sub hsbRed_Change()speDemo.FillColor = RGB(hsbRed.Value, hsbGreen.Value, hsbBlue.Value) End SubPrivate Sub hsbRed_Scroll()hsbRed_ChangeEnd SubPrivate Sub hsbBlue_Change()hsbRed_ChangeEnd SubPrivate Sub hsbBlue_Scroll()hsbRed_ChangeEnd SubPrivate Sub hsbGreen_Change()hsbRed_ChangeEnd SubPrivate Sub hsbGreen_Scroll()hsbRed_ChangeEnd SubPrivate Sub vsbSize_Change()speDemo.Width = vsbSize.ValuespeDemo.Height = vsbSize.ValueEnd SubPrivate Sub vsbSize_Scroll()hsbRed_ChangeEnd Sub*程序设计基础（计算圆的面积）Private Sub Command1_Click()Dim r As Single, c As SingleDim s As SingleConst Pi As Single = 3.14159r = Val(InputBox("请输入圆的半径"))c = 2 * Pi * rs = Pi * r ^ 2End Sub*控制结构1（比三个数的大小）Private Sub Command1_Click()Dim a As Integer, b As Integer, c As Integer Dim Min As Integera = Val(Text1.Text)b = Val(Text2.Text)c = Val(Text3.Text)If a < c ThenIf b < a ThenMin = bElseMin = aEnd IfElseIf c < b ThenMin = cElseMin = bEnd IfText4.Text = CStr(Min)End Sub*控制结构2（十进制转换成二进制）Option ExplicitPrivate Sub Command1_Click()Dim n As Integer, st As String, p As Stringn = Text1.TextDop = n Mod 2st = p & stn = n \ 2Loop Until n <= 0Text2.Text = stEnd SubPrivate Sub Command2_Click()Text1.Text = "": Text2.Text = ""Text1.SetFocusEnd SubPrivate Sub Command3_Click()EndEnd SubPrivate Sub Text1_Change()End Sub*控制结构3（颠倒字符串）Option ExplicitPrivate Sub Command1_Click()Dim i As Integer, n As Integer, s As Stringn = Len(Text1.Text)For i = n To 1 Step -1s = s & Mid(Text1.Text, i, 1)Next iText2.Text = sText3.Text = nEnd SubPrivate Sub Command2_Click()Text1.Text = ""Text2.Text = ""Text3.Text = ""Text1.SetFocusEnd SubPrivate Sub Command3_Click()EndEnd SubPrivate Sub Form_Load()End SubPrivate Sub Text1_Change()End Sub* 控制结构4 (随机生成的数中产生素数个数)Option ExplicitPrivate Sub Command1_Click()Dim i As Integer, j As Integer, n As Integer, n1 As Integer, st As Integer For i = 1 To 10Randomizen = Int((Rnd * 90) + 10)For j = 2 To n - 1If n Mod j = 0 Then Exit ForNext jIf j > n - 1 Thenst = st + 1End IfText1.Text = n & " " & Text1.TextText2.Text = stNext iEnd SubPrivate Sub Command2_Click()Text1.Text = ""Text2.Text = ""Command1.SetFocusEnd SubPrivate Sub Command3_Click()EndEnd Sub**数组1Option Base 1Dim A(5, 5) As Integer, i As Integer, j As IntegerPrivate Sub Command1_Click()RandomizeFor i = 1 To 5For j = 1 To 5A(i, j) = Int(Rnd() * 9 + 1)Picture1.Print A(i, j);Next jPicture1.PrintNext iEnd SubPrivate Sub Command2_Click()Dim lsum As Integer, i As Integer, j As IntegerFor j = 1 To 5lsum = 0For i = 1 To 5lsum = lsum + A(i, j)Next iText2.Text = Text2.Text & lsum & " "Next jEnd SubPrivate Sub Command3_Click()Dim lsum As Integer, i As Integer, j As IntegerFor j = 1 To 5lsum = 0For i = 1 To 5lsum = lsum + A(i, j)Next iText1.Text = Text1.Text & lsum & vbCrLf Next jEnd SubPrivate Sub Command4_Click()Dim i As Integer, j As Integer, x As Integer, y As IntegerFor i = 1 To 5For j = 1 To 5If i = j Then x = x + A(i, j)If i + j = 6 Then y = y + A(i, j)Next jText3.Text = x + yNext iEnd Sub**数组2Option Base 1Dim A(4, 5) As Integer, i As Integer, j As IntegerPrivate Sub Command1_Click()RandomizeFor i = 1 To 4For j = 1 To 5A(i, j) = Int(Rnd() * 90 + 10)Text1.Text = Text1.Text & CStr(A(i, j)) & " "Next jText1.Text = Text1.Text & vbCrLfNext iEnd SubPrivate Sub Command2_Click()Dim sum As Integer, aver As Integer, i As Integer, j As Integer For i = 1 To 4For j = 1 To 5sum = sum + A(i, j)Next jNext iFor i = 1 To 4For j = 1 To 5If A(i, j) - sum / 20 > 0 ThenText2.Text = Text2.Text & "H" & " "ElseIf A(i, j) - sum / 20 < 0 ThenText2.Text = Text2.Text & "L" & " "ElseText2.Text = Text2.Text & "E" & " "End IfNext jText2.Text = Text2.Text & vbCrLfNext iEnd SubPrivate Sub Command3_Click()Text1.Text = ""Text2.Text = ""Command1.SetFocusEnd SubPrivate Sub Form_Load()End Sub数组3Option ExplicitOption Base 1Private Sub Command1_Click()Dim x As String, k As Integer, i As Integer, a() As String, j As Integer, max As Integer x = Text1.Texti = i + 1ReDim Preserve a(i) As Stringk = InStr(x, " ")a(i) = Left(x, k - 1)x = Mid(x, k + 1)List1.AddItem a(i)Loop Until InStr(x, " ") = 0ReDim Preserve a(i + 1) As Stringa(i + 1) = xList1.AddItem a(i + 1)For j = 1 To i + 1max = Len(a(1))If Len(a(j)) > max Then max = Len(a(j))Next jFor j = 1 To i + 1If Len(a(j)) >= max Then Text2.Text = Text2.Text & a(j) & vbCrLf Next jEnd SubPrivate Sub Command2_Click()Text1.Text = " "Text2.Text = " "List1.ClearText1.SetFocusEnd Sub过程1Option ExplicitPrivate Sub Command1_Click()Dim m As Integer, n As Integer, i As Integer, x As String, j As Integer, a As Integer m = Val(Text1.Text)n = Val(Text2.Text)List1.AddItem "幻影素数对:"For i = m To nx = ""For j = Len(CStr(i)) To 1 Step -1x = x & Mid(i, j, 1)Next ja = Val(x)If pu(i) And pu(a) And i <> a Then List1.AddItem i & "与" & a Next iEnd SubPrivate Function pu(x As Integer) As BooleanDim i As IntegerFor i = 2 To x - 1If x Mod i = 0 Then Exit FunctionNext ipu = TrueEnd FunctionPrivate Sub Command2_Click()Text1.Text = " "Text2.Text = " "List1.ClearText1.SetFocusEnd Sub过程2Option ExplicitPrivate Sub Command1_Click()Dim n As String, a As IntegerDim i As Integer, sum As Longn = Val(Text1.Text)For i = 1 To Len(n)a = Mid(n, i, 1)sum = sum + fact(a)Next iText2.Text = sumEnd SubPrivate Static Function fact(ByVal a As Integer) As LongDim x As Integerfact = 1For x = 1 To afact = fact * xNext xEnd FunctionPrivate Sub Command2_Click() Text1.Text = " "Text2.Text = " "Text1.SetFocusEnd Sub过程3Option ExplicitPrivate Sub Command1_Click()Dim x As String, y As Stringx = Text1.Texty = Text2.TextText3.Text = cr(x, y)End SubPrivate Sub Command2_Click()Text1.Text = " "Text2.Text = " "Text3.Text = " "Text1.SetFocusEnd SubPrivate Sub Command3_Click()EndEnd SubPrivate Function cr(a As String, b As String) As StringDim i As Integer, k As Integer, m As StringFor i = 1 To Len(a)If b < Mid(a, i, 1) Then m = Left(a, i - 1) & b & Mid(a, i): k = 1If b = Mid(a, i, 1) Then m = Left(a, i - 1) & Mid(a, i + 1): k = 1If k = 1 Then Exit ForNext icr = mEnd Function文件打开D盘根目录VB文件夹下的"P1.vbp"的工程文件，完成VB程序设计实验教程（P52）实验6.3：设计一个文件资源查看程序。

合集下载

vb编程代码大全.doc

vb编程代码大全.doc

vb编程代码大全1.数值型函数：abs(num): 返回绝对值sgn(num): num>0 1; num=0 0; num<0 -1;判断数值正负hex(num): 返回十六进制值直接表示：&Hxx 最大8位oct(num): 返回八进制值直接表示：&Oxx 最大8位sqr(num): 返回平方根num>0int(num): 取整int(99.8)=99; int(-99.2)=100fix(num): 取整fix(99.8)=99; fix(-99.2)=99round(num,n): 四舍五入取小数位round(3.14159,3)=3.142 中点数值四舍五入为近偶取整round(3.25,1)=3.2log(num): 取以e为底的对数num>0exp(n): 取e的n次幂通常用num^nsin(num): 三角函数，以弧度为值计算(角度*Pai)/180=弧度con(num); tan(num); atn(num)2.字符串函数：len(str)：计算字符串长度中文字符长度也计为一！mid(str,起始字符,[读取长度])：截取字符串中间子字符串left(str,nlen)：从左边起截取nlen长度子字符串right(str,nlen)：从右边起截取nlen长度子字符串Lcase(str)：字符串转成小写Ucase(str)：字符串转成大写trim(str)：去除字符串两端空格Ltrim(str)：去除字符串左侧空格Rtrim(str)：去除字符串右侧空格replace(str,查找字符串,替代字符串,[起始字符,替代次数,比较方法])：替换字符串注：默认值：起始字符1；替代次数不限；比较方法区分大小写（0）InStr([起始字符,]str,查找字符串[,比较方法])：检测是否包含子字符串可选参数需同时选返回起始位置InStrRev(str,查找字符串[,起始字符][,比较方法])：反向检测是否包含子字符串返回起始位置space(n)：构造n个空格的字符串string(n,str)：构造由n个str第一个字符组成的字符串StrReverse(str)：反转字符串split(str,分割字符串[,次数][,比较方法])：以分割字符串为分割标志将字符串转为字符数组可选参数需同时选3.数据类型转换函数：Cint(str)：转换正数True -1；False 0；日期距离1899/12/31天数；时间上午段0；下午段1；Cstr(str)：日期输出格式yyyy/mm/dd；时间输出格式Am/Pm hh:mm:ssClng(str)：与Cin()类似Cbool(num)：num不为零True；反之FalseCdate(str)：转换日期格式0：#Am 12:00:00#；正数距离1899/12/31天数的日期；浮点数日期＋小数时间Cbyte(num)：num<255 转换为字节Csng(str)：转换为单精度数值Cdbl(str)：转换为双精度数值Ccur(str)：转换为现金格式4.时间函数：date：取系统当前日期time：取系统当前时间now：取系统当前时间及日期值Datetime类型timer：取当前时间距离零点秒值，计时器，可计算时间差DateAdd(间隔单位,间隔值,日期)：推算相邻日期DateDiff(间隔单位,日期一,日期二)：计算时间差日期二-日期一Datepart(间隔单位,日期)：计算日期的间隔单位值Dateserial(date)：输出日期值（按序列计算）Timeserial(time)：输出时间值（按序列计算）Datevalue(datetime)：取出字符串中日期值Timevalue(datetime)：取出字符串中时间值weekday(date)：计算星期几MonthName(date)：输出月分名year(datetime)：截取年份month(datetime)：截取月份day(datetime)：截取日hour(datetime)：截取小时minute(datetime)：截取分钟second(datetime)：截取秒5.其它函数：Array(unit,..)：动态生成数组Asc(str)：输出字符串第一个字符的ASCII码Chr(asc)：转换ASCII为字符Enter：Chr(13)&Chr(10)Filter(数组名称,关键字符串,[,包含][,比较方法])：将字符串数组中含有关键字符串的元素存成新的数组（默认）[包含]为false则取不包含的元素oin(ArrayName)：将数组中元素连成字符串Ubound(ArrayName[,维数])：取得数组相应维数的上界Lbound(ArrayName[,维数])：取得数组相应维数的下界一般为0Randmize n：启动随机数种子Rnd(n)：取得随机数，n>0或为空，取序列下一随机值，n<0，随机值相同，n=0，生产与上一随机值相同的数取介于A和B之间的随机正数C，公式：C=Int((B-A+1)*Rnd+A) 条件（B>A）子程序和自定义函数Sub StrSubName Function StrFunName(arg[1],..)子程序体函数体Exit Sub 中途跳出Exit Function 中途跳出End Sub StrFunName＝value 返回值End Function[call] StrSubName 引用子程序Var=StrFunName(arg[1],..) 引用函数。

vb代码(小白常用)

vb代码(小白常用)

strSQL = "SELECT * FROM煤质资料"
Adodc1.RecordSource = strSQL
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
全部条件查询：
Private Sub Command6_Click()
Dim iidd As String
Declare Function 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)
dirname = App.Path + "\Documentation\设备档案\" + Frame2.Caption + aaa
deleterec = MsgBox(dirname, vbYesNo, "新建目录")
If deleterec = vbYes Then
MkDir dirname＇新建目录
Command11.Caption = "显示系统记事"
End Sub
If MsgBox("请确认是否退出系统?", vbYesNo) = vbYes Then End‘退出系统
程序目录：App.Path
由数据库字义菜单：
n1 = Adodc5.Recordset.RecordCount - 1 '定义名称菜单
vb经典代码

vb经典代码

1.求三角形的面积代码：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 Thenr = 1 / 2 * (a + b + c)s = Sqr(r * (r - a) * (r - b) * (r - c))Label1.Caption = "三角形的面积为" & sElseLabel2.Caption = "输入的数据不能构成三角形"End IfEnd Sub2.三个数排列代码：Option ExplicitDim x!, y!, z!, t!Private Sub Command1_Click()x = InputBox("输入第一个数 x")y = InputBox("输入第二个数 y")z = InputBox("输入第三个数 z")Print "排序前"; x & " " & y & " " & zIf x < y Then t = x: x = y: y = tIf y < z Thent = y: y = z: z = tIf x < y Thent = x: x = y: y = tEnd IfEnd IfPrint "排序后"; z & " " & y & " " & xEnd Sub3.计算一元二次方程的代码：Option ExplicitDim a!,b!,c!,d!,x1!,x2!Private Sub Command1_Click()a = InputBox("a=", "请输入一元二次方程的系数a")b = InputBox("b=", "请输入一元二次方程的系数b")c = InputBox("c=", "请输入一元二次方程的系数c")If a = 0 ThenPrint "因为a≠0，你输入的a＝0，请重新输入系数a"End Ifd = b ^ 2 - 4 * a * cIf d >= 0 Thenx1 = (-b + Sqr(d)) / (2 * a)x2 = (-b - Sqr(d)) / (2 * a)Print "系数为" & a; b; c & "的一元二次方程的根分别为" & "x1=" & x1 & " " & "x2=" & x2ElsePrint "此方程在实数范围内无解"End IfEnd Sub4.利用Select Case语句输入年份计算属相代码：Option ExplicitPrivate Sub Command1_Click()Dim i As Integer, x As String, Y As IntegerY = InputBox("输入你的出生年份Y")i = Y Mod 12 Select Case i Case Is = 0 x = "猴" Case Is = 1 x = "鸡" Case Is = 2 x = "狗" Case Is = 3 x = "猪" Case Is = 4 x = "鼠" Case Is = 5 x = "牛" Case Is = 6 x = "虎" Case Is = 7 x = "兔" Case Is = 8 x = "龙" Case Is = 9 x = "蛇" Case Is = 10 x = "马" Case Is = 11 x = "羊" End SelectPrint xEnd Sub5.闰年两种判断方法的代码; 方法一：Option ExplicitDim y As IntegerPrivate Sub Command1_Click()y = InputBox("y=", "输入年份")If y Mod 4 = 0 ThenIf y Mod 100 = 0 ThenIf y Mod 400 = 0 ThenPrint "这年为闰年"ElsePrint "这年为平年"End IfElsePrint "这年为闰年"End IfElsePrint "这年为平年"End IfEnd Sub方法二：Private Sub Command2_Click()y = InputBox("y=", "输入年份")If y Mod 4 = 0 And y Mod 100 = 0 Then Print "这年为闰年"ElseIf y Mod 400 = 0 ThenPrint "这年为闰年"ElsePrint "这年为平年"End IfEnd Sub法一：Option ExplicitDim x!,y!Private Sub Command1_Click()x = InputBox("x=", "输入x的值")If x <> 0 ThenIf x >= 1 Or x <= -1 Theny = (1 + Sin(x) * Sin(x) - Sqr(x ^ 2 - 1)) / x Print "y="; Format(y, "0.0000")ElsePrint "所输入的x不在定义域"End IfElsePrint "除数不能为零"End IfEnd Sub法二：Private Sub Command2_Click()x = InputBox("x=", "输入x的值")Select Case xCase Is = 0Print "除数不能为零"Case Is >= 1, Is <= -1y = (1 + Sin(x) * Sin(x) - Sqr(x ^ 2 - 1)) / x Print "y="; Format(y, "0.0000")Case Is <> 0, Is < 1, Is > -1Print "所输入的x不在定义域"End SelectEnd Sub法三：Private Sub Command3_Click()x = InputBox("x=", "输入x的值")If x >= 1 Theny = (1 + Sin(x) * Sin(x) - Sqr(x ^ 2 - 1)) / x Print "y="; Format(y, "0.0000")ElseIf x < 1 And x > 0 ThenPrint "所输入的x不在定义域"ElseIf x = 0 ThenPrint "除数不能为零"ElseIf x >= -1 And x < 0 ThenPrint "所输入的x不在定义域"ElseIf x <= -1 Theny = (1 + Sin(x) * Sin(x) - Sqr(x ^ 2 - 1)) / x Print "y="; Format(y, "0.0000")End IfEnd Sub流程图：伪代码：step1：输入x的值；step2：判断x是否为零;step3：若x=0，输出“除数不能为零”；若x不为零，则继续判断x的绝对值是否大于1；step4：若x的绝对值是否大于1，输出y的值；否则x的值不在函数的定义域里，结束。

VB代码大全

VB代码大全

隐藏form1：form1.hide显示form1：form1.show--------------------------------------------------------------------------------------------- 退出程序时，弹出窗口提示是否要退出：Private Sub Form_Unload(Cancel As Integer)Dim iAnswer As IntegeriAnswer = MsgBox("真要退出吗?", vbYesNo)If iAnswer = vbNo ThenCancel = TrueElseEndEnd IfEnd Sub---------------------------------------------------------------------------------------------- 只能用任务管理器关闭程序的代码：Private Sub From_Unload(Cancel As Integer)Cancel = trueEnd Sub------------------------------------------------------------------------------------------------ 点击command1打开33IQ网：Dim strURLPrivate Sub Command1_Click()strURL = "错误！超链接引用无效。

Shell "explorer.exe " & strURL, 1End Sub------------------------------------------------------------------------------------------------ 运行c:\1.exeshell "c:\1.exe"执行c:\1.batshell "c:\1.bat"注：只适用于大部分exe和全部bat。