rl_newbooksmanage.frm

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

    rc.MoveNext
    Loop
        
    Exit Function
cbo_sPublishing_load:
    MsgBox "cbo_sPublishing_load()---出错", vbCritical, "错误"
End Function

'****************************************************************
'*  cbo_Place_load
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'****************************************************************
Private Function cbo_Place_load()
    On Error GoTo cbo_Place_load
        
    Dim S_SQL As String
    
    S_SQL = ""
    S_SQL = "select Place from T_Place "
    
    Call Cmn_Ado_Select_Nolock(S_SQL, rc)
    
    '---将数据逐条写进cbo_Place中
    Do While Not rc.EOF
    cbo_Place.AddItem rc("Place")
    rc.MoveNext
    Loop
        
    Exit Function
cbo_Place_load:
    MsgBox "cbo_Place_load()---出错", vbCritical, "错误"
End Function

'****************************************************************
'*  cbo_sBooksType_load
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'****************************************************************
Private Function cbo_sBooksType_load()
    On Error GoTo cbo_sBooksType_load
        
    Dim S_SQL As String
    '---插入一空白行，保证不将其列入搜索条件
    cbo_sBooksType.AddItem ""
    
    S_SQL = ""
    S_SQL = "select BooksType from T_BooksType "
    
    Call Cmn_Ado_Select_Nolock(S_SQL, rc)
    
    '---将数据逐条写进cbo_sBooksType中
    Do While Not rc.EOF
    cbo_sBooksType.AddItem rc("BooksType")
    rc.MoveNext
    Loop
        
    Exit Function
cbo_sBooksType_load:
    MsgBox "cbo_sBooksType_load()---出错", vbCritical, "错误"
