bookmange.frm

图书管理系统．一个具有多功能的图书馆里系统

      FormatString    =   "图书编号|图书名称|类别编号|图书类别|图书作者|图书价格|出版社|出版时间|入库时间|是否借出|借出时间|读者姓名|备注"
      RowSizingMode   =   1
      _NumberOfBands  =   1
      _Band(0).Cols   =   13
      _Band(0).GridLineWidthBand=   1
      _Band(0).TextStyleBand=   0
   End
End
Attribute VB_Name = "BookMange"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' 数据绑定变量
Dim WithEvents adoPrimaryRS As Recordset
Attribute adoPrimaryRS.VB_VarHelpID = -1
Private Const MARGIN_SIZE = 60      ' 单位为缇
' 能列排序变量
Private m_iSortCol As Integer
Private m_iSortType As Integer

' 列拖拽变量
Private m_bDragOK As Boolean
Private m_iDragCol As Integer
Private xdn As Integer, ydn As Integer
Private Sub Data_Conn()
  On Error GoTo DataErr
  Dim sSql As String
  sSql = "select 图书编号,图书名称,类别编号,图书类别,图书作者,图书价格,出版社,出版时间,入库时间,是否借出,借出时间,读者姓名,备注 from books Order by 图书编号"
  Set adoPrimaryRS = New Recordset
  adoPrimaryRS.Open sSql, tsdata.db, adOpenStatic, adLockOptimistic

    Set MSHFlexGrid1.DataSource = adoPrimaryRS
   
    With MSHFlexGrid1
        .Redraw = False
        ' 设置网格列宽度
        .ColWidth(0) = -1
        .ColWidth(1) = -1
        .ColWidth(2) = -1
        .ColWidth(3) = -1
        .ColWidth(4) = -1
        .ColWidth(5) = -1
        .ColWidth(6) = -1
        .ColWidth(7) = -1
        .ColWidth(8) = -1
        .ColWidth(9) = -1
        .ColWidth(10) = -1
        .ColWidth(11) = -1
        .ColWidth(12) = -1
        ' 设置网格样式
        .AllowBigSelection = True
        .FillStyle = flexFillRepeat
        ' 将标头作成粗体
        .Row = 0
        .Col = 0
        .RowSel = .FixedRows - 1
        .ColSel = .Cols - 1
        .CellFontBold = True
        .AllowBigSelection = False
        .FillStyle = flexFillSingle
        .Redraw = True
       ' .FormatString = "图书编号|图书名称|类别编号|图书类别|图书作者|图书价格|出版社|出版时间|入库时间|是否借出|借出时间|读者姓名|备注"
    End With
      Exit Sub
DataErr:
      MsgBox Err.Description
End Sub
Private Sub Look_Conn(i As Integer)  '图书查询
    '1-全部未借图书 2-全部借出 3-今日入库 4-全部
    On Error GoTo ErrLook
    Dim Nums As Integer
    Dim sSql As String
    Dim sSQL1 As String, sSQL2 As String, sSQL3 As String, sSQL4 As String
    Dim datP As New Recordset
    ' 设置字符串
    sSQL1 = "select 图书编号,图书名称,类别编号,图书类别,图书作者,图书价格,出版社,出版时间,入库时间,是否借出,借出时间,读者姓名,备注 from books where 是否借出=false Order by 图书编号"
    sSQL2 = "select 图书编号,图书名称,类别编号,图书类别,图书作者,图书价格,出版社,出版时间,入库时间,是否借出,借出时间,读者姓名,备注 from books where 是否借出=true Order by 图书编号"
    sSQL3 = "select 图书编号,图书名称,类别编号,图书类别,图书作者,图书价格,出版社,出版时间,入库时间,是否借出,借出时间,读者姓名,备注 from books where 入库时间=" & Date & " Order by 图书编号"
    sSQL4 = "select 图书编号,图书名称,类别编号,图书类别,图书作者,图书价格,出版社,出版时间,入库时间,是否借出,借出时间,读者姓名,备注 from books Order by 图书编号"

    ' 打开连接

