rl_newreadermanage.frm

图书管理软件,基本功能已具备

        
    Exit Function
cbo_sReaderType_load:
    MsgBox "cbo_sReaderType_load()---出错", vbCritical, "错误"
End Function

'****************************************************************
'*  项目检测
'*
'*  [参数]
'*      无
'*  [返回]
'*      True:成功
'*      False:失败
'****************************************************************
Private Function Item_Check() As Boolean
    On Error GoTo Item_Check

    '---返回值初始设置
    Item_Check = False
    
    
    Dim S_Check_ReaderID   As String
    Dim S_Check_ReaderName As String

    
    '---设置读者编号长度检测
    S_Check_ReaderID = Check_Txt(txt_ReaderID, 0, 20, "读者编号", "读者管理")
    '---设置读者姓名长度检测
    S_Check_ReaderName = Check_Txt(txt_ReaderName, 0, 8, "读者姓名", "读者管理")
   
    '[txt_ReaderID]
    If (False = S_Check_ReaderID) Then
        txt_ReaderID.SetFocus
        Exit Function
    End If
    '[txt_ReaderName]
    If (False = S_Check_ReaderName) Then
        txt_ReaderName.SetFocus
        Exit Function
    End If
   
    
    '---返回值正确设置
    Item_Check = True

    Exit Function
Item_Check:
    MsgBox "Item_Check()---出错", vbCritical, "错误"
End Function

'****************************************************************
'*  Form_KeyPress
'*
'*  [参数]
'*      1:系统参数
'*  [返回]
'*      无
'****************************************************************
Private Sub Form_KeyPress(KeyAscii As Integer)
    On Error GoTo Form_KeyPress

    Select Case KeyAscii
    Case vbKeyReturn
        KeyAscii = &H0
        If TypeOf ActiveControl Is CommandButton Then Exit Sub
        
        '--- 焦点移动
        Select Case ActiveControl.hWnd
        Case Else
            SendKeys "{TAB}", True
        End Select
        
    End Select
    
    Exit Sub
Form_KeyPress:
    MsgBox "Form_KeyPress()---出错", vbCritical, "错误"
End Sub

