图书管理.frm

原码和使用说明都有,用VB和SQL2000综合、设计的

         Top             =   240
         Width           =   2055
      End
      Begin VB.TextBox txtQuery 
         Height          =   375
         Left            =   4200
         TabIndex        =   1
         Top             =   240
         Width           =   1935
      End
      Begin VB.PictureBox DataGrid1 
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   1815
         Left            =   120
         ScaleHeight     =   1755
         ScaleWidth      =   8235
         TabIndex        =   22
         Top             =   720
         Width           =   8295
      End
      Begin VB.Label Label8 
         Caption         =   "选择条件："
         Height          =   255
         Index           =   0
         Left            =   1080
         TabIndex        =   23
         Top             =   240
         Width           =   1095
      End
   End
End
Attribute VB_Name = "A读者信息"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rs As ADODB.Recordset
Dim SQL As String
Dim msg As String
Dim Index As Integer
Dim flag As String '判断是新增记录还是修改记录
Private Function CheckData() As Boolean
'检查数据的合法性
    Dim rst As ADODB.Recordset
    Dim msgt As String
    msgt = ""
    '检查数据
    If Trim(txtReadNo.Text) = "" Then               '检查读者号是否为空
        msgt = "读者号为空； "
    ElseIf Not Len(Trim(txtReadNo.Text)) = 10 Then  '检查读者号是否为10位
        msgt = "读者号不是10位； "
    ElseIf Trim(txtName.Text) = "" Then             '姓名是否为空
        msgt = msgt & " 姓名为空； "
    ElseIf Trim(txtPenalty.Text) = "" Then          '罚款金额是否为空
        msgt = msgt & " 罚款金额为空； "
    End If
    
    If Not msgt = "" Then                           '如果不为空，给出错误提示
        MsgBox (msgt)
        CheckData = False                           '返回False
        Exit Function
    End If
    '检查唯一性
    SQL = " select * from 读者信息表 where 读者号='" & Trim(txtReadNo.Text) & "'"
    Set rst = SelectSQL(SQL, msg)
    If flag = "Add" And rst.RecordCount > 0 Then    '如果是进行添加操作且已经存在该记录，提示重复添加
        MsgBox ("该信息已经存在，重复添加!")
        rst.Close
        CheckData = False                           '返回False
        Exit Function
    End If
    CheckData = True                                '合法返回True
End Function
Private Sub ControlEnable(flag As Boolean)
'设置控件的Enable值
    Me.txtReadNo.Enabled = flag
    Me.txtName.Enabled = flag
    Me.txtCardId.Enabled = flag
    Me.DTPicker1.Enabled = flag
    Me.txtPenalty.Enabled = False
    Me.txtAddress.Enabled = flag
    Me.txtPhone.Enabled = flag
    Me.txtEmail.Enabled = flag
End Sub
Private Sub ControlClear()
'重置控件
    Me.txtReadNo.Text = ""
    Me.txtName.Text = ""
    Me.txtCardId.Text = ""
    Me.DTPicker1.Refresh
    Me.txtPenalty.Text = "0"
    Me.txtAddress.Text = ""
    Me.txtPhone.Text = ""
    Me.txtEmail.Text = ""
End Sub

Private Sub DataGrid1_Click()

End Sub

Private Sub Form_Load()
    '初始化查询条件ComboBox
    CboQuery.AddItem ("读者号")
    CboQuery.AddItem ("姓名")
    CboQuery.AddItem ("身份证号")
    CboQuery.ListIndex = 0       '默认为读者号
    Call LoadData                               '装载数据
    Call ShowData                               '显示数据