Select Case i
  Case 1
    sSql = sSQL1
  Case 2
    sSql = sSQL2
   Case 3
    sSql = sSQL3
  Case 4
    sSql = sSQL4
  End Select
    ' 使用提供的集合创建 recordset
   ' Set datP = New Recordset
    datP.CursorLocation = adUseClient
    datP.Open sSql, tsdata.db, adOpenForwardOnly, adLockReadOnly
    Set MSHFlexGrid1.DataSource = datP
    Sbar.Panels(2).Text = 0: Sbar.Panels(4).Text = 0: Sbar.Panels(6).Text = 0
     Sbar.Panels(2).Text = datP.RecordCount
    For Nums = 0 To datP.RecordCount - 1
      Sbar.Panels(4).Text = Sbar.Panels(4).Text + datP.Fields(5)
      If datP.Fields(9) = True Then Sbar.Panels(6).Text = Sbar.Panels(6).Text + 1
      datP.MoveNext
    Next
    Set datP = Nothing
      Exit Sub
ErrLook:
   MsgBox Err.Description
End Sub
Private Sub Condi_Conn(i As Integer)  '条件查询
    '1-按图书编号 2-按图书类别 3-按图书名称 4-按借阅人
    On Error GoTo ErrCondi
    Dim sSql As String
    Dim sSQL1 As String, sSQL2 As String, sSQL3 As String, sSQL4 As String
    ' 设置字符串
    sSQL1 = "select 图书编号,图书名称,类别编号,图书类别,图书作者,图书价格,出版社,出版时间,入库时间,是否借出,借出时间,读者姓名,备注 from books where 图书编号=" & Text1 & " Order by 图书编号"
    sSQL2 = "select 图书编号,图书名称,类别编号,图书类别,图书作者,图书价格,出版社,出版时间,入库时间,是否借出,借出时间,读者姓名,备注 from books where 图书名称='" & Text1 & "' Order by 图书编号"
    sSQL3 = "select 图书编号,图书名称,类别编号,图书类别,图书作者,图书价格,出版社,出版时间,入库时间,是否借出,借出时间,读者姓名,备注 from books where 图书类别='" & Text1 & "' Order by 图书编号"
    sSQL4 = "select 图书编号,图书名称,类别编号,图书类别,图书作者,图书价格,出版社,出版时间,入库时间,是否借出,借出时间,读者姓名,备注 from books where 读者姓名='" & Text1 & "' Order by 图书编号"
    ' 打开连接
  Select Case i
  Case 1
    sSql = sSQL1
  Case 2
    sSql = sSQL2
   Case 3
    sSql = sSQL3
  Case 4
    sSql = sSQL4
  End Select
    ' 使用提供的集合创建 recordset
    Set datP = New Recordset
    datP.CursorLocation = adUseClient
    datP.Open sSql, tsdata.db, adOpenForwardOnly, adLockReadOnly
    Set MSHFlexGrid1.DataSource = datP
    
    Sbar.Panels(2).Text = 0: Sbar.Panels(4).Text = 0: Sbar.Panels(6).Text = 0
     Sbar.Panels(2).Text = datP.RecordCount
    For Nums = 0 To datP.RecordCount - 1
      Sbar.Panels(4).Text = Sbar.Panels(4).Text + datP.Fields(5)
      If datP.Fields(9) = True Then Sbar.Panels(6).Text = Sbar.Panels(6).Text + 1
      datP.MoveNext
    Next
    Text1 = ""
    Set datP = Nothing
      Exit Sub
ErrCondi:
  MsgBox Err.Description
End Sub
Private Sub cmdAdd_Click()
AddBook.Show
End Sub
Private Sub CmdDele_Click()
On Error GoTo DeleteErr
  With adoPrimaryRS
    .Delete
    .MoveNext
    If .EOF Then .MoveLast
   End With
   Data_Conn
  Exit Sub
DeleteErr:
  MsgBox Err.Description
End Sub
Private Sub CmdExit_Click()
Unload Me
End Sub
Private Sub CmdLook_Click()
 If Text1.Text = "" Then
   MsgBox "请输入你的查询条件!", vbOKOnly, "提醒"
   Exit Sub