'****************************************************************
'*  表格控件加载数据
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'****************************************************************
Public Function Fr_Mshf()
    On Error GoTo err_Fr_Mshf
    
    Dim S_SQL         As String
    Dim S_sReaderID   As String
    Dim S_sReaderName As String
    Dim S_sCardNumber As String
    Dim S_sDepartment As String
    Dim S_sTelNumber  As String
    Dim S_sReaderType As String
    Dim S_sRemark     As String
    Dim T_SQL         As String
    
    S_sReaderID = Trim(txt_sReaderID.text)
    S_sReaderName = Trim(txt_sReaderName.text)
    S_sCardNumber = Trim(txt_sCardNumber.text)
    S_sDepartment = Trim(txt_sDepartment.text)
    S_sTelNumber = Trim(txt_sTelNumber.text)
    S_sReaderType = Trim(cbo_sReaderType.text)
    S_sRemark = Trim(txt_sRemarks.text)
    
    T_SQL = ""
    
    '---判断搜索区内是否有数据，如果有则按搜索条件显示，无则无条件显示
    '[txt_sReaderID]
    If txt_sReaderID.text <> "" Then
        T_SQL = T_SQL & "and ReaderID='" & S_sReaderID & "'"
    End If
    '[txt_sReaderName]
    If txt_sReaderName.text <> "" Then
        T_SQL = T_SQL & "and ReaderName='" & S_sReaderName & "'"
    End If
    '[txt_sCardNumber]
    If txt_sCardNumber.text <> "" Then
        T_SQL = T_SQL & "and CardNumber='" & S_sCardNumber & "'"
    End If
    '[txt_sDepartment]
    If txt_sDepartment.text <> "" Then
        T_SQL = T_SQL & "and Department='" & S_sDepartment & "'"
    End If
    '[txt_sTelNumber]
    If txt_sTelNumber.text <> "" Then
        T_SQL = T_SQL & "and ReaderTelNumber='" & S_sTelNumber & "'"
    End If
    '[cbo_sReaderType]
    If cbo_sReaderType.text <> "" Then
        T_SQL = T_SQL & "and ReaderType='" & S_sReaderType & "'"
    End If
    '[txt_sRemarks]
    If txt_sRemarks.text <> "" Then
        T_SQL = T_SQL & "and Remark='" & S_sRemark & "'"
    End If
    
    '---判断是否有搜索条件
    If T_SQL = "" Then
        '---如果没有不做任何操作执行下一条语句
    Else
        '---如果有将其加入到S_SQL语句后面
        T_SQL = Mid(T_SQL, 4)
        T_SQL = " WHERE " & T_SQL
    End If
    
    '---查询语句
    S_SQL = ""
    S_SQL = S_SQL & " SELECT t_reader.ReaderID as 读者编号,"
    S_SQL = S_SQL & " t_reader.ReaderName as 读者姓名,"
    S_SQL = S_SQL & "t_reader.sex as 性别,"
    S_SQL = S_SQL & " T_ReaderType.ReaderType as 读者类型,"
    S_SQL = S_SQL & " T_CardType.CardType as 证件类型,"
    S_SQL = S_SQL & " t_reader.CardNumber as 证件号,"
    S_SQL = S_SQL & " t_reader.Department as 部门,"
    S_SQL = S_SQL & " t_reader.ReaderTelNumber as 联系电话,"
    S_SQL = S_SQL & " t_reader.ReaderRegisterDate as 注册日期"
    S_SQL = S_SQL & " FROM"
    S_SQL = S_SQL & " (T_ReaderType INNER JOIN t_reader ON T_ReaderType.ReaderTypeID = t_reader.ReaderTypeID)"
    S_SQL = S_SQL & " INNER JOIN T_CardType ON"
    S_SQL = S_SQL & " t_reader.CardTypeID = T_CardType.CardTypeID"
    S_SQL = S_SQL & T_SQL

    '---执行查询语句
    Call Cmn_Ado_Select_Nolock(S_SQL, rc)
    
    msh_ReaderManage.Redraw = False '不数据表格重绘
    
    If rc.RecordCount <> 0 Then
    
        '---有数据的情况
        Set msh_ReaderManage.DataSource = rc
        msh_ReaderManage.Row = 1
        msh_ReaderManage.TextMatrix(msh_ReaderManage.RowSel, 0) = " →" '标出表格控件最左边的选定当前行标志"→"
    Else
        '---没有数据的情况
        Set msh_ReaderManage.DataSource = rc
        msh_ReaderManage.Rows = 2
        msh_ReaderManage.Col = 0
        msh_ReaderManage.Enabled = False
    End If
    
    '---设置表格控件最左边的选定当前行标志"→"列的宽度
    msh_ReaderManage.ColWidth(0) = 400
    
    '---数据表格重绘
    msh_ReaderManage.Redraw = True
    
    Exit Function
err_Fr_Mshf:
    MsgBox "Fr_Mshf()---出错", vbCritical, "错误"
End Function

'****************************************************************
'*  msh_ReaderManage_Click 写当前行标记
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'****************************************************************
Private Sub msh_ReaderManage_Click()
    On Error GoTo msh_ReaderManage_Click
    
    Dim i As Integer
    
    msh_ReaderManage.Redraw = False
    
    For i = 0 To msh_ReaderManage.Rows - 1
        msh_ReaderManage.TextMatrix(i, 0) = "" '清除表格控件最左边的选定当前行标志"→"
    Next
    msh_ReaderManage.TextMatrix(msh_ReaderManage.RowSel, 0) = " →"  '标出表格控件最左边的选定当前行标志"→"
    msh_ReaderManage.Redraw = True
    
    C_UserName = ""

    C_UserName = msh_ReaderManage.TextMatrix(msh_ReaderManage.RowSel, 1)
    
    txt_ReaderID.Enabled = False
    
    Call Data_Get
    
    
    Exit Sub
