main.frm

vb做的电气设备管理系统的完整版毕业设计 有源码 论文 测试报告

End
Attribute VB_Name = "Mainfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim db1 As Database
Dim db2 As Database
Dim db3 As Database
Dim rst As Recordset
Dim rst1 As Recordset '打开表Personal
Dim rst2 As Recordset '打开表BookFlag
Dim rst3 As Recordset '打开表Book
Dim ws1 As Workspace
Dim ws2 As Workspace
Dim qry2 As QueryDef
Dim RecNumBookFf As Integer '表BookFf的记录个数
Dim SFlag As String
Private Type MSet
    BookNum As Integer
    BookCost As Single
End Type
Dim SetFlag As MSet
Option Explicit
Private Sub AboutMnu_Click()
Aboutfrm.Show (1)
End Sub
Private Sub AddMnu_Click()
    AddNewBook.Show (1)
End Sub

Private Sub BackMnu_Click()
cmdBackBook_Click
End Sub

Private Sub cmdBackBook_Click() '打开还书对话框
cmdKong_Click
Lentfrm.Show (1)
cmdKong_Click
End Sub
Private Sub cmdKong_Click() '清空所有文本
txtBookId.Text = ""
txtName.Text = ""
txtClass.Text = ""
txtDepart.Text = ""
txtBookHao.Text = ""
txtBookName = ""
txtZhiCheng = ""
txtFa.Text = ""
txtBookBian.Text = ""
Frame4.Visible = False
Frame7.Visible = True
LV2.ListItems.Clear
'CmdLogin.SetFocus
End Sub
Private Sub cmdOkCancel_Click(Index As Integer)
Select Case Index
    Case 1
        If rst3.Fields("是否修改") = True Then
            MsgBox "此信息已经修改！", 0 + 48, "提示"
            txtBookBian.Text = ""
            txtBookBian.SetFocus
            Frame4.Visible = False
            Frame7.Visible = True
            Exit Sub
        End If
        rst2.AddNew
        rst2.Fields("信息编号") = rst3.Fields("信息编号")
        rst2.Fields("名称") = rst3.Fields("名称")
        rst2.Fields("值") = rst3.Fields("值")
        rst2.Fields("描述") = rst3.Fields("描述")
        rst2.Fields("日期") = Date
        rst2.Fields("查询证号") = BookId
        rst2.Fields("姓名") = txtName.Text
        rst2.Fields("类别") = rst3.Fields("类别")
        rst2.Update
        rst3.Edit
        rst3.Fields("是否修改") = True
        rst3.Fields("修改日期") = Date
        rst3.Update
        DataRef
        txtBookBian.Text = ""
        txtBookBian.SetFocus
        Frame4.Visible = False
        Frame7.Visible = True
End Select
End Sub
Private Sub CmdLogin_Click()
loop1:  '如果没有此证，返回
LentLogin.Show (1)
If LoginFlag Then
LV2.ListItems.Clear
rst1.Seek "=", BookId  '查找借书证号码
If rst1.NoMatch Then
    MsgBox "没有此员工证号码！", 0 + 48, "错误"
    LoginFlag = False
    GoTo loop1  '返回loop1
End If
txtBookId.Text = BookId
txtName.Text = rst1.Fields("姓名") & vbNullString
txtClass.Text = rst1.Fields("班组") & vbNullString
txtDepart.Text = rst1.Fields("部门") & vbNullString
txtZhiCheng = rst1.Fields("职称") & vbNullString
txtFa.Text = rst1.Fields("罚款") & Empty
txtBookBian.Text = ""
Frame4.Visible = False
Frame7.Visible = True
txtBookBian.SetFocus
DataRef '输出所借图书
LoginFlag = False
If rst1.Fields("罚款") > 0 Then
   If MsgBox(txtBookId & " " & txtName & " 共计欠费 " _
        & rst1.Fields("罚款") & "元 是否从数据库中删除？", 4 + 48, "欠费") _
            = vbYes Then
        '从数据库中删除欠费记录
        rst1.Edit
        rst1.Fields("罚款") = 0
        rst1.Update
        txtFa.Text = rst1.Fields("罚款") & Empty
    End If