End If
 If Option1(0).Value = True Then
    Condi_Conn 1
   ElseIf Option1(1).Value = True Then
    Condi_Conn 2
   ElseIf Option1(2).Value = True Then
    Condi_Conn 3
   ElseIf Option1(3).Value = True Then
    Condi_Conn 4
 End If
End Sub
Private Sub Command1_Click()
Look_Conn 4
End Sub
Private Sub Command2_Click()
Look_Conn 2
End Sub
Private Sub Command3_Click()
Look_Conn 1
End Sub
Private Sub Command4_Click()
Look_Conn 3
End Sub
Private Sub Form_Load()
Data_Conn
End Sub
Private Sub MSHFlexGrid1_DragDrop(Source As Control, X As Single, Y As Single)
'-------------------------------------------------------------------------------------------
' 网格中 DragDrop, MouseDown, MouseMove, 和 MouseUp 事件代码能进行列拖拽
'-------------------------------------------------------------------------------------------
    If m_iDragCol = -1 Then Exit Sub    ' 现在不能拖拽
    If MSHFlexGrid1.MouseRow <> 0 Then Exit Sub
    With MSHFlexGrid1
        .Redraw = False
        .ColPosition(m_iDragCol) = .MouseCol
        .Redraw = True
    End With
End Sub
Private Sub MSHFlexGrid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'-------------------------------------------------------------------------------------------
' 网格中 DragDrop, MouseDown, MouseMove, 和 MouseUp 事件代码能进行列拖拽
'-------------------------------------------------------------------------------------------
    If MSHFlexGrid1.MouseRow <> 0 Then Exit Sub
    xdn = X
    ydn = Y
    m_iDragCol = -1     ' 清除拖拽标志
    m_bDragOK = True
End Sub
Private Sub MSHFlexGrid1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'-------------------------------------------------------------------------------------------
' 网格中 DragDrop, MouseDown, MouseMove, 和 MouseUp 事件代码能进行列拖拽
'-------------------------------------------------------------------------------------------
    ' 测试是否能够开始拖拽
    If Not m_bDragOK Then Exit Sub
    If Button <> 1 Then Exit Sub                        ' 错误按钮
    If m_iDragCol <> -1 Then Exit Sub                   ' 已经开始拖拽
    If Abs(xdn - X) + Abs(ydn - Y) < 50 Then Exit Sub   ' 移得不够
    If MSHFlexGrid1.MouseRow <> 0 Then Exit Sub         ' 必须拖拽标头
    ' 如果到达这则开始拖拽
    m_iDragCol = MSHFlexGrid1.MouseCol
    MSHFlexGrid1.Drag vbBeginDrag
End Sub
Private Sub MSHFlexGrid1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'-------------------------------------------------------------------------------------------
' 网格中 DragDrop, MouseDown, MouseMove, 和 MouseUp 事件代码能进行列拖拽
'-------------------------------------------------------------------------------------------
    m_bDragOK = False
End Sub
Private Sub MSHFlexGrid1_DblClick()
'-------------------------------------------------------------------------------------------
' 网格的 DblClick 事件代码能进行列排序
'-------------------------------------------------------------------------------------------
    Dim i As Integer
    ' 仅在单击固定行时进行排序
    If MSHFlexGrid1.MouseRow >= MSHFlexGrid1.FixedRows Then Exit Sub
    i = m_iSortCol                  ' 保存旧列
    m_iSortCol = MSHFlexGrid1.Col   ' 设置新列
    ' 递增排序类型
    If i <> m_iSortCol Then
        ' 如果在新的列上单击鼠标，开始升序排序
        m_iSortType = 1
    Else
        ' 如果在相同列单击鼠标，则进行升序和降序排序的转换。
        m_iSortType = m_iSortType + 1
    If m_iSortType = 3 Then m_iSortType = 1
    End If
    DoColumnSort
End Sub
Sub DoColumnSort()
'-------------------------------------------------------------------------------------------
' 作 Exchange-type 排序在列 m_iSortCol
'------------------------------------------------------------------------------------------
    With MSHFlexGrid1
        .Redraw = False
        .Row = 1
        .RowSel = .Rows - 1
        .Col = m_iSortCol
        .Sort = m_iSortType
        .Redraw = True
    End With
End Sub