End Sub
Private Sub LoadData()
'装载数据
    '得到查询条件
    Dim colName As String
    Dim colValue As String
    Dim strWhere As String
    colName = CboQuery.Text
    colValue = txtQuery.Text
    '构建条件
    strWhere = " where " & colName & " like '%" & colValue & "%'"
    Set rs = Nothing
    '查询读者信息
    SQL = "SELECT * FROM 读者信息表 " & strWhere & " ORDER BY 读者号 "
    Set rs = SelectSQL(SQL, msg)
    Set Me.DataGrid1.DataSource = rs
    DataGrid1.Refresh
    If rs.RecordCount = 0 Then   '如果不存在记录
        '编辑控件可用性
        CmdAdd.Enabled = True: CmdModify.Enabled = False: CmdDelete.Enabled = False
        CmdCancel.Enabled = False: CmdSave.Enabled = False
        '移动控件不可用
        For Index = 0 To 3
            CmdMove(Index).Enabled = False
        Next Index
    Else
         '编辑控件可用性
        CmdAdd.Enabled = True: CmdModify.Enabled = True: CmdDelete.Enabled = True
        CmdCancel.Enabled = False: CmdSave.Enabled = False
        '移动控件可用
        For Index = 0 To 3
            CmdMove(Index).Enabled = True
        Next Index
    End If
    '设置控件Enable值
    Call ControlEnable(False)
End Sub
Private Sub ShowData()
'在控件中显示数据
    If rs.RecordCount <> 0 Then                     '如果存在记录
        '为控件赋值，并不可用
        Me.txtReadNo.Text = rs.Fields("读者号")
        Me.txtName.Text = rs.Fields("姓名")
        Me.txtCardId.Text = rs.Fields("身份证号")
        If IsDate(rs.Fields("办理日期")) Then
        Me.DTPicker1.Value = rs.Fields("办理日期")
        End If
        Me.txtPenalty.Text = rs.Fields("罚款金额")
        Me.txtAddress.Text = rs.Fields("住址")
        Me.txtPhone.Text = rs.Fields("电话")
        Me.txtEmail.Text = rs.Fields("邮箱")
    End If
End Sub
Private Sub CmdQuery_Click()
    Call LoadData    '装载数据
    Call ShowData    '显示数据
End Sub
Private Sub CmdMove_Click(Index As Integer)
'移动记录
    Select Case Index
    Case Is = 0     '移到第一条记录
        If Not rs.BOF Then rs.MoveFirst
    Case Is = 1     '移到上一条记录
        If rs.RecordCount <> 0 Then
            If rs.BOF = False Then rs.MovePrevious
            If rs.BOF = True Then rs.MoveFirst
        End If
    Case Is = 2     '移到下一条记录
        If rs.RecordCount <> 0 Then
            If rs.EOF = False Then rs.MoveNext
            If rs.EOF = True Then rs.MoveLast
        End If
    Case Is = 3     '移到最后一条记录
        If rs.RecordCount <> 0 Then
            If Not rs.EOF = True Then rs.MoveLast
        End If
    End Select
    Call ShowData
End Sub
Private Sub CmdAdd_Click()
'添加操作
    '所有控件重置
    Call ControlClear
    '设置控件Enable值为可用
    Call ControlEnable(True)
    '设置标志flag，表示所进行的操作为添加
    flag = "Add"
    '所有移动按钮不可用
    For Index = 0 To 3
        CmdMove(Index).Enabled = False
    Next Index
    '添加、修改、删除按钮不可用，取消、保存按钮可用
    CmdAdd.Enabled = False: CmdModify.Enabled = False: CmdDelete.Enabled = False
    CmdCancel.Enabled = True: CmdSave.Enabled = True
End Sub
Private Sub CmdModify_Click()
'修改操作
    If rs.RecordCount > 0 Then          '如果存在记录
        '读者号不可以修改,其他控件可用
        '设置控件Enable值
        Call ControlEnable(True)
        Me.txtReadNo.Enabled = False
        '设置标志flag，表示所进行的操作为修改
        flag = "Modify"
        '移动控件不可用
        For Index = 0 To 3
            CmdMove(Index).Enabled = False
        Next Index
        '添加、修改、删除按钮不可用，取消、保存按钮可用
        CmdAdd.Enabled = False: CmdModify.Enabled = False: CmdDelete.Enabled = False
        CmdCancel.Enabled = True: CmdSave.Enabled = True
    Else
         MsgBox ("没有可以修改的数据!")
    End If
