35.txt

图书管理系统源码 Microsoft Visual Basic6.0提供了开发Microsoft Windows应用程序的最迅速、最简捷的方法。”Visual”的意思是“可视化程序设计”

Private Sub txtItem_GotFocus(Index As Integer)
    txtItem(Index).SelStart = 0
    txtItem(Index).SelLength = Len(txtItem(Index))
    
End Sub

Private Sub txtItem_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
        EnterToTab KeyCode

End Sub
Private Function GetRkno() As String
    GetRkno = Format(Now, "yymmddhhmmss")
    Randomize
    GetRkno = GetRkno & Int((99 - 10 + 1) * Rnd + 10)
End Function

书籍查询信息：
Option Explicit
'用于传递查询块

Private Sub chkItem_Click(Index As Integer)
    If Index = 0 Then
        txtItem(0).SetFocus
    ElseIf Index = 1 Then
        txtItem(1).SetFocus
    ElseIf Index = 3 Then
        txtItem(2).SetFocus
    
    Else
        cboItem(0).SetFocus
    End If
End Sub

Private Sub cmdExit_Click()
   Unload Me
End Sub

Private Sub cmdOK_Click()
    Dim sQSql As String
    
    
    If chkItem(0).Value = vbChecked Then
        sQSql = " bookname = '" & Trim(txtItem(0) & " ") & "'"
    End If
    
    If chkItem(1).Value = vbChecked Then
        If Trim(sQSql & " ") = "" Then
            sQSql = " booktype ='" & Trim(cboItem(0) & " ") & "'"
        Else
            sQSql = sQSql & " and booktype ='" & Trim(cboItem(0) & " ") & "'"
        End If
    End If
    
    If chkItem(2).Value = vbChecked Then
        If Trim(sQSql & " ") = "" Then
            sQSql = " bookauthor ='" & Trim(txtItem(1) & " ") & "'"
        Else
            sQSql = sQSql & " and bookauthor ='" & Trim(txtItem(1) & " ") & "'"
        End If
    End If
    
    If chkItem(3).Value = vbChecked Then
        If Trim(sQSql & " ") = "" Then
            sQSql = " bookpub ='" & Trim(txtItem(2) & " ") & "'"
        Else
            sQSql = sQSql & " and bookpub ='" & Trim(txtItem(2) & " ") & "'"
        End If
    End If
    
    
    If Trim(sQSql) = "" Then
        MsgBox "请设置查询条件！", vbOKOnly + vbExclamation, "警告"
        Exit Sub
    Else
        If flagBedit Then
            Unload frmBook
        End If
        frmBook.txtSQL = "select * from books where" & sQSql
        frmBook.Show
    End If
   Unload Me
End Sub

Private Sub Form_Load()
    
    
    Dim i As Integer
    Dim j As Integer
    Dim sSql As String
    Dim txtSQL As String
    Dim MsgText As String
    Dim mrc As ADODB.Recordset
    
  
    '初始化物资名称
        txtSQL = "select DISTINCT typename from booktype"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        
        If Not mrc.EOF Then
            
                Do While Not mrc.EOF
                    cboItem(0).AddItem Trim(mrc.Fields(0))
                    mrc.MoveNext
                Loop
                cboItem(0).ListIndex = 0
            
        Else
            MsgBox "请先进行书籍类别设置！", vbOKOnly + vbExclamation, "警告"
            
            Exit Sub
        End If
        mrc.Close
End Sub

Private Sub lblitem_Click(Index As Integer)
    chkItem(Index).Value = vbChecked
    
End Sub

Private Sub txtItem_GotFocus(Index As Integer)
   
    txtItem(Index).SelStart = 0
    txtItem(Index).SelLength = Len(txtItem(Index))
End Sub

书籍类别列表：
Option Explicit
Dim mrc As ADODB.Recordset
Dim MsgText As String
Public txtSQL As String

Private Sub Form_Load()
   
    ShowTitle
    ShowData
    flagBTedit = True
End Sub

