COMBO值为什么为空

ccyylib 2003-08-26 01:26:54
我建立一个数据库输入窗口可向ACCESS数据库表中插入数据,在窗口中有一个COMBO输入控件对应数据库某个字段在COMBO中选择一个值后按保存,此时查看数据库看到此值已经存到数据库中,关闭窗口再打开发现控件中值为空不知这是为什么请高手指点.
...全文
71 4 打赏 收藏 转发到动态 举报
写回复
用AI写文章
4 条回复
切换为时间正序
请发表友善的回复…
发表回复
TIANHEI 2003-08-26
  • 打赏
  • 举报
回复
初始化??
富察咪咪 2003-08-26
  • 打赏
  • 举报
回复
加载控件值的过程是否被执行
comboBox.AddIte语句
yo_jo 2003-08-26
  • 打赏
  • 举报
回复
查看一下combo的style属性
---------------------------------------
Style 属性


返回或设置一个值,该值用来指示控件的显示类型和行为。在运行时是只读的。

语法

object.Style

object 所在处代表一个对象表达式,其值是“应用于”列表中的一个对象。

设置值

对于 Checkbox、CommandButton 和 OptionButton 控件,Style 属性的设置值为:

常数 值 描述
VbButtonStandard 0 (缺省的) 标准的。控件按它们在 Visual Basic 老版本中的样子显示。也就是,Checkbox 控件显示为在其身旁有一个标签的复选框,OptionButton 显示为在其身旁有一个标签的选项按钮,而 CommandButton 显示为标准的、没有相关图形的 CommandButton。
VbButtonGraphical 1 图形的。控件用图形的样式显示。即,Checkbox 控件显示为类似按钮的 CommandButton,它能上下切换;OptionButton 显示为类似按钮的 CommandButton,它保持向上或向下的切换,直到它的选项群组内的另一个 OptionButton 被选中;而 CommandButton 显示为标准的、也能显示相关图形的 CommandButton。


对于 ComboBox 控件, Style 属性值为:

常数 值 描述
VbComboDropDown 0 (缺省值)下拉式组合框。包括一个下拉式列表和一个文本框。可以从列表选择或在文本框中输入。
VbComboSimple 1 简单组合框。包括一个文本框和一个不能下拉的列表。可以从列表中选择或在文本框中输入。简单 组合框的大小包括编辑和列表部分。按缺省规定,简单组合框的大小调整在没有任何列表显示的状态。增加 Height 属性值可显示列表的更多部分。
VbComboDrop-DownList 2 下拉式列表。这种样式仅允许从下拉式列表中选择。


对于 ListBox 控件,Style 属性值为:

常数 值 描述
VbListBoxStandard 0 (缺省值)标准的。ListBox 控件按它在Visual Basic 老版本中的样子显示;即,象是文本项的列表。
VbListBoxCheckbox 1 复选框。在 ListBox 控件中,每一个文本项的边上都有一个复选框。在 ListBox 中可以选择多项。


说明

对于 ComboBox 控件,根据下面这些原则来决定选用哪种设置值:

使用设置值 0(下拉式组合框)或设置值 1(简单组合框)来给用户一选择列表。每种风格都使用户能在文本框中输入一个选择。设置值 0 能节省窗体上的空间,因为列表部分在用户选择一个项时将关闭。


使用设置值 2(下拉式列表)能显示一个从中选择一个项的固定选择列表。列表部分在用户选择一个项时关闭。
---------------------------------------

lxcc 2003-08-26
  • 打赏
  • 举报
