rl_newreadermanage.frm

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

    S_SQL = S_SQL & " t_reader.ReaderTelNumber,"
    S_SQL = S_SQL & " t_reader.Address,"
    S_SQL = S_SQL & " t_reader.ReaderRegisterDate,"
    S_SQL = S_SQL & " t_reader.NonceHoldAmount,"
    S_SQL = S_SQL & " t_reader.BorrowTime,"
    S_SQL = S_SQL & " t_reader.GiveBackTime,"
    S_SQL = S_SQL & " t_reader.Remark,"
    S_SQL = S_SQL & " T_ReaderType.RestrictAmount,"
    S_SQL = S_SQL & " T_ReaderType.AllowContinueTime,"
    S_SQL = S_SQL & " T_ReaderType.AllowBorrowDay"
    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 & " where t_reader.readerID='" & S_UserName & "'"
        
    Call Cmn_Ado_Select_Nolock(S_SQL, rc)
    
    '---数据库字段写到窗体控件中
    txt_ReaderID.text = rc("ReaderID")
    txt_ReaderName.text = rc("ReaderName")
    cbo_Sex.text = rc("sex")
    cbo_ReaderType.text = rc("ReaderType")
    cbo_CardType.text = rc("CardType")
    txt_CardNumber.text = rc("CardNumber")
    txt_Department.text = rc("Department")
    txt_TelNumber.text = rc("ReaderTelNumber")
    txt_Address.text = rc("Address")
    dtp_ReaderRegisterDate.Value = rc("ReaderRegisterDate")
    txt_NonceHoldAmount.text = rc("NonceHoldAmount")
    txt_BorrowTime.text = rc("BorrowTime")
    txt_GiveBackTime.text = rc("GiveBackTime")
    txt_Remarks.text = rc("Remark")
    txt_RestrictAmmount.text = rc("RestrictAmount")
    txt_AllowContinueTime.text = rc("AllowContinueTime")
    txt_AllowBorrowDay.text = rc("AllowBorrowDay")
    

    '---鼠标状态置为正常
    Me.MousePointer = vbDefault
    
    '---正确返回值设置
    Data_Get = True
    
    Exit Function
Data_Get:
    Me.MousePointer = vbDefault
    MsgBox "Data_Get()---出错", vbCritical, "错误"
    '--- 返回值：异常终了设定
    Data_Get = False
End Function