Private Sub Form_Resize()
    If Me.WindowState <> vbMinimized And fMainForm.WindowState <> vbMinimized Then
        '边界处理
        If Me.ScaleHeight < 10 * lblTitle.Height Then
            
            Exit Sub
        End If
        If Me.ScaleWidth < lblTitle.Width + lblTitle.Width / 2 Then
            
            Exit Sub
        End If
        '控制控件的位置
                
        lblTitle.Top = lblTitle.Height
        lblTitle.Left = (Me.Width - lblTitle.Width) / 2
        
        msgList.Top = lblTitle.Top + lblTitle.Height + lblTitle.Height / 2
        msgList.Width = Me.ScaleWidth - 200
        msgList.Left = Me.ScaleLeft + 100
        msgList.Height = Me.ScaleHeight - msgList.Top - 200
    End If
End Sub

Public Sub FormClose()
    Unload Me
End Sub

'删除记录

Private Sub Form_Unload(Cancel As Integer)
    flagBTedit = False
    gintBTmode = 0
End Sub

'显示Grid的内容

Private Sub ShowData()
        Dim i As Integer
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        With msgList
        .Rows = 1
        
        Do While Not mrc.EOF
            .Rows = .Rows + 1
            For i = 1 To mrc.Fields.Count
                Select Case mrc.Fields(i - 1).Type
                    Case adDBDate
                        .TextMatrix(.Rows - 1, i) = Format(mrc.Fields(i - 1) & "", "yyyy-mm-dd")
                    Case Else
                        .TextMatrix(.Rows - 1, i) = mrc.Fields(i - 1) & ""
                End Select
            Next i
            mrc.MoveNext
        Loop
       
    End With
    mrc.Close
End Sub


'显示Grid表头
Private Sub ShowTitle()
    Dim i As Integer
    
    With msgList
        .Cols = 5
        .TextMatrix(0, 1) = "类别编号"
        .TextMatrix(0, 2) = "类别名称"
        .TextMatrix(0, 3) = "关键词"
        .TextMatrix(0, 4) = "备注信息"
       
        
        '固定表头
        .FixedRows = 1
                
        '设置各列的对齐方式
        For i = 0 To 4
            .ColAlignment(i) = 0
        Next i
        
        '表头项居中
        .FillStyle = flexFillRepeat
        .Col = 0
        .Row = 0
        .RowSel = 1
        .ColSel = .Cols - 1
        .CellAlignment = 4
        
        '设置单元大小
        .ColWidth(0) = 300
        .ColWidth(1) = 1000
        .ColWidth(2) = 1000
        .ColWidth(3) = 1000
        .ColWidth(4) = 1000
        
        .Row = 1
    End With
End Sub

Private Sub msgList_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    '右键弹出
    If Button = 2 And Shift = 0 Then
        PopupMenu fMainForm.menuBooktype
    End If
    
    
End Sub

书籍类别：
Option Explicit
'是否改动过记录，ture为改过
Dim mblChange As Boolean
Dim mrc As ADODB.Recordset
Public txtSQL As String

Private Sub cmdExit_Click()
    If mblChange And cmdSave.Enabled Then
        If MsgBox("保存当前记录的变化吗？", vbOKCancel + vbExclamation, "警告") = vbOK Then
            '保存
            Call cmdSave_Click
        End If
    End If
    Unload Me
End Sub

