frmbookstostore.frm

图书管理系统

Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim objCopy As New Recordset

Private Sub cmdAddOne_Click(Index As Integer)
    '选择当前条码
    ListItem_Add lstPre(Index), lstIn(Index), Index, False
End Sub
Private Sub lstPre_DblClick(Index As Integer)
    '选择当前条码
    ListItem_Add lstPre(Index), lstIn(Index), Index, False
End Sub
Private Sub cmdAddAll_Click(Index As Integer)
    '选择全部条码
    ListItem_Add lstPre(Index), lstIn(Index), Index, True
End Sub

Private Sub ListItem_Add(LstFrom As ListBox, lstTo As ListBox, Index As Integer, isAll As Boolean)
    Dim i%, j%, strO$, strI$, intM%, intN%, iStart%, iEnd%, i1%, i2%
    '根据是否选择源列表中的所有条码，设置选择条码的开始和结束序号
    If isAll Then
        '设置选择全部条码
        If LstFrom.ListCount < 1 Then Exit Sub
        iStart = 0
        iEnd = LstFrom.ListCount - 1
    Else
        '设置选择当前条码
        If LstFrom.ListIndex < 0 Then Exit Sub
        iStart = LstFrom.ListIndex
        iEnd = iStart
    End If
    '从源列表中将选择的条码按指定复本数添加到目标列表中
    For i = iStart To iEnd
        strO = LstFrom.List(i)      '获得源列表中的选定列表项目
        If isAll Then               '获得复本数
            intM = Val(InputBox("请输入" & strO & "的分配数量"))
        Else
            If txtSum(Index) = "" Then
                intM = Val(InputBox("请输入" & strO & "的分配数量"))
            Else
                intM = Val(txtSum(Index))
            End If
        End If
        If Index = 1 Then           'Index=1表示指定库室调配
            '获得源列表项目中的条码和复本数
            i1 = InStr(1, strO, "(")
            i2 = InStr(1, strO, ")")
            intN = Val(Mid(strO, i1 + 1, i2 - i1 - 1))
            strO = Left(strO, i1 - 1)
            If intM > intN Then intM = intN
        End If
        If intM > 0 Then             '在复本数大于0时才在目标列表中添加条码
            For j = 0 To lstTo.ListCount - 1
                '获得目标列表项目
                strI = lstTo.List(j)
                i1 = InStr(1, strI, "(")
                i2 = InStr(1, strI, ")")
                '在目标列表中已经存在源列表条码时跳出循环
                If Left(strI, i1 - 1) = strO Then Exit For
            Next
            If j = lstTo.ListCount Then
                '目标列表中没有源列表条码，添加新的条码项目
                lstTo.AddItem strO & "(" & intM & ")"
            Else
                '目标列表中存在源列表条码，增加复本数
                lstTo.List(j) = strO & "(" & (intM + _
                       Val(Mid(strI, i1 + 1, i2 - i1 - 1))) & ")"
            End If
            If Index = 1 Then
                '执行库室调配时，应从源列表中减去相应的复本数
                intN = intN - intM
                LstFrom.List(i) = strO & "(" & intN & ")"
            End If
        End If
    Next
End Sub
Private Sub cmdRAll_Click(Index As Integer)
    ListItem_Remove lstIn(Index), lstPre(Index), Index, True
End Sub
Private Sub cmdROne_Click(Index As Integer)
    ListItem_Remove lstIn(Index), lstPre(Index), Index, False
End Sub
Private Sub lstIn_DblClick(Index As Integer)
    ListItem_Remove lstIn(Index), lstPre(Index), Index, False