'***************************************************************
'*  数据插入
'*
'*  [参数]
'*      无
'*  [返回]
'*      True:成功
'*      False:失败
'***************************************************************
Private Function Data_Insert() As Boolean
    On Error GoTo Data_Insert
    
    '---返回值初始设置
    Data_Insert = False
    
    Dim S_SQL                As String
    Dim S_ReaderID           As String
    Dim S_ReaderName         As String
    Dim S_Sex                As String
    Dim S_CardType           As String
    Dim S_CardNumber         As String
    Dim S_ReaderType         As String
    Dim S_Department         As String
    Dim S_TelNumber          As String
    Dim S_Address            As String
    Dim S_ReaderRegisterDate As String
    Dim S_Remarks            As String
    
    '---查询条件
    S_ReaderID = Trim(txt_ReaderID.text)
    
    '---鼠标置忙状态
    Me.MousePointer = vbHourglass
    
    '---检测读者编号是否已经存在
    S_SQL = ""
    S_SQL = S_SQL & " SELECT readerID"
    S_SQL = S_SQL & " FROM T_Reader"
    S_SQL = S_SQL & " WHERE readerid='" & S_ReaderID & "'"
    
    '---执行SQL语句
    Call Cmn_Ado_Select_Nolock(S_SQL, rc)
    
    If rc.EOF Then

    Else
        '---用户名已存在执行以下操作
        MsgBox "此读者编号已存在，请重新输入读者编号", , "读者管理"
        txt_ReaderID.SetFocus
        Me.MousePointer = vbDefault
        Exit Function
    End If
    
    S_ReaderID = Trim(txt_ReaderID.text)
    S_ReaderName = Trim(txt_ReaderName.text)
    S_CardType = Int(cbo_CardType.ListIndex) + 1
    S_CardNumber = Trim(txt_CardNumber.text)
    S_ReaderType = Int(cbo_ReaderType.ListIndex) + 1
    S_Department = Trim(txt_Department.text)
    S_TelNumber = Trim(txt_TelNumber.text)
    S_Address = Trim(txt_Address.text)
    S_ReaderRegisterDate = dtp_ReaderRegisterDate.Value
    S_Remarks = Trim(txt_Remarks.text)
    S_Sex = Trim(cbo_Sex.text)
    '---鼠标置忙状态
    Me.MousePointer = vbHourglass
    
    '---数据插入语句
    S_SQL = ""
    S_SQL = S_SQL & "INSERT INTO T_reader("
    S_SQL = S_SQL & "ReaderID,"
    S_SQL = S_SQL & "ReaderName,"
    S_SQL = S_SQL & "Sex,"
    S_SQL = S_SQL & "CardTypeID,"
    S_SQL = S_SQL & "CardNumber,"
    S_SQL = S_SQL & "ReaderTypeid,"
    S_SQL = S_SQL & "Department,"
    S_SQL = S_SQL & "readerTelNumber,"
    S_SQL = S_SQL & "Address,"
    S_SQL = S_SQL & "ReaderRegisterDate,"
    S_SQL = S_SQL & "Remark"
    S_SQL = S_SQL & ")VALUES("
    S_SQL = S_SQL & "'" & S_ReaderID & "',"
    S_SQL = S_SQL & "'" & S_ReaderName & "',"
    S_SQL = S_SQL & "'" & S_Sex & "',"
    S_SQL = S_SQL & "'" & S_CardType & "',"
    S_SQL = S_SQL & "'" & S_CardNumber & "',"
    S_SQL = S_SQL & "'" & S_ReaderType & "',"
    S_SQL = S_SQL & "'" & S_Department & "',"
    S_SQL = S_SQL & "'" & S_TelNumber & "',"
    S_SQL = S_SQL & "'" & S_Address & "',"
    S_SQL = S_SQL & "'" & S_ReaderRegisterDate & "',"
    S_SQL = S_SQL & "'" & S_Remarks & "'"
    S_SQL = S_SQL & ")"
    
    Dim YesNo As Integer
    
    '---执行SQL语句前确认
    YesNo = MsgBox("确定添加数据吗？", vbYesNo + vbQuestion, "提示")
    If YesNo = vbYes Then
        '---执行数据插入语句
        Call Cmn_Ado_Execute(S_SQL)
    Else
        Me.MousePointer = vbDefault
        Exit Function
    End If
    
    '---鼠标置默认状态
    Me.MousePointer = vbDefault
 
    '---正常返回值设置
    Data_Insert = True
    
    Call Item_Clear '各项目清空
    
    '---将焦点设置到读者编号文本框
    txt_ReaderID.SetFocus
    
    Exit Function
Data_Insert:
    Me.MousePointer = vbDefault
    MsgBox "Data_Insert()---出错", vbCritical, "错误"
    
    '---异常终止设置
    Data_Insert = False
End Function

'****************************************************************
'*  数据修改
'*
'*  [参数]
'*      无
'*  [返回]
'*      实行状况
'*      True：成功
'*      False：失败
'****************************************************************
Private Function Data_Upd() As Boolean
    On Error GoTo Data_Upd
    
    '---设置返回初始值
    Data_Upd = False
        
    Dim S_SQL                As String
    Dim S_ReaderID           As String
    Dim S_ReaderName         As String
    Dim S_Sex                As String
    Dim S_CardType           As String
    Dim S_CardNumber         As String
    Dim S_ReaderType         As String
    Dim S_Department         As String
    Dim S_TelNumber          As String
    Dim S_Address            As String
    Dim S_ReaderRegisterDate As String
    Dim S_Remarks            As String
    
    '---获取修改数据
    S_ReaderID = Trim(txt_ReaderID.text)
    S_ReaderName = Trim(txt_ReaderName.text)
    S_Sex = Trim(cbo_Sex.text)
    S_CardType = Int(cbo_CardType.ListIndex) + 1 '将当前选中信息索引后置一位
    S_CardNumber = Trim(txt_CardNumber.text)
    S_ReaderType = Int(cbo_ReaderType.ListIndex) + 1 '将当前选中信息索引后置一位
    S_Department = Trim(txt_Department.text)
    S_TelNumber = Trim(txt_TelNumber.text)
    S_Address = Trim(txt_Address.text)
    S_ReaderRegisterDate = dtp_ReaderRegisterDate.Value
    S_Remarks = Trim(txt_Remarks.text)
    
    Me.MousePointer = vbHourglass
              
    '---修改语句
    S_SQL = ""
    S_SQL = S_SQL & " UPDATE T_Reader SET"
    S_SQL = S_SQL & " ReaderID='" & S_ReaderID & "',"
    S_SQL = S_SQL & " ReaderName='" & S_ReaderName & "',"
    S_SQL = S_SQL & " Sex='" & S_Sex & "',"
    S_SQL = S_SQL & " CardTypeID='" & S_CardType & "',"
    S_SQL = S_SQL & " CardNumber='" & S_CardNumber & "',"
    S_SQL = S_SQL & " ReaderTypeid='" & S_ReaderType & "',"
    S_SQL = S_SQL & " Department='" & S_Department & "',"
    S_SQL = S_SQL & " readerTelNumber='" & S_TelNumber & "',"
    S_SQL = S_SQL & " Address='" & S_Address & "',"
    S_SQL = S_SQL & " Remark='" & S_Remarks & "'"
    S_SQL = S_SQL & " WHERE readerid='" & S_ReaderID & "'"
    
    Dim YesNo As Integer
    
    '---执行SQL语句前确认
    YesNo = MsgBox("确定修改数据吗？", vbYesNo + vbQuestion, "提示")
    If YesNo = vbYes Then
        '---执行数据插入语句
        Call Cmn_Ado_Execute(S_SQL)
    Else
        Me.MousePointer = vbDefault
        Exit Function
    End If
    
    
    Me.MousePointer = vbDefault
    
    '---正确返回值设置
    Data_Upd = True
    
    '---将窗体中控件初始
    Call Item_Clear
    
    Exit Function