Private Sub cmdSave_Click()
    
    Dim intCount As Integer
    Dim sMeg As String
    Dim MsgText As String
    
  
    For intCount = 0 To 3
        If Trim(txtItem(intCount) & " ") = "" Then
            Select Case intCount
                Case 0
                    sMeg = "类别编号"
                Case 1
                    sMeg = "类别名称"
                Case 2
                    sMeg = "关键词"
                Case 3
                    sMeg = "备注信息"
                
            End Select
            sMeg = sMeg & "不能为空！"
            MsgBox sMeg, vbOKOnly + vbExclamation, "警告"
            txtItem(intCount).SetFocus
        
            Exit Sub
        End If
    Next intCount
   
    '添加判断是否有相同的ID记录
    If gintBTmode = 1 Then
        txtSQL = "select * from booktype where booktypeno = '" & Trim(txtItem(0)) & "'"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        If mrc.EOF = False Then
            MsgBox "已经存在此类别编号的记录！", vbOKOnly + vbExclamation, "警告"
            txtItem(0).SetFocus
            Exit Sub
        End If
        mrc.Close
    End If
    
    '判断是否有相同内容的记录
    txtSQL = "select * from booktype where booktypeno <>'" & Trim(txtItem(0)) & "' and typename='" & Trim(txtItem(1)) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    If mrc.EOF = False Then
        MsgBox "已经存在相同书籍类别的记录！", vbOKOnly + vbExclamation, "警告"
        txtItem(1).SetFocus
        Exit Sub
    End If
    
    '先删除已有记录
    If gintBTmode = 2 Then
        txtSQL = "delete from booktype where booktypeno ='" & Trim(txtItem(0)) & "'"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
   End If
    
    '再加入新记录
    txtSQL = "select * from booktype"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    mrc.AddNew
           
    For intCount = 0 To 3
        mrc.Fields(intCount) = Trim(txtItem(intCount))
    Next intCount
    
    mrc.Update
    mrc.Close
    
    If gintBTmode = 1 Then
        MsgBox "添加记录成功！", vbOKOnly + vbExclamation, "添加记录"
        For intCount = 0 To 3
            txtItem(intCount) = ""
        Next intCount
        
        mblChange = False
        If flagBTedit Then
            Unload frmBooktype
            frmBooktype.txtSQL = "select * from booktype"
            frmBooktype.Show
        End If
    ElseIf gintBTmode = 2 Then
        Unload Me
        If flagBTedit Then
            Unload frmBooktype
        End If
        frmBooktype.txtSQL = "select * from booktype"
        frmBooktype.Show
    End If
    

End Sub

Private Sub Form_Load()
    
    Dim intCount As Integer
    Dim MsgText As String
    Dim i As Integer
  
    If gintBTmode = 1 Then
        Me.Caption = Me.Caption & "添加"
        
    ElseIf gintBTmode = 2 Then
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        
        If mrc.EOF = False Then
            With mrc
                For intCount = 0 To 3
                    txtItem(intCount) = .Fields(intCount)
                Next intCount
                
            End With
            txtItem(0).Enabled = False
        End If
        
        Me.Caption = Me.Caption & "修改"
    End If
    
    mblChange = False

End Sub

Private Sub Form_Unload(Cancel As Integer)
    gintBTmode = 0
End Sub

Private Sub txtItem_Change(Index As Integer)
    '有变化设置gblchange
    mblChange = True
End Sub

Private Sub txtItem_GotFocus(Index As Integer)
    txtItem(Index).SelStart = 0
    txtItem(Index).SelLength = Len(txtItem(Index))
End Sub

Private Sub txtItem_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    EnterToTab KeyCode
End Sub

借书信息：
Option Explicit
'是否改动过记录，ture为改过
Dim mblChange As Boolean
Dim mrc As ADODB.Recordset
Public txtSQL As String
Dim bookNUM As Integer


Private Sub cboItem_Change(Index As Integer)
    '有变化设置gblchange
    
    mblChange = True
    
End Sub

Private Sub cboItem_Click(Index As Integer)
    Dim mrcc As ADODB.Recordset
    Dim mrcd As ADODB.Recordset
    Dim intCount As Integer
    Dim MsgText As String
    
    If gintBOmode = 1 Then
        If Index = 1 Then
            cboItem(0).Clear
            txtSQL = "select distinct bookname from books where booktype = '" & Trim(cboItem(1)) & "'"
            Set mrcc = ExecuteSQL(txtSQL, MsgText)
            
            If Not mrcc.EOF Then
                Do While Not mrcc.EOF
                    cboItem(0).AddItem mrcc.Fields(0)
                    mrcc.MoveNext
                Loop
            End If
            cboItem(0).ListIndex = 0
            mrcc.Close
        ElseIf Index = 0 Then
            If Trim(cboItem(0)) = "" Then
                MsgBox "请首先选择书籍种类！", vbOKOnly + vbExclamation, "警告"
                cboItem(1).SetFocus
                Exit Sub
            Else
                txtSQL = "select * from books where bookname = '" & Trim(cboItem(0)) & "'"
                Set mrcd = ExecuteSQL(txtSQL, MsgText)
                
                If Not mrcd.EOF Then