frmadditional.frm

本人用VB 6.0和ACCESS编写的图书管理系统

VERSION 5.00
Begin VB.Form frmAdditional 
   Caption         =   "用户类别管理"
   ClientHeight    =   4920
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   6015
   Icon            =   "frmAdditional.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4920
   ScaleWidth      =   6015
   StartUpPosition =   2  '屏幕中心
   Begin VB.Data Data1 
      Connect         =   "Access 2000;"
      DatabaseName    =   ""
      DefaultCursorType=   0  '缺省游标
      DefaultType     =   2  '使用 ODBC
      Exclusive       =   0   'False
      Height          =   315
      Left            =   120
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   ""
      Top             =   3840
      Width           =   2175
   End
   Begin VB.ListBox lstUser 
      DataSource      =   "Data1"
      Enabled         =   0   'False
      Height          =   3300
      ItemData        =   "frmAdditional.frx":0442
      Left            =   120
      List            =   "frmAdditional.frx":0444
      TabIndex        =   7
      Top             =   480
      Width           =   2175
   End
   Begin VB.CommandButton cmdDelete 
      Caption         =   "删除类别(&D)"
      Height          =   375
      Left            =   1200
      TabIndex        =   3
      Top             =   4200
      Width           =   1215
   End
   Begin VB.CommandButton cmdAdd 
      Caption         =   "添加类别(&A)"
      Height          =   375
      Left            =   0
      TabIndex        =   2
      Top             =   4200
      Width           =   1215
   End
   Begin VB.Frame Frame1 
      Caption         =   "用户权限"
      Height          =   4335
      Left            =   2520
      TabIndex        =   0
      Top             =   360
      Width           =   3255
      Begin VB.CheckBox chkPurview 
         Caption         =   "用户管理"
         DataSource      =   "Data1"
         Height          =   255
         Index           =   12
         Left            =   1680
         TabIndex        =   19
         Top             =   2760
         Width           =   1095
      End
      Begin VB.CheckBox chkPurview 
         Caption         =   "打印报表"
         DataSource      =   "Data1"
         Height          =   255
         Index           =   11
         Left            =   1680
         TabIndex        =   18
         Top             =   2280
         Width           =   1095
      End
      Begin VB.CheckBox chkPurview 
         Caption         =   "查询统计"
         DataSource      =   "Data1"
         Height          =   255
         Index           =   10
         Left            =   1680
         TabIndex        =   17
         Top             =   1800
         Width           =   1095
      End
      Begin VB.CheckBox chkPurview 
         Caption         =   "图书类别管理"
         DataSource      =   "Data1"
         Height          =   255
         Index           =   9
         Left            =   1680
         TabIndex        =   16
         Top             =   1320
         Width           =   1455
      End
      Begin VB.CheckBox chkPurview 
         Caption         =   "修改图书"
         DataSource      =   "Data1"
         Height          =   255
         Index           =   8
         Left            =   1680
         TabIndex        =   15
         Top             =   840
         Width           =   1095
      End
      Begin VB.CheckBox chkPurview 
         Caption         =   "新增图书"
         DataSource      =   "Data1"
         Height          =   255
         Index           =   7
         Left            =   1680
         TabIndex        =   14
         Top             =   360
         Width           =   1095
      End
      Begin VB.CheckBox chkPurview 
         Caption         =   "借书证管理"
         DataSource      =   "Data1"
         Height          =   255
         Index           =   6
         Left            =   240
         TabIndex        =   13
         Top             =   3240
         Width           =   1215
      End
      Begin VB.CheckBox chkPurview 
         Caption         =   "部门管理"
         DataSource      =   "Data1"
         Height          =   255
         Index           =   5
         Left            =   240
         TabIndex        =   12
         Top             =   2760
         Width           =   1095
      End
      Begin VB.CheckBox chkPurview 
         Caption         =   "读者类别管理"
         DataSource      =   "Data1"
         Height          =   255
         Index           =   4
         Left            =   240
         TabIndex        =   11
         Top             =   2280
         Width           =   1455
      End
      Begin VB.CheckBox chkPurview 
         Caption         =   "读者修改"
         DataSource      =   "Data1"
         Height          =   255
         Index           =   3
         Left            =   240
         TabIndex        =   10
         Top             =   1800
         Width           =   1095
      End
      Begin VB.CheckBox chkPurview 
         Caption         =   "新增读者"
         DataSource      =   "Data1"
         Height          =   255
         Index           =   2
         Left            =   240
         TabIndex        =   9
         Top             =   1320
         Width           =   1095
      End
      Begin VB.CheckBox chkPurview 
         Caption         =   "还书作业"
         DataSource      =   "Data1"
         Height          =   255
         Index           =   1
         Left            =   240
         TabIndex        =   8
         Top             =   840
         Width           =   1095
      End
      Begin VB.CommandButton cmdReturn 
         Caption         =   "返回(&R)"
         Height          =   375
         Left            =   1920
         TabIndex        =   6
         Top             =   3720
         Width           =   975
      End
      Begin VB.CommandButton cmdSet 
         Caption         =   "设置(&S)"
         Height          =   375
         Left            =   480
         TabIndex        =   5
         Top             =   3720
         Width           =   975
      End
      Begin VB.CheckBox chkPurview 
         Caption         =   "借书作业"
         DataSource      =   "Data1"
         Height          =   255
         Index           =   0
         Left            =   240
         TabIndex        =   4
         Top             =   360
         Width           =   1095
      End
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "用户:"
      Height          =   180
      Left            =   240
      TabIndex        =   1
      Top             =   240
      Width           =   450
   End
