VB+access实验室设备管理系统 第7页
运行本系统程序,首先出现登录界面,输入正确的用户名和密码之后进入主窗体
图6.1登录界面窗体
Option Explicit
Public Function ESQL(ByVal sql As String) As ADODB.Recordset '定义函数
'定义连接
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
'创建连接
Set cnn = New ADODB.Connection
'打开连接
cnn.Open StrCnn
Set rs = New ADODB.Recordset
rs.Open Trim(sql), cnn, adOpenKeyset, adLockOptimistic
Set ESQL = rs
End Function
Public Function StrCnn()
'返回一个数据库连接
StrCnn = "Provider=MSDASQL.1;Persist Security Info=False;User ID=sa;Data Source=XYGLXT"
End Function
Function valiText(keyIn As Integer, validateString As String, Editable As Boolean) As Integer
Dim valiDatelist As String
Dim keyOut As Integer
If Editable = False Then
valiDatelist = UCase(validateString) & Chr(8)
Else
valiDatelist = UCase(validateString)
End If
If InStr(1, valiDatelist, UCase(Chr(keyIn)), 1) > 0 Then
keyOut = keyIn
Else
keyOut = 0
Beep
End If
valiText = keyOut
End Function
主界面的菜单栏包含的主要菜单有系统、仪器管理、人员管理、借用仪器、查询信息和帮助.
若图片无法显示请联系QQ752018766,本论文免费,转发请注明源于www.youerw.com
图6.2登录主界面窗体
Private Sub a_Click()
Load main_jbxx_bfxxgl
main_jbxx_bfxxgl.Show
frm_main.Enabled = False
End Sub
Private Sub czysz_Click()
Load main_xtwh_czysz
main_xtwh_czysz.Show
Form1.Enabled = False
End Sub
Private Sub dwxxgl_Click()
Load Form4
Form4.Show
End Sub
Private Sub mmsz_Click()
Load main_xtwh_klsz
main_xtwh_klsz.Show
End Sub
Private Sub QUIT_Click()
End
End Sub
Private Sub sbxxgl_Click()
Load Form2
Form2.Show
End Sub
Private Sub Timer1_Timer()
'设置时间
St1.Panels(1).Text = Format(Date, "long date") & " " & Time
End Sub
Private Sub tjyh_Click()
Load main_xtwh_czysz
main_xtwh_czysz.Show
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.key
Case Is = "sbxxgl"
sbxxgl_Click '调入总台服务管理窗口
Case Is = "ztxxgl"
ztxxgl_Click '调入日结算管理窗口
Case Is = "dwxxgl"
dwxxgl_Click '调入日结算管理窗口
Case Is = "mmsz"
mmsz_Click '调入日结算管理窗口
Case Is = "exit"
End
End Select
End Sub
Private Sub ztxxgl_Click()
Load Form3
Form3.Show
Form1.Enabled = False
End Sub
图6.3 设备基本信息
Dim i As Integer '定义整数变量，表示字段编号和数组编号
Dim rs1 As New ADODB.Recordset '定义数据集对象
Dim txtSQL As String '定义一个字符串变量
Private Sub Form_Load()
Combo1.AddItem ("教师实验设备"):
Combo1.AddItem ("学生实验设备"): Combo1.ListIndex = 0
'添加查询内容列表
Combo3.AddItem ("设备名称"): Combo3.AddItem ("型号")
Combo3.AddItem ("生产厂家"): Combo3.ListIndex = 0
'添加查询条件列表
Combo4.AddItem ("like"): Combo4.AddItem ("=")
Combo4.ListIndex = 0
Adodc1.RecordSource = "select * from 实验设备基本信息 order by 型号"
Adodc1.Refresh
End Sub
Private Sub Form_Unload(Cancel As Integer)
Form1.Enabled = True '设置frm_main窗体有效
End Sub
Private Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
Select Case Index
Case Is = Index
If KeyCode = vbKeyReturn And Index >= 1 And Index < 5 Then Text1(Index + 1).SetFocus '回车获得焦点
If KeyCode = vbKeyReturn And Index = 4 Then Combo1.SetFocus
If KeyCode = vbKeyReturn And Index = 5 Then Combo5.SetFocus '回车获得焦点
If KeyCode = vbKeyReturn And Index >= 9 And Index < 12 Then Text1(Index + 1).SetFocus
If KeyCode = vbKeyReturn And Index = 12 Then ComSave.SetFocus
End Select
End Sub
Private Sub ComFirst_Click() '移到第一条记录
If Not Adodc1.Recordset.BOF Then Adodc1.Recordset.MoveFirst
End Sub
Private Sub ComPrevious_Click() '向上移一条记录
If Adodc1.Recordset.RecordCount <> 0 Then
If Adodc1.Recordset.BOF = False Then Adodc1.Recordset.MovePrevious
If Adodc1.Recordset.BOF = True Then Adodc1.Recordset.MoveFirst
End If
End Sub
Private Sub ComNext_Click() '向下移一条记录
If Adodc1.Recordset.RecordCount <> 0 Then
If Adodc1.Recordset.EOF = False Then Adodc1.Recordset.MoveNext
If Adodc1.Recordset.EOF = True Then Adodc1.Recordset.MoveLast
End If
End Sub
Private Sub ComLast_Click() '移到最后一条记录
If Not Adodc1.Recordset.EOF Then Adodc1.Recordset.MoveLast
End Sub
Private Sub ComAdd_Click() '添加
Frame1.Visible = True 'frame1可见
Dim dm As Integer '定义一个整型变量
txtSQL = "select * from 实验设备基本信息 order by 型号"
Set rs1 = ESQL(txtSQL) '执行SQL语句
If rs1.RecordCount > 0 Then '当记录大于零时
If Not rs1.EOF Then rs1.MoveLast '如记录没到头，那么移到最后一条记录
If rs1.Fields("型号") <> "" Then '假如编号不等于空
dm = Trim(rs1.Fields("型号")) + 1 '赋值给dm变量
Text1(0).Text = Format(dm, "000") '赋值给text1(0).text
End If
Else '否则
Text1(0).Text = "0001" '为text1(0).text设初值
End If
'清空数据
For i = 1 To 4
Text1(i).Text = ""
Next i
Text1(5).Text = ""
Text1(9).Text = ""
Text1(10).Text = ""
上一页 [1] [2] [3] [4] [5] [6] [7] [8] [9] [10] ... 下一页 >>