vb手写笔迹源代码.frm
图书馆管理系统源代码
源程序清单1、文件名 login(login.frm)功能说明:整个系统的登陆界面,需要输入用户名和登陆密码才能进入到系统中,进行借阅等操作。
源代码:Option ExplicitDim cnt As IntegerPrivate Sub Command1_Click()Dim sql As StringDim rs_login As New ADODB.RecordsetIf Trim(Combo1.Text) = "" ThenMsgBox "没有这个用户", vbOKOnly + vbExclamation, ""Combo1.SetFocusElsesql = "select * from 系统管理 where 用户名='" & Combo1.Text & "'" rs_login.Open sql, conn, adOpenKeyset, adLockPessimisticIf rs_login.EOF = True ThenMsgBox "没有这个用户", vbOKOnly + vbExclamation, ""Combo1.SetFocusElseIf Trim(rs_login.Fields(1)) = Trim(txtpwd.Text) ThenuserID = Combo1.Textrs_login.CloseUnload Meform1.ShowElseMsgBox "密码不正确", vbOKOnly + vbExclamation, ""txtpwd.SetFocusEnd IfEnd Ifcnt = cnt + 1If cnt = 3 ThenUnload MeEnd IfExit SubEnd SubPrivate Sub Command2_Click()Unload MeEnd SubPrivate Sub Form_Load()Dim connectionstring As Stringconnectionstring = "provider=Microsoft.Jet.oledb.4.0;" & _"data source=book.mdb"conn.Open connectionstringcnt = 0End SubPrivate Sub txtuser_Change()End Sub2、文件名 form1(form1.frm)功能说明:整个系统的主界面,其中包括图书管理、读者管理、图书借阅管理、系统管理、关于,以及在这下面的子菜单。
vba源程序
例1-1Private Sub CommandButton1_Click()Dim textPoint(0 To 2) As Double '声明文字插入点Dim textHeight As Double '声明文字高度Dim textStr As String '声明字符串Dim textObject As AcadText '声明文字对象textPoint(0) = 20 '设置插入点的X坐标textPoint(1) = 40 '设置插入点的Y坐标textPoint(2) = 0 '设置插入点的Z坐标textHeight = 10 '设置文字高度为10textStr = "AutoCAD ActiveX/VBA" '设置字符串Set textObject = ThisDrawing.ModelSpace.AddText(textStr, textPoint, textHeight)'创建text对象ThisDrawing.Application.ZoomExtents '根据实际范围计算缩放textObject.Update '更新显示图形对象End SubPrivate Sub_CommandButton_Click()UnloadMe '卸载窗体End '结束应用程序End Sub例4—1:将AutoCAD应用程序窗口放在屏幕的左上角,并将其大小调整为宽400像素、高400像素。
okSub Ch4_PositionApplicationWindow()ThisDrawing.Application.WindowTop = 0ThisDrawing.Application.WindowLeft = 0ThisDrawing.Application.Width = 400ThisDrawing.Application.Height = 400End Sub例4—2:最大化应用程序窗口。
vb简单的计算机源代码
vb 简单的计算机源代码 .txt 如果青春的时光在闲散中度过,那么回忆岁月将是一场凄凉的悲剧。
杂草多的地方庄稼少,空话多的地方智慧少。
即使路上没有花朵,我仍可以欣赏荒芜。
Private Sub Command1_Click()Form1.Caption = " 欢迎使用智能计算器 "'载入默认正常显示If Check1.Value = "0" Then'1类分歧ElseIf Text1.Text = "" Or Text2.Text = "" Then'2类分歧Form1.Caption = "xataliq kuruldi"Text3.Text = "运算数值不能为空 "ElseIf Text1.Text = "" And Text2.Text = "" Then'2类分歧Form1.Caption = "xataliq kuruldi"Text3.Text = "运算数值不能为空 "Else'2类分歧Dim a, b, c As Doublea = Val(Text1.Text)b = Val(Text2.Text)c = a + bText3.Text = cText1.Text = ""Text2.Text = ""End IfIf Check1.Value = "1" Then'1类分歧ElseIf Text1.Text = "" Or Text2.Text = "" Then'2类分歧Form1.Caption = "xataliq kuruldi"Text3.Text = "运算数值不能为空 "ElseIf Text1.Text = "" And Text2.Text = "" Then'2类分歧Form1.Caption = "xataliq kuruldi"Text3.Text = "运算数值不能为空 "Else'2类分歧Dim d, e, f As Doubled = Val(Text1.Text)e = Val(Text2.Text)f = d + eText3.Text = fEnd IfEnd SubPrivate Sub Command2_Click()Form1.Caption = " 欢迎使用智能计算器 "If Check1.Value = "1" ThenElseIf Text1.Text = "" Or Text2.Text = "" ThenForm1.Caption = "xataliq kuruldi"Text3.Text = "运算数值不能为空 "ElseIf Text1.Text = "" And Text2.Text = "" ThenForm1.Caption = "xataliq kuruldi"Text3.Text = "运算数值不能为空"ElseDim d, e, f As Doubled = Val(Text1.Text)e = Val(Text2.Text)f = d - eText3.Text = fEnd IfIf Check1.Value = "0" ThenElseIf Text1.Text = "" Or Text2.Text = "" Then Form1.Caption = "xataliq kuruldi"Text3.Text = "运算数值不能为空"ElseIf Text1.Text = "" And Text2.Text = "" Then Form1.Caption = "xataliq kuruldi"Text3.Text = "运算数值不能为空"ElseDim a, b, c As Doublea = Val(Text1.Text)b = Val(Text2.Text)c = a - bText3.Text = cText1.Text = ""Text2.Text = ""End IfEnd SubPrivate Sub Command3_Click()Form1.Caption = "欢迎使用智能计算器" If Check1.Value = "1" ThenElseIf Text1.Text = "" Or Text2.Text = "" Then Form1.Caption = "xataliq kuruldi"Text3.Text = "运算数值不能为空"ElseIf Text1.Text = "" And Text2.Text = "" Then Form1.Caption = "xataliq kuruldi"Text3.Text = "运算数值不能为空"ElseDim d, e, f As Doubled = Val(Text1.Text)e = Val(Text2.Text)f = d * eText3.Text = fEnd IfIf Check1.Value = "0" ThenElseIf Text1.Text = "" Or Text2.Text = "" Then Form1.Caption = "xataliq kuruldi"Text3.Text = "运算数值不能为空"ElseIf Text1.Text = "" And Text2.Text = "" Then Form1.Caption = "xataliq kuruldi"Text3.Text = "运算数值不能为空"ElseDim a, b, c As Doublea = Val(Text1.Text)b = Val(Text2.Text)c = a * bText3.Text = cText1.Text = ""Text2.Text = ""End IfEnd SubPrivate Sub Command4_Click()Form1.Caption = "欢迎使用智能计算器" If Check1.Value = "0" ThenElseIf Text1.Text = "" Or Text2.Text = "" Then Form1.Caption = "xataliq kuruldi"Text3.Text = "运算数值不能为空"ElseIf Text1.Text = "" And Text2.Text = "" Then Form1.Caption = "xataliq kuruldi"Text3.Text = "运算数值不能为空" ElseIf Val(Text2.Text) = "0" ThenForm1.Caption = "xataliq kuruldi"Text3.Text = "分数的分子不能为零" ElseDim a, b, c As Doublea = Val(Text1.Text)b = Val(Text2.Text)c = a / bText3.Text = cText1.Text = ""Text2.Text = ""End IfIf Check1.Value = "1" ThenElseIf Text1.Text = "" Or Text2.Text = "" Then Form1.Caption = "xataliq kuruldi"Text3.Text = "运算数值不能为空"ElseIf Text1.Text = "" And Text2.Text = "" Then Form1.Caption = "xataliq kuruldi"Text3.Text = "运算数值不能为空" ElseIf Val(Text2.Text) = "0" ThenForm1.Caption = "xataliq kuruldi"Text3.Text = "分数的分子不能为零" ElseDim d, e, f As Doubled = Val(Text1.Text)e = Val(Text2.Text)f = d / eText3.Text = fEnd IfEnd SubPrivate Sub Command5_Click()Form1.Caption = "欢迎使用智能计算器" Text1.Text = ""Text2.Text = ""Text3.Text = ""End SubPrivate Sub Command6_Click()Form1.Caption = "欢迎使用智能计算器" Form1.HideForm3.ShowEnd SubPrivate Sub Command7_Click()EndEnd SubPrivate Sub Command8_Click()Form1.Caption = "欢迎使用智能计算器" If Text3.Text <> "" ThenText1.Text = Text3.TextText2.Text = ""Text3.Text = ""ElseForm1.Caption = "xataliq kuruldi"Text3.Text = "没有结果无法继续"End IfEnd SubPrivate Sub Text2_Change()End SubPrivate Sub乘_Click()Form1.Caption = "欢迎使用智能计算器" If Check1.Value = "1" ThenElseIf Text1.Text = "" Or Text2.Text = "" Then Form1.Caption = "xataliq kuruldi"Text3.Text = "运算数值不能为空"ElseIf Text1.Text = "" And Text2.Text = "" Then Form1.Caption = "xataliq kuruldi"Text3.Text = "运算数值不能为空"ElseDim d, e, f As Doubled = Val(Text1.Text)e = Val(Text2.Text)f = d * eText3.Text = fEnd IfIf Check1.Value = "0" ThenElseIf Text1.Text = "" Or Text2.Text = "" Then Form1.Caption = "xataliq kuruldi"Text3.Text = "运算数值不能为空"ElseIf Text1.Text = "" And Text2.Text = "" Then Form1.Caption = "xataliq kuruldi"Text3.Text = "运算数值不能为空"ElseDim a, b, c As Doublea = Val(Text1.Text)b = Val(Text2.Text)c = a * bText3.Text = cText1.Text = ""Text2.Text = ""End IfEnd SubPrivate Sub除_Click()Form1.Caption = "欢迎使用智能计算器"If Check1.Value = "0" ThenElseIf Text1.Text = "" Or Text2.Text = "" Then Form1.Caption = "xataliq kuruldi"Text3.Text = "运算数值不能为空"ElseIf Text1.Text = "" And Text2.Text = "" Then Form1.Caption = "xataliq kuruldi"Text3.Text = "运算数值不能为空" ElseIf Val(Text2.Text) = "0" ThenForm1.Caption = "xataliq kuruldi"Text3.Text = "分数的分子不能为零" ElseDim a, b, c As Doublea = Val(Text1.Text)b = Val(Text2.Text)c = a / bText3.Text = cText1.Text = ""Text2.Text = ""End IfIf Check1.Value = "1" ThenElseIf Text1.Text = "" Or Text2.Text = "" Then Form1.Caption = "xataliq kuruldi"Text3.Text = "运算数值不能为空"ElseIf Text1.Text = "" And Text2.Text = "" Then Form1.Caption = "错误"Text3.Text = "运算数值不能为空" ElseIf Val(Text2.Text) = "0" ThenForm1.Caption = "错误"Text3.Text = "分数的分子不能为零" ElseDim d, e, f As Doubled = Val(Text1.Text)e = Val(Text2.Text)f = d / eText3.Text = fEnd IfEnd SubPrivate Sub munasiwetlik_Click()Form1.Caption = "欢迎使用智能计算器" Form1.HideForm3.ShowEnd SubPrivate Sub继续 _Click()Form1.Caption = " 欢迎使用智能计算器" If Text3.Text <> "" ThenText1.Text = Text3.TextText2.Text = ""Text3.Text = ""ElseForm1.Caption = "xataliq"Text3.Text = "没有结果无法继续 "End IfEnd SubPrivate Sub加_Click()Form1.Caption = " 欢迎使用智能计算器" If Check1.Value = "0" ThenElseIf Text1.Text = "" Or Text2.Text = "" Then Form1.Caption = "xataliq kuruldi"Text3.Text = "运算数值不能为空 "ElseIf Text1.Text = "" And Text2.Text = "" Then Form1.Caption = "错误"Text3.Text = "运算数值不能为空"ElseDim a, b, c As Doublea = Val(Text1.Text)b = Val(Text2.Text)c = a + bText3.Text = cText1.Text = ""Text2.Text = ""End IfIf Check1.Value = "1" ThenElseIf Text1.Text = "" Or Text2.Text = "" Then Form1.Caption = "xataliq kuruldi"Text3.Text = "运算数值不能为空"ElseIf Text1.Text = "" And Text2.Text = "" Then Form1.Caption = "xataliq kuruldi"Text3.Text = "运算数值不能为空"ElseDim d, e, f As Doubled = Val(Text1.Text)e = Val(Text2.Text)f = d + eText3.Text = fEnd IfEnd SubPrivate Sub减_Click()Form1.Caption = "欢迎使用智能计算器" If Check1.Value = "1" ThenElseIf Text1.Text = "" Or Text2.Text = "" Then Form1.Caption = "xataliq kuruldi"Text3.Text = "运算数值不能为空"ElseIf Text1.Text = "" And Text2.Text = "" Then Form1.Caption = "错误"Text3.Text = "运算数值不能为空"ElseDim d, e, f As Doubled = Val(Text1.Text)e = Val(Text2.Text)f = d - eText3.Text = fEnd IfIf Check1.Value = "0" ThenElseIf Text1.Text = "" Or Text2.Text = "" Then Form1.Caption = "错误"Text3.Text = "运算数值不能为空"ElseIf Text1.Text = "" And Text2.Text = "" Then Form1.Caption = "错误"Text3.Text = "运算数值不能为空"ElseDim a, b, c As Doublea = Val(Text1.Text)b = Val(Text2.Text)c = a - bText3.Text = cText1.Text = ""Text2.Text = ""End IfEnd SubPrivate Sub清空_Click()Form1.Caption = "欢迎使用智能计算器" Text1.Text = ""Text2.Text = ""Text3.Text = ""End Sub----------------------------------------------form2 ?? ???? ??????Private Sub Command1_Click() Form3.HideForm1.ShowForm1.Text3.Text = ""End SubPrivate Sub Command2_Click() EndEnd Sub。
vb编程代码大全
vb编程代码大全Visual Basic (VB) 是一种广泛用于软件开发的高级编程语言,可以用于开发 Windows 应用程序、Web 应用程序、数据库应用程序等。
在本文中,将介绍一些常用的 VB 编程代码,帮助初学者快速入门和提高编程水平。
一、基本数据类型1. 整型数据在 VB 中,整型数据可以使用 Integer 类型表示,范围为 -32,768 到32,767。
定义整型变量的代码如下:```Dim num As Integernum = 10```2. 浮点数据浮点数据可以使用 Single 或 Double 类型表示,分别表示单精度浮点数和双精度浮点数。
定义浮点变量的代码如下:```Dim num As Singlenum = 3.143. 字符串数据字符串数据可以使用 String 类型表示,可以存储文本数据。
定义字符串变量的代码如下:```Dim str As Stringstr = "Hello, World!"```二、控制流程1. If...Then...Else 语句If...Then...Else 语句用于根据条件执行不同的代码块。
例如:```Dim num As Integernum = 10If num > 0 ThenMsgBox("Num is positive.")ElseMsgBox("Num is negative.")End If2. For 循环For 循环用于重复执行一段代码。
例如:```For i = 1 To 10MsgBox(i)Next i```3. Do While 循环Do While 循环在满足条件时执行代码块。
例如:```Dim i As Integeri = 1Do While i <= 10MsgBox(i)i = i + 1Loop```三、数组1. 一维数组一维数组在 VB 中用于存储相同类型的多个元素。
VB常用代码
VB常用代码Private Declare Function fCreateShellLink Lib "" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As LongSub Command1_Click()Dim lReturn As Long'添加到桌面lReturn = fCreateShellLink("..\..\Desktop", "Shortcut to Calculator", "c:\windows\", "")'添加到程序组lReturn = fCreateShellLink("", "Shortcut to Calculator", "c:\windows\", "")'添加到启动组lReturn = fCreateShellLink("\Startup", "Shortcut to Calculator", "c:\windows\", "")End Sub问题二、如何让程序在Windows 启动时自动执行?有以下二个方法:方法1: 直接将快捷方式放到启动群组中。
方法2:在注册档HKEY_LOCAL_MACHINE 中找到以下机码\Software\Microsoft\Windows\CurrentVersion\Run新增一个字串值,包括二个部份1. 名称部份:自己取名,可设定为AP 名称。
代码及外文文献
附录1 部分源代码1)系统主窗体(M DIFrm M ain)Private Sub aboutcheng_Click() '显示科研成果查询窗体frmprint2.ShowEnd SubPrivate Sub aboutxm_Click() '显示项目查询窗体frmPrint.ShowEnd SubPrivate Sub code_Click() '显示密码更改窗体frmPasswordChange.ShowEnd SubPrivate Sub exit_Click() '退出Dim answer As StringDim Cancel As Integeranswer = MsgBox("是否退出本系统?", vbInformation + vbYesNo, "警告")If answer = vbNo ThenCancel = 1ElseIf answer = vbYes ThenEndEnd IfEnd SubPrivate Sub help_Click() '帮助frmSplash.ShowEnd SubPrivate Sub kedit_Click() '显示科研成果录入窗体frmCheng.ShowEnd SubPrivate Sub km_Click() '显示科研成果修改窗体frmChengModify.ShowEnd SubPrivate Sub MDIForm_Load() '主窗体登录If LogAdimsucceeded = False Then '在这里设置用户权限user.Enabled = False: code.Enabled = Falseproj.Enabled = False: proc.Enabled = False: mon.Enabled = Falsekeyan.Enabled = FalseEnd IfEnd SubPrivate Sub mm_Click() '显示经费修改窗体frmMonModify.ShowEnd SubPrivate Sub monedit_Click() '显示经费录入窗体frmMonEdit.ShowEnd SubPrivate Sub pedit_Click() '显示项目基本情况录入窗体frmProjEdit.ShowEnd SubPrivate Sub pm_Click() '显示项目基本情况修改窗体frmProjModify.ShowEnd SubPrivate Sub predit_Click() '显示项目进度情况录入窗体frmProcEdit.ShowEnd SubPrivate Sub prm_Click() '显示项目进度情况修改窗体frmProcModify.ShowEnd SubPrivate Sub searall_Click() '显示所有项目情况查询窗体frmSearchxm.Showssear = "all"End SubPrivate Sub searfuze_Click() '显示按申请者姓名进行项目查询窗体frmSearch.Showssear = "2"With frmSearch.Label1.Caption = "请输入申请者姓名:"End WithEnd SubPrivate Sub searname_Click() '显示按输入项目名称进行查询窗体frmSearch.ShowfrmSearch.Showssear = "1"With frmSearch.Label1.Caption = "请输入项目名称:"End WithEnd SubPrivate Sub searxueke_Click() '显示按学科进行项目查询窗体frmSearch.Showssear = "3"With frmSearch.Label1.Caption = "请输入学科:"End WithEnd SubPrivate Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) '工具拦Select Case Button.IndexCase 1frmProjEdit.ShowCase 3frmSearchxm.Showssear = "all"Case 5frmPrint.ShowCase 7frmSplash.ShowCase 9If MsgBox("是否真的退出系统?", vbQuestion + vbYesNo, "登录验证") =vbYes ThenUnload MeEnd IfEnd SelectEnd SubPrivate Sub Toolbar1_ButtonMenuClick (ByValButtonMenu AsMSComctlLib.ButtonMenu) '工具栏菜单Select Case ButtonMenu.IndexCase 1frmSearch.Showssear = "1"bel1.Caption = "请输入项目名称:"Case 2frmSearch.Showssear = "2"bel1.Caption = "请输入申请者姓名:"Case3frmSearch.Showssear = "3"bel1.Caption = "请输入学科:"Case 5frmSearchxm.Showssear = "all"End SelectEnd SubPrivate Sub user_Click() '显示用户管理窗体frmUserManage.ShowEnd sub2)登录窗体(frmLogin)Option ExplicitDim rsuser As DAO.RecordsetPrivate Sub cmdCancel_Click()Dim answer As StringDim Cancel As Integeranswer = MsgBox("是否退出本系统?", vbInformation + vbYesNo, "警告")If answer = vbNo ThenCancel = 1ElseIf answer = vbYes ThenEndEnd IfEnd SubPrivate Sub cmdOk_Click()Set db = OpenDatabase(App.Path & "/课题数据库I.mdb")Set rsuser = db.OpenRecordset("select * from 用户表where 用户名='" &txtUserName.Text & "' and 密码='" & txtPassword.Text & "'") If Not (rsuser.EOF And rsuser.BOF) ThenIf rsuser.Fields("身份") = "管理员" ThenLogAdimsucceeded = True '说明是管理员登录LoginID = rsuser.Fields("用户名")LoginPassword = rsuser.Fields("密码")MDIFrmMain.ShowMe.HideElseLogAdimsucceeded = False '普通用户登录LoginID = rsuser.Fields("用户名")LoginPassword = rsuser.Fields("密码")MDIFrmMain.ShowMe.HideEnd IfElseMsgBox "无效的密码,请重试!", , "登录"txtPassword.SetFocusSendKeys "{Home}+{End}"End IfEnd SubPrivate Sub Form_Unload(Cancel As Integer) '确定关闭系统Dim answer As Stringanswer = MsgBox("是否退出本系统?", vbInformation + vbYesNo, "警告")If answer = vbNo ThenCancel = 1ElseIf answer = vbYes ThenEndEnd IfEnd Sub3)密码修改窗体(frmPasswordChange)Dim rspach As DAO.RecordsetPrivate Sub cmdExit_Click()Me.HideEnd SubPrivate Sub Form_Load()txtOldPWD = LoginPasswordtxtOldPWD.Locked = TrueEnd SubPrivate Sub cmdSave_Click()If txtNewPWD(1) <> txtNewPWD(0) ThenMsgBox "两次输入的新口令必须相等!", vbExclamation, "新口令"txtNewPWD(0).SetFocustxtNewPWD(0).SelStart = 0txtNewPWD(0).SelLength = Len(txtNewPWD(0))ElseSet db = OpenDatabase(App.Path & "/课题数据库I.mdb")Set rspach = db.OpenRecordset("select * from 用户表 where 用户名 = '" & LoginID&"'") rspach.Editrspach.Fields("密码") = txtNewPWD(0).TextMsgBox "口令修改成功!", vbInformation, "修改口令"rspach.Updaterspach.ClosetxtNewPWD(0).Text = ""txtNewPWD(1).Text = ""Me.HideEnd IfEnd Sub4)用户管理窗体(frmUser M anage)Dim rsum As DAO.RecordsetPrivate Sub cmdAdd_Click()MsgBox "请在表中直接添加用户!", vbInformation, ""cmdAdd.Enabled = FalsecmdSave.Enabled = TrueEnd SubPrivate Sub cmdAlter_Click()MsgBox "请在表中直接修改用户", vbInformation, ""cmdAlter.Enabled = FalsecmdSave.Enabled = TrueEnd SubPrivate Sub cmdDelete_Click()Set db = OpenDatabase(App.Path & "/课题数据库I.mdb")Set rsum = db.OpenRecordset("SELECT * FROM 用户表WHERE 用户名= '" &DataGrid1.Columns(0) &"'")Dim d As Integerd = MsgBox("确实要删除吗?", vbQuestion + vbYesNo, "删除记录")If d = vbYes Thenrsum.DeleteMsgBox "删除成功!", vbInformation + vbOKOnly, ""Adodc1.RefreshcmdSave.Enabled = TruecmdDelete.Enabled = FalseEnd IfEnd SubPrivate Sub cmdSave_Click()cmdAdd.Enabled = TrueDataGrid1.RefreshEnd SubPrivate Sub cmdUnload_Click()Unload MeEnd SubPrivate Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer) cmdDelete.Enabled = TrueEnd SubPrivate Sub Form_Load()cmdDelete.Enabled = FalsecmdSave.Enabled = FalseAdodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;PersistSecurity Info=False;Data Source=" & App.Path & "/课题数据库I.mdb"mandType = adCmdUnknownss = "SELECT * FROM 用户表"Adodc1.RecordSource = ssAdodc1.RefreshEnd Sub5)项目基本情况录入窗体(frmProjEdit)Public AddRecord As BooleanPrivate Sub cmdAdd_Click() ' ‘新添项目’按钮ClearDisplay ' 清除项目基本信息ClearDisplay2 ' 清除负责人信息AddRecord = TrueSSTab1.Enabled = TruecmdSave.Enabled = TrueDataGrid1.AllowAddNew = TruecmdAdd.Enabled = FalseWith rs1 '自动增加项目编号If .RecordCount > 0 Then.MoveLasttxtNum = .RecordCount + 1.MoveFirstElsetxtNum = 1End IfEnd WithDim sql3 As String ' 将Adodc1控件连接数据库,Datagrid1中添加参加人员信息Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Persist SecurityInfo=False;Data Source=" & App.Path & "/课题数据库I.mdb"mandType = adCmdUnknownsql3 = "SELECT 姓名,性别,出生日期,专业职务,研究专长,学位,学历 FROM 参加人员表WHERE 项目编号 LIKE '" &txtNum.Text & "%'"Set rs3 = db.OpenRecordset(sql3, dbOpenDynaset)Adodc1.RecordSource = sql3Adodc1.RefreshText2(0).SetFocusEnd SubPrivate Sub cmdRubiao_Click() '‘入表’按钮Dim stcan As StringDim rscan As Recordsetstcan = "select * from 参加人员表 where 项目编号 like '" & Trim(txtNum.Text) & "%'"Set rscan = db.OpenRecordset(stcan, dbOpenDynaset)If rscan.EOF And rscan.BOF Thenrscan.AddNewrscan.Fields("项目编号") = txtNum.TextIf txtcan(17) <> "" Then rscan.Fields("姓名") = txtcan(17).TextIf txtcan(16) <> "" Then rscan.Fields("出生日期") = txtcan(16).TextIf txtcan(15) <> "" Then rscan.Fields("研究专长") = txtcan(15).TextIf txtcan(12) <> "" Then rscan.Fields("专业职务") = txtcan(12).TextIf txtcan(13) <> "" Then rscan.Fields("学位") = txtcan(13).TextIf txtcan(14) <> "" Then rscan.Fields("学历") = txtcan(14).TextIf cmbsex(2) <> "" Then rscan.Fields("性别") = cmbsex(2).Textrscan.UpdateMsgBox "已列入表中!", vbOKOnlyClearDisplay3rscan.CloseAdodc1.RefreshEnd IfEnd SubPrivate Sub cmdSave_Click() '‘保存’按钮If (Not Text2(3).Text = "") And (Not IsNumeric(Trim(Text2(3).Text))) Then MsgBox "请您正确输入申请经费!", vbInformation + vbOKOnly, "提示"Text2(3).SetFocusSendKeys "{home}+{end}"Exit SubElseIf (Text2(0).Text = "") ThenMsgBox "请您输入项目名称!", vbInformation + vbOKOnly, "提示"Text2(0).SetFocusExit SubElseIf (Not Text2(4).Text = "") And (Not IsDate(Trim(Text2(4).Text))) ThenMsgBox "请您正确输入起始时间!", vbInformation + vbOKOnly, "提示"Exit SubElseIf (Not Text2(5).Text = "") And (Not IsDate(Trim(Text2(4).Text))) Then MsgBox "请您正确输入截止时间!", vbInformation + vbOKOnly, "提示"Exit SubElseIf (Not text3(1).Text = "") And (Not IsDate(Trim(text3(1).Text))) Then MsgBox "请您正确输入申请人的出生日期!", vbInformation + vbOKOnly, "提示"Exit SubElseIf (Not txtcan(16).Text = "") And (Not IsDate(Trim(txtcan(16).Text))) Then MsgBox "请您正确输入参加者的出生日期!", vbInformation + vbOKOnly, "提示"Exit SubElseIf Not Text2(4).Text = "" And Not Text2(5).Text = "" And DateDiff("d",Text2(4), Text2(5)) <= 0 ThenMsgBox "请您正确输入起止时间!", vbInformation + vbOKOnly, "提示"Exit SubElsers1.AddNewWriteRecordrs1.Updaters2.AddNewWriteRecord2rs2.UpdateMsgBox "保存成功!", vbOKOnly, ""cmdAdd.Enabled = TruecmdSave.Enabled = FalseEnd IfEnd SubPrivate Sub cmdUnload_Click()Unload MeEnd SubPrivate Sub Form_Load()cmdSave.Enabled = FalseAddRecord = FalseSSTab1.Enabled = FalseSet db = OpenDatabase(App.Path & "/课题数据库I.mdb")Dim sql1 As Stringsql1 = "select * from 项目基本情况表"Set rs1 = db.OpenRecordset(sql1, dbOpenDynaset)Dim m As IntegerClearDisplayDim sql2 As Stringsql2 = "SELECT * FROM 项目人员表 WHERE 项目编号 LIKE '" & Trim(txtNum.Text) & "%' AND 项目中的分工 LIKE '" & 负责 & "'"Set rs2 = db.OpenRecordset(sql2, dbOpenDynaset)ClearDisplay2End SubPublic Sub ClearDisplay() ' 清除项目基本信息Dim i As IntegerDim j As IntegerFor i = 0 To 8Text2(i) = ""NextFor j = 0 To 2Combo1(j).Text = ""NextEnd SubPublic Sub ClearDisplay2() ' 清除负责人信息Dim i As IntegerDim j As IntegerFor i = 0 To 11text3(i) = ""NextFor j = 0 To 1Combo2(j).Text = ""NextEnd SubPublic Sub WriteRecord() ' 将录入的项目基本信息添加到数据库表中With rs1If txtNum.Text <> "" Then .Fields(0) = txtNum.TextIf Text2(0).Text <> "" Then .Fields(1) = Text2(0).TextIf Text2(1).Text <> "" Then .Fields(2) = Text2(1).TextIf Combo1(0).Text <> "" Then .Fields(3) = Combo1(0).TextIf Combo1(1).Text <> "" Then .Fields(4) = Combo1(1).TextIf Combo1(2).Text <> "" Then .Fields(5) = Combo1(2).TextIf Text2(4).Text <> "" Then .Fields(6) = Text2(4).TextIf Text2(5).Text <> "" Then .Fields(7) = Text2(5).TextIf Text2(3).Text <> "" Then .Fields(8) = Text2(3).TextIf Text2(6).Text <> "" Then .Fields(9) = Text2(6).TextIf Text2(7).Text <> "" Then .Fields(10) = Text2(7).TextIf Text2(8).Text <> "" Then .Fields(11) = Text2(8).TextIf Text2(2).Text <> "" Then .Fields(12) = Text2(2).TextIf text3(0).Text <> "" Then .Fields(13) = text3(0).Text End WithEnd SubPublic Sub WriteRecord2() ' 将录入的负责人员信息添加到数据库表中With rs2If text3(0) <> "" Then .Fields(1) = text3(0)If Combo2(0) <> "" Then .Fields(2) = Combo2(0)If Combo2(1) <> "" Then .Fields(3) = Combo2(1)If text3(1) <> "" Then .Fields(4) = text3(1)If text3(5) <> "" Then .Fields(5) = text3(5)If text3(8) <> "" Then .Fields(6) = text3(8)If text3(2) <> "" Then .Fields(7) = text3(2)If text3(6) <> "" Then .Fields(8) = text3(6)If text3(9) <> "" Then .Fields(9) = text3(9)If text3(3) <> "" Then .Fields(10) = text3(3)If text3(7) <> "" Then .Fields(11) = text3(7)If text3(10) <> "" Then .Fields(12) = text3(10)If text3(4) <> "" Then .Fields(13) = text3(4)If text3(11) <> "" Then .Fields(14) = text3(11).Fields("项目中的分工") = "负责".Fields("项目编号") = txtNumEnd WithEnd SubPrivate Sub Form_Unload(Cancel As Integer)Set DataGrid1.DataSource = NothingEnd SubPublic Sub ClearDisplay3()txtcan(17).Text = ""txtcan(16).Text = ""txtcan(15).Text = ""txtcan(12).Text = ""txtcan(13).Text = ""txtcan(14).Text = ""cmbsex(2).Text = ""End Sub6)项目基本情况修改窗体(frmProj M odify)Public AlterRecord As BooleanPrivate Sub cmdAlter_Click()MsgBox "请首先选择需要修改的项目!", vbInformation + vbOKOnly, ""End SubPrivate Sub cmdDelete_Click()cmdDelete.Enabled = FalseSet db = OpenDatabase(App.Path & "/课题数据库I.mdb")Dim rsxmj1 As Recordset: Dim rsren1 As Recordset: Dim rscanjia1 As Recordset Set rsxmj1 = db.OpenRecordset("select * from 项目基本情况表 where 项目编号='" &frmProjSelectPM.DataGrid1.Columns(0) &"'")Set rsren1 = db.OpenRecordset("select * from 项目人员表 where 项目编号='" &frmProjSelectPM.DataGrid1.Columns(0) &"'")Set rscanjia1 = db.OpenRecordset("select * from 参加人员表 where 项目编号='" &Trim(txtNum.Text) &"'")Dim d As Integerd = MsgBox("确实要删除关于该项目的所有信息" & vbCr _ & "(包括申请人、参加人)吗?", vbQuestion + vbYesNo, "删除记录")If d = vbYes Thenrsxmj1.Deletersren1.Deletersxmj1.MoveNextrsren1.MoveNextIf rsxmj1.RecordCount > 0 ThenIf rsxmj1.EOF Thenrsxmj1.MoveLastEnd IfElsersxmj1.AddNewEnd IfIf rsren1.RecordCount > 0 ThenIf rsxren1.EOF Thenrsren1.MoveLastEnd IfElsersren1.AddNewEnd Ifrsxmj1.Closersren1.CloseDim mm As Integer: Dim nn As IntegerIf Not (rscanjia1.BOF And rscanjia1.EOF) Thenrscanjia1.MoveLastmm = rscanjia1.RecordCountFor nn = 1 To mmrscanjia1.DeleteSet rscanjia1 = db.OpenRecordset("select * from 参加人员表 where 项目编号='" &Trim(txtNum.Text) &"'")NextEnd IfMsgBox "删除成功!", vbOKOnlyAdodc1.RefreshClearAllEnd Ifrscanjia1.CloseEnd SubPrivate Sub cmdExit_Click()AlterRecord = FalsefrmProjSelectPM.Write1frmProjSelectPM.Write2End SubPrivate Sub cmdSave_Click()Dim stxmj As StringDim rsxmj As RecordsetSet db = OpenDatabase(App.Path & "/课题数据库I.mdb")stxmj = "select * from 项目基本情况表where 项目编号='" &frmProjSelectPM.DataGrid1.Columns(0)& "'"Set rsxmj = db.OpenRecordset(stxmj, dbOpenDynaset)With rsxmj.EditIf txtNum.Text <> "" Then .Fields(0) = txtNum.TextIf Text2(0).Text <> "" Then .Fields(1) = Text2(0).TextIf Text2(1).Text <> "" Then .Fields(2) = Text2(1).TextIf Combo1(0).Text <> "" Then .Fields(3) = Combo1(0).TextIf Combo1(1).Text <> "" Then .Fields(4) = Combo1(1).TextIf Combo1(2).Text <> "" Then .Fields(5) = Combo1(2).TextIf Text2(4).Text <> "" Then .Fields(6) = Text2(4).TextIf Text2(5).Text <> "" Then .Fields(7) = Text2(5).TextIf Text2(3).Text <> "" Then .Fields(8) = Text2(3).TextIf Text2(6).Text <> "" Then .Fields(9) = Text2(6).TextIf Text2(7).Text <> "" Then .Fields(10) = Text2(7).TextIf Text2(8).Text <> "" Then .Fields(11) = Text2(8).TextIf Text2(2).Text <> "" Then .Fields(12) = Text2(2).TextIf text3(0).Text <> "" Then .Fields(13) = text3(0).Text.UpdateEnd WithDim stren As StringDim rsren As RecordsetSet db = OpenDatabase(App.Path & "/课题数据库I.mdb")stren = "select * from 项目人员表where 项目编号='" &frmProjSelectPM.DataGrid1.Columns(0)& "'"Set rsren = db.OpenRecordset(stren, dbOpenDynaset)With rsren.EditIf text3(0) <> "" Then .Fields(1) = text3(0)If Combo2(0) <> "" Then .Fields(2) = Combo2(0)If Combo2(1) <> "" Then .Fields(3) = Combo2(1)If text3(1) <> "" Then .Fields(4) = text3(1)If text3(5) <> "" Then .Fields(5) = text3(5)If text3(8) <> "" Then .Fields(6) = text3(8)If text3(2) <> "" Then .Fields(7) = text3(2)If text3(6) <> "" Then .Fields(8) = text3(6)If text3(9) <> "" Then .Fields(9) = text3(9)If text3(3) <> "" Then .Fields(10) = text3(3)If text3(7) <> "" Then .Fields(11) = text3(7)If text3(10) <> "" Then .Fields(12) = text3(10)If text3(4) <> "" Then .Fields(13) = text3(4)If text3(11) <> "" Then .Fields(14) = text3(11) .UpdateEnd WithMsgBox "修改成功!", vbInformation + vbOKOnly, "" rsxmj.Closersren.ClosecmdSave.Enabled = FalsecmdDelete.Enabled = FalsecmdExit.Enabled = FalsecmdAlter.Enabled = TrueEnd SubPrivate Sub cmdUnload_Click()Unload MeEnd SubPrivate Sub Command1_Click()frmProjSelectPM.ShowfrmProjSelectPM.Adodc1.RefreshEnd SubPrivate Sub Form_Load()AlterRecord = FalsecmdDelete.Enabled = FalsecmdSave.Enabled = FalsecmdExit.Enabled = FalseSSTab1.Enabled = FalseEnd SubPublic Sub ClearAll()txtNum.Text = ""Text2(0).Text = ""Text2(1).Text = ""Combo1(0).Text = ""Combo1(1).Text = ""Combo1(2).Text = ""Text2(4).Text = ""Text2(5).Text = ""Text2(3).Text = ""Text2(6).Text = ""Text2(7).Text = ""Text2(8).Text = ""Text2(2).Text = ""text3(0) = ""Combo2(0) = ""Combo2(1) = ""text3(1) = ""text3(5) = ""text3(8) = ""text3(2) = ""text3(6) = ""text3(9) = ""text3(3) = ""text3(7) = ""text3(10) = ""text3(4) = ""text3(11) = ""End Sub7)项目进展情况录入窗体(frmProcEdit)Option ExplicitPublic AddRecord As BooleanPrivate Sub cmdAdd_Click()MsgBox "请首先选择需要添加阶段的项目!", vbInformation + vbOKOnly, "" AddRecord = TrueEnd SubPrivate Sub cmdExit_Click()AddRecord = FalseClearEnd SubPrivate Sub cmdSave_Click()If Text2.Text = "" ThenMsgBox "请输入阶段号!", vbInformation + vbOKOnly, "提示"Exit SubElseIf (Not Text4.Text = "") And (Not IsDate(Trim(Text4.Text))) Then MsgBox "请您正确输入检查日期!", vbInformation + vbOKOnly, "提示" Exit SubEnd IfDim sql As StringSet db = OpenDatabase(App.Path & "/课题数据库I.mdb")sql = "select * from 项目进展情况表where 项目编号='" & frmProjSelect1.DataGrid1.Columns(0) & "'AND 阶段号 ='" & Text2.Text& "'"Set rsp = db.OpenRecordset(sql, dbOpenDynaset)If rsp.EOF And rsp.BOF Thenrsp.AddNewrsp.Fields("项目编号") = frmProjSelect1.DataGrid1.Columns(0)rsp.Fields(1)=Text2.Text '阶段号If Combo1.Text<>"" Then rsp.Fields(2) = Combo1.Text '研究进度If Text4 <> "" Then rsp.Fields(3) = Text4 '检查日期Dim i As IntegerFor i = 0 To 4If Text3(i) <> "" Then rsp.Fields(i + 4) = Text3(i)Nextrsp.Updatersp.CloseMsgBox "保存成功!", vbOKOnly, ""ClearAdodc1.RefreshcmdAdd.Enabled = TruecmdSave.Enabled = FalseAddRecord = False '不在添加状态Exit SubEnd IfMsgBox "阶段号不能重复!", vbInformation + vbOKOnly, "提示"ClearEnd SubPrivate Sub Command1_Click() '选择项目按钮cmdSave.Enabled = TruecmdAdd.Enabled = FalsefrmProjSelect1.ShowAddRecord = TrueEnd SubPrivate Sub cmdUnload_Click()Unload MeEnd SubPrivate Sub Command2_Click() '查看项目基本情况按钮Set db = OpenDatabase(App.Path & "/课题数据库I.mdb")Dim tt1 As StringDim rsxm As DAO.Recordsettt1 = "SELECT * FROM 项目基本情况表 WHERE 项目编号 = '" &frmProjSelect1.DataGrid1.Columns(0) & "'"Set rsxm = db.OpenRecordset(tt1)frmProjSearOne.Showmand2.Visible = FalseIf rsxm.Fields(0) <> "" Then frmProjSearOne.txtNum.Text = rsxm.Fields(0)If rsxm.Fields(1) <> "" Then frmProjSearOne.Text2(0).Text = rsxm.Fields(1)If rsxm.Fields(2) <> "" Then frmProjSearOne.Text2(1).Text = rsxm.Fields(2)If rsxm.Fields(3) <> "" Then bo1(0).Text = rsxm.Fields(3)If rsxm.Fields(4) <> "" Then bo1(1).Text = rsxm.Fields(4)If rsxm.Fields(5) <> "" Then bo1(2).Text = rsxm.Fields(5)If rsxm.Fields(6) <> "" Then frmProjSearOne.Text2(4).Text = rsxm.Fields(6)If rsxm.Fields(7) <> "" Then frmProjSearOne.Text2(5).Text = rsxm.Fields(7)If rsxm.Fields(8) <> "" Then frmProjSearOne.Text2(3).Text = rsxm.Fields(8)If rsxm.Fields(9) <> "" Then frmProjSearOne.Text2(6).Text = rsxm.Fields(9)If rsxm.Fields(10) <> "" Then frmProjSearOne.Text2(7).Text = rsxm.Fields(10)If rsxm.Fields(11) <> "" Then frmProjSearOne.Text2(8).Text = rsxm.Fields(11)If rsxm.Fields(12) <> "" Then frmProjSearOne.Text2(2).Text = rsxm.Fields(12)Dim stren As StringDim rsren As RecordsetSet db = OpenDatabase(App.Path & "/课题数据库I.mdb")stren = "select * from 项目人员表where 项目编号='" &frmProjSelect1.DataGrid1.Columns(0) &"'"Set rsren = db.OpenRecordset(stren, dbOpenDynaset)If rsren.Fields(1) <> "" Then frmProjSearOne.Text3(0) = rsren.Fields(1)If rsren.Fields(2) <> "" Then bo2(0) = rsren.Fields(2)If rsren.Fields(3) <> "" Then bo2(1) = rsren.Fields(3)If rsren.Fields(4) <> "" Then frmProjSearOne.Text3(1) = rsren.Fields(4)If rsren.Fields(5) <> "" Then frmProjSearOne.Text3(5) = rsren.Fields(5)If rsren.Fields(6) <> "" Then frmProjSearOne.Text3(8) = rsren.Fields(6)If rsren.Fields(7) <> "" Then frmProjSearOne.Text3(2) = rsren.Fields(7)If rsren.Fields(8) <> "" Then frmProjSearOne.Text3(6) = rsren.Fields(8)If rsren.Fields(9) <> "" Then frmProjSearOne.Text3(9) = rsren.Fields(9)If rsren.Fields(10) <> "" Then frmProjSearOne.Text3(3) = rsren.Fields(10)If rsren.Fields(11) <> "" Then frmProjSearOne.Text3(7) = rsren.Fields(11)If rsren.Fields(12) <> "" Then frmProjSearOne.Text3(10) = rsren.Fields(12)If rsren.Fields(13) <> "" Then frmProjSearOne.Text3(4) = rsren.Fields(13)If rsren.Fields(14) <> "" Then frmProjSearOne.Text3(11) = rsren.Fields(14)With frmProjSearOne.Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;PersistSecurity Info=False;Data Source=" & App.Path & "/课题数据库I.mdb"mandType = adCmdUnknownDim stcanjia As Stringstcanjia = "select 姓名,性别,出生日期,专业职务,研究专长,学历,学位 from 参加人员表where 项目编号='" &frmProjSelect1.DataGrid1.Columns(0) & "'".Adodc1.RecordSource = stcanjia.Adodc1.RefreshEnd WithEnd SubPrivate Sub Form_Load()cmdSave.Enabled = FalsecmdExit.Enabled = FalseAddRecord = False '不在添加状态Text2.Enabled = False: Text4.Enabled = False: Combo1.Enabled = FalseSSTab1.Enabled = FalseCommand2.Enabled = FalseEnd SubPublic Sub Clear()Text2 = "": Text4 = "": Combo1.Text = ""Dim i As IntegerFor i = 0 To 4Text3(i) = ""NextEnd Sub8)项目进展情况修改窗体(frmProc M odify)Option ExplicitPublic AlterRecord As BooleanPrivate Sub cmdAlter_Click()MsgBox "请首先选择需要修改的项目!", vbInformation + vbOKOnly, ""AlterRecord = TrueEnd SubPrivate Sub Command2_Click()Set db = OpenDatabase(App.Path & "/课题数据库I.mdb")Dim tt1 As StringDim rsxm As DAO.Recordsettt1 = "SELECT * FROM 项目基本情况表WHERE 项目编号= '" &frmProjSelect3.DataGrid1.Columns(0)& "'"Set rsxm = db.OpenRecordset(tt1)frmProjSearOne.Showmand2.Visible = FalseIf rsxm.Fields(0) <> "" Then frmProjSearOne.txtNum.Text = rsxm.Fields(0)If rsxm.Fields(1) <> "" Then frmProjSearOne.Text2(0).Text = rsxm.Fields(1)If rsxm.Fields(2) <> "" Then frmProjSearOne.Text2(1).Text = rsxm.Fields(2)If rsxm.Fields(3) <> "" Then bo1(0).Text = rsxm.Fields(3)If rsxm.Fields(4) <> "" Then bo1(1).Text = rsxm.Fields(4)If rsxm.Fields(5) <> "" Then bo1(2).Text = rsxm.Fields(5)If rsxm.Fields(6) <> "" Then frmProjSearOne.Text2(4).Text = rsxm.Fields(6)If rsxm.Fields(7) <> "" Then frmProjSearOne.Text2(5).Text = rsxm.Fields(7)If rsxm.Fields(8) <> "" Then frmProjSearOne.Text2(3).Text = rsxm.Fields(8)If rsxm.Fields(9) <> "" Then frmProjSearOne.Text2(6).Text = rsxm.Fields(9)If rsxm.Fields(10) <> "" Then frmProjSearOne.Text2(7).Text = rsxm.Fields(10)If rsxm.Fields(11) <> "" Then frmProjSearOne.Text2(8).Text = rsxm.Fields(11)If rsxm.Fields(12) <> "" Then frmProjSearOne.Text2(2).Text = rsxm.Fields(12)Dim stren As StringDim rsren As RecordsetSet db = OpenDatabase(App.Path & "/课题数据库I.mdb")stren = "select * from 项目人员表where 项目编号='" &frmProjSelect3.DataGrid1.Columns(0)& "'"Set rsren = db.OpenRecordset(stren, dbOpenDynaset)If rsren.Fields(1) <> "" Then frmProjSearOne.Text3(0) = rsren.Fields(1)If rsren.Fields(2) <> "" Then bo2(0) = rsren.Fields(2)If rsren.Fields(3) <> "" Then bo2(1) = rsren.Fields(3)If rsren.Fields(4) <> "" Then frmProjSearOne.Text3(1) = rsren.Fields(4)If rsren.Fields(5) <> "" Then frmProjSearOne.Text3(5) = rsren.Fields(5)If rsren.Fields(6) <> "" Then frmProjSearOne.Text3(8) = rsren.Fields(6)If rsren.Fields(7) <> "" Then frmProjSearOne.Text3(2) = rsren.Fields(7)If rsren.Fields(8) <> "" Then frmProjSearOne.Text3(6) = rsren.Fields(8)If rsren.Fields(9) <> "" Then frmProjSearOne.Text3(9) = rsren.Fields(9)If rsren.Fields(10) <> "" Then frmProjSearOne.Text3(3) = rsren.Fields(10)。
VB文字加密程序
VB文字加密程序:界面如下:源代码如下:Private Sub Ca1_Click()If Ca1.Value = 1 Thentxt.Enabled = TrueEnd IfIf Ca1.Value = 0 Thentxt.Enabled = FalseEnd IfEnd SubPrivate Sub Command1_Click()Me.Enabled = Falseasd.Max = Len(Text1.Text)asd.Value = 0'On Error GoTo x'x:'MsgBox Err.Description, vbOKOnly, Err.Number Dim n As String, m As String, a As StringFor i = 1 To Len(Text1.Text) ‘循环n = Asc(Mid(Text1.Text, i, 1)) + txt.Texta = Len(n)If a <> 6 ThenFor j = 1 To 6 - an = n & " "asd.Value = iNext jEnd Ifm = m & nNext iText2.Text = mMe.Enabled = TrueEnd SubPrivate Sub Command2_Click()'On Error GoTo x'x:'MsgBox Err.Description, vbOKOnly, Err.Number Me.Enabled = Falseasd.Max = Len(Text1.Text)asd.Value = 0Dim n As String, m As String, a As StringIf txt.Text = 0 ThenFor i = 1 To Len(Text1.Text) Step 6n = Mid(Text1.Text, i, 6)m = m & Chr(n)asd.Value = iNextText2.Text = mMe.Enabled = TrueEnd IfIf txt.Text <> 0 ThenFor i = 1 To Len(Text1.Text) Step 6n = Mid(Text1.Text, i, 6)m = m & Chr(n - Val(txt.Text))NextText2.Text = mMe.Enabled = TrueEnd IfEnd SubPrivate Sub Command3_Click()Dim n As String, m As StringText1.Text = ""Text2.Text = ""CommonDialog1.Filter = "文本文件(.txt)|*.txt" CommonDialog1.ShowOpenOpen CommonDialog1.FileName For Input As #1 While Not EOF(1)Line Input #1, nm = m & n & vbCrLfWendClose #1Text1.Text = ""Text1.Text = mEnd SubPrivate Sub Command4_Click()CommonDialog1.Filter = "文本文件(.txt)|*.txt"CommonDialog1.ShowSaveOpen CommonDialog1.FileName For Append As #1Print #1, Text2.TextClose #1MsgBox "save successful!" & vbCrLf & "save path:" & CommonDialog1.FileName, vbInformation, "save successful!"End SubPrivate Sub Command5_Click()Text1.Text = ""Text2.Text = ""End SubPrivate Sub Command6_Click()Unload MeEnd SubPrivate Sub Form_Load()txt.Enabled = FalseEnd SubPrivate Sub Text2_Change()End SubPrivate Sub txt_Change()If Len(txt.Text) >= 4 ThenMsgBox "the number is too big! "txt.Text = "0"End IfEnd SubPrivate Sub txt_KeyPress(KeyAscii As Integer) If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0End IfEnd Sub运行效果如下:。
vb编程代码大全
v b编程代码大全(总5页) --本页仅作为文档封面,使用时请直接删除即可----内页可以根据需求调整合适字体及大小--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; int=100fix(num): 取整 fix=99; fix=99round(num,n): 四舍五入取小数位 round,3)= 中点数值四舍五入为近偶取整 round,1)= log(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程序源代码
EndProperty
ForeColor = &H00FF0000&
Height = 615
Left = 1800
Width = 615
End
Begin bel Label8
Caption = "游"
BeginProperty Font
Name = "宋体"
Begin bel Label6
Caption = "猜"
BeginProperty Font
Name = "宋体"
Size = 24
Charset = 134
BeginProperty Font
Name = "宋体"
Size = 24
Charset = 134
Weight = 400
EndProperty
ForeColor = &H000080FF&
Height = 615
Left = 3720
TabIndex = 11
Top = 240
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Weight = 400
Underline = 0 'False
Italic = 0 'False
vb程序设计登陆界面代码详例
vb程序设计登陆界面代码详例Imports System.Data.SqlClientPublic Class frmMagementMain'Inherits System.Windows.Forms.FormDim constr As String = "User ID=sa;pwd=a;Initial Catalog=zbb;Data Source=(local)" '定义一个变量,连接字符串Dim sqlstr As String = "select * from manid" '定义一个变量,SQL语句Dim mycon As New SqlConnection(constr) '定义一个变量,为一个连接对象Dim mycom As New SqlCommand(sqlstr, mycon) '定义一个变量,为命令对象Dim myReader As SqlDataReader '定义一个变量,阅读器Dim i As Integer = 0Dim userIDsys() As ArrayPrivate Sub frmMagementMain_Load(ByVal sender As System.Object, ByVal e AsSystem.EventArgs) Handles MyBase.Loadmycon.Open() '打开这个联接myReader = mycom.ExecuteReader '把这个命令的连接送入阅读器myReader.Read()Dim k As Integer = 0While myReader.Read 'while 为遍历集合的每一项,用阅读器的read的方法来读取'定义一个变量的第一项k = k + 1'MsgBox(myReader.Item(1))End WhileMsgBox(k)End SubPrivate Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)Handles Button1.Click' Visual Basic 2005' Declare a new TextBox.Dim TextBox2 As New TextBox' Set the location below the first TextBoxTextBox2.Left = 102TextBox2.Top = 242' Add the TextBox to the form's Controls collection.Me.Controls.Add(TextBox2)TextBox2.Text = "这可是我动态加的控件呀"End SubPrivate Sub mnu_magement_Click(ByVal sender As System.Object, ByVal e AsSystem.EventArgs) Handles mnu_magement.ClickDim frmlogin As frmlogin = New frmloginfrmlogin.Show()'GBmagemetPeple.Left = 8'GBmagemetPeple.Top = 28'GBmagemetPeple.Visible = TrueEnd SubPrivate Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)Handles Button2.ClickEnd SubEnd Class/////////////////////////////////////Imports System.Data.SqlClientPublic Class frmloginDim i As Integer = 0Dim constr1 As String = "" '定义一个变量,连接字符串Dim sqlstr1 As String = ""Dim mycon1 As New SqlConnection(constr1) '定义一个变量,为一个连接对象Dim mycom1 As New SqlCommand(sqlstr1, mycon1) '定义一个变量,为命令对象Dim myReader1 As SqlDataReader '定义一个变量,阅读器Private Sub OK_Button_Click(ByVal sender As System.Object, ByVal e AsSystem.EventArgs) Handles OK_Button.ClickIf txtUsename.Text = "" Or txtPassword.Text = "" ThenMsgBox("请输入用户名和密码")Exit SubEnd Ifsqlstr1 = "select * from mgpep where usernameID='" & txtUsename.Text & "' andpasswordID='" & txtPassword.Text & "'" '定义一个变量,SQL语句constr1 = "User ID=sa;pwd=a;Initial Catalog=SaleCD;DataSource=(local)" '定义一个变量,连接字符串mycon1.ConnectionString = constr1mandText = sqlstr1mycon1.Open() '重新打开这个联接myReader1 = mycom1.ExecuteReader '第二次把这个命令的连接送入阅读器If myReader1.VisibleFieldCount = 0 ThenMsgBox("密码不对请重新输入~")Exit SubEnd IfmyReader1.Read() '阅读器重新使用read方法On Error GoTo ssIf myReader1(0) > 0 ThenfrmMagementMain.GBmagemetPeple.Visible = Truesqlstr1 = "select * from mgpep"If mycon1.State = 1 Thenmycon1.Close()End Ifmycon1.Open()myReader1 = mycom1.ExecuteReader '把这个命令的连接送入阅读器Dim userIDsys(myReader1.VisibleFieldCount - 1, 2)'ReDim userIDsys(10, 2)Dim k As Integer = 0While myReader1.ReadfrmMagementMain.CmbUser.Items.Add(myReader1(0)) For i = 0 To 2userIDsys(k, i) = myReader1.Item(i)Nextk = k + 1End WhileMsgBox("已经成功登录~")mycon1.Close()Me.Close()Exit SubElseMsgBox("您没有权限登录~")mycon1.Close()Me.Close()Exit SubEnd Ifss:MsgBox("您没有权限登录~")Me.Close()End SubPrivate Sub Cancel_Button_Click(ByVal sender As System.Object, ByVal e AsSystem.EventArgs) Handles Cancel_Button.ClickMe.Close()End SubEnd ClassPublic ADOcn As ConnectionPublic Sub main()Dim strSQLServer As StringstrSQLServer = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist SecurityInfo=False;Initial Catalog=图书销售管理系统;DataSource=longmingxue\SQLEXPRESS"Set ADOcn = New ConnectionADOcn.Open = strSQLServerFrmMain.ShowEnd SubPrivate Sub Command1_Click()Dim ADOrs As New RecordsetDim strSQL As StringDim strXB As StringADOrs.ActiveConnection = ADOcnADOrs.Open "select 学号 from 学生表"If Not ADOrs.EOF ThenMsgBox "该学号已经存在,不能继续添加~", vbCritical + vbOKOnly, "信息提示"ElseIf Option1.Value ThenstrXB = "男"ElsestrXB = "女"End IfstrSQL = "Insert Into 学生表( 学号,姓名,性别)"strSQL = strSQL + " Values('" + Text1 + "','"strSQL = strSQL + Text2 + "','" + strXB + "')"ADOcn.Execute strSQLMsgBox "添加成功~", vbOKOnly, "信息提示"End IfEnd Sub。
vb编程代码大全
vb编程代码大全VB(Visual Basic)是一种易于学习和使用的编程语言,广泛应用于Windows平台的软件开发。
VB编程通过编写和执行代码来实现任务,可以用于创建各种类型的应用程序,包括窗体应用程序、控制台应用程序、Web应用程序等。
本文将介绍一些常用的VB编程代码,帮助读者快速入门和掌握VB编程技巧。
一、VB基本语法在开始编写VB代码之前,我们先来了解一些基本的VB语法规则。
1. 注释VB中的注释用于解释代码的作用,不会被编译器执行。
注释可以是单行注释(以“'”开头)或多行注释(以“/*”开始,“*/”结束)。
示例:' 这是一个单行注释/*这是一个多行注释可以跨越多行*/2. 变量声明在VB中,变量需要先声明后使用。
变量的声明可以包括数据类型和变量名称。
示例:Dim x As Integer '声明一个整型变量x3. 变量赋值在VB中,可以使用赋值语句将一个值赋给变量。
示例:x = 10 '将变量x赋值为104. 运算符VB支持常见的运算符,包括算术运算符、比较运算符和逻辑运算符等。
示例:Dim a As Integer, b As Integera = 10b = 5Dim c As Integerc = a + b '加法运算c = a - b '减法运算c = a * b '乘法运算c = a / b '除法运算c = a Mod b '取余运算c = a > b '比较运算c = (a > 0) And (b > 0) '逻辑运算5. 控制结构VB中的控制结构包括条件语句和循环语句。
条件语句通过判断条件来选择不同的执行路径。
循环语句可以重复执行一段代码。
示例:If condition Then' 执行语句块1ElseIf condition2 Then' 执行语句块2Else' 执行语句块3End IfFor i = 1 To 10' 执行循环体Next i以上是VB的基本语法规则,通过掌握这些语法,可以编写简单的VB程序。
VB代码
CDg1.Filter = "Text Files(*.TXT)|*.txt|All Files(*.*)|*.*"
CDg1.DialogTitle = "读取已知数据"
CDg1.FileName = "": CDg1.Action = 1
'显示读入的控制点地面坐标
txtShow.Text = txtShow.Text & Xt(1) & " , " & Yt(1) & " , " & Zt(1) & vbCrLf
txtShow.Text = txtShow.Text & Xt(2) & " , " & Yt(2) & " , " & Zt(2) & vbCrLf
Dim fai_R#, omg_R#, kap_R#, XsR#, YsR#, ZsR# '左片外方位元素
Dim Bx#, By#, Bz# '基线分量
Dim R_L#(1 To 3, 1 To 3), R_R#(1 To 3, 1 To 3) '左右像片的旋转矩阵
If CDg1.FileName = "" Then Exit Sub
Open CDg1.FileName For Input As #1
Line Input #1, strTemp '读第一行题头信息
txtShow.Text = txtShow.Text & vbCrLf & strTemp & vbCrLf
北大青鸟:源代码清单
Load frmReminderPopUp
frmReminderPopUp.lblMessage.Caption = Adodc1.Recordset.Fields(2).Value
frmReminderPopUp.Show
Adodc2.RecordSource = "SELECT * FROM Task"
Adodc2.Refresh
If Me.Adodc2.Recordset.RecordCount > 0 Then
If Not Adodc2.Recordset.EOF Then Adodc2.Recordset.MoveLast
Exit Do
Else
TaskRecset.MoveNext
End If
End With
Loop
DBasecon.Close
Unload frmReminder
End Sub
Private Sub Cancel_Click()
Me.txtTime.Clear
Me.cboMonth.Clear
Me.cboDay.Clear
Me.txtScheduleDay.Enabled = False
End If
End Sub
Private Sub tlbMenu_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "btnNew"
If tlbMenu.Buttons.Item(1).Caption = "New" Then
人事管理系统(源代码
附录:毕业设计程序清单设计题目人事管理系统教学班:学生姓名:学号:指导教师:完成日期:Option ExplicitDim Bupdata As BooleanDim i As IntegerPrivate Sub Cmbdegree_Click()If Cmbdegree.Text = "定制" ThenFrmTable.ShowCmbdegree.ListIndex = 0End IfEnd SubPrivate Sub Cmbdepart_Click()If Cmbdepart.Text = "定制" ThenFrmTable.ShowCmbdepart.ListIndex = 0End IfEnd SubPrivate Sub CmdAddNew_Click()If CmdAddNew.Caption = "添加" ThenCmdAddNew.Caption = "确认"CmdDel.Enabled = FalseCmdOK.Enabled = FalseDataA.ReadOnly = FalseFor i = 1 To 12If Txt(i).Text = "" Then Txt(i).Text = 0 'DataA.Recordset.Fields(i) = 0Next iDataA.Recordset.AddNewTxt(0).Locked = FalseIf FrmMain.cutable = "employee" ThenDataA.Recordset.Fields(13) = frmLogin.EmploIDDataA.Recordset.Fields(14) = NowIf Opsex(0) ThenDataA.Recordset.Fields(4) = "男"ElseDataA.Recordset.Fields(4) = "女"End IfDataA.Recordset.Fields(7) = Cmbdegree.TextDataA.Recordset.Fields(8) = Cmbdepart.TextElseIf FrmMain.cutable = "leave" ThenDataA.Recordset.Fields(8) = frmLogin.EmploIDDataA.Recordset.Fields(9) = NowElseDataA.Recordset.Fields(13) = frmLogin.EmploIDDataA.Recordset.Fields(14) = NowEnd IfTxt(0).SetFocusElse 'OKIf Txt(0).Text = "" ThenMsgBox "不可以为空"Txt(0).SetFocusExit SubEnd IfFor i = 1 To 12If Txt(i).Text = "" Then Txt(i).Text = 0 'DataA.Recordset.Fields(i) = 0 Next iIf FrmMain.cutable = "employee" ThenDataB.Recordset.FindFirst "职工编号=" + Txt(0).TextIf Not DataB.Recordset.NoMatch ThenMsgBox "职员编号重复"Txt(0).Text = ""Txt(0).SetFocusExit SubEnd IfElseIf FrmMain.cutable = "leave" ThenDataB.Recordset.FindFirst "假条编号=" + Txt(0).TextIf Not DataB.Recordset.NoMatch ThenMsgBox "假条编号重复"Txt(0).Text = ""Txt(0).SetFocusExit SubEnd IfElseFor i = 4 To 10If Not IsNumeric(Txt(i).Text) ThenMsgBox "not a number"Txt(i).SetFocusExit SubEnd IfNext iDataB.Recordset.FindFirst "工资编号=" + Txt(0).TextIf Not DataB.Recordset.NoMatch ThenMsgBox "工资编号重复"Txt(0).Text = ""Txt(0).SetFocusExit SubEnd IfEnd IfDataA.Recordset.UpdateDataA.Recordset.MoveLastFrmMain.DataA.RefreshFrmMain.DataB.RefreshDataB.RefreshCmdAddNew.Caption = "添加"CmdDel.Enabled = TrueCmdOK.Enabled = TrueEnd IfEnd SubPrivate Sub CmdCacel_Click()If CmdAddNew.Caption = "确认" ThenDataA.Recordset.CancelUpdateEnd IfFrmMain.Enabled = TrueFrmMain.SetFocusUnload MeFrmMain.DataA.RefreshIf FrmMain.cutable = "employee" ThenFrmMain.DBGA.Columns("性别").Button = TrueFrmMain.DBGA.Columns("学历").Button = TrueFrmMain.DBGA.Columns("部门").Button = True End IfEnd SubPrivate Sub CmdDel_Click()DataA.ReadOnly = FalseDataA.Recordset.DeleteDataA.Recordset.MoveNextIf DataA.Recordset.EOF ThenDataA.Recordset.MoveLastEnd IfFrmMain.DataA.RefreshEnd SubPrivate Sub cmdOK_Click()If Txt(0).Text = "" ThenMsgBox "不可以为空"Txt(0).SetFocusExit SubEnd IfBupdata = FalseDataA.Recordset.EditIf FrmMain.cutable = "leave" ThenDataA.Recordset.Fields(8) = frmLogin.EmploIDDataA.Recordset.Fields(9) = NowElseIf FrmMain.cutable = "employee" ThenDataA.Recordset.Fields(13) = frmLogin.EmploIDDataA.Recordset.Fields(14) = NowIf Opsex(0) ThenDataA.Recordset.Fields(4) = "男"ElseDataA.Recordset.Fields(4) = "女"End IfDataA.Recordset.Fields(7) = Cmbdegree.TextDataA.Recordset.Fields(8) = Cmbdepart.TextDataA.Recordset.Fields(13) = frmLogin.EmploIDDataA.Recordset.Fields(14) = NowElseFor i = 4 To 10If Not IsNumeric(Txt(i).Text) ThenMsgBox "not a number"Txt(i).SetFocusExit SubEnd IfNext iDataA.Recordset.Fields(13) = frmLogin.EmploIDDataA.Recordset.Fields(14) = NowEnd IfFor i = 1 To 12If Txt(i).Text = "" Then Txt(i).Text = 0 'DataA.Recordset.Fields(i) = 0 Next iDataA.Recordset.UpdateFrmMain.DataA.RefreshDataB.RefreshEnd SubPrivate Sub DataA_V alidate(Action As Integer, Save As Integer)If Action = 11 And Bupdata ThenSave = 0End IfEnd SubPrivate Sub Lab_Click(Index As Integer)End SubPrivate Sub Txt_KeyPress(Index As Integer, KeyAscii As Integer)If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> vbKeyBack And Index = 0 Then KeyAscii = 0Exit SubEnd IfIf FrmMain.cutable = "leave" And Index = 1 ThenIf (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> vbKeyBack ThenKeyAscii = 0Exit SubEnd IfEnd IfIf FrmMain.cutable = "salary" ThenIf Index <= 3 ThenIf (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> vbKeyBack ThenKeyAscii = 0Exit SubEnd IfEnd IfIf Index = 13 Then Exit SubIf (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> vbKeyBack And KeyAscii <> 46 ThenKeyAscii = 0Exit SubEnd IfEnd IfEnd SubPrivate Sub Txt_change(Index As Integer)If Bupdata = False Then Bupdata = TrueIf FrmMain.cutable = "salary" ThenIf Txt(Index).Text = "" Then Exit SubIf Index >= 4 And Index <= 6 ThenTxt(7).Text = V al(Txt(4).Text) + V al(Txt(5).Text) + V al(Txt(6).Text)Txt(12).Text = V al(Txt(7).Text) - V al(Txt(11).Text)End IfIf Index >= 8 And Index <= 10 ThenTxt(11).Text = V al(Txt(8).Text) + V al(Txt(9).Text) + V al(Txt(10).Text)Txt(12).Text = V al(Txt(7).Text) - V al(Txt(11).Text)End IfEnd IfEnd SubPrivate Sub Form_Load()DataA.DatabaseName = App.Path + "\sm.mdb"DataB.DatabaseName = App.Path + "\sm.mdb"DataA.Caption = FrmMain.cutableDataA.RecordSource = "select * from " + FrmMain.cutableDataB.RecordSource = "select * from " + FrmMain.cutableDataA.RefreshTxt(0).Locked = True'If FrmMain.DBGA.Row = 0 Then Exit SubIf FrmMain.cutable = "employee" Then 'employeeFor i = 0 To 12Lab(i).Caption = DataA.Recordset.Fields(i).NameNext iTxt(0).DataField = DataA.Recordset.Fields(0).NameTxt(1).DataField = DataA.Recordset.Fields(1).NameTxt(2).DataField = DataA.Recordset.Fields(2).NameTxt(3).DataField = DataA.Recordset.Fields(3).NameTxt(4).V isible = FalseTxt(5).DataField = DataA.Recordset.Fields(5).NameTxt(6).DataField = DataA.Recordset.Fields(6).NameTxt(7).V isible = FalseTxt(8).V isible = FalseTxt(9).DataField = DataA.Recordset.Fields(9).NameTxt(10).DataField = DataA.Recordset.Fields(10).NameTxt(11).DataField = DataA.Recordset.Fields(11).NameTxt(12).DataField = DataA.Recordset.Fields(12).NameTxt(13).DataField = DataA.Recordset.Fields(15).NameIf FrmMain.cuAp > -1 ThenDataA.Recordset.Move (FrmMain.cuAp)ElseDataA.Recordset.MoveFirstEnd IfIf DataA.Recordset.Fields(4) = "男" ThenOpsex(0).V alue = TrueElseOpsex(1).V alue = TrueEnd If'设置lsdegree的显示项For i = 0 To FrmMain.LsDegree.ListCount - 2Cmbdegree.AddItem FrmMain.LsDegree.List(i)If FrmMain.LsDegree.List(i) = DataA.Recordset.Fields(7) ThenCmbdegree.ListIndex = iEnd IfNext iIf Cmbdegree.ListIndex = -1 ThenCmbdegree.AddItem DataA.Recordset.Fields(7)Cmbdegree.ListIndex = Cmbdegree.ListCount - 1End IfCmbdegree.AddItem "定制"'设置lsdepart的显示项For i = 0 To FrmMain.LsDepart.ListCount - 2Cmbdepart.AddItem FrmMain.LsDepart.List(i)If FrmMain.LsDepart.List(i) = DataA.Recordset.Fields(8) ThenCmbdepart.ListIndex = iEnd IfNext iIf Cmbdepart.ListIndex = -1 ThenCmbdepart.AddItem DataA.Recordset.Fields(8)Cmbdepart.ListIndex = Cmbdepart.ListCount - 1End IfCmbdepart.AddItem "定制"'设置完毕ElseIf FrmMain.cutable = "leave" Then 'leaveTxt(7).V isible = TrueCmbdegree.V isible = FalseCmbdepart.V isible = FalseFrame1.V isible = FalseFor i = 8 To 12Lab(i).Visible = FalseTxt(i).V isible = FalseNext iFor i = 0 To 7Lab(i).Caption = DataA.Recordset.Fields(i).NameTxt(i).DataField = DataA.Recordset.Fields(i).NameNext iTxt(13).DataField = DataA.Recordset.Fields(10).NameIf FrmMain.cuAp > -1 ThenDataA.Recordset.Move (FrmMain.cuAp)ElseDataA.Recordset.MoveFirstEnd IfElse 'salaryFrame1.V isible = FalseCmbdegree.V isible = FalseCmbdepart.V isible = FalseFor i = 0 To 12Lab(i).Caption = DataA.Recordset.Fields(i).NameTxt(i).DataField = DataA.Recordset.Fields(i).NameNext iTxt(13).DataField = DataA.Recordset.Fields(15).NameTxt(7).Locked = TrueTxt(11).Locked = TrueTxt(12).Locked = TrueIf FrmMain.cuAp > -1 ThenDataA.Recordset.Move (FrmMain.cuAp)ElseDataA.Recordset.MoveFirstEnd IfEnd IfEnd SubPrivate Sub Form_Unload(Cancel As Integer)FrmMain.Enabled = TrueFrmMain.SetFocusUnload MeFrmMain.DataB.RefreshEnd SubOption ExplicitConst MxUser = 100Public EmploID As IntegerPublic CurUser As StringPublic CurId As StringPublic CurPsw As StringDim user(MxUser), pws(MxUser), state(MxUser), Emplo(MxUser) As StringPrivate Sub Form_Load()Dim i As IntegerIf App.PrevInstance ThenMsgBox ("程序已经运行,不能再次装载。
vb图书管理系统窗口frmedbook代码
Private Sub Command1_Click()If Trim(Text1.Text) = "" Or Trim(Text2.Text) = "" Or Trim(Text3.Text) = "" Or Trim(Text4.Text) = "" Or Trim(Text7.Text) = "" ThenMsgBox "加*项数据不能为空,请从新设置", , "信息提示"Exit SubEnd IfIf flag = 1 ThenfrmEdQuBook.Adodc1.Recordest.AddNewfrmEdQuBook.Adodc1.Recordest("图书编号") = Trim(Text1.Text)frmEdQuBook.Adodc1.Recordest("分类号") = Trim(Text2.Text)frmEdQuBook.Adodc1.Recordest("书名") = Trim(Text3.Text)frmEdQuBook.Adodc1.Recordest("作者") = Trim(Text4.Text)frmEdQuBook.Adodc1.Recordest("出版社") = Trim(Text5.Text)frmEdQuBook.Adodc1.Recordest("定价") = Trim(Text6.Text)frmEdQuBook.Adodc1.Recordest("入库日期") = Trim(Text7.Text)frmEdQuBook.Adodc1.Recordest("借否") = FalsefrmEdQuBook.Adodc1.Recordest.updatElsefrmEdQuBook.Adodc1.Recordest("图书编号") = Trim(Text1.Text)frmEdQuBook.Adodc1.Recordest("分类号") = Trim(Text2.Text)frmEdQuBook.Adodc1.Recordest("书名") = Trim(Text3.Text)frmEdQuBook.Adodc1.Recordest("作者") = Trim(Text4.Text)frmEdQuBook.Adodc1.Recordest("出版社") = Trim(Text5.Text)frmEdQuBook.Adodc1.Recordest("定价") = Trim(Text6.Text)frmEdQuBook.Adodc1.Recordest("入库日期") = Format(Trim(Text7.Text), "yyyy-mm-dd") frmEdQuBook.Adodc1.Recordest.updatEnd IfUnload MeEnd SubPrivate Sub Command2_Click()Unload MeEnd SubPrivate Sub Form_Load()If flag = 2 ThenText1(0).Text = frmEdQuBook.Adodc1.Recordest("图书编号")Text(1).Text = frmEdQuBook.Adodc1.Recordest("分类号")Text(2).Text = frmEdQuBook.Adodc1.Recordest("书名")Text(3).Text = frmEdQuBook.Adodc1.Recordest("作者")Text(4).Text = frmEdQuBook.Adodc1.Recordest("出版社")Text(5).Text = frmEdQuBook.Adodc1.Recordest("定价")Text(6).Text = frmEdQuBook.Adodc1.Recordest("入库日期")ElseText(6).Text = DataEnd IfEnd SubPrivate Sub Text1_Change()End SubPrivate Sub Text1_KeyPress(KeyAscii As Integer) Call enddata(KeyAscii)End Sub。
vb中format函数定义(精)
vb中format函数定义Format[$] ( expr [ , fmt ] )format 返回变体型format$ 强制返回为文本--------------------------------数字类型的格式化--------------------------------固定格式参数:General Number 普通数字,如可以用来去掉千位分隔号format$("100,123.12","General Number") 返回值100123.12Currency 货币类型,可添加千位分隔号和货币符号format$("100123.12","Currency") 返回值¥100,123.12Fixed 格式为带两位小数的数字format$("100123","Fixed") 返回值100123.00Standard 标准,即带千位分隔号和两位小数format$("100123","Standard") 返回值100,123.00Percent 百分数format$("100123","Percent") 返回值10012300.00%Scientific 科学记数法format$("100123","Scientific") 返回值1.00E+05Yes/No 当值为0时返回NO,否则返回YESformat$("100123","Yes/No") 返回值YesTrue/False 当值为0时返回False,否则返回Trueformat$("100123","True/False") 返回值TrueOn/Off 当值为0时返回Off,否则返回Onformat$("100123","Yes/No") 返回值On自定义格式参数"" 不进行格式化返回值原值0 占位格式化,不足补0format$("100123","0000000") 返回值0100123# 占位格式化,不足时不补0format$("100123","#######") 返回值100123. 强制显示小数点format$("100123.12",".000") 返回值100123.120% 转化为百分数,一个%代表乘以100format$("10.23","0.00%") 返回值1023.00%format$("10.23","0.00%%") 返回值102300.00%%, 以千为单位格化format$("10.23",",") 返回值0format$("10010.23",",") 返回值10format$("10010.23",",0.00") 返回值10.01E- E+ e- e+ 显示为科学记数(要注意格式语句,否则会和E的其它含义相混)Format$(12.5,"0.00E+00") 返回值1.25E+01$ 强制显示货币符号format$("10.23","{threadcontent}.00") 返回值¥10.23- + ( ) space 按位置显示本样Format$("1234.56","-(0.00)") 返回值-(1234.56)\ 转义符,显示出特殊符号Format$("1234.56","\#.00") 返回值#1234.56"ABC" 显示双引号(" ") 之内的字符串。
[VIP专享]北大青鸟:源代码清单
End Sub
Private Sub Form_Activate() Me.txtUserId.SetFocus
End Sub
Private Sub cmdLogin_Click() Dim DBasecon As ADODB.Connection Dim LoginRecset As Recordset Set DBasecon = New Connection DBasecon.ConnectionString =
End Sub
2、设置提示信息窗体 frmReminder.frm 的代码如下
Private myConnectionString As String Private Sub cmdSave_Click()
- 1、下载文档前请自行甄别文档内容的完整性,平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益,请联系客服反馈,我们会尽快为您处理(人工客服工作时间:9:00-18:30)。
Left = 6840
Style = 1 'Graphical
TabIndex = 4
Top = 3840
Top = 4560
Width = 975
End
Begin VB.TextBox TextLineWidth
Height = 375
Left = 2640
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
End Sub
Rem 防止执行多次
Private Sub Form_Initialize()
Begin mandButton Command2
Caption = "删除"
Height = 615
Left = 4320
TabIndex = 5
BorderStyle = 0 'None
FillStyle = 0 'Solid
Height = 3615
Left = 0
ScaleHeight = 3615
If App.PrevInstance Then End
End Sub
Private Sub Command1_Click()
' Picture1.PaintPicture Picture1.Image, 0, 0, Picture1.width / 2, Picture1.Height / 2, 0, 0, Picture1.width / 3, Picture1.Height / 3
Rem 移动没有标题栏窗体的声明
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Picture1.Picture = Picture1.Image
Rem 窗口置顶的声明
Private 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) As Long
VERSION 5.00
Begin VB.Form Form1
AutoRedraw = -1 'True
Caption = "原笔迹"
ClientHeight = 5010
ClientLeft = 60
Rem 模拟按键声明
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Rem 禁止本窗体拥有输入焦点的常数
Width = 1815
End
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H8000000E&
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const HWND_TOPMOST = -1
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_SHOWWINDOW = &H40
SpeedDoor = Val(TextSpeed.Text)
LineWidth = Val(TextLineWidth.Text)
widthAdd = Val(TextAdd.Text)
Picture1.DrawWidth = LineWidth
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Command2_Click()
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Rem 转移输入焦点的声明
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
ToolTipText = "平均书写速度"
Top = 4560
Width = 975
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Private Const HWND_NOTOPMOST = -2
Private Const WS_DISABLED = &H8000000
Private Const GWL_EXSTYLE = (-20)
Private Const GWL_STYLE = (-16)
Rem 窗口置顶的常数
Dim lastX, lastY As Single
Dim LineWidth As Single
Dim lastWidth As Single
Dim SpeedDoor As Single
Dim widthAdd As Single
Dim lastSpeed As Single
Dim times As Integer
ScaleWidth = 8775
TabIndex = 3
Top = 120
Width = 8775
End
Begin VB.TextBox TextAdd
Height = 375
Left = 4080
TabIndex = 2
Text = "0.1"
ToolTipText = "笔画粗细增加量"
ClientTop = 450
ClientWidth = 8805
LinkTopic = "Form1"
ScaleHeight = 5010
ScaleWidth = 8805
StartUpPosition = 2 '屏幕中心
TabIndex = 1
Text = "5"
ToolTipText = "笔画最大宽度"
Top = 4560
Width = 975
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
SetWindowLong Me.hwnd, GWL_EXSTYLE, GetWindowLong(Me.hwnd, GWL_EXSTYLE) Or WS_DISABLED
Rem 移动没有标题栏窗体的常数
Private Const HTCAPTION = 2
Private Const WM_NCLBUTTONDOWN = &HA1
Rem 模拟按钮常数
Private Const KEYEVENTF_KEYUP = &H2
Dim IsMouseDown As Boolean
SendKeys "{BKSP}"
Clipboard.Clear
Picture1.Picture = Nothing
End Sub
Rem 以下是程序执行主体部分
Rem 窗体调用时置顶,且禁止拥有输入焦点