msh_ReaderManage_Click:
    MsgBox "msh_ReaderManage_Click()---出错", vbCritical, "错误"
End Sub
'***************************************************************
'*  cmd_Add_Click
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub cmd_Add_Click()
    On Error GoTo cmd_Add_Click
    
    '---如果当前处于修改状态则设置为添加状态
    If txt_ReaderID.Enabled = False Then
        Call Add_Check
        Exit Sub
    End If
    
    '---检查必添项
    If Item_Check() = False Then
        Exit Sub
    End If
    
    '---添加函数
    If Data_Insert = False Then
        Exit Sub
    End If
    
    Call Fr_Mshf
    
    Exit Sub
cmd_Add_Click:
    MsgBox "cmd_Add_Click()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  cmd_Clear_Click
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub cmd_Clear_Click()
    On Error GoTo cmd_Clear_Click
    
    '---将窗体各个控件的值清空
    Call Item_Clear
    
    Exit Sub
cmd_Clear_Click:
    MsgBox "cmd_Clear_Click()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  cmd_Modification_Click
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub cmd_Modification_Click()
    On Error GoTo cmd_Modification_Click
    
    '---更新函数
    Call Data_Upd
    
    '---表格控件重新加载
    Call Fr_Mshf
    
    Exit Sub
cmd_Modification_Click:
    MsgBox "cmd_Modification_Click()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  cmd_Delete_Click
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub cmd_Delete_Click()
    On Error GoTo cmd_Delete_Click
    
    '---删除函数
    Call Data_Del
    
    '---表格控件重新加载
    Call Fr_Mshf
    
    '---将窗体各个控件的值清空
    Call Item_Clear
    
    Exit Sub
cmd_Delete_Click:
    MsgBox "cmd_Delete_Click()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  cmd_Search_Click
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub cmd_Search_Click()
    On Error GoTo cmd_Search_Click
    
    
    '---如果前一次没有找到结果，重新搜索时将表格控件设置为可以点击
    msh_ReaderManage.Enabled = True
    
    '---表格控件重新加载
    Call Fr_Mshf
    
    '---将窗体各个控件的值清空
    Call Item_Clear
    
    Exit Sub
cmd_Search_Click:
    MsgBox "cmd_Search_Click()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  cmd_Quit_Click
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub cmd_Quit_Click()
    On Error GoTo cmd_Quit_Click
    
    '---关闭窗体
    Unload Me
    Exit Sub
cmd_Quit_Click:
    MsgBox "cmd_Quit_Click()---出错", vbCritical, "错误"
End Sub

'****************************************************************
'*  数据查看
'*
'*  [参数]
'*      无
'*  [返回]
'*      实行状况
'*      True：成功
'*      False：失败
'****************************************************************
Private Function Data_Get() As Boolean
    On Error GoTo Data_Get
    
    '---设置返回初始值
    Data_Get = False
    
    Dim S_UserName    As String
    Dim S_SQL         As String
    Dim S_sReaderID   As String
    Dim S_sReaderName As String
    Dim S_sCardNumber As String
    Dim S_sDepartment As String
    Dim S_sTelNumber  As String
    Dim S_sReaderType As String
         
    
    '---被选中的用户名
    S_UserName = Trim(C_UserName)
            
    Me.MousePointer = vbHourglass
    
    S_SQL = ""
    S_SQL = S_SQL & " SELECT t_reader.ReaderID,"
    S_SQL = S_SQL & " t_reader.ReaderName,"
    S_SQL = S_SQL & " t_reader.sex,"
    S_SQL = S_SQL & " T_ReaderType.ReaderType,"
    S_SQL = S_SQL & " T_CardType.CardType,"
    S_SQL = S_SQL & " t_reader.CardNumber,"
    S_SQL = S_SQL & " t_reader.Department,"