Else    '把罚款复制为0
    rst1.Edit
    rst1.Fields("罚款") = 0
    rst1.Update
End If

End If
End Sub

Private Sub EditIdMnu_Click()
    EditBookId.Show (1)
End Sub

Private Sub EditMnu_Click()
    EditBook.Show (1)
End Sub

Private Sub ExitMnu_Click()
    Unload Me
End Sub

Private Sub FenMnu_Click()
    SetType.Show (1)
End Sub


'响应快捷键
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
'按下Ctrl键了
If Shift = 2 Then
    Select Case KeyCode
        Case 68 'D-登录证
            CmdLogin_Click
        Case 72 'H-还书
        
        Case 81 'Q-清空文本
            cmdKong_Click
        Case 83 'S-修改
            If Frame4.Visible Then cmdOkCancel_Click 1
        Case 71 'G-改回
            cmdBackBook_Click
        
    End Select
End If

End Sub

Private Sub Form_Load()
Set db1 = Workspaces(0).OpenDatabase(App.Path & "\Database\Data.mdb", False)
Set rst1 = db1.OpenRecordset("Personal", dbOpenTable)
rst1.Index = "查询证号"


Set db2 = Workspaces(0).OpenDatabase(App.Path & "\Database\Data.mdb", False)
Set rst2 = db2.OpenRecordset("BookFf", dbOpenTable)
Set qry2 = db2.CreateQueryDef("")
rst2.Index = "信息编号"

Set db3 = Workspaces(0).OpenDatabase(App.Path & "\Database\Data.mdb", False)
Set rst3 = db3.OpenRecordset("Book", dbOpenTable)
rst3.Index = "信息编号"

Open App.Path & "\Database\Set.Dat" For Random As #1 Len = Len(SetFlag)
Get #1, 1, SetFlag
BookNum = SetFlag.BookNum
FaCost = SetFlag.BookCost

LV2.View = lvwReport
LV2.ColumnHeaders.Add , , "证件号"
LV2.ColumnHeaders.Add , , "查询人姓名"
LV2.ColumnHeaders.Add , , "信息编号"
LV2.ColumnHeaders.Add , , "名称"
LV2.ColumnHeaders.Add , , "值"
LV2.ColumnHeaders.Add , , "类别"
LV2.ColumnHeaders.Add , , "描述"
LV2.ColumnHeaders.Add , , "修改日期"



txtBookId.Text = ""
txtName.Text = ""
txtClass.Text = ""
txtDepart.Text = ""
txtBookHao.Text = ""
txtBookName = ""
txtZhiCheng = ""
txtFa.Text = ""

txtCost = ""
txtChuBan = ""
txtLentDate = ""


End Sub

Private Sub Form_Unload(Cancel As Integer)
rst1.Close
rst2.Close
rst3.Close
db1.Close
db2.Close
db3.Close
Close #1
End Sub

Private Sub LoginMnu_Click()
 CmdLogin_Click
End Sub

Private Sub MnuOP_Click()
    SetPer.Show
End Sub

Private Sub SearchMnu_Click()
 Findfrm.Show
End Sub

Private Sub SetMnu_Click()
setfrm.Show (1)
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
    Case 3
'        Sb.Panels(1).Text = "编辑借书证"
        EditBookId.Show (1)
'        Sb.Panels(1).Text = "编辑借书证"
    Case 5
        SetPer.Show (1)

End Select
End Sub

Private Sub Toolbar1_ButtonMenuClick(ByVal buttonmenu As MSComctlLib.buttonmenu)
Select Case buttonmenu.Key
    Case "添加"
'        Sb.Panels(1).Text = "添加新书"
        AddNewBook.Show (1)
'        Sb.Panels(1).Text = SFlag
    Case "编辑"
'        Sb.Panels(1).Text = "编辑图书"
        EditBook.Show (1)
'        Sb.Panels(1).Text = "编辑图书"
    Case "新借"
        MsgBox "Add BookCard"
    Case "编借"
        MsgBox "Edit BookCard"
End Select
End Sub

Private Sub Toolbar2_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
    Case 1
        CmdLogin_Click
    Case 3
        cmdKong_Click
    Case 7
        cmdBackBook_Click
    Case 5
        Findfrm.Show