End Sub
Private Sub CmdDelete_Click()
'删除操作
    On Error GoTo ErrMsg                '错误处理
    If rs.RecordCount > 0 Then
        msg = MsgBox("删除该条记录吗?", vbYesNo)
        If msg = vbYes Then
            rs.Delete
            Call LoadData '重新装载数据
            '清空控件
            Call ControlClear
            '设置控件Enable值为不可用
            Call ControlEnable(False)
            '所有移动控件不可用
            If rs.RecordCount = 0 Then
                For Index = 0 To 3
                    CmdMove(Index).Enabled = False
                Next Index
            End If
            '添加、删除按钮可用，修改、取消、保存按钮不可用
            CmdAdd.Enabled = True: CmdModify.Enabled = False: CmdDelete.Enabled = True
            CmdSave.Enabled = False: CmdCancel.Enabled = False
            MsgBox ("成功删除的数据!")
        End If
    Else
        MsgBox ("没有可删除的数据!")
    End If
    Exit Sub
ErrMsg:                                 '报告出错信息
    MsgBox Err.Description, vbExclamation, "出错"
End Sub
Private Sub cmdCancel_Click()
'取消操作
    Call ShowData                       '重新在控件中显示信息
    '所有移动控件可用
    If rs.RecordCount > 0 Then
        For Index = 0 To 3
            CmdMove(Index).Enabled = True
        Next Index
    End If
    '设置控件Enable值为不可用
    Call ControlEnable(False)
    '修改、删除、添加按钮可用,保存和取消按钮不可用
    CmdAdd.Enabled = True: CmdModify.Enabled = True: CmdDelete.Enabled = True
    CmdSave.Enabled = False: CmdCancel.Enabled = False
End Sub
Private Sub setData()
'为字段设置数据
    rs.Fields("读者号") = Me.txtReadNo.Text
    rs.Fields("姓名") = Me.txtName.Text
    rs.Fields("身份证号") = Me.txtCardId.Text
    rs.Fields("办理日期") = Me.DTPicker1.Value
    rs.Fields("罚款金额") = Me.txtPenalty.Text
    rs.Fields("住址") = Me.txtAddress.Text
    rs.Fields("电话") = Me.txtPhone.Text
    rs.Fields("邮箱") = Me.txtEmail.Text
End Sub
Private Sub CmdSave_Click()
    On Error GoTo ErrMsg
    If Not CheckData Then Exit Sub   '如果数据不合法就退出
    If flag = "Modify" Then          '如果是修改数据
        msg = MsgBox("您确实要修改这条数据吗?", vbYesNo)
        If msg = vbYes Then
            Call setData         '设置数据
        Else
            Exit Sub
        End If
    ElseIf flag = "Add" Then         '如果是添加新数据
        rs.AddNew
        Call setData                 '设置数据
    End If
    rs.Update                        '更新数据
    '移动控件可用
    For Index = 0 To 3
        CmdMove(Index).Enabled = True
    Next Index
    CmdModify.Enabled = True: CmdDelete.Enabled = True: CmdAdd.Enabled = True
    CmdSave.Enabled = False: CmdCancel.Enabled = False
    If flag = "Add" Then
        MsgBox ("成功添加数据!")
    Else
        MsgBox ("成功更新数据!")
    End If
    Call LoadData                    '重新装载数据
    '定位到添加或修改记录
    If rs.RecordCount > 0 Then
        rs.MoveFirst
        rs.Find ("读者号='" & Trim(Me.txtReadNo.Text) & "'")
        If Not rs.EOF Then Call ShowData                    '重新显示数据
    End If
    Exit Sub
ErrMsg:
    MsgBox Err.Description, vbExclamation, "出错"
End Sub
Private Sub CmdExit_Click()
    '退出操作
    图书管理系统.Enabled = True
    Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
    '退出操作
    图书管理系统.Enabled = True
    rs.Close
    Unload Me
End Sub