rl_borrow.frm

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

    
    W_BooksCode = rc("bookscode")
    W_ReaderID = rc("readerid")
    W_EstateID = rc("estateid")
    
    If (W_BooksCode = "") And (W_ReaderID = "") And (W_EstateID = "") Then
        Where_Estate = 0 '未借
        Exit Function
    End If
    
    If (W_BooksCode = S_BooksCode) And (W_ReaderID = S_ReaderID) And (W_EstateID = 1) Then
        Where_Estate = 1 '借出
        Exit Function
    End If
    
    If (W_BooksCode = S_BooksCode) And (W_ReaderID = S_ReaderID) And (W_EstateID = 2) Then
        Where_Estate = 2 '续借
        Exit Function
    End If
    
    If (W_BooksCode = S_BooksCode) And (W_ReaderID = S_ReaderID) And (W_EstateID = 3) Then
        Where_Estate = 3 '已还
        Exit Function
    End If
    
    Exit Function
Where_Estate:
    MsgBox "Where_Estate()---出错", vbCritical, "错误"
End Function

'****************************************************************
'*  Continue_Borrow
'*
'*  [参数]
'*      无
'*  [返回]
'*      True:成功
'*      False:失败
'****************************************************************
Private Function Continue_Borrow() As Boolean
    On Error GoTo Continue_Borrow
    
    Continue_Borrow = False
    
    Dim S_SQL        As String
    Dim S_BooksCode  As String
    Dim S_ReaderID   As String
    Dim S_EstateID   As String
    Dim S_Handler    As String
    Dim S_HandleDate As String
    Dim YesNo        As Integer
    
    Me.MousePointer = vbHourglass
    
    S_BooksCode = Trim(txt_BooksID.text)
    S_ReaderID = Trim(txt_ReaderID.text)
    S_Handler = C_LoginName
    S_HandleDate = CStr(Format(Now, "yyyy年MM月dd日 HH:mm:ss"))
    
    S_SQL = ""
    S_SQL = S_SQL & " UPDATE T_BooksBorrow SET"
    S_SQL = S_SQL & " FaithReturnDate=cstr(cdate(FaithReturnDate)+15),"
    S_SQL = S_SQL & " EstateID=2,"
    S_SQL = S_SQL & " Handler='" & S_Handler & "',"
    S_SQL = S_SQL & " Handledate='" & S_HandleDate & "'"
    S_SQL = S_SQL & " WHERE"
    S_SQL = S_SQL & " BooksCode='" & S_BooksCode & "'"
    S_SQL = S_SQL & " AND"
    S_SQL = S_SQL & " ReaderID='" & S_ReaderID & "'"
    S_SQL = S_SQL & " AND"
    S_SQL = S_SQL & " EstateID=1"
    
    YesNo = MsgBox("您已借阅此书,是否续借？", vbYesNo + vbQuestion, "提示")
    
    If YesNo = vbYes Then
        Call Cmn_Ado_Execute(S_SQL)
    Else
        Me.MousePointer = vbDefault
        Exit Function
    End If
    
    Continue_Borrow = True
    
    Me.MousePointer = vbDefault
    
    Exit Function
Continue_Borrow:
    Me.MousePointer = vbDefault
    MsgBox "Continue_Borrow()---出错", vbCritical, "错误"
End Function

'****************************************************************
'*  First_Borrow
'*
'*  [参数]
'*      无
'*  [返回]
'*      True:成功
'*      False:失败
'****************************************************************
Private Function First_Borrow() As Boolean
    On Error GoTo First_Borrow
    
    First_Borrow = False
    
    Dim S_SQL             As String
    Dim S_BooksCode       As String
    Dim S_BarCode         As String
    Dim S_ReaderID        As String
    Dim S_BorrowDate      As String
    Dim S_FaithReturnDate As String
    Dim S_EstateID        As String
    Dim S_Handler         As String
    Dim S_HandleDate      As String
    
    Dim YesNo        As Integer
    
    Me.MousePointer = vbHourglass
    
    S_BooksCode = Trim(txt_BooksID.text)
    S_BarCode = Trim(txt_BarCode.text)
    S_ReaderID = Trim(txt_ReaderID.text)
    S_BorrowDate = CStr(Date)
    S_FaithReturnDate = CStr(Date + 15)
    S_EstateID = 1
    S_Handler = C_LoginName
    S_HandleDate = CStr(Format(Now, "yyyy年MM月dd日 HH:mm:ss"))
    
    
    S_SQL = ""
    S_SQL = S_SQL & " INSERT INTO T_BooksBorrow"
    S_SQL = S_SQL & " (BooksCode,"
    S_SQL = S_SQL & " BarCode,"
    S_SQL = S_SQL & " ReaderID,"
    S_SQL = S_SQL & " BorrowDate,"
    S_SQL = S_SQL & " FaithReturnDate,"
    S_SQL = S_SQL & " EstateID,"
    S_SQL = S_SQL & " Handler,"
    S_SQL = S_SQL & " HandleDate)"
    S_SQL = S_SQL & " VALUES"
    S_SQL = S_SQL & " ('" & S_BooksCode & "',"
    S_SQL = S_SQL & " '" & S_BarCode & "',"
    S_SQL = S_SQL & " '" & S_ReaderID & "',"
    S_SQL = S_SQL & " '" & S_BorrowDate & "',"
    S_SQL = S_SQL & " '" & S_FaithReturnDate & "',"
    S_SQL = S_SQL & " " & S_EstateID & ","
    S_SQL = S_SQL & " '" & S_Handler & "',"
    S_SQL = S_SQL & " '" & S_HandleDate & "')"
    
    If M_Where = False Then
        YesNo = MsgBox("您确定要借阅此书吗？", vbYesNo + vbQuestion, "提示")
        
        If YesNo = vbYes Then
            Call Cmn_Ado_Execute(S_SQL)
        Else
            Me.MousePointer = vbDefault
            Exit Function
        End If
    Else
        YesNo = MsgBox("您已借阅过此树,您要再一次借阅吗？", vbYesNo + vbQuestion, "提示")
        
        If YesNo = vbYes Then
            Call Cmn_Ado_Execute(S_SQL)
            M_Where = False
        Else
            Me.MousePointer = vbDefault
            Exit Function
        End If
    End If
    
    First_Borrow = True
    
    Me.MousePointer = vbDefault
    
    Exit Function