End
Attribute VB_Name = "frmAdditional"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim ws As Workspace, db As Database, rs As Recordset
'声明数组(人员名,权限名称),加入的人员代号索引
Dim ReadPersonName() As String
Dim ReadPurString(PurviewCount) As String
Dim AddIndex As Integer

Private Sub cmdAdd_Click()
    On Error GoTo AddErr
    Dim strPersonName As String, strAddString As String
    strAddString = "请输入用户类别名称:"
    strPersonName = InputBox(strAddString, "输入框")
    If strPersonName <> "" Then
        AddIndex = AddIndex + 1
        With Data1.Recordset
            '.MoveLast
            .AddNew
            .Fields("人员代号") = AddIndex
            .Fields("人员名") = strPersonName
            .Update
            .MoveLast
        End With
        lstUser.AddItem strPersonName
        lstUser.Refresh
    Else
        MsgBox "输入为空值!", vbOKOnly, "输入错误"
    End If
    Exit Sub
AddErr:
    MsgBox Err.Description
End Sub

Private Sub cmdDelete_Click()
    On Error GoTo DeleteErr
    Dim i As Integer
    i = MsgBox("确定要删除当前用户吗？", vbInformation + vbOKCancel)
    If i <> vbOK Then Exit Sub
    With Data1.Recordset
        .Delete
        lstUser.RemoveItem lstUser.ListIndex
        lstUser.Refresh
        .MoveNext
        If .EOF Then .MoveLast
    End With
    Exit Sub
DeleteErr:
    MsgBox Err.Description
End Sub

Private Sub cmdReturn_Click()
    Unload Me
End Sub

Private Sub cmdSet_Click()
    On Error GoTo SetErr
    Data1.Recordset.Edit
    Data1.Recordset.Update
    MsgBox "设置成功!", vbInformation + vbOKOnly, "设置用户权限"
    Exit Sub
SetErr:
    MsgBox Err.Description
End Sub

Private Sub Data1_Reposition()
    Data1.Caption = "人员:" & Data1.Recordset.AbsolutePosition + 1
End Sub

Private Sub Form_Load()
    '打开人员库
    Dim strAppName As String, strSQL As String
    strAppName = App.Path & "\人员库.mdb"
    strSQL = "select * from 权限表"
    Data1.DatabaseName = strAppName
    Data1.RecordSource = strSQL
    '数据绑定控件初始化
    Dim i As Integer, j As Integer
    lstUser.DataField = "人员名"
    ReadPurStr
    For i = 1 To PurviewCount
        chkPurview(i - 1).DataField = ReadPurString(i)
    Next i
    '建立工作区
    Set ws = DBEngine.Workspaces(0)
    Set db = ws.OpenDatabase(strAppName, False, True)
    Set rs = db.OpenRecordset("权限表")
    '向列表框中添加人员名
    Dim ReadCount As Integer
    ReadCount = rs.RecordCount
    AddIndex = ReadCount
    ReDim Preserve ReadPersonName(ReadCount)
    rs.MoveFirst
    For i = 1 To ReadCount
        ReadPersonName(i) = rs.Fields("人员名")
        lstUser.AddItem ReadPersonName(i)
        rs.MoveNext
    Next
    rs.Close
    db.Close
    ws.Close
    Set rs = Nothing
    Set db = Nothing
    Set ws = Nothing
    Data1.Refresh
End Sub

Private Sub ReadPurStr()
    '给权限数组名赋值
    ReadPurString(1) = "借书作业": ReadPurString(2) = "还书作业"
    ReadPurString(3) = "新增读者": ReadPurString(4) = "读者修改"
    ReadPurString(5) = "读者类别管理": ReadPurString(6) = "部门管理"
    ReadPurString(7) = "借书证管理": ReadPurString(8) = "新增图书"
    ReadPurString(9) = "修改图书": ReadPurString(10) = "图书类别管理"
    ReadPurString(11) = "查询统计": ReadPurString(12) = "打印报表"
    ReadPurString(13) = "用户管理"
End Sub