回复
代码?
      课程设计题目    学生成绩管理系统 课程设计的目的   理解面向对象的软件设计基本理论,学习VB软件设计的基本方法,熟悉一般软件项目开发的基本步骤,培养运用VB解决实际问题的能力和技巧。 课程设计的主要内容和要求(包括原始数据、技术参数、设计要求、工作量要求等) 四、工作进度安排 2011-2012学年第19周。 五、主要参考文献 Visual Basic程序设计教程 审核批准意见                                           系主任(签字)    年  月  日     指导教师评语及成绩 指 导 教 师 评 语                           成 绩                                    导师签字: 年 月 日                    设计思路及其创建过程    一、任务概述     简易学生成绩管理系统主要完成学生成绩的管理,包括:    1)、添加信息模块:主要完成学生记录、课程记录、学生成绩和用户记录的添加工作。    2)、删除信息模块:主要完成学生记录、课程记录、学生成绩和用户记录的删除工作。    3)、修改成绩模块:主要完成学生成绩的修改工作。    4)、查询模块:主要完成学生成绩的查询工作。    1.进行数据库设计     要编写一个实用的数据库程序,必须系统地学习过数据库原理的知识,并首先设计出符合用户业务需求的数据库体系,然后才能利用某种语言,开发出针对这个数据库的交互程序:数据库应用程序。    2. 程序的主要功能    利用SQL语句完成对学生成绩表的插入、修改、删除和查询操作。比如:    (1)插入记录:    Insert Into 学生成绩表(学号,课程号,成绩)    Values(‘001’,’001’,85)    (2)删除记录    Delete From 学生成绩表    Where 学号=‘001’ And 课程号=‘001’    (3)修改记录    Update 学生成绩表 set 成绩 =90    Where 学号=‘001’ And 课程号=‘001’    (4)按学号查询    Select * From 学生成绩表 Where 学号=‘001’    二、界面设计    1.创建工程    新建一“标准EXE”工程.工程名为“成绩查询”.    2.创建主窗体(frmMain)-MDI主窗体    设计菜单:    增加 删除 修改 查询 退出    增加学生记录 删除学生记录 修改成绩    增加课程记录 删除课程记录    增加成绩 删除成绩记录    增加用户 删除用户 3.创建新增学生记录窗体(frmAddStudent)-MDI子窗体 4、建新增课程记录窗体(frmAddCourse)-MDI子窗体 5.创建新增成绩记录窗体(frmAddGrade)-MDI子窗体 6.创建新增用户记录窗体(frmAddUser)-MDI子窗体 7. 创建修改记录窗体( frmUpdate )-MDI子窗体 8.创建删除学生记录窗体(frmDeleteStudent)-MDI子窗体 9.创建删除课程记录窗体(frmDeleteCourse)-MDI子窗体 10.创建删除成绩记录窗体(frmDeleteGrade)-MDI子窗体 11.创建删除用户窗体(frmDelete)-MDI子窗体 12.创建查询记录窗体(frmQuery)-MDI子窗体 13.创建身份验证窗体-MDI子窗体 1.3 代码设计 1. 连接数据库代码 步骤: (1)通过“工程—引用”菜单添加对象库: Microsoft Activex Data Objects 2.7 Library (Ado数据对象)。 (2)通过工程菜单添加一个标准模块(Module),并设计代码。 (3) 通过“工程—工程1属性”菜单,将主窗体(frmMain)MDIform1设置为启动对象。 添加标准模块代码: '声明全局对象变量ABOcn,用于创建于数据库的连接 Public ADOcn As New ADODB.Connection 添加主窗体初始化过程代码: Private Sub MDIForm_Initialize() ADOcn.ConnectionString = "Provider=SQLOLEDB.1;Password=;User ID=sa;Initial Catalog=成绩;Data Source= localhost;" If ADOcn.State = adStateClosed Then ADOcn.Open '打开到数据库的连接 End Sub 完成本项工作后,就创建了一个全局变量ADOcn,但它是一个特殊的变量,其数据类型是数据连接对象(Connection对象)。可以把ADDcn理解成是一个虚拟的数据库。或者称为VB程序中的逻辑数据库,通过它可以非常方便地访问其中的数据。换句话说,ADOcn是VB程序的后台数据库交互的通道。 2.设置窗体间的调用关系 2.设置窗体间的调用关系 ’调用增加课程窗体 Private Sub AddCourse_Click(Index As Integer) frmAddCourse.Show End Sub ’调用增加成绩窗体 Private Sub AddGrade_Click(Index As Integer) FrmAdd.Show End Sub ’调用增加学生窗体 Private Sub AddStudent_Click(Index As Integer) FrmAddStudent.Show End Sub ’调用增加用户窗体 Private Sub AddUser_Click() FrmAddUser.Show End Sub ’调用删除课程窗体 Private Sub DeleteCourse_Click() frmDeleteCourse.Show End Sub ’调用删除成绩窗体 Private Sub DeleteGrade_Click() frmDelete.Show End Sub ’调用删除学生窗体 Private Sub DeleteStudent_Click() frmDeleteStudent.Show End Sub ’调用删除用户窗体 Private Sub DeleteUser_Click() frmDeleteUser.Show End Sub ’调用学生基本信息查询窗体 Private Sub Querystudent_Click() frmQuerystudent.Show End Sub ’调用学生成绩查询窗体 Private Sub QueryGrade_Click() frmQueryGrade.Show End Sub’调用修改成绩窗体 Private Sub Update_Click() FrmUpdate.Show End Sub 调用退出程序 Private Sub Exit_Click() End End Sub 3.frmAddStudent (增加学生)窗体的代码设计: Private Sub Command1_Click() Dim ADOrs As New Recordset '声明一个记录集对象 Dim strSQL As String ADOrs.ActiveConnection = ADOcn '与ADOcn连接对象关联 If Text1.Text = "" Then MsgBox "未输入学号,请重新输入数据!", vbCritical + vbOKOnly Text1.SetFocus '定位光标 Exit Sub End If If Text2.Text = "" Then MsgBox "未输入姓名,请重新输入数据!", vbCritical + vbOKOnly Text2.SetFocus '定位光标 Exit Sub End If '首先查询表中是否存在关键字相同的记录 strSQL = "select * from 学生情况表" strSQL = strSQL & " Where 学号='" + Text1.Text + " '" strSQL = strSQL & " and 姓名='" + Text2.Text + "'" ADOrs.Open strSQL '如果关键字重复,则退出 If Not ADOrs.EOF Then MsgBox "该记录已经存在,不能继续增加", vbCritical + vbOKOnly Exit Sub End If '拼写Insert插入语句 strSQL = "Insert Into 学生情况表(学号,姓名)" strSQL = strSQL + " Values('" + Text1.Text + "'," strSQL = strSQL + "'" + Text2.Text + "'" + ")" ADOcn.Execute strSQL '执行Insert语句 Text1.Text = "“ '初始化文本框控件 Text2.Text = "" Text1.SetFocus '定位光标 MsgBox "已成功添加新记录", vbQuestion + vbOKOnly ADOrs.Close '关闭记录集 Set ADOrs = Nothing End Sub Private Sub Command2_Click() Unload Me End Sub 4.frmAddCourse (增加课程)窗体的代码设计: (1)在Load事件中,进行初始化工作,代码如下: Private Sub Form_Load() '初始化文本框控件 Text1.Text = "" Text2.Text = "" End Sub (2)’Command1_Click()(”确定”按钮)事件代码 Private Sub Command1_Click() Dim ADOrs As New Recordset '声明一个记录集对象 Dim strSQL As String '与ADOcn连接对象关联 ADOrs.ActiveConnection = ADOcn If Text1.Text = "" Then MsgBox "未输入课程号,请重新输入数据!", vbCritical + vbOKOnly Text1.SetFocus '定位光标 Exit Sub End If If Text2.Text = "" Then MsgBox "未输入课程名,请重新输入数据!", vbCritical + vbOKOnly Text2.SetFocus '定位光标 Exit Sub End If ’Command1_Click()(”确定”按钮)事件代码 '首先查询表中是否存在关键字相同的记录 strSQL = "select * from 课程情况表" strSQL = strSQL & " Where 课程号='" + Text1.Text + " '" strSQL = strSQL & " and 课程名='" + Text2.Text + "'" ADOrs.Open strSQL '如果关键字重复,则退出 If Not ADOrs.EOF Then MsgBox "该记录已经存在,不能继续增加", vbCritical + vbOKOnly Exit Sub End If ’Command1_Click()(”确定”按钮)事件代码 '拼写Insert插入语句 strSQL = "Insert Into 学生情况表(学号,姓名)" strSQL = strSQL + " Values('" + Text1.Text + "'," strSQL = strSQL + "'" + Text2.Text + "'" + ")" ADOcn.Execute strSQL '执行Insert语句 Text1.Text = "“ '初始化文本框控件 Text2.Text = "" Text1.SetFocus '定位光标 MsgBox "已成功添加新记录", vbQuestion + vbOKOnly ADOrs.Close '关闭记录集 Set ADOrs = Nothing End Sub (3)’Command2_Click()(”返回”按钮)事件代码 Private Sub Command2_Click() Unload Me End Sub 5.frmAddGrade(增加成绩)窗体的代码设计: (1)在Load事件中,进行初始化工作,代码如下: Private Sub Form_Load() Dim ADOrs As New Recordset '声明记录集对象 ADOrs.ActiveConnection = ADOcn '与ADOcn连接对象关联 '对Combo1组合框进行初始化 ADOrs.Open "Select 学号 From 学生情况表 Order By 学号" Combo1.Clear Do While Not ADOrs.EOF Combo1.AddItem Trim(ADOrs.Fields("学号")) '添加"学号"字段 ADOrs.MoveNext '取下一条记录 Loop ADOrs.Close '关闭记录集 (1)Load事件代码 '对Combo2组合框进行初始化 ADOrs.Open "select 课程号 from 课程情况表 Order By 课程号" Combo2.Clear Do While Not ADOrs.EOF Combo2.AddItem Trim(ADOrs.Fields("课程号")) '添加"课程号"字段 ADOrs.MoveNext '取下一条记录 Loop ADOrs.Close '关闭记录集 '初始化文本框控件 Text1.Text = "" Text2.Text = "" Text3.Text = "0" End Sub (2) Combo1_Click 事件代码 Private Sub Combo1_Click() Dim ADOrs As New Recordset '声明一个记录集对象 ADOrs.ActiveConnection = ADOcn '与ADOcn连接对象关联 '如果输入了学号,则把姓名显示在Text1.Text strSQL = "select * from 学生情况表" strSQL = strSQL + " Where 学号='" + Combo1.Text + " '" ADOrs.Open strSQL Text1.Text = ADOrs.Fields("姓名") ADOrs.Close '关闭记录集 Set ADOrs = Nothing End Sub (3) Combo2_Click 事件代码 Private Sub Combo2_Click() Dim ADOrs As New Recordset '声明一个记录集对象 ADOrs.ActiveConnection = ADOcn '与ADOcn连接对象关联 '如果输入了课程号,则把课程名显示在Text2.text strSQL = "select * from 课程情况表" strSQL = strSQL + " Where 课程号='" + Combo2.Text + " '" ADOrs.Open strSQL Text2.Text = ADOrs.Fields("课程名") ADOrs.Close '关闭记录集 Set ADOrs = Nothing End Sub (4) Command1_Click(确认) 事件代码 Private Sub Command1_Click() Dim strSQL As String Dim ADOrs As New Recordset '声明一个记录集对象 ADOrs.ActiveConnection = ADOcn '与ADOcn连接对象关联 '检查学号与课程号是否输入 If Combo1.Text = "" Or Combo2.Text = "" Then MsgBox "输入数据不全,请重新输入数据!", vbCritical + vbOKOnly Exit Sub End If '首先查询表中是否存在关键字相同的记录 strSQL = "select * from 学生成绩表" strSQL = strSQL & " Where 学号='" + Combo1.Text + " '" strSQL = strSQL & " and 课程号='" + Combo2.Text + "'" ADOrs.Open strSQL '如果关键字重复,则退出 If Not ADOrs.EOF Then MsgBox "该记录已经存在,不能继续增加", vbCritical + vbOKOnly Exit Sub End If (4) Command1_Click(确认) 事件代码 '拼写Insert插入语句 strSQL = "Insert Into 学生成绩表(学号,课程号,成绩)" strSQL = strSQL + "Values('" + Combo1.Text + "','" strSQL = strSQL + Combo2.Text + "'," + Str(Val(Text3.Text)) + ")" ADOcn.Execute strSQL '执行Insert语句 MsgBox "已成功添加新记录", vbQuestion + vbOKOnly '初始化文本框控件 Text1.Text = "" Text2.Text = "" Text3.Text = "0" ADOrs.Close '关闭记录集 Set ADOrs = Nothing End Sub (5) Command2_Click(返回) 事件代码 Private Sub Command2_Click() Unload Me End Sub 6.frmAddUser(增加用户)代码设计 (1)在Load事件中,进行初始化工作,代码如下: Private Sub Form_Load() '初始化文本框控件 Text1.Text = "" Text2.Text = "" Text3.Text = "" End Sub (2) Command1_Click(确认) 事件代码 Private Sub Command1_Click() Dim strSQL As String Dim ADOrs As New Recordset '声明一个记录集对象 ADOrs.ActiveConnection = ADOcn '与ADOcn连接对象关联 '记录已输入的用户信息 UserName = Text1.Text PaasWord = Text2.Text PaasWord1 = Text3.Text '若 Text1.Text 或Text2.Text或Text3.Text为空则提示用户重新输入 If Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "" Then MsgBox "未输入用户名、密码或密码确认,请重新输入!", vbCritical + vbOKOnly Exit Sub End If '若 两此输入密码不一致则提示用户重新输入 If PaasWord PaasWord1 Then MsgBox "两次输入的密码不一致,请重新输入!", vbCritical + vbOKOnly Text2.Text = "" Text3.Text = "" Text2.SetFocus Exit Sub End If '首先查询用户中是否存在相同的记录 strSQL = "Select * From 用户" strSQL = strSQL + " Where 用户名='" + UserName + "'" ADOrs.Open strSQL If Not ADOrs.EOF Then '如果关键字重复,则退出 MsgBox "该用户已经存在,请重新注册", vbCritical + vbOKOnly Exit Sub End If '拼写Insert插入语句 strSQL = "Insert Into 用户(用户名,密码)" strSQL = strSQL + " Values('" + UserName + "','" + PaasWord + "')" ADOcn.Execute strSQL '执行Insert语句 MsgBox "已成功添加新记录", vbQuestion + vbOKOnly ADOrs.Close '关闭记录集 Set ADOrs = Nothing End Sub (3) Command2_Click(返回) 事件代码 Private Sub Command2_Click() Unload Me End Sub 7.frmUpdata (修改成绩)窗体代码设计 (1)、在Load事件中,进行初始化工作,代码如下: Private Sub Form_Load() Dim ADOrs As New Recordset '声明记录集对象 ADOrs.ActiveConnection = ADOcn '与ADOcn连接对象关联 '对Combo1组合框进行初始化 ADOrs.Open "Select 学号 From 学生情况表 Order By 学号" Combo1.Clear Do While Not ADOrs.EOF Combo1.AddItem Trim(ADOrs.Fields("学号")) '添加"学号"字段 ADOrs.MoveNext '取下一条记录 Loop ADOrs.Close '关闭记录集 (1)、Form_Load()事件代码 '对Combo2组合框进行初始化 ADOrs.Open "select 课程号 from 课程情况表 Order By 课程号" Combo2.Clear Do While Not ADOrs.EOF Combo2.AddItem Trim(ADOrs.Fields("课程号")) '添加"课程号"字段 ADOrs.MoveNext '取下一条记录 Loop ADOrs.Close '关闭记录集 '初始化文本框控件 Text1.Text = "" Text2.Text = "" Text3.Text = "0" End Sub (2) Combo1_Click 事件代码 Private Sub Combo1_Click() Dim ADOrs As New Recordset '声明一个记录集对象 ADOrs.ActiveConnection = ADOcn '与ADOcn连接对象关联 '如果输入了学号,则把姓名显示在Text1.Text strSQL = "select * from 学生情况表" strSQL = strSQL + " Where 学号='" + Combo1.Text + " '" ADOrs.Open strSQL Text1.Text = ADOrs.Fields("姓名") ADOrs.Close '关闭记录集 (2) Combo1_Click 事件代码 If Combo2 "" Then '输入完毕则显示成绩信息 '查询学生成绩表中是否有指定指定学号与课程号的记录 strSQL = "select * from 学生成绩表" strSQL = strSQL & " Where 学号='" + Combo1.Text + " '" strSQL = strSQL & " and 课程号='" + Combo2.Text + "'" ADOrs.Open strSQL If ADOrs.EOF Then MsgBox "学生成绩表在不存在学号为" + Combo1.Text + "课程号为" + Combo2.Text + "的记录,请重新输入!", vbCritical + vbOKOnly Text1.Text = "" Text3.Text = "" Exit Sub Else Text3.Text = ADOrs.Fields("成绩") End If End If If ADOrs.State = adStateOpen Then ADOrs.Close '关闭记录集 Set ADOrs = Nothing End Sub (3) Combo2_Click 事件代码 Private Sub Combo2_Click() Dim ADOrs As New Recordset '声明一个记录集对象 ADOrs.ActiveConnection = ADOcn '与ADOcn连接对象关联 '如果输入了课程号,则把课程名显示在Text2.text strSQL = "select * from 课程情况表" strSQL = strSQL + " Where 课程号='" + Combo2.Text + " '" ADOrs.Open strSQL Text2.Text = ADOrs.Fields("课程名") ADOrs.Close '关闭记录集 (3) Combo2_Click 事件代码 If Combo1 "" Then '输入完毕则显示成绩信息 '查询学生成绩表中是否有指定指定学号与课程号的记录 strSQL = "select * from 学生成绩表" strSQL = strSQL & " Where 学号='" + Combo1.Text + " '" strSQL = strSQL & " and 课程号='" + Combo2.Text + "'" ADOrs.Open strSQL If ADOrs.EOF Then MsgBox "学生成绩表在不存在学号为" + Combo1.Text + "课程号为" + Combo2.Text + "的记录,请重新输入!", vbCritical + vbOKOnly Text2.Text = "" Text3.Text = "" Exit Sub Else Text3.Text = ADOrs.Fields("成绩") End If End If If ADOrs.State = adStateOpen Then ADOrs.Close '关闭记录集 Set ADOrs = Nothing End Sub (4)、 Command1_Click()(修改/确认按钮)事件代码 Private Sub Command1_Click() Dim strSQL As String Dim ADOrs As New Recordset '声明一个记录集对象 ADOrs.ActiveConnection = ADOcn '与ADOcn连接对象关联 '检查学号与课程号是否输入 If Combo1.Text = "" Or Combo2.Text = "" Then MsgBox "输入数据不全,请重新输入数据!", vbCritical + vbOKOnly Exit Sub End If (4)、 Command1_Click()(修改/确认按钮)事件代码 '根据当前按钮文字的不同进行相关处理 If Command1.Caption = "修改" Then Command1.Caption = "确认" Command2.Caption = "放弃" Else Command1.Caption = "修改" Command2.Caption = "返回" '拼写Update语句,以便进行修改 strSQL = "Update 学生成绩表" strSQL = strSQL + " Set 成绩=" + Text3.Text strSQL = strSQL + " Where 学号='" + Combo1.Text + "'" strSQL = strSQL + " And 课程号='" + Combo2.Text + " '" ADOcn.Execute strSQL '执行Updata语句 MsgBox "修改成功!", vbQuestion + vbOKOnly End If If ADOrs.State = adStateOpen Then ADOrs.Close '关闭记录集 Set ADOrs = Nothing End Sub (5) Command2_Click(返回/放弃) 事件代码 Private Sub Command2_Click() If Command2.Caption = "返回" Then Unload Me Else Command2.Caption = "返回" Command1.Caption = "修改" End If End Sub 8.frmDeleteStudent (删除学生)窗体的代码设计 (1)、Form_Load()事件代码 Private Sub Form_Load() Dim ADOrs As New Recordset '声明记录集对象 ADOrs.ActiveConnection = ADOcn '与ADOcn连接对象关联 '对Combo1组合框进行初始化 ADOrs.Open "select 学号 from 学生情况表 Order By 学号" Combo1.Clear Do While Not ADOrs.EOF Combo1.AddItem Trim(ADOrs.Fields("学号")) '添加"学号"字段 ADOrs.MoveNext '取下一条记录 Loop ADOrs.Close '关闭记录集 '对Combo2组合框进行初始化 ADOrs.Open "select 姓名 from 学生情况表 Order By 学号" Combo2.Clear Do While Not ADOrs.EOF Combo2.AddItem Trim(ADOrs.Fields("姓名")) '添加"姓名"字段 ADOrs.MoveNext '取下一条记录 Loop ADOrs.Close '关闭记录集 End Sub (2) Combo1_Click 事件代码 Private Sub Combo1_Click() Dim ADOrs As New Recordset '声明一个记录集对象 ADOrs.ActiveConnection = ADOcn '与ADOcn连接对象关联 '若选择了学号则将姓名自动填写到Combo2.Text ADOrs.Open "Select 姓名 From 学生情况表 Where 学号 ='" + Combo1.Text + "'" If ADOrs.EOF Then MsgBox "学生情况表中没有学号为" + Combo1.Text + "的记录,请重新输入!", vbQuestion + vbOKOnly Combo1.Text = "" Exit Sub Else Combo2.Text = ADOrs.Fields("姓名") End If ADOrs.Close '关闭记录集 End Sub (3) Combo2_Click 事件代码 Private Sub Combo2_Click() Dim ADOrs As New Recordset '声明一个记录集对象 ADOrs.ActiveConnection = ADOcn '与ADOcn连接对象关联 '若选择了姓名则将学号自动填写到Combo1.Text ADOrs.Open "Select 学号 From 学生情况表 Where 姓名 ='" + Combo2.Text + "'" If ADOrs.EOF Then MsgBox "学生情况表中没有姓名为" + Combo2.Text + "的记录,请重新输入!", vbQuestion + vbOKOnly Combo1.Text = "" Exit Sub Else Combo1.Text = ADOrs.Fields("学号") End If ADOrs.Close '关闭记录集 End Sub (4)、 Command1_Click()(确定按钮)事件代码 Private Sub Command1_Click() Dim ADOrs As New Recordset '声明记录集对象 Dim ADOrs1 As New Recordset '声明记录集对象 ADOrs.ActiveConnection = ADOcn '与ADOcn连接对象关联 ADOrs1.ActiveConnection = ADOcn '与ADOcn连接对象关联 '若学号和姓名同时为空则提示用户重新输入 If Combo1.Text = "" And Combo2.Text = "" Then MsgBox "学号和姓名不能同时为空,请重新输入!", vbQuestion + vbOKOnly Exit Sub End If (4)、 Command1_Click()(确定按钮)事件代码 '若输入了学号则将姓名自动填写到Combo2.Text If Combo1.Text "" And Combo2.Text = "" Then ADOrs.Open "Select 姓名 From 学生情况表 Where 学号 ='" + Combo1.Text + "'" If ADOrs.EOF Then MsgBox "学生情况表中没有学号为" + Combo1.Text + "的记录,请重新输入!", vbQuestion + vbOKOnly Combo1.Text = "" Exit Sub Else Combo2.Text = ADOrs.Fields("姓名") End If If ADOrs.State = adStateOpen Then ADOrs.Close '关闭记录集 End If (4)、 Command1_Click()(确定按钮)事件代码 '若输入了号姓名则将学号自动填写到Combo1.Text If Combo2.Text "" And Combo1.Text = "" Then ADOrs1.Open "Select 学号 From 学生情况表 Where 姓名='" + Combo2.Text + "'" If ADOrs1.EOF Then MsgBox "学生情况表中没有姓名为" + Combo2.Text + "的记录,请重新输入!", vbQuestion + vbOKOnly Combo2.Text = "" Exit Sub Else Combo1.Text = ADOrs1.Fields("学号") End If If ADOrs1.State = adStateOpen Then ADOrs1.Close '关闭记录集 End If '查询学生情况表中是否有指定学号和指定姓名的记录 If Combo1.Text "" And Combo2.Text "" Then ADOrs.Open "Select * From 学生情况表 Where 学号='" + Combo1.Text + "'" + " And 姓名='" + Combo2.Text + "'" If ADOrs.EOF Then MsgBox "学生情况表中没有学号为" + Combo1.Text + "且姓名为" + Combo2.Text + "的记录,请重新输入!", vbQuestion + vbOKOnly Combo1.Text = "" Combo2.Text = "" Exit Sub Else Combo1.Text = ADOrs.Fields("学号") Combo2.Text = ADOrs.Fields("姓名") End If If ADOrs.State = adStateOpen Then ADOrs.Close '关闭记录集 End If End Sub (5)、 Command2_Click()(确认按钮)事件代码 Private Sub Command2_Click() Dim xm As String Dim xh As String Dim strSQL As String Dim ADOrs As New Recordset '声明记录集对象 ADOrs.ActiveConnection = ADOcn '与ADOcn连接对象关联 '如果学号与姓名同时为空则提示重新输入/选择 If Combo1.Text = "" Or Combo2.Text = "" Then MsgBox "学号和姓名不能为空,请重新输入!", vbQuestion + vbOKOnly Else xh = Combo1.Text xm = Combo2.Text If MsgBox("删除学号为" + xh + "姓名为" + xm + "的学生记录,该学生在学生成绩表中的全部记录也将一起删除,是否继续?", vbQuestion + vbYesNo) = vbYes Then '拼写Delete学生成绩表指定记录语句 strSQL = "Delete From 学生成绩表" strSQL = strSQL + " Where 学号='" + Combo1.Text + "'" ADOcn.Execute strSQL '执行Delete语句 '拼写Delete学生情况表指定记录语句 strSQL = "Delete From 学生情况表" strSQL = strSQL + " Where 学号='" + Combo1.Text + "'" ADOcn.Execute strSQL '执行Delete语句 MsgBox "删除成功!", vbQuestion + vbOKOnly Combo1.Text = "" Combo2.Text = "" End If End If If ADOrs.State = adStateOpen Then ADOrs.Close '关闭记录集 End Sub (6)、 Command3_Click()(返回按钮)事件代码 Private Sub Command3_Click() Unload Me End Sub 9. frmDeleteCourse(删除课程)窗体代码设计 (1)、Form_Load()事件代码 Private Sub Form_Load() Dim ADOrs As New Recordset '声明记录集对象 ADOrs.ActiveConnection = ADOcn '与ADOcn连接对象关联 '对Combo1组合框进行初始化 ADOrs.Open "select 课程号 from 课程情况表 Order By 课程号" Combo1.Clear Do While Not ADOrs.EOF Combo1.AddItem Trim(ADOrs.Fields("课程号")) '添加"课程号"字段 ADOrs.MoveNext '取下一条记录 Loop ADOrs.Close '关闭记录集 '对Combo2组合框进行初始化 ADOrs.Open "select 课程名 from 课程情况表 Order By 课程号" Combo2.Clear Do While Not ADOrs.EOF Combo2.AddItem Trim(ADOrs.Fields("课程名")) '添加"课程名"字段 ADOrs.MoveNext '取下一条记录 Loop ADOrs.Close '关闭记录集 End Sub (2) Combo1_Click 事件代码 Private Sub Combo1_Click() Dim ADOrs As New Recordset '声明一个记录集对象 ADOrs.ActiveConnection = ADOcn '与ADOcn连接对象关联 '若选择了课程号则将课程名自动填写到Combo2.Text ADOrs.Open "Select 课程名 From 课程情况表 Where 课程号 ='" + Combo1.Text + "'" If ADOrs.EOF Then MsgBox "课程情况表中没有课程号为" + Combo1.Text + "的记录,请重新输入!", vbQuestion + vbOKOnly Combo1.Text = "" Exit Sub Else Combo2.Text = ADOrs.Fields("课程名") End If ADOrs.Close '关闭记录集 End Sub (3) Combo2_Click 事件代码 Private Sub Combo2_Click() Dim ADOrs As New Recordset '声明一个记录集对象 ADOrs.ActiveConnection = ADOcn '与ADOcn连接对象关联 '若选择了课程名则将课程号自动填写到Combo1.Text ADOrs.Open "Select 课程号 From 课程情况表 Where 课程名 ='" + Combo2.Text + "'" If ADOrs.EOF Then MsgBox "课程情况表中没有课程名为" + Combo2.Text + "的记录,请重新输入!", vbQuestion + vbOKOnly Combo1.Text = "" Exit Sub Else Combo1.Text = ADOrs.Fields("课程号") End If ADOrs.Close '关闭记录集 End Sub (4)、 Command1_Click()(确定按钮)事件代码 Private Sub Command1_Click() Dim ADOrs As New Recordset '声明记录集对象 Dim ADOrs1 As New Recordset '声明记录集对象 ADOrs.ActiveConnection = ADOcn '与ADOcn连接对象关联 ADOrs1.ActiveConnection = ADOcn '与ADOcn连接对象关联 '若课程号和课程名同时为空则提示用户重新输入 If Combo1.Text = "" And Combo2.Text = "" Then MsgBox "课程号和课程名不能同时为空,请重新输入!", vbQuestion + vbOKOnly Exit Sub End If (4)、 Command1_Click()(确定按钮)事件代码 '若输入了课程号则将课程名自动填写到Combo2.Text If Combo1.Text "" And Combo2.Text = "" Then ADOrs.Open "Select 课程名 From 课程情况表 Where 课程号 ='" + Combo1.Text + "'" If ADOrs.EOF Then MsgBox "课程情况表中没有课程号为" + Combo1.Text + "的记录,请重新输入!", vbQuestion + vbOKOnly Combo1.Text = "" Exit Sub Else Combo2.Text = ADOrs.Fields("课程名") End If If ADOrs.State = adStateOpen Then ADOrs.Close '关闭记录集 End If (4)、 Command1_Click()(确定按钮)事件代码 '若输入了课程名则将课程号自动填写到Combo1.Text If Combo2.Text "" And Combo1.Text = "" Then ADOrs1.Open "Select 课程号 From 课程情况表 Where 课程名='" + Combo2.Text + "'" If ADOrs1.EOF Then MsgBox "课程情况表中没有课程名为" + Combo2.Text + "的记录,请重新输入!", vbQuestion + vbOKOnly Combo2.Text = "" Exit Sub Else Combo1.Text = ADOrs1.Fields("课程号") End If If ADOrs1.State = adStateOpen Then ADOrs1.Close '关闭记录集 End If (4)、 Command1_Click()(确定按钮)事件代码 '查询课程情况表中是否有指定课程号和指定课程名的记录 If Combo1.Text "" And Combo2.Text "" Then ADOrs.Open "Select * From 课程情况表 Where 课程号='" + Combo1.Text + "'" + " And 课程名='" + Combo2.Text + "'" If ADOrs.EOF Then MsgBox "课程情况表中没有课程号为" + Combo1.Text + "且课程名为" + Combo2.Text + "的记录,请重新输入!", vbQuestion + vbOKOnly Combo1.Text = "" Combo2.Text = "" Exit Sub Else Combo1.Text = ADOrs.Fields("课程号") Combo2.Text = ADOrs.Fields("课程名") End If If ADOrs.State = adStateOpen Then ADOrs.Close '关闭记录集 End If End Sub (5)、 Command2_Click()(确认按钮)事件代码 Private Sub Command2_Click() Dim xm As String Dim xh As String Dim strSQL As String Dim ADOrs As New Recordset '声明记录集对象 ADOrs.ActiveConnection = ADOcn '与ADOcn连接对象关联 '如果课程号与课程名同时为空则提示重新输入/选择 If Combo1.Text = "" Or Combo2.Text = "" Then MsgBox "课程号和课程名不能为空,请重新输入!", vbQuestion + vbOKOnly Else xh = Combo1.Text xm = Combo2.Text If MsgBox("删除课程号为" + xh + "课程名为" + xm + "的课程记录,该课程在学生成绩表中的全部记录也将一起删除,是否继续?", vbQuestion + vbYesNo) = vbYes Then (5)、 Command2_Click()(确认按钮)事件代码 '拼写Delete学生成绩表指定记录语句 strSQL = "Delete From 学生成绩表" strSQL = strSQL + " Where 课程号='" + Combo1.Text + "'" ADOcn.Execute strSQL '执行Delete语句 '拼写Delete课程情况表指定记录语句 strSQL = "Delete From 课程情况表" strSQL = strSQL + " Where 课程号='" + Combo1.Text + "'" ADOcn.Execute strSQL '执行Delete语句 MsgBox "删除成功!", vbQuestion + vbOKOnly Combo1.Text = "" Combo2.Text = "" End If End If If ADOrs.State = adStateOpen Then ADOrs.Close '关闭记录集 End Sub (6)、 Command3_Click()(返回按钮)事件代码 Private Sub Command3_Click() Unload Me End Sub 10. frmDeleteGrade (删除成绩)窗体代码设计 (1)、Form_Load()事件代码 Private Sub Form_Load() Dim ADOrs As New Recordset '声明记录集对象 ADOrs.ActiveConnection = ADOcn '与ADOcn连接对象关联 '对Combo1组合框进行初始化 ADOrs.Open "Select 学号 From 学生情况表 Order By 学号" Combo1.Clear Do While Not ADOrs.EOF Combo1.AddItem Trim(ADOrs.Fields("学号")) '添加"学号"字段 ADOrs.MoveNext '取下一条记录 Loop ADOrs.Close '关闭记录集 '对Combo2组合框进行初始化 ADOrs.Open "select 课程号 from 课程情况表 Order By 课程号" Combo2.Clear Do While Not ADOrs.EOF Combo2.AddItem Trim(ADOrs.Fields("课程号")) '添加"课程号"字段 ADOrs.MoveNext '取下一条记录 Loop ADOrs.Close '关闭记录集 'End Sub (2) Combo1_Click 事件代码 Private Sub Combo1_Click() Dim ADOrs As New Recordset '声明一个记录集对象 ADOrs.ActiveConnection = ADOcn '与ADOcn连接对象关联 '如果输入了学号,则把姓名显示在Text1.Text strSQL = "select * from 学生情况表" strSQL = strSQL + " Where 学号='" + Combo1.Text + " '" ADOrs.Open strSQL Text1.Text = ADOrs.Fields("姓名") ADOrs.Close '关闭记录集 (2) Combo1_Click 事件代码(续) If Combo2 "" Then '输入完毕则显示成绩信息 '查询学生成绩表中是否有指定指定学号与课程号的记录 strSQL = "select * from 学生成绩表" strSQL = strSQL & " Where 学号='" + Combo1.Text + " '" strSQL = strSQL & " and 课程号='" + Combo2.Text + "'" ADOrs.Open strSQL If ADOrs.EOF Then MsgBox "学生成绩表在不存在学号为" + Combo1.Text + "课程号为" + Combo2.Text + "的记录,请重新输入!", vbCritical + vbOKOnly Text1.Text = "" Text3.Text = "" Exit Sub Else Text3.Text = ADOrs.Fields("成绩") End If End If If ADOrs.State = adStateOpen Then ADOrs.Close '关闭记录集 Set ADOrs = Nothing End Sub (3) Combo2_Click 事件代码 Private Sub Combo2_Click() Dim ADOrs As New Recordset '声明一个记录集对象 ADOrs.ActiveConnection = ADOcn '与ADOcn连接对象关联 '如果输入了课程号,则把课程名显示在Text2.text strSQL = "select * from 课程情况表" strSQL = strSQL + " Where 课程号='" + Combo2.Text + " '" ADOrs.Open strSQL Text2.Text = ADOrs.Fields("课程名") ADOrs.Close '关闭记录集 (3) Combo2_Click 事件代码(续) If Combo1 "" Then '输入完毕则显示成绩信息 '查询学生成绩表中是否有指定指定学号与课程号的记录 strSQL = "select * from 学生成绩表" strSQL = strSQL & " Where 学号='" + Combo1.Text + " '" strSQL = strSQL & " and 课程号='" + Combo2.Text + "'" ADOrs.Open strSQL If ADOrs.EOF Then MsgBox "学生成绩表在不存在学号为" + Combo1.Text + "课程号为" + Combo2.Text + "的记录,请重新输入!", vbCritical + vbOKOnly Text2.Text = "" Text3.Text = "" Exit Sub Else Text3.Text = ADOrs.Fields("成绩") End If End If If ADOrs.State = adStateOpen Then ADOrs.Close '关闭记录集 Set ADOrs = Nothing End Sub (4)、 Command1_Click()(确定按钮)事件代码 Private Sub Command1_Click() Dim strSQL As String Dim ADOrs As New Recordset '声明一个记录集对象 ADOrs.ActiveConnection = ADOcn '与ADOcn连接对象关联 Dim ADOrs1 As New Recordset '声明一个记录集对象 ADOrs1.ActiveConnection = ADOcn '与ADOcn连接对象关联 Dim ADOrs2 As New Recordset '声明一个记录集对象 ADOrs2.ActiveConnection = ADOcn '与ADOcn连接对象关联 ‘如果学号为空则提示用户重新输入 If Combo1.Text = "" Then MsgBox "学号不能为空,请重新输入!", vbQuestion + vbOKOnly Combo1.Text = "" Text1.Text = "" Exit Sub End If (4)、 Command1_Click()(确定按钮)事件代码---续 '如果课程号为空则提示拥护重新输入 If Combo2.Text = "" Then MsgBox "课程号不能为空,请重新输入!", vbQuestion + vbOKOnly Combo2.Text = "" Text2.Text = "" Exit Sub End If '查询学生情况表中是否有指定学号的记录 If Combo1.Text "" Then ADOrs1.Open "Select 姓名 From 学生情况表 Where 学号='" + Combo1.Text + "'" If ADOrs1.EOF Then MsgBox “学生情况表中没有学号为” + Combo1.Text + “的记录,请重新输入!”, vbQuestion + vbOKOnly Combo1.Text = "" Text1.Text = "" Exit Sub Else '若有指定学号的学生记录,则将姓名字段填写到text1 Text1.Text = ADOrs1.Fields("姓名") End If End If '查询课程情况表中是否有指定课程号的记录 If Combo2.Text "" Then ADOrs2.Open "Select 课程名 From 课程情况表 Where 课程号='" + Combo2.Text + "'" If ADOrs2.EOF Then MsgBox "课程情况表中没有课程号为" + Combo2.Text + "的记录,请重新输入!", vbQuestion + vbOKOnly Combo2.Text = "" Text2.Text = "" Exit Sub Else '若有指定课程号的课程记录,则将课程名字段填写到text2 Text2.Text = ADOrs2.Fields("课程名") End If End If '查询学生表中是否有指定学号与课程号的记录 If Combo1 "" And Combo1 "" Then strSQL = "select * from 学生成绩表" strSQL = strSQL & " Where 学号='" + Combo1.Text + " '" strSQL = strSQL & " and 课程号='" + Combo2.Text + "'" ADOrs.Open strSQL If ADOrs.EOF Then MsgBox "学生成绩表在不存在学号为" + Combo1.Text + "课程号为" + Combo2.Text + "的记录,请重新输入!", vbCritical + vbOKOnly Combo1.Text = "" Combo2.Text = "" Text1.Text = "" Text2.Text = "" Text3.Text = "" Exit Sub Else Text3.Text = Val(ADOrs.Fields("成绩")) End If End If End Sub 5)、 Command2_Click()(确认按钮)事件代码 Private Sub Command2_Click() If MsgBox("是否要删除学号为" + Combo1.Text + "课程号为" + Combo2.Text + "的成绩记录?", vbQuestion + vbYesNo) = vbYes Then '拼写Delete语句 strSQL = "Delete From 学生成绩表" strSQL = strSQL + " Where 学号='" + Combo1.Text + "'" strSQL = strSQL + " And 课程号='" + Combo2.Text + "'" ADOcn.Execute strSQL '执行Delete语句 Combo1.Text = "" Combo2.Text = "" Text1.Text = "" Text2.Text = "" Text3.Text = "" MsgBox "删除成功!", vbQuestion + vbOKOnly End If End Sub (6)、 Command3_Click()(返回按钮)事件代码 Private Sub Command3_Click() Unload Me End Sub 11. frmDeleteUser(删除用户)窗体代码设计 (1)、 Command1_Click()(确定按钮)事件代码 Private Sub Command1_Click() '定义变量,建立与数据库的连接 Dim strSQL As String Dim ADOrs2 As New Recordset ADOrs2.ActiveConnection = ADOcn If Trim(Text1.Text) = "" Then MsgBox "请输入用户名!", , "删除用户" Text1.SetFocus Exit Sub End If If Trim(Text2.Text) = "" Then MsgBox "请输入用户密码!", , "删除用户" Text2.SetFocus Exit Sub End If '查询是否有指定用户名和密码的记录 ADOrs2.Open "Select * From 用户 Where 用户名='" + Text1.Text + "'" + " And 密码='" + Text2.Text + "'" If ADOrs2.EOF Then MsgBox "用户中没有名为:" + Text1.Text + " 密码为:" + Text2.Text + "的记录,请重新输入!", vbQuestion + vbOKOnly Text1.Text = "" Text2.Text = "" Text1.SetFocus Else If MsgBox("是否删除用户名为“" + Text1.Text + "”密码为“" + Text2.Text + "”的用户记录?", vbQuestion + vbYesNo) = vbYes Then '拼写Delete用户指定记录语句 strSQL = "Delete From 用户 Where 用户名='" + Text1.Text + "'" + " And 密码='" + Text2.Text + "'" ADOcn.Execute strSQL '执行Delete语句 MsgBox "删除成功!", vbQuestion + vbOKOnly Text1.Text = "" Text2.Text = "" Text1.SetFocus End If End If End Sub (2)、 Command2_Click()(返回按钮)事件代码 Private Sub Command2_Click() Unload Me End Sub 12. frmQuerystudent(学生基本信息查询)窗体代码设计 使用ado数据控件与DataGrid数据绑定控件实现 (1)、Form_Load()事件代码 Private Sub Form_Load() Combo1.Text = "全部学生" '默认查询全部学生 Label2.Caption = "全部学生数据浏览表格:" Label1.Visible = False Text1.Visible = False End Sub 说明:这里使用ado数据控件adodc1与DataGrid数据绑定控件DataGrid1,并已设置好adodc属性---查询数据库中的表格(学生情况表)。 (2) Combo1_Click 事件代码 Private Sub Combo1_Click() Select Case Combo1.ListIndex '根据选择的组合框项进行处理 Case 0 '选择“全部学生”时隐藏提示信息 strSQL = "select * from 学生情况表" Adodc1.CommandType = adCmdText Adodc1.RecordSource = strSQL Adodc1.Refresh Label2.Caption = "全部学生数据浏览表格:“ DataGrid1.Visible = True Label1.Visible = False Text1.Visible = False Case 1 '选择“按学号查询”时给出提示并定位光标 Label1.Visible = True Text1.Visible = True Text1.SetFocus Label1.Caption = "请输入学号并按回车键确认:" Case 2 '选择“按姓名查询”时给出提示并定位光标 Label1.Visible = True Text1.Visible = True Text1.SetFocus Label1.Caption = "请输入姓名并按回车键确认:" End Select End Sub (3) Text1_KeyPress 事件代码 Private Sub Text1_KeyPress(KeyAscii As Integer) Dim atrsql As String If KeyAscii = 13 Then Select Case Combo1.ListIndex '根据选择的组合框项进行处理 Case 1 '选择“按学号查询”时 strSQL = "select * from 学生情况表 where 学号='" & Trim(Text1.Text) & "'" Adodc1.CommandType = adCmdText Adodc1.RecordSource = strSQL Adodc1.Refresh If Adodc1.Recordset.EOF Then '没有找到时 Label2.Caption = "" DataGrid1.Visible = False MsgBox "没有该生记录信息,请检查你输入的学号是否正确!" Else '找到时 Label2.Caption = "学号为" & Text1.Text & "的学生数据浏览表格:" DataGrid1.Visible = True End If Text1.Text = "" Case 2 '选择“按姓名查询”时 strSQL = "select * from 学生情况表 where 姓名='" & Trim(Text1.Text) & "'" Adodc1.CommandType = adCmdText Adodc1.RecordSource = strSQL Adodc1.Refresh If Adodc1.Recordset.EOF Then '没有找到时 Label2.Caption = "" DataGrid1.Visible = False MsgBox "没有该生记录信息,请检查你输入的姓名是否正确!" Else '找到时 Label2.Caption = "姓名为" & Text1.Text & "的学生数据浏览表格:" DataGrid1.Visible = True End If Text1.Text = "" End Select End If End Sub (4) Command1_Click(返回按钮)事件代码 Private Sub Command1_Click() Unload Me End Sub 13. frmQueryGrade(学生成绩查询)窗体代码设计 使用MSFlexGrid1控件(编程模型)实现 (1)、Form_Load()事件代码 Private Sub Form_Load() Dim ADOrs As New Recordset '声明一个记录集对象 ADOrs.ActiveConnection = ADOcn '与ADOcn连接对象关联 MSFlexGrid1.Visible = False '隐藏MSFlexGrid1控件 '对Combo1组合框进行初始化 ADOrs.Open "select 学号 from 学生情况表 Order By 学号" Combo1.Clear Do While Not ADOrs.EOF Combo1.AddItem Trim(ADOrs.Fields("学号")) '添加"学号"字段 ADOrs.MoveNext '取下一条记录 Loop ADOrs.Close '关闭记录集对象 Text1.Text = "" End Sub (2) Combo1_Click 事件代码 Private Sub Combo1_Click() Dim ADOrs As New Recordset '声明一个记录集对象 ADOrs.ActiveConnection = ADOcn '与ADOcn连接对象关联 '若选择了学号则将姓名自动填写到text1 ADOrs.Open "Select 姓名 From 学生情况表 Where 学号 ='" & Combo1.Text & "'" If ADOrs.EOF Then MsgBox "学生情况表中没有学号为" & Combo1.Text & "的记录,请重新输入!", vbQuestion & vbOKOnly Text1.Text = "" Else Text1.Text = ADOrs.Fields("姓名") End If ADOrs.Close '关闭记录集 End Sub (3) Command1_Click(确定按钮)事件代码 Private Sub Command1_Click() Dim strSQL As String, strSQL2 As String Dim strRecord As String Dim ADOrs As New Recordset '声明记录集对象 Dim ADOrs2 As New Recordset ADOrs.ActiveConnection = ADOcn '与ADOcn连接对象关联 ADOrs2.ActiveConnection = ADOcn strSQL = "select * from 学生情况表 Where 学号='" & Combo1.Text & " '" ADOrs.Open strSQL If ADOrs.EOF Then MsgBox ("数据库中找不到学号为" & Combo1.Text & "的记录,请重新输入!") Combo1.Text = "" Text1.Text = "" Else Text1.Text = ADOrs.Fields("姓名") End If '拼写Select语句 strSQL2 = "Select 学生成绩表.学号,学生成绩表.课程号,学生成绩表.成绩," strSQL2 = strSQL2 & "学生情况表.姓名,课程情况表.课程名" strSQL2 = strSQL2 & " From 学生成绩表,学生情况表,课程情况表" strSQL2 = strSQL2 & " Where 学生成绩表.学号=学生情况表.学号" strSQL2 = strSQL2 & " And 学生成绩表.课程号=课程情况表.课程号" strSQL2 = strSQL2 & " And 学生成绩表.学号= '" & Combo1.Text & "'" ADOrs2.Open strSQL2 '执行Select语句 If ADOrs2.EOF = True Then MSFlexGrid1.Visible = False '隐藏MSFlexGrid1控件 MsgBox "没有该生成绩!" Else '初始化MSFlexGrid表格 MSFlexGrid1.Rows = 0 '行数 MSFlexGrid1.Cols = 5 '列数 MSFlexGrid1.ColWidth(3) = 1500 '调节第4列宽度 MSFlexGrid1.Visible = True '显示MSFlexGrid1控件 '设置表格标题栏 strRecord = "学号" & vbTab & "姓名" & vbTab & "课程号" strRecord = strRecord & vbTab & "课程名" & vbTab & "成绩" MSFlexGrid1.AddItem strRecord '从第一条记录开始循环,直至表尾,填写表格内容 Do While Not ADOrs2.EOF '拼写表格内容 strRecord = Trim(ADOrs2.Fields("学号")) & vbTab & Trim(ADOrs2.Fields("姓名")) & vbTab strRecord = strRecord & Trim(ADOrs2.Fields("课程号")) & vbTab & Trim(ADOrs2.Fields("课程名")) strRecord = strRecord & vbTab & Trim(Str(ADOrs2.Fields("成绩"))) MSFlexGrid1.AddItem strRecord '向表格内添加行 ADOrs2.MoveNext '取下一条记录 Loop End If ADOrs.Close '关闭记录集对象 ADOrs2.Close '释放记录集对象 Set ADOrs = Nothing Set ADOrs2 = Nothing End Sub (4) Command2_Click(返回按钮)事件代码 Private Sub Command2_Click() Unload Me End Sub 14.身份验证窗体(frmlogin)代码设计 1)、Form_Initialize()事件代码 Private Sub Form_Initialize() ADOcn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=成绩.MDB" If ADOcn.State = adStateClosed Then ADOcn.Open '打开到数据库的连接 End Sub 2)、Command1_Click()事件代码—登录按钮 Private Sub Command1_Click() Dim ADOrs As New Recordset '声明记录集对象 Dim strSQL As String ADOrs.ActiveConnection = ADOcn '与连接对象adocn关联 If Trim(Text1.Text) = "" Or Trim(Text2.Text) = "" Then '检验用户名与密码为空否 MsgBox "帐号和密码不能为空,请重新填写", vbOKOnly + vbInformation Exit Sub End If strSQL = "select * from 用户 where 用户名='" + Trim(Text1.Text) + "'" ADOrs.Open strSQL '按用户名查询 If ADOrs.EOF Then '找不到该用户 MsgBox "用户不存在", vbCritical + vbOKOnly Text1.Text = "" Text1.SetFocus Exit Sub ElseIf Trim(Text2.Text) ADOrs.Fields(“密码”) Then ‘找到用户后检验密码 MsgBox "密码不正确", vbOKOnly + vbInformation Text2.Text = "" Text2.SetFocus Exit Sub End If '用户登录成功,记录用户类型参数 usertype = ADOrs.Fields("用户类型") Unload Me MDIForm1.Show '登录成功,打开MDI主窗体 ADOrs.Close Set ADOrs = Nothing End Sub 3)、Command2_Click()事件代码—退出按钮 Private Sub Command2_Click() ADOcn.Close Set ADOcn = Nothing Unload Me End Sub 4)、登录成功并打开MDI主窗体后,应根据人员类型设置菜单权限 Private Sub MDIForm_Load() '根据人员类型设置菜单权限 Select Case usertype 'Case "管理员" Case "查询人员" addmenu.Enabled = False deletemenu.Enabled = False Updata.Enabled = False End Select End Sub 1.4 其他 一、用户自定义函数的使用 1、初始化窗体大小及显示座标函数 Public Sub init(frmname As Object, X As Integer, Y As Integer) frmname.Width = X frmname.Height = Y frmname.Left = (MDIForm1.Width - frmname.Width) / 2 frmname.Top = (MDIForm1.Height - frmname.Height) / 2 End Sub 2、校验输入的文本框字符是否为数字或backspace回格键函数 ,’如果是则返回true,否则返回false Public Function in_int(KeyAscii As Integer) As Boolean Dim Accept_int(10) As String '可接受的字符数组 Accept_int(0) = "0" Accept_int(1) = "1" Accept_int(2) = "2" Accept_int(3) = "3" Accept_int(4) = "4" Accept_int(5) = "5" Accept_int(6) = "6" Accept_int(7) = "7" Accept_int(8) = "8" Accept_int(9) = "9" Accept_int(10) = Chr(8) 'Chr(8)是backspace键对应的字符 in_int = False For i = 1 To 10 '检查输入的字符是否在数组中 If Chr(KeyAscii) = Accept_int(i) Then in_int = True End If Next i End Function