End Select
End Sub
Private Sub txtBookBian_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    If txtBookId.Text = "" Then
        MsgBox "请先登录！", 0 + 48, "提示"
'        CmdLogin.SetFocus
        txtBookBian.Text = ""
        Exit Sub
    End If
    rst3.Seek "=", txtBookBian.Text
    If rst3.NoMatch Then
        MsgBox "没有此编号，请重新填写", 0 + 48, "填写错误"
        txtBookBian.SetFocus
        Frame4.Visible = False
        Frame7.Visible = True
        Exit Sub
    End If
    Frame4.Visible = True
    Frame7.Visible = False
    txtBookHao.Text = txtBookBian.Text
    txtBookName.Text = rst3.Fields("名称") & vbNullString
    txtChuBan.Text = rst3.Fields("描述") & vbNullString
    txtCost.Text = rst3.Fields("值") & Empty
    txtLentDate = Date
    txtType.Text = rst3.Fields("类别") & vbNullString
End If
End Sub
Private Sub DataRef()
Dim i As Integer
Dim SeaStr As String
SeaStr = "select * from Bookff where 查询证号="
SeaStr = SeaStr & "'" & BookId & "'"
qry2.SQL = SeaStr
Set rst = qry2.OpenRecordset()
If rst.RecordCount = 0 Then
     Label1.Caption = "可以占用更改" & BookNum & "条记录"
     Exit Sub
End If
rst.MoveLast
RecNumBookFf = rst.RecordCount
rst.MoveFirst
LV2.ListItems.Clear
For i = 1 To RecNumBookFf
    LV2.ListItems.Add i, , rst.Fields("查询证号") & vbNullString
    With LV2.ListItems(i)
        .SubItems(1) = rst.Fields("姓名") & vbNullString
        .SubItems(2) = rst.Fields("信息编号") & vbNullString
        .SubItems(3) = rst.Fields("名称") & vbNullString
        .SubItems(4) = rst.Fields("值") & Empty
        .SubItems(5) = rst.Fields("类别") & vbNullString
        .SubItems(6) = rst.Fields("描述") & vbNullString
        .SubItems(7) = rst.Fields("日期") & vbNullString
    End With
    rst.MoveNext
    If rst.EOF Then Exit For
Next i
If RecNumBookFf = BookNum Then
    MsgBox "已经更改了 " & BookNum & "条记录,不能再进行纪录更改,请登录其它员工证号", 0 + 48, "提示"
    txtBookId.Text = ""
    txtName.Text = ""
    txtClass.Text = ""
    txtDepart.Text = ""
    txtZhiCheng = ""
    txtFa.Text = ""
'    CmdLogin.SetFocus
    LV2.ListItems.Clear
    Label1.Caption = "名下更改记录"
    Exit Sub
End If
Label1.Caption = "已经更改 " & RecNumBookFf & "条，还可以再更改 " _
        & BookNum - RecNumBookFf & "条"
End Sub
Private Sub txtBookId_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    LV2.ListItems.Clear
    BookId = txtBookId
    rst1.Seek "=", BookId  '查找借书证号码
    If rst1.NoMatch Then
     MsgBox "没有此员工证号码！", 0 + 48, "错误"
     txtBookId.SetFocus
     txtName.Text = ""
     txtClass.Text = ""
     txtDepart.Text = ""
     Exit Sub
    End If
        txtBookHao.Text = ""
        txtBookName.Text = ""
        txtCost.Text = ""
        txtChuBan.Text = ""
        txtLentDate.Text = ""
        txtBookBian.Text = ""
        txtZhiCheng.Text = ""
    txtBookId.Text = BookId
    txtName.Text = rst1.Fields("姓名") & vbNullString
    txtClass.Text = rst1.Fields("班组") & vbNullString
    txtDepart.Text = rst1.Fields("部门") & vbNullString
    txtZhiCheng = rst1.Fields("职称") & vbNullString
    txtFa.Text = rst1.Fields("罚款") & Empty
    txtBookBian.SetFocus
    DataRef '输出所借图书
End If
End Sub