End Sub
Private Sub ListItem_Remove(LstFrom As ListBox, lstTo As ListBox, Index As Integer, isAll As Boolean)
    Dim i%, j%, strO$, strI$, intM%, intN%, iStart%, iEnd%, i1%, i2%, o1%, o2%
    If isAll Then
        '设置取消全部条码
        If LstFrom.ListCount < 1 Then Exit Sub
        iStart = 0
        iEnd = LstFrom.ListCount - 1
    Else
        '设置取消当前条码
        If LstFrom.ListIndex < 0 Then Exit Sub
        iStart = LstFrom.ListIndex
        iEnd = iStart
    End If
    For i = iStart To iEnd
        '获得目标列表中的被取消列表项目
        strO = LstFrom.List(i)
        o1 = InStr(1, strO, "(")
        o2 = InStr(1, strO, ")")
        For j = 0 To lstTo.ListCount - 1
            '获得源列表中的列表项目
            strI = lstPre(Index).List(j)
            i1 = InStr(1, strI, "(")
            i2 = InStr(1, strI, ")")
            '根据源列表是否为调出库室列表执行不同的比较操作，
            '在源列表存在对应的库表列表项目时跳出循环
            If Index = 1 Then
                If Left(strO, o1 - 1) = Left(strI, i1 - 1) Then _
                    Exit For
            Else
                If Left(strO, o1 - 1) = strI Then Exit For
            End If
        Next
        If j = lstTo.ListCount Then
            '不存在目标列表项目，直接执行添加操作
            lstTo.AddItem strO
        Else
            '存在目标列表项目，如果时取消库室调配则还原源列表中的复本数
            If Index = 1 Then
                lstTo.List(j) = Left(strI, i1 - 1) & "(" _
                & (Val(Mid(strO, o1 + 1, o2 - o1 - 1)) _
                   + Val(Mid(strI, i1 + 1, i2 - i1 - 1))) & ")"
            End If
        End If
    Next
    If isAll Then
        '如果取消全部条码，则清空目标列表
        LstFrom.Clear
    Else
        '如果是取消当前条码，则从目标列表中删除当前条码
        LstFrom.RemoveItem i - 1
    End If
End Sub


Private Sub cmdExit_Click()
    If lstIn(0).ListCount > 0 Then
        If MsgBox("你选定了部分新书准备入库，但没有执行保存操作，" _
                   & vbCr & "是否需要执行保存操作？", _
                   vbCritical + vbYesNo, "图书典藏管理") = vbYes Then
            SSTab1.Tab = 0
            cmdSave.Value = True
        End If
    ElseIf lstIn(1).ListCount > 0 Then
        If MsgBox("你选定了部分图书准备调库，但没有执行保存操作，" _
                   & vbCr & "是否需要执行保存操作？", _
                   vbCritical + vbYesNo, "图书典藏管理") = vbYes Then
            SSTab1.Tab = 1
            cmdSave.Value = True
        End If
    End If
    Unload Me       '关闭图书典藏管理窗体
End Sub

Private Sub cmdRefresh_Click(Index As Integer)
    Select Case Index
        Case 0  '刷新新书条码列表
            With Library_Manage.rsNewBooksBibli
                If .State = adStateClosed Then .Open
                .Requery
            End With
            AddListNew
        Case 1  '刷新调出库室条码列表
            With Library_Manage.rsBooksStore
                If .State = adStateClosed Then .Open
                .Requery
            End With
            AddListOut
    End Select
    lstIn(Index).Clear
End Sub