Data_Upd:
    Me.MousePointer = vbDefault
    MsgBox "Data_Upd()---出错", vbCritical, "错误"
    '--- 返回值：异常终了设定
    Data_Upd = False
End Function

'****************************************************************
'*  数据删除
'*
'*  [参数]
'*      无
'*  [返回]
'*      实行状况
'*      True：成功
'*      False：失败
'****************************************************************
Private Function Data_Del() As Boolean
    On Error GoTo Data_Del
    
    '---设置返回初始值
    Data_Del = False
        
    Dim S_SQL      As String
    Dim S_ReaderID As String
            
    Me.MousePointer = vbHourglass
    
    S_ReaderID = msh_ReaderManage.TextMatrix(msh_ReaderManage.RowSel, 1) '选择当前行的读者编号
   
    S_SQL = ""
    S_SQL = S_SQL & "DELETE FROM T_Reader"
    S_SQL = S_SQL & " WHERE ReaderID='" & S_ReaderID & "'"
    
    Dim YesNo As Integer
    
    '---执行SQL语句前确认
    YesNo = MsgBox("确定删除数据吗？", vbYesNo + vbQuestion, "提示")
    If YesNo = vbYes Then
        '---执行数据插入语句
        Call Cmn_Ado_Execute(S_SQL)
    Else
        Me.MousePointer = vbDefault
        Exit Function
    End If
    
    Me.MousePointer = vbDefault
    
    Data_Del = True
    Exit Function
Data_Del:
    Me.MousePointer = vbDefault
    MsgBox "Data_Del()---出错", vbCritical, "错误"
    '--- 返回值：异常终了设定
    Data_Del = False
End Function

'***************************************************************
'*  txt_ReaderID获得焦点
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub txt_ReaderID_GotFocus()
    On Error GoTo txt_ReaderID_GotFocus
    
    Call Cmn_Txt_GotFocus(txt_ReaderID)
    
    Exit Sub
txt_ReaderID_GotFocus:
    MsgBox "txt_ReaderID_GotFocus()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  txt_ReaderID失去焦点
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub txt_ReaderID_LostFocus()
    On Error GoTo txt_ReaderID_LostFocus
    
    Call Cmn_Txt_LostFocus(txt_ReaderID)
    
    Exit Sub
txt_ReaderID_LostFocus:
    MsgBox "txt_ReaderID_LostFocus()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  txt_ReaderName获得焦点
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub txt_ReaderName_GotFocus()
    On Error GoTo txt_ReaderName_GotFocus
    
    Call Cmn_Txt_GotFocus(txt_ReaderName)
    
    Exit Sub
txt_ReaderName_GotFocus:
    MsgBox "txt_ReaderName_GotFocus()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  txt_ReaderName失去焦点
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub txt_ReaderName_LostFocus()
    On Error GoTo txt_ReaderName_LostFocus
    
    Call Cmn_Txt_LostFocus(txt_ReaderName)
    
    Exit Sub
txt_ReaderName_LostFocus:
    MsgBox "txt_ReaderName_LostFocus()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  txt_CardNumber获得焦点
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub txt_CardNumber_GotFocus()
    On Error GoTo txt_CardNumber_GotFocus
    
    Call Cmn_Txt_GotFocus(txt_CardNumber)
    
    Exit Sub
txt_CardNumber_GotFocus:
    MsgBox "txt_CardNumber_GotFocus()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  txt_CardNumber失去焦点
'*
'*  [参数]
'*      无
'*  [返回]
'*      无