frmbookmanage.frm

在线图书馆系统 包括VB程序设计的后台与ASP的网页

End Sub

Private Sub ChkSort_Click()
    If ChkSort Then OptSelect.Value = True
End Sub

Private Sub cmdAdd_Click()
   ' On Error GoTo AddErr
  
    Call TxtClear
    Call TxtEdit(False)
    Adodc1.Refresh
    With Adodc1.Recordset
       If Not (.BOF And .EOF) Then
            mvBookMark = .Bookmark
        End If
     '  .MoveLast
        .AddNew
    End With
    txtAddDate.Text = Format(Now, "YYYY-MM-DD")
    mbAddNewFlag = True
    'cmdCancel.Enabled = False
    SF = True
    FrameEnable (False)
    Exit Sub
AddErr:
  MsgBox Err.Description
End Sub

Private Sub cmdCancel_Click()
    Adodc1.Recordset.CancelBatch
    Adodc1.Refresh
    If Not (Adodc1.Recordset.BOF And Adodc1.Recordset.EOF) Then
        If mvBookMark > 0 Then
            Adodc1.Recordset.Bookmark = mvBookMark
        Else
            Adodc1.Recordset.MoveFirst
        End If
    End If
    Call TxtEdit(True)
End Sub

Private Sub cmdClose_Click()
    Unload Me
End Sub

Private Sub cmdDelete_Click()
    Dim rs As New ADODB.Recordset
    Dim SQL As String
    Dim i  As Integer
    SQL = "select cs=count(*) from bookdetail where ID='" & BookId & "' and status<>'1' "
    Set rs = ExecuteSQL(SQL, ms)
    i = rs!cs
    rs.Close
    If i <> 0 Then
        MsgBox "本书已有" & i & "借出、预约、报损，不能删除！ "
    Else
        On Error GoTo DeleteErr
        With Adodc1.Recordset
            .Delete
            .MoveNext
            If Not .EOF Then .MoveLast
        End With
    End If
    Exit Sub
DeleteErr:
  MsgBox Err.Description
End Sub

Private Sub CmdOK_Click()
    Dim s As String
    s = ""
    If OptSelect.Value Then
        If ChkSort.Value Then s = " Sort='" & Trim(txtSort1.Text) & "'"
        If ChkPub.Value Then
            If s <> "" Then
                s = s & " and Publisher='" & Trim(txtPub.Text) & "'"
            Else
                s = s & " Publisher='" & Trim(txtPub.Text) & "'"
            End If
        End If
        If ChkPubD.Value Then
            If s <> "" Then
                s = s & " and PublishDate='" & Trim(txtPubD.Text) & "'"
            Else
                s = s & " PublishDate='" & Trim(txtPubD.Text) & "'"
            End If
        End If
        If ChkAddD.Value Then
            If s <> "" Then
                s = s & " and Adddate='" & Trim(txtAddD.Text) & "'"
            Else
                s = s & " Adddate='" & Trim(txtAddD.Text) & "'"
            End If
        End If
    End If
    If s = "" Then
        s = "select * from BookProperties  Order by ID"
    Else
        s = "select * from BookProperties where " & s
        s = s & "   Order by ID"
    End If
    Adodc1.RecordSource = s
    Adodc1.Refresh
    If Adodc1.Recordset.RecordCount = 0 Then
         CmdUpdate.Enabled = False
         cmdDelete.Enabled = False
    Else
        CmdUpdate.Enabled = True
        cmdDelete.Enabled = True
    End If
End Sub

Private Sub cmdSave_Click()
    '数据检查
    If Not IsNumeric(txtPage.Text) And Trim(txtPage.Text) <> "" Then
        MsgBox "页数输入错误！", vbOKOnly, "出错信息"
        txtPage.SetFocus
        txtPage.SelStart = 0
        txtPage.SelLength = Len(txtPage.Text)
        Exit Sub
    End If
    If Not IsNumeric(txtPrice.Text) And Trim(txtPrice.Text) <> "" Then
        MsgBox "价格输入错误！", vbOKOnly, "出错信息"
        txtPrice.SetFocus
        txtPrice.SelStart = 0
        txtPrice.SelLength = Len(txtPrice.Text)
        Exit Sub
    End If
    If (Not IsNumeric(txtTotal.Text) And Trim(txtTotal.Text) <> "") Or Trim(txtTotal.Text) = "" Then
        MsgBox "数量输入错误！", vbOKOnly, "出错信息"
        txtTotal.SetFocus
        txtTotal.SelStart = 0
        txtTotal.SelLength = Len(txtPage.Text)
        Exit Sub
    Else
        txtSupNum.Text = txtTotal.Text
    End If
        
    If Not IsDate(txtPubDate.Text) And Trim(txtPubDate.Text) <> "" Then
        MsgBox "出版日期输入错误！", vbOKOnly, "出错信息"
        txtPubDate.SetFocus
        txtPubDate.SelStart = 0
        txtPubDate.SelLength = Len(txtPubDate.Text)
        Exit Sub
    End If
    If Not IsDate(txtAddDate.Text) And Trim(txtAddDate.Text) <> "" Then
        MsgBox "登录日期输入错误！", vbOKOnly, "出错信息"
        txtAddDate.SetFocus
        txtAddDate.SelStart = 0
        txtAddDate.SelLength = Len(txtAddDate.Text)
        Exit Sub
    End If
    On Error GoTo UpdateErr
    If mbAddNewFlag = False Then   '修改图书记录
        If UpdateBookDetail(txtID.Text, txtTotal.Text) = 0 Then
            Exit Sub
        End If
    End If