First_Borrow:
    Me.MousePointer = vbDefault
    MsgBox "First_Borrow()---出错", vbCritical, "错误"
End Function

'****************************************************************
'*  Exe_Return
'*
'*  [参数]
'*      无
'*  [返回]
'*      True:成功
'*      False:失败
'****************************************************************
Private Function Exe_Return() As Boolean
    On Error GoTo Exe_Return
    
    Exe_Return = False
    
    Dim S_SQL        As String
    Dim S_BooksCode  As String
    Dim S_ReaderID   As String
    Dim S_EstateID   As String
    Dim S_Handler    As String
    Dim S_HandleDate As String
    Dim S_ReturnDate As String
    Dim YesNo        As Integer
    Dim S_Now As String
    
    Me.MousePointer = vbHourglass
    
    S_BooksCode = Trim(txt_BooksID.text)
    S_ReaderID = Trim(txt_ReaderID.text)
    S_Handler = C_LoginName
    S_HandleDate = CStr(Format(Now, "yyyy年MM月dd日 HH:mm:ss"))
    S_ReturnDate = CStr(Date)
    S_Now = CStr(Date)
    
    If Check_Return = False Then
        Exit Function
    End If
    
       
    S_SQL = ""
    S_SQL = S_SQL & " UPDATE T_BooksBorrow SET"
    S_SQL = S_SQL & " EstateID=3,"
    S_SQL = S_SQL & " ReturnDate='" & S_ReturnDate & "',"
    S_SQL = S_SQL & " Handler='" & S_Handler & "',"
    S_SQL = S_SQL & " Handledate='" & S_HandleDate & "'"
    S_SQL = S_SQL & " WHERE"
    S_SQL = S_SQL & " BooksCode='" & S_BooksCode & "'"
    S_SQL = S_SQL & " AND"
    S_SQL = S_SQL & " ReaderID='" & S_ReaderID & "'"
    S_SQL = S_SQL & " AND"
    S_SQL = S_SQL & " EstateID<>3 "
    
    YesNo = MsgBox("您确定还书吗？", vbYesNo + vbQuestion, "提示")
    
    If YesNo = vbYes Then
        Call Cmn_Ado_Execute(S_SQL)
    Else
        Me.MousePointer = vbDefault
        Exit Function
    End If
    
    Exe_Return = True
    
    Me.MousePointer = vbDefault
    
 
    
    Exit Function
Exe_Return:
    Me.MousePointer = vbDefault
    MsgBox "Exe_Return()---出错", vbCritical, "错误"
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_BooksID获得焦点
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub txt_BooksID_GotFocus()
    On Error GoTo txt_BooksID_GotFocus
    
    Call Cmn_Txt_GotFocus(txt_BooksID)
    
    Exit Sub
txt_BooksID_GotFocus:
    MsgBox "txt_BooksID_GotFocus()---出错", vbCritical, "错误"
End Sub

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

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

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

'***************************************************************
'*  Check_Return
'*
'*  [参数]
'*      无
'*  [返回]
'*      True:成功
'*      False:失败
'***************************************************************
Private Function Check_Return() As Boolean
    On Error GoTo Check_Return
    
    Check_Return = False
    
    Dim S_SQL        As String
    Dim S_BooksCode  As String
    Dim S_ReaderID   As String
    Dim S_ReturnDate As String
    

    S_BooksCode = msh_Borrow.TextMatrix(msh_Borrow.RowSel, 3)
    S_ReaderID = msh_Borrow.TextMatrix(msh_Borrow.RowSel, 1)
    S_ReturnDate = msh_Borrow.TextMatrix(msh_Borrow.RowSel, 8)


    If Len(S_ReturnDate) <> 0 Then
        MsgBox "此图书已归还", vbInformation, "提示"
        Exit Function
    End If
         
    Check_Return = True
    Exit Function
Check_Return:
    MsgBox "Check_Return()---出错", vbCritical, "错误"
End Function

'***************************************************************
'*  Check_Return
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Function Fr_Mshf_Clear()
    On Error GoTo Fr_Mshf_Clear
    
    msh_Borrow.Clear '将表格控件清空
    msh_Borrow.Rows = 2 '设置表格控件行数为2
    
    Exit Function
Fr_Mshf_Clear:
    MsgBox "Fr_Mshf_Clear()---出错", vbCritical, "错误"
End Function