End Function

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

    '---返回值初始设置
    Item_Check = False
    
    
    Dim S_Check_BooksCode As String
    Dim S_Check_ISBN      As String
    Dim S_Check_BarCode   As String
    Dim S_Check_Title     As String
    
    
    '---设置图书编号长度检测
    S_Check_BooksCode = Check_Txt(txt_BooksID, 0, 10, "图书编码", "图书管理")
    '---设置ISBN长度检测
    S_Check_ISBN = Check_Txt(txt_ISBN, 0, 13, "ISBN", "图书管理")
    '---设置条形码长度检测
    S_Check_BarCode = Check_Txt(txt_BarCode, 0, 13, "条形码", "图书管理")
    '---设置图书名称长度检测
    S_Check_Title = Check_Txt(txt_BooksName, 0, 50, "图书名称", "图书管理")
    '[txt_BooksID]
    If (False = S_Check_BooksCode) Then
        txt_BooksID.SetFocus
        Exit Function
    End If
    '[txt_ISBN]
    If (False = S_Check_ISBN) Then
        txt_ISBN.SetFocus
        Exit Function
    End If
    '[txt_BarCode]
    If (False = S_Check_BarCode) Then
        txt_BarCode.SetFocus
        Exit Function
    End If
    '[txt_Title]
    If (False = S_Check_Title) Then
        txt_BooksName.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_sBooksID    As String
    Dim S_sWriter     As String
    Dim S_sBooksName  As String
    Dim S_sBarCode    As String
    Dim S_sPublishing As String
    Dim S_sRemark     As String
    Dim S_sBooksType  As String
    Dim T_SQL         As String
    
    S_sBooksID = Trim(txt_sBooksID.text)
    S_sWriter = Trim(txt_sWriter.text)
    S_sBooksName = Trim(txt_sBooksName.text)
    S_sBarCode = Trim(txt_sBarCode.text)
    S_sPublishing = Trim(cbo_sPublishing.text)
    S_sRemark = Trim(txt_sRemarks.text)
    S_sBooksType = Trim(cbo_sBooksType.text)
    
    T_SQL = ""
    
    '---判断搜索区内是否有数据，如果有则按搜索条件显示，无则无条件显示
    '[txt_sBooksID]
    If txt_sBooksID.text <> "" Then
        T_SQL = T_SQL & "and BooksCode='" & S_sBooksID & "'"
    End If
    '[txt_sWriter]
    If txt_sWriter.text <> "" Then
        T_SQL = T_SQL & "and Writer='" & S_sWriter & "'"
    End If
    '[txt_sBooksName]
    If txt_sBooksName.text <> "" Then
        T_SQL = T_SQL & "and title='" & S_sBooksName & "'"
    End If
    '[txt_sBarCode]
    If txt_sBarCode.text <> "" Then
        T_SQL = T_SQL & "and BarCode='" & S_sBarCode & "'"
    End If
    '[cbo_sBooksType]
    If cbo_sBooksType.text <> "" Then
        T_SQL = T_SQL & "and BooksType='" & S_sBooksType & "'"
    End If
    '[cbo_sPublishing]
    If cbo_sPublishing.text <> "" Then
        T_SQL = T_SQL & "and Publishing='" & S_sPublishing & "'"
    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_Books.BooksCode AS 图书编码,"
    S_SQL = S_SQL & " T_Books.BarCode AS 条形码,"
    S_SQL = S_SQL & " T_Books.ISBN,"
    S_SQL = S_SQL & " T_Books.Title AS 图书名称,"
    S_SQL = S_SQL & " T_BooksType.BooksType AS 图书种类,"
    S_SQL = S_SQL & " T_Books.Writer AS 作者,"
    S_SQL = S_SQL & " T_Publishing.Publishing AS 出版社,"
    S_SQL = S_SQL & " T_Books.Price AS 价格,"
    S_SQL = S_SQL & " T_Books.PublishDate AS 出版日期,"
    S_SQL = S_SQL & " T_Books.Page AS 页数,"
    S_SQL = S_SQL & " T_Books.BriefIntroduction AS 简介,"
    S_SQL = S_SQL & " T_Books.EnterDate AS 入馆日期,"
    S_SQL = S_SQL & " T_Books.EnterNumber AS 入馆数量,"
    S_SQL = S_SQL & " T_Place.Place AS 摆放位置,"
    S_SQL = S_SQL & " T_Books.Handler AS 操作员,"
    S_SQL = S_SQL & " T_Books.HandleDate AS 操作日期"
    S_SQL = S_SQL & " FROM T_Publishing INNER JOIN"
    S_SQL = S_SQL & " (T_Place INNER JOIN"
    S_SQL = S_SQL & " (T_BooksType INNER JOIN T_Books ON T_BooksType.BooksTypeID = T_Books.BooksTypeID)"
    S_SQL = S_SQL & " ON T_Place.PlaceID = T_Books.PlaceID)"
    S_SQL = S_SQL & " ON T_Publishing.PublishingID = T_Books.PublishingID"
    S_SQL = S_SQL & T_SQL
    
    '---执行查询语句
    Call Cmn_Ado_Select_Nolock(S_SQL, rc)
    
    msh_BooksManage.Redraw = False '不数据表格重绘
    
    If rc.RecordCount <> 0 Then
    
        '---有数据的情况
        Set msh_BooksManage.DataSource = rc
        msh_BooksManage.Row = 1
        msh_BooksManage.TextMatrix(msh_BooksManage.RowSel, 0) = " →" '标出表格控件最左边的选定当前行标志"→"
    Else
        '---没有数据的情况
        Set msh_BooksManage.DataSource = rc
        msh_BooksManage.Rows = 2
        msh_BooksManage.Col = 0
        msh_BooksManage.Enabled = False
    End If
    
    '---设置表格控件最左边的选定当前行标志"→"列的宽度
    msh_BooksManage.ColWidth(0) = 400
    
    '---数据表格重绘
    msh_BooksManage.Redraw = True
    
    Exit Function
err_Fr_Mshf:
    MsgBox "Fr_Mshf()---出错", vbCritical, "错误"
End Function

'****************************************************************
'*  msh_BooksManage_Click 写当前行标记
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'****************************************************************
Private Sub msh_BooksManage_Click()
    On Error GoTo msh_BooksManage_Click
    
    Dim i As Integer
    
    msh_BooksManage.Redraw = False
    
    For i = 0 To msh_BooksManage.Rows - 1
        msh_BooksManage.TextMatrix(i, 0) = "" '清除表格控件最左边的选定当前行标志"→"
    Next
    msh_BooksManage.TextMatrix(msh_BooksManage.RowSel, 0) = " →"  '标出表格控件最左边的选定当前行标志"→"
    msh_BooksManage.Redraw = True
    
    C_UserName = ""
    
    '---读取所选的图书编号
    C_UserName = msh_BooksManage.TextMatrix(msh_BooksManage.RowSel, 1)
    
    Call Data_Get
    
    
    Exit Sub
msh_BooksManage_Click:
    MsgBox "msh_BooksManage_Click()---出错", vbCritical, "错误"
End Sub
'***************************************************************
'*  cmd_Add_Click
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub cmd_Add_Click()
    On Error GoTo cmd_Add_Click
       
    '---检查必添项
    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