看实例学VFP:更复杂的查询 时间:2009-02-12来源:编程入门网 作者:老马   在看实例学VFP:对表中记录进行定位与查找操作及看实例学VFP:用SELECT语句创建查询这两个例子中,我们可以在查询时可以从组合框中选定一个要查询的字段。本例对这种查询方式再做进一步改进,使之在查询时不仅可以从一个组合框中选取要查询的字段,还可以从另一个组合框中选定操作符(如<、=、>等),从而实现更复杂的查询。本例应用到了数据环境,并使用“数据1”数据库中的“人员信息表”作为数据环境的数据源,关于该数据库的情况已经在看实例学VFP:示例数据库一文中给出,这里不再详述。运行界面见本文末尾。   制作步骤如下:   一、新建表单,将其caption属性设置为“更复杂的查询例子”,AutoCenter属性设置为.T.,width属性设置为520,height属性设置为245,并保存为“更复杂的查询例子.scx”。   二、右击表单空白处,选“数据环境”命令,将“人员信息表”添加到数据环境中。在“数据环境设计器”中拖动“人员信息表”的标题栏到表单上,自动生成一个表格控件。由于是从数据环境中把“人员信息表”拖动过来由系统自动生成的,该表格控件的RecordSource属性及RecordSourceType属性已经由系统设置好了,不用管它,但name属性系统给出的好长,为了书写代码的方便,我们把这个表格控件的name属性修改为“grid1”。   三、在表格控件的下方添加一个Label控件,并把它的caption属性设置为“查询条件”。   四、在label控件的右侧依次添加两个组合框控件、一个文本框控件及两个命令按钮command1和command2,并把这两个命令按钮的caption属性依次设置为“查找”和“退出”。   五、适当调整各控件在表单上的位置,调整后的表单设计器如下图所示:   六、设置组合框控件的属性:   (一)组合框Combo1:RecordSourceType属性设置为“8-结构”,RecordSource属性设置为“人员信息表”。   (二)组合框Combo2:RecordSourceType属性设置为“1-”,RecordSource属性设置为“,>,<,=,>=,<=,<>”。   七、添加事件代码:   (一)表单的unload事件代码:close data   (二)组合框Combo1的InteractiveChange事件代码: if alltrim(this.displayvalue)="出生日期" thisform.text1.value={} else thisform.text1.value='' endif   (三)“查找”按钮command1的click事件代码: if thisform.grid1.recordsource='临时人员信息表' thisform.grid1.recordsource='人员信息表' endif' private CXTJ if empty(thisform.combo1.displayvalue) or empty(thisform.combo2.displayvalue) ; or empty(thisform.text1.value) && 判断列表框和文本框是否为空 messagebox('请输入完整条件!',16,'系统提示') thisform.combo1.setfocus else do case case alltrim(thisform.Combo1.Displayvalue)='基本工资' CXTJ=alltrim(thisform.combo1.displayvalue); +' '+alltrim(thisform.combo2.displayvalue); +' '+alltrim(thisform.text1.value) case alltrim(thisform.Combo1.Displayvalue)='出生日期' CXTJ=alltrim(thisform.combo1.displayvalue); +' '+alltrim(thisform.combo2.displayvalue); +' ctod("'+dtoc(thisform.text1.value)+'")' otherwise CXTJ=alltrim(thisform.combo1.displayvalue); +' '+alltrim(thisform.combo2.displayvalue); +' "'+alltrim(thisform.text1.value)+'"' endcase Select * from 人员信息表 where &CXTJ. into cursor 临时人员信息表 thisform.grid1.recordsource='临时人员信息表' thisform.grid1.backcolor=rgb(200,224,248) endif   (四)“退出”按钮command2的click事件代码:thisform.release   八、运行“更复杂的查询例子.scx”,界面见下图:
\'日期数据定义方法如下 \'前12个字节代表1-12月为大月或是小月,1为大月30天,0为小月29天,第13位为闰月的情况,1为大月30天,0为小月29天,第14位为闰月的月 \'份,如果不是闰月为0,否则给出月份,10、11、12分别用A、B、C来表示,即使用16进制。最后4位为当年农历新年-即农历1月1日所在公历 \'的日期,如0131代表1月31日。FunGetDate函数使用方式如下tYear为要输入的年,tMonth为月,tDay为 \'日期,YLyear是返回,返加农历的年份,如甲子年,YLShuXing返回的是属象,如鼠。IsGetGongLi是设置是不是通过农历取公历,如果是, \'前三个返回相应的公历日期,而且返回是一个公历日期。 \'by lichangfeng mytoday2004@163.com 2007.4.5 5:30 Function FunGetDate(tYear As Integer, tMonth As Integer, tDay As Integer, YLyear As String, YLShuXing As String, Optional IsGetGongLi As Boolean) As String On Error Resume Next Dim dateList(1900 To 2011) As String * 18 Dim conDate As Date, setDate As Date Dim AddMonth As Integer, AddDay As Integer, AddYear As Integer, getDay As Integer Dim RunYue As Boolean If tYear > 2010 Or tYear < 1901 Then Exit Function \'如果不是有效有日期,退出 \'1900 to 2009 dateList(1900) = \"010010110110180131\" dateList(1901) = \"010010101110000219\" dateList(1902) = \"101001010111000208\" dateList(1903) = \"010100100110150129\" dateList(1904) = \"110100100110000216\" dateList(1905) = \"110110010101000204\" dateList(1906) = \"011010101010140125\" dateList(1907) = \"010101101010000213\" dateList(1908) = \"100110101101000202\" dateList(1909) = \"010010101110120122\" dateList(1910) = \"010010101110000210\" dateList(1911) = \"101001001101160130\" dateList(1912) = \"101001001101000218\" dateList(1913) = \"110100100101000206\" dateList(1914) = \"110101010100150126\" dateList(1915) = \"101101010101000214\" dateList(1916) = \"010101101010000204\" dateList(1917) = \"100101101101020123\" dateList(1918) = \"100101011011000211\" dateList(1919) = \"010010011011170201\" dateList(1920) = \"010010011011000220\" dateList(1921) = \"101001001011000208\" dateList(1922) = \"101100100101150128\" dateList(1923) = \"011010100101000216\" dateList(1924) = \"011011010100000205\" dateList(1925) = \"101011011010140124\" dateList(1926) = \"001010110110000213\" dateList(1927) = \"100101010111000202\" dateList(1928) = \"010010010111120123\" dateList(1929) = \"010010010111000210\" dateList(1930) = \"011001001011060130\" dateList(1931) = \"110101001010000217\" dateList(1932) = \"111010100101000206\" dateList(1933) = \"011011010100150126\" dateList(1934) = \"010110101101000214\" dateList(1935) = \"001010110110000204\" dateList(1936) = \"100100110111030124\" dateList(1937) = \"100100101110000211\" dateList(1938) = \"110010010110170131\" dateList(1939) = \"110010010101000219\" dateList(1940) = \"110101001010000208\" dateList(1941) = \"110110100101060127\" dateList(1942) = \"101101010101000215\" dateList(1943) = \"010101101010000205\" dateList(1944) = \"101010101101140125\" dateList(1945) = \"001001011101000213\" dateList(1946) = \"100100101101000202\" dateList(1947) = \"110010010101120122\" dateList(1948) = \"101010010101000210\" dateList(1949) = \"101101001010170129\" dateList(1950) = \"011011001010000217\" dateList(1951) = \"101101010101000206\" dateList(1952) = \"010101011010150127\" dateList(1953) = \"010011011010000214\" dateList(1954) = \"101001011011000203\" dateList(1955) = \"010100101011130124\" dateList(1956) = \"010100101011000212\" dateList(1957) = \"101010010101080131\" dateList(1958) = \"111010010101000218\" dateList(1959) = \"011010101010000208\" dateList(1960) = \"101011010101060128\" dateList(1961) = \"101010110101000215\" dateList(1962) = \"010010110110000205\" dateList(1963) = \"101001010111040125\" dateList(1964) = \"101001010111000213\" dateList(1965) = \"010100100110000202\" dateList(1966) = \"111010010011030121\" dateList(1967) = \"110110010101000209\" dateList(1968) = \"010110101010170130\" dateList(1969) = \"010101101010000217\" dateList(1970) = \"100101101101000206\" dateList(1971) = \"010010101110150127\" dateList(1972) = \"010010101101000215\" dateList(1973) = \"101001001101000203\" dateList(1974) = \"110100100110140123\" dateList(1975) = \"110100100101000211\" dateList(1976) = \"110101010010180131\" dateList(1977) = \"101101010100000218\" dateList(1978) = \"101101101010000207\" dateList(1979) = \"100101101101060128\" dateList(1980) = \"100101011011000216\" dateList(1981) = \"010010011011000205\" dateList(1982) = \"101001001011140125\" dateList(1983) = \"101001001011000213\" dateList(1984) = \"1011001001011A0202\" dateList(1985) = \"011010100101000220\" dateList(1986) = \"011011010100000209\" dateList(1987) = \"101011011010060129\" dateList(1988) = \"101010110110000217\" dateList(1989) = \"100100110111000206\" dateList(1990) = \"010010010111150127\" dateList(1991) = \"010010010111000215\" dateList(1992) = \"011001001011000204\" dateList(1993) = \"011010100101030123\" dateList(1994) = \"111010100101000210\" dateList(1995) = \"011010110010180131\" dateList(1996) = \"010110101100000219\" dateList(1997) = \"101010110110000207\" dateList(1998) = \"100100110110150128\" dateList(1999) = \"100100101110000216\" dateList(2000) = \"110010010110000205\" dateList(2001) = \"110101001010140124\" dateList(2002) = \"110101001010000212\" dateList(2003) = \"110110100101000201\" dateList(2004) = \"010110101010120122\" dateList(2005) = \"010101101010000209\" dateList(2006) = \"101010101101170129\" dateList(2007) = \"001001011101000218\" dateList(2008) = \"100100101101000207\" dateList(2009) = \"110010010101150126\" dateList(2010) = \"101010010101000214\" dateList(2011) = \"101101001010000214\" AddYear = tYear RunYue = False If IsGetGongLi Then AddMonth = Val(Mid(dateList(AddYear), 15, 2)) AddDay = Val(Mid(dateList(AddYear), 17, 2)) conDate = DateSerial(AddYear, AddMonth, AddDay) AddDay = tDay For i = 1 To tMonth - 1 AddDay = AddDay + 29 + Val(Mid(dateList(tYear), i, 1)) Next i \'MsgBox DateDiff(\"d\", conDate, Date) setDate = DateAdd(\"d\", AddDay - 1, conDate) FunGetDate = setDate tYear = Year(setDate) tMonth = Month(setDate) tDay = Day(setDate) Exit Function End If CHUSHIHUA: AddMonth = Val(Mid(dateList(AddYear), 15, 2)) AddDay = Val(Mid(dateList(AddYear), 17, 2)) conDate = DateSerial(AddYear, AddMonth, AddDay) setDate = DateSerial(tYear, tMonth, tDay) getDay = DateDiff(\"d\", conDate, setDate) If getDay < 0 Then AddYear = AddYear - 1: GoTo CHUSHIHUA \' addday = NearDay AddDay = 1: AddMonth = 1 For i = 1 To getDay AddDay = AddDay + 1 If AddDay = 30 + Mid(dateList(AddYear), AddMonth, 1) Or (RunYue And AddDay = 30 + Mid(dateList(AddYear), 13, 1)) Then If RunYue = False And AddMonth = Val(\"&H\" & Mid(dateList(AddYear), 14, 1)) Then RunYue = True Else RunYue = False AddMonth = AddMonth + 1 End If AddDay = 1 End If Next md$ = \"初一初二初三初四初五初六初七初八初九初十十一十二十三十四十五十六十七十八十九二十廿一廿二廿三廿四廿五廿六廿七廿八廿九三十\" dd$ = Mid(md$, (AddDay - 1) * 2 + 1, 2) mm$ = Mid(\"正二三四五六七八九十寒腊\", AddMonth, 1) + \"月\" YouGetDate = DateSerial(AddYear, AddMonth, AddDay) tiangan$ = \"甲乙丙丁戊已庚辛壬癸\" dizhi$ = \"子丑寅卯辰巳午未申酉戌亥\" Dim ganzhi(0 To 59) As String * 2 For i = 0 To 59 ganzhi(i) = Mid(tiangan$, (i Mod 10) + 1, 1) + Mid(dizhi$, (i Mod 12) + 1, 1) \'ff$ = ff$ + ganzhi(i) Next i \'MsgBox ff$, , Len(ff$) YLyear = ganzhi((AddYear - 4) Mod 60) shu$ = \"鼠牛虎兔龙蛇马羊猴鸡狗猪\" YLShuXing = Mid(shu$, ((AddYear - 4) Mod 12) + 1, 1) If RunYue Then mm$ = \"闰\" + mm$ FunGetDate = mm$ + dd$ End Function \'添加三个combobox控件 \'四个标签\"年\"\"月\"\"日\",其中一个caption为空name 为lb作为显示日期的容器 Private Sub Combo1_Click() Dim ty As Integer, tm As Integer, td As Integer, yl As String, sx As String, yOn As Boolean yOn = False If Check1.Value = 1 Then yOn = True End If lb.Caption = FunGetDate(Combo1.Text, Combo2.Text, Combo3.Text, yl, sx, yOn) & \" \" & yl & \" \" & sx End Sub Private Sub Combo2_Click() com11 = Combo3.Text Combo3.Clear Select Case Combo2.Text Case 1 For i = 1 To 31 Combo3.AddItem i, i - 1 Next Case 2 If Combo1.Text Mod 4 <> 0 Then For i = 1 To 28 Combo3.AddItem i, i - 1 Next Else For i = 1 To 29 Combo3.AddItem i, i - 1 Next End If Case 3 For i = 1 To 31 Combo3.AddItem i, i - 1 Next Case 4 For i = 1 To 30 Combo3.AddItem i, i - 1 Next Case 5 For i = 1 To 31 Combo3.AddItem i, i - 1 Next Case 6 For i = 1 To 30 Combo3.AddItem i, i - 1 Next Case 7 For i = 1 To 31 Combo3.AddItem i, i - 1 Next Case 8 For i = 1 To 31 Combo3.AddItem i, i - 1 Next Case 9 For i = 1 To 30 Combo3.AddItem i, i - 1 Next Case 10 For i = 1 To 31 Combo3.AddItem i, i - 1 Next Case 11 For i = 1 To 30 Combo3.AddItem i, i - 1 Next Case 12 For i = 1 To 31 Combo3.AddItem i, i - 1 Next End Select Combo3.Text = com11 Dim ty As Integer, tm As Integer, td As Integer, yl As String, sx As String, yOn As Boolean yOn = False If Check1.Value = 1 Then yOn = True End If lb.Caption = FunGetDate(CInt(Combo1.Text), CInt(Combo2.Text), CInt(com11), yl, sx, yOn) & \" \" & yl & \" \" & sx End Sub Private Sub Combo3_Click() Dim ty As Integer, tm As Integer, td As Integer, yl As String, sx As String, yOn As Boolean yOn = False If Check1.Value = 1 Then yOn = True End If lb.Caption = FunGetDate(CInt(Combo1.Text), CInt(Combo2.Text), CInt(Combo3.Text), yl, sx, yOn) & \" \" & yl & \" \" & sx End Sub Private Sub Form_Load() For i = 1900 To 2011 Combo1.AddItem i, i - 1900 Next For i = 1 To 12 Combo2.AddItem i, i - 1 Next Select Case Combo2.Text Case 1 For i = 1 To 31 Combo3.AddItem i, i - 1 Next Case 2 If Combo1.Text Mod 4 <> 0 Then For i = 1 To 28 Combo3.AddItem i, i - 1 Next Else For i = 1 To 29 Combo3.AddItem i, i - 1 Next End If Case 3 For i = 1 To 31 Combo3.AddItem i, i - 1 Next Case 4 For i = 1 To 30 Combo3.AddItem i, i - 1 Next Case 5 For i = 1 To 31 Combo3.AddItem i, i - 1 Next Case 6 For i = 1 To 30 Combo3.AddItem i, i - 1 Next Case 7 For i = 1 To 31 Combo3.AddItem i, i - 1 Next Case 8 For i = 1 To 31 Combo3.AddItem i, i - 1 Next Case 9 For i = 1 To 30 Combo3.AddItem i, i - 1 Next Case 10 For i = 1 To 31 Combo3.AddItem i, i - 1 Next Case 11 For i = 1 To 30 Combo3.AddItem i, i - 1 Next Case 12 For i = 1 To 31 Combo3.AddItem i, i - 1 Next End Select Combo1.Text = Year(Now) Combo2.Text = Month(Now) Combo3.Text = Day(Now) End Sub
很不错的哦,很好的Option Explicit Public gUserName As String Public gUserKind As String Public gLoginSucceeded As Boolean ' ****************************************************************************** '过程名:Main '说 明:系统启动函数 '参 数:无 '返回:无 ' ****************************************************************************** Sub Main() '启动登陆窗体 Dim fLogin As New frmLogin fLogin.Show vbModal If Not gLoginSucceeded Then MsgBox "系统启动失败,请重试!", vbOKOnly + vbExclamation, "警告" End If Unload fLogin End Sub ' ****************************************************************************** '函数名:ConnectString '说 明:设置数据库连接字符串,连接数据库前要首先通过ODBC建立文件DSN:house.dsn '参 数:无 '返回:数据库连接字符串 ' ****************************************************************************** Public Function ConnectString() As String ConnectString = "Provider=SQLOLEDB.1;Password=sa;User ID=sa;Initial Catalog=DBHouse;Data Source=1D5C3B643D354AB;" End Function ' ****************************************************************************** '函数名:ExecuteSQL '说 明:执行SQL语句 '参 数:SQL As String, rst As ADODB.Recordset, Optional enableWrite As Boolean '返回:SQL语句执行成功——true,失败——false ' ****************************************************************************** Public Function ExecuteSQL(ByVal SQL As String, rst As ADODB.Recordset, _ Optional enableWrite As Boolean = True) As Boolean Dim con As ADODB.Connection Dim sTokens() As String On Error GoTo Execute_Error sTokens = Split(SQL) Set con = New ADODB.Connection con.Open ConnectString Set rst = New ADODB.Recordset If enableWrite Then rst.Open Trim$(SQL), con, adOpenStatic, adLockOptimistic Else rst.Open Trim$(SQL), con, adOpenStatic, adLockReadOnly End If ExecuteSQL = True Exit Function Execute_Error: ExecuteSQL = False Exit Function End Function ' ****************************************************************************** '函数名:DBExist '说 明:判断数据库中是否存在记录 '参 数:SQL As String '返回:存在则返回记录数,不存在返回0 ' ****************************************************************************** Public Function DBExist(ByVal SQL As String) As Integer Dim con As ADODB.Connection Dim sTokens() As String Dim flag As String Dim rst As ADODB.Recordset sTokens = Split(SQL) Set con = New ADODB.Connection con.Open ConnectString flag = ExecuteSQL(SQL, rst, False) '判断该记录是否存在 If rst.RecordCount 0 Then DBExist = rst.RecordCount Else DBExist = 0 End If con.Close End Function ' ****************************************************************************** '函数名:TxtIsNull '说 明:判断输入内容是否为空 '参 数:text As TextBox '返回:存在——true,不存在——false ' ****************************************************************************** Public Function TxtIsNull(txt As TextBox) As Boolean If Trim(txt.Text) = "" Then TxtIsNull = True txt.SetFocus txt.BackColor = &HFF0000 Else TxtIsNull = False End If End Function ' ****************************************************************************** '函数名:IsOverStringLen '说 明:判断输入内容是否超过允许最大lenthText '参 数:str As String, lenthText As Integer '返回:不超过——true,超过——false ' ****************************************************************************** Public Function IsOverStringLen(ByVal str As String, lenthText As Integer) As Boolean If Len(Trim(str)) > lenthText Then IsOverStringLen = True Else IsOverStringLen = False End If End Function ' ****************************************************************************** '过程名:viewData '说 明:将数据在datagrid中显示 '参 数:txtSql as String,dataGridAll As DataGrid '返回:存在则返回记录数,不存在返回0 ' ****************************************************************************** Public Function viewData(ByVal txtSql As String, dataGridAll As DataGrid) As Integer Dim rstData As ADODB.Recordset Dim result As String '检索需要的信息 result = ExecuteSQL(txtSql, rstData, False) '设置datagrid的数据源 If rstData.RecordCount 0 Then Set dataGridAll.DataSource = rstData viewData = rstData.RecordCount Else MsgBox "还没有数据!", vbOKOnly + vbExclamation, "警告" viewData = 0 End If End Function ' ****************************************************************************** '过程名:ISEquelLen '说 明:判断文本框中内容是否等于给定的长度 '参 数:txt As TextBox, intlen As Integer '返回:超过返回为True,否则为false ' ****************************************************************************** Public Function ISEquelLen(ByVal txt As TextBox, intlen As Integer) As Boolean If Len(txt.Text) intlen Then txt.SetFocus txt.BackColor = &HFF0000 ISEquelLen = False Else ISEquelLen = True End If End Function ' ****************************************************************************** '过程名:ComboData '说 明:为Combo '参 数:txt as String,cmb as ComboBox '返回:存在记录返回true,否则返回false ' ******************************************************************************v Public Function ComboData(ByVal txt As String, cbo As ComboBox) As Boolean Dim res As String Dim rstcbo As ADODB.Recordset Dim i As Integer res = ExecuteSQL(txt, rstcbo, False) If rstcbo.RecordCount 0 Then For i = 0 To rstcbo.RecordCount - 1 cbo.AddItem (rstcbo.Fields(1)) cbo.ItemData(cbo.NewIndex) = rstcbo.Fields(0) rstcbo.MoveNext Next ComboData = True Else ComboData = False End If End Function ' ****************************************************************************** '过程名:ComboYear '说 明:为年份列表赋 '参 数:Combo as Combobox '返回:无 ' ******************************************************************************v Public Sub ComboYear(Combo As ComboBox) Dim i As Integer For i = 1990 To 2050 Combo.AddItem (CStr(i)) Next End Sub ' ****************************************************************************** '过程名:ComboMonth '说 明:为月份列表赋 '参 数:Combo as Combobox '返回:无 ' ******************************************************************************v Public Sub ComboMonth(Combo As ComboBox) Dim i As Integer For i = 1 To 12 If Len(CStr(i)) 2 Then Combo.AddItem ("0" + CStr(i)) Else Combo.AddItem (CStr(i)) End If Next End Sub ' ****************************************************************************** '过程名:ComboDate '说 明:为日期列表赋 '参 数:Combo as Combobox '返回:无 ' ******************************************************************************v Public Sub ComboDate(Combo As ComboBox) Dim i As Integer For i = 1 To 31 If Len(CStr(i)) 2 Then Combo.AddItem ("0" + CStr(i)) Else Combo.AddItem (CStr(i)) End If Next End Sub ' ****************************************************************************** '过程名:ComboHour '说 明:为小时列表赋 '参 数:Combo as Combobox '返回:无 ' ******************************************************************************v Public Sub ComboHour(Combo As ComboBox) Dim i As Integer For i = 0 To 24 If Len(CStr(i)) 2 Then Combo.AddItem ("0" + CStr(i)) Else Combo.AddItem (CStr(i)) End If Next End Sub ' ****************************************************************************** '过程名:ComboMin '说 明:为分钟列表赋 '参 数:Combo as Combobox '返回:无 ' ******************************************************************************v Public Sub ComboMin(Combo As ComboBox) Dim i As Integer For i = 0 To 60 If Len(CStr(i)) 2 Then Combo.AddItem ("0" + CStr(i)) Else Combo.AddItem (CStr(i)) End If Next End Sub ' ****************************************************************************** '过程名:setCboDataReg() '说 明:为cboReg赋 '参 数:无 '返回:无 ' ******************************************************************************v Public Sub setCboDataReg(Combo As ComboBox) Dim txtReg As String Dim resReg As String txtReg = "select RegId,RegName from tbRegion" resReg = ComboData(txtReg, Combo) End Sub ' ****************************************************************************** '过程名:setCboDataItem '说 明:为cboItem赋 '参 数:无 '返回:无 ' ******************************************************************************v Public Sub setCboDataItem(Combo As ComboBox) Dim txtItem As String Dim resItem As String txtItem = "select ItemId,ItemName from tbItem" resItem = ComboData(txtItem, Combo) End Sub ' ****************************************************************************** '过程名:setCboDataStru() '说 明:为cboStru赋 '参 数:无 '返回:无 ' ******************************************************************************v Public Sub setCboDataStru(Combo As ComboBox) Dim txtStru As String Dim resStru As String txtStru = "select StruId,StruName from tbStru" resStru = ComboData(txtStru, Combo) End Sub ' ****************************************************************************** '过程名:getCboRegId() '说 明:获取显示检索部分区域名称的ComboBox所对应的Id '参 数:无 '返回:无 ' ****************************************************************************** Public Sub getCboId(Combo As ComboBox, str As String) If Combo.Text = "" Then str = "" Else str = CStr(Combo.ItemData(Combo.ListIndex)) If Len(str) 5 Then Select Case Len(str) Case 4 str = "0" + str Case 3 str = "00" + str Case 2 str = "000" + str Case 1 str = "0000" + str End Select End If End If End Sub ' ****************************************************************************** '过程名:setCboIdData '说 明:为Combo '参 数:txt as String,cmb as ComboBox '返回:存在记录返回true,否则返回false ' ******************************************************************************v Public Sub setCboIdData(cbo As ComboBox) Dim res As String Dim rstcbo As ADODB.Recordset Dim i As Integer Dim strSQL As String strSQL = "select HouseId from tbHouse" res = ExecuteSQL(strSQL, rstcbo, False) If rstcbo.RecordCount 0 Then For i = 0 To rstcbo.RecordCount - 1 cbo.AddItem (rstcbo.Fields(0)) rstcbo.MoveNext Next End If End Sub ' ****************************************************************************** '过程名:setLabelData '说 明:为Combo '参 数:txt as String,cmb as ComboBox '返回:存在记录返回true,否则返回false ' ******************************************************************************v Public Sub setLabelData(cbo As ComboBox, lbl As Label) Dim res As String Dim rstcbo As ADODB.Recordset Dim strSQL As String strSQL = "select HouseName from tbHouse where HouseId='" + Trim(cbo.Text) + "'" res = ExecuteSQL(strSQL, rstcbo, False) If rstcbo.RecordCount 0 Then lbl.Caption = rstcbo.Fields(0) End If End Sub

7,759

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