Private Sub cmdSave_Click()
    Dim i%, id%, strI$, intN%, strO$
    Dim objFrom As New Recordset, objTo As New Recordset
    'SSTab1.Tab为0、1分别表示执行新书分配和库室调配操作
    id = SSTab1.Tab
    If lstIn(id).ListCount < 1 Then Exit Sub
    If id = 0 Then
        '设置执行新书分配操作时使用的源纪录集
        With Library_Manage.rsNewBooksBibli
            If .State = adStateClosed Then .Open
            Set objFrom = .Clone
        End With
    Else
        '设置执行执行库室调配操作的源记录集
        With Library_Manage.rsBooksStore
            If .State = adStateClosed Then .Open
            Set objFrom = .Clone
        End With
    End If
    With Library_Manage.rsBooksStore
        '设置目标记录集
        If .State = adStateClosed Then .Open
        Set objTo = .Clone
        objTo.Filter = "库室名 = '" & cmbIn & "'"
    End With
    '根据目标条码列表将对应的新书或调出图书数据保存到馆藏纪录中
    For i = 0 To lstIn(id).ListCount - 1
        '获得目标条码列表项目中的条码和复本数
        strI = lstIn(id).List(i)
        intN = Val(Mid(strI, Len(strI) - 1, 1))
        strI = Left(strI, Len(strI) - 3)
        '在源记录集定位条码对应的记录
        objFrom.MoveFirst
        objFrom.Find "条码='" & strI & "'"
        '在目标记录集中定位条码对应的记录
        If objTo.RecordCount > 0 Then objTo.MoveFirst
        objTo.Find "条码 = '" & strI & "'"
        If objTo.EOF Then
            '目标记录集中无条码对应的记录，添加新的记录
            objTo.AddNew
            objTo.Fields("条码") = objFrom.Fields("条码")
            objTo.Fields("索书号") = objFrom.Fields("索书号")
            objTo.Fields("书名") = objFrom.Fields("书名")
            objTo.Fields("出版社") = objFrom.Fields("出版社")
            objTo.Fields("出版日期") = objFrom.Fields("出版日期")
            objTo.Fields("作者") = objFrom.Fields("作者")
            objTo.Fields("字数") = objFrom.Fields("字数")
            objTo.Fields("页数") = objFrom.Fields("页数")
            objTo.Fields("内容简介") = objFrom.Fields("内容简介")
            objTo.Fields("关键词") = objFrom.Fields("关键词")
            objTo.Fields("入馆时间") = Date
            objTo.Fields("复本数") = intN
            objTo.Fields("可借数") = intN
            objTo.Fields("库室名") = cmbIn
        Else
            '目标记录集中存在条码对应的记录，修改复本数和可借数
            objTo.Fields("复本数") = objTo.Fields("复本数") + intN
            objTo.Fields("可借数") = objTo.Fields("可借数") + intN
        End If
        objTo.Update
    Next
    lstIn(id).Clear
    '显示完成提示信息
    If id = 0 Then
        MsgBox "成功完成选定新书入库操作！", vbInformation, "图书典藏管理"
    Else
        '如果执行库室调配操作，则检查源条码列表中是否存在复本数为0的条码项目
        '将复本数为0的条码从源记录集中删除
        objFrom.Filter = "库室名='" & cmbOut & "'"
        For i = 0 To lstPre(1).ListCount - 1
            If objFrom.RecordCount > 0 Then objFrom.MoveFirst
            strO = lstPre(1).List(i)
            intN = Val(Mid(strO, Len(strO) - 1, 1))
            strO = Left(strO, Len(strO) - 3)
            objFrom.Find "条码='" & strO & "'"
            If intN = 0 Then
                objFrom.Delete
            Else
                objFrom.Fields("可借数") = objFrom.Fields("可借数") - _
                                           objFrom.Fields("复本数") + intN
                objFrom.Fields("复本数") = intN
            End If
            objFrom.Update
        Next
        For i = 0 To lstPre(1).ListCount - 1
            strO = lstPre(1).List(i)
            If strO = "" Then Exit For
            If Val(Mid(strO, Len(strO) - 1, 1)) = 0 Then
                lstPre(1).RemoveItem i
                i = i - 1
            End If
        Next
        MsgBox "成功完成选定图书库室调配操作！", vbInformation, "图书典藏管理"
    End If
End Sub

Private Sub Form_Load()
    cmbRoom.ListIndex = 0
    cmbIn.ListIndex = 0
    AddListNew
End Sub


Private Sub txtF1_Change()
    With Library_Manage.rsNewBooksBibli
        If txtF1 <> "" Then
            .Filter = "条码 LIKE '" & Trim(txtF1) & "%'"
        Else
            .Filter = ""
        End If
    End With
    AddListNew
End Sub

Private Sub AddListNew()
    lstPre(0).Clear
    With Library_Manage.rsNewBooksBibli
        If .State = adStateClosed Then .Open
        If .RecordCount > 0 Then
            .MoveFirst
            While Not .EOF
                lstPre(0).AddItem .Fields("条码")
                .MoveNext
            Wend
        Else
            lstPre(0).AddItem "当前无待分配新书"
        End If
    End With
End Sub

Private Sub cmbOut_Click()
    AddListOut
End Sub
Private Sub AddListOut()
    lstPre(1).Clear
    With Library_Manage.rsBooksStore
        If txtF2 <> "" Then
            .Filter = "库室名='" & cmbOut & "' And " & _
                    "条码 LIKE '" & Trim(txtF2) & "%'"
        Else
            .Filter = "库室名='" & cmbOut & "'"
        End If
        If .State = adStateClosed Then .Open
        If .RecordCount > 0 Then
            .MoveFirst
            While Not .EOF
                lstPre(1).AddItem .Fields("条码") & "(" & .Fields("复本数") & ")"
                .MoveNext
            Wend
        Else
            lstPre(1).AddItem "当前无可调出图书"
        End If
    End With
End Sub

Private Sub txtF2_Change()
    AddListOut
End Sub