'    If mbAddNewFlag Then
'        Adodc1.Refresh
'        With Adodc1.Recordset
'           If Not (.BOF And .EOF) Then
'                mvBookMark = .Bookmark
'            End If
'         '  .MoveLast
'            .AddNew
'        End With
'    Else
'
'    End If
    Adodc1.Recordset.UpdateBatch adAffectAll
    If mbAddNewFlag Then
        Adodc1.Recordset.MoveLast                '移到新记录
        '生成每本书的索书号及状态信息
        InserBookDeatil txtID.Text, Val(txtTotal.Text)
    End If
    mbEditFlag = False
    mbAddNewFlag = False
    Call TxtEdit(True)
    Exit Sub
UpdateErr:
  MsgBox Err.Description
    
End Sub

Private Sub CmdSel_Click()
    SF = False
    FrameEnable (flag)
End Sub

Private Sub CmdSelCancel_Click()
    FrameEnable (True)
End Sub

Private Sub CmdSelect_Click()
    SF = True
    FrameEnable (False)
End Sub

Private Sub CmdSelOk_Click()
    Dim AdoRs1 As New ADODB.Recordset
    Dim i As Long
    Dim SortId As String
    SortId = TreeView1.SelectedItem.Key
    '查本类书上次最大ID
    AdoRs1.Open "select MID=max(id) from bookproperties where id like '" & SortId & "%'", Conn, adOpenKeyset
    '算本次ID
    If Not IsNull(AdoRs1!Mid) Then
        i = Val(Right(AdoRs1!Mid, Len(AdoRs1!Mid) - Len(SortId))) + 1
    Else
        i = 1
    End If
    If SF Then
        txtSort.Text = SortId
        txtID.Text = SortId + Trim(Str(i))
    Else
        txtSort1.Text = SortId
    End If
    FrameEnable (True)
End Sub

Private Sub cmdUpdate_Click()
    Call TxtEdit(False)
    txtTotal.Tag = txtTotal.Text
    mbEditFlag = True
    CmdSelect.Enabled = False
    If Not (Adodc1.Recordset.BOF And Adodc1.Recordset.EOF) Then
       mvBookMark = Adodc1.Recordset.Bookmark
    End If
End Sub


Sub TxtClear()
    '文本框清空
   txtSort.Text = ""
   txtID.Text = ""
   txtTitle.Text = ""
   txtAuthor.Text = ""
   txtISBN.Text = ""
   txtIntro.Text = ""
   txtPage.Text = ""
   txtPrice.Text = ""
   CombCarrier.Text = ""
   txtPublisher.Text = ""
   txtPubDate.Text = ""
   txtAddDate.Text = ""
   txtShelf.Text = ""
End Sub

Sub TxtEdit(flag As Boolean)
    '
    txtTitle.Locked = flag
    txtAuthor.Locked = flag
    txtISBN.Locked = flag
    txtIntro.Locked = flag
    txtPage.Locked = flag
    txtPrice.Locked = flag
    CombCarrier.Locked = flag
    txtPublisher.Locked = flag
    txtPubDate.Locked = flag
    txtAddDate.Locked = flag
    txtShelf.Locked = flag
    txtTotal.Locked = flag
    
    CmdUpdate.Enabled = flag
    cmdDelete.Enabled = flag
    CmdAdd.Enabled = flag
    cmdCancel.Enabled = Not flag
    cmdSave.Enabled = Not flag
    If mbEditFlag Then
        CmdSelect.Enabled = False
    Else
        CmdSelect.Enabled = Not flag
    End If
    cmdClose.Enabled = flag
End Sub






Private Sub Form_Load()
     Dim s As String
    
    '使用本地的SQLOLEDB连接到数据库
     Adodc1.ConnectionString = Connstr
     '  Call TxtClear
     '文本框显示内容不能修改
     Call TxtEdit(True)
     s = "select * from BookProperties "
     s = s & " where adddate='" & Format(Now, "YYYY-MM-DD") & "' Order by ID"
     Adodc1.RecordSource = s
     Adodc1.Refresh
    
    If Adodc1.Recordset.RecordCount = 0 Then
         CmdUpdate.Enabled = False
         cmdDelete.Enabled = False
    Else
         CmdUpdate.Enabled = True
         cmdDelete.Enabled = True
    End If
     
     Set DataGrid1.DataSource = Adodc1
     DataGrid1.Refresh
     FirstEnter = False
         
      '填充图书类别TreeView控件
     Dim AdoRs As New ADODB.Recordset
          
          
     TreeView1.LineStyle = tvwTreeLines '在兄弟节点和父节点之间显示线
     TreeView1.ImageList = ImageList1 '链接图像列
     TreeView1.Style = tvwTreelinesPlusMinusPictureText
    '树状外观包含全部元素
     Dim i As Integer
    '使用非DSN连接到数据库
     Conn.Provider = "sqloledb"
     Conn.ConnectionString = ConnString
     Conn.Open
    AdoRs.Open "select * from  BookSort where datalength(sortcode)=1", Conn, adOpenKeyset
    Do While Not AdoRs.EOF
        ' 建立名称为AdoRs!SortName的父节点,选择索引为1的图像
        Set nodx = TreeView1.Nodes.Add(, , AdoRs!SortCode, AdoRs!sortname, 1)
        AdoRs.MoveNext
    Loop
    AdoRs.Close
    AdoRs.Open "select * from  BookSort where datalength(sortcode)=2", Conn, adOpenKeyset
    Do While Not AdoRs.EOF
        CunZai = False
        For i = 1 To TreeView1.Nodes.Count '检查新输入的父节点名称是否存在
            If Left(AdoRs!SortCode, 1) = TreeView1.Nodes(i).Key Then
                CunZai = True
                Exit For
            End If
        Next i
        If CunZai = True Then '若存在, 则在父节点下建立子节点
          Set nodx = TreeView1.Nodes.Add(Left(AdoRs!SortCode, 1), tvwChild, AdoRs!SortCode, AdoRs!sortname, 1)
        End If
        AdoRs.MoveNext
    Loop
    AdoRs.Close


End Sub

Private Sub OptAll_Click()
    s = "select * from BookProperties  Order by ID"
    Adodc1.RecordSource = s
    Adodc1.Refresh
    If Adodc1.Recordset.RecordCount = 0 Then
         CmdUpdate.Enabled = False
         cmdDelete.Enabled = False
    Else
         CmdUpdate.Enabled = True
         cmdDelete.Enabled = True
    End If
    
End Sub

Sub FrameEnable(flag As Boolean)
    DataGrid1.Enabled = flag
    Frame1.Enabled = flag
    Frame2.Enabled = flag
    Frame3.Enabled = flag
    Frame5.Visible = Not flag
End Sub

Sub InserBookDeatil(BookId As String, BookNum As Integer)
    Dim myConn As New ADODB.Connection
    Dim MyComm As New ADODB.Command
    Dim parm0 As New ADODB.Parameter
    Dim parm1 As New ADODB.Parameter
    parm0.Direction = adParamInput
    parm0.Type = adVarChar
    parm0.Size = 12
    parm1.Direction = adParamInput
    parm1.Type = adSmallInt
    parm0.Value = BookId
    parm1.Value = BookNum
    myConn.Open cnString   '建立连接
    Screen.MousePointer = vbHourglass
    With MyComm
        .ActiveConnection = myConn  '使用连接
        .CommandType = adCmdStoredProc
        .CommandText = "BookBarCreate"
        .Parameters.Append parm0
        .Parameters.Append parm1
        .Execute     '调用存储过程
    End With
    Screen.MousePointer = vbDefault
    myConn.Close
    Exit Sub
ErrorHandle:
   MsgBox Err.Description
   Screen.MousePointer = vbDefault
   myConn.Close
End Sub
 
Function UpdateBookDetail(BookId As String, BookNum As Integer) As Integer
    Dim rs As ADODB.Recordset
    Dim SQL As String
    Dim ms As String
    Dim i As Integer
    If Val(txtTotal.Text) < Val(txtTotal.Tag) Then
        SQL = "select cs=count(*) from bookdetail where ID='" & BookId & "' and status<>'1' "
        Set rs = ExecuteSQL(SQL, ms)
        i = rs!cs
        rs.Close
        If BookNum < i Then
            MsgBox "本书已有" & i & "借出、预约、报损，修改后图书数量不得小于”& i "
            UpdateBookDetail = 0
        Else
            '删除多余书的明细信息
            SQL = " delete from bookdetail where barcode in ( "
            SQL = SQL & " select top " & Val(txtTotal.Tag) - Val(txtTotal.Text) & " barcode from bookdetail "
            SQL = SQL & " where ID='" & BookId & "' order by barcode desc)"
            ExecuteSQL SQL, ms
            UpdateBookDetail = 1
        End If
    Else
        UpdateBookDetail = 1
        '增加书的明细信息
        InserBookDeatil txtID.Text, Val(txtTotal.Text) - Val(txtTotal.Tag)
    End If
End Function