frmjhsquery.frm

通用书店管理系统

        
        '标题
        .cqFirstTitle.Content = "还书查询"
        .cqFirstTitle.FontSize = 18
        .cqFirstTitle.FontBold = True
        
        '表前叙述
                   
        .cqSayingAboveTable.Content = "打印于：|" & Format(Date, "yyyy-MM-dd")
        .cqSayingAboveTable.LayOut = "Body align=left cols=3 interwidth=50 |label align=left width=16|text align=left width=20"
        
       sqlstring = "SELECT IntMemberNo, ChrBookNo, ChrBookName, DatJSDate, Datediff('d', DatJSDate,DatTSGHDate),ChrOperator,DatTSGHDate From BooksBorrow " & strQuery(1) & " order by DatTSGHDate desc"
       Set rstmp = New ADODB.Recordset
       rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
         If rstmp.Recordcount > 0 Then
        arr = rstmp.GetRows
       End If
        
        .cqTable.Content = arr
        .cqTable.LayOut = " Format=^80|100|100|100|100|100|100" & _
                          " Header=会员卡号|书号|书名|借书日期|借阅天数|操作员|图书归还日期"
                          
    
            
        '采用传句柄方式
        '.cqTable.Hwnd = Me.grdDetail.Hwnd
    End With
        
    With frm
        Set .PrintInfo = p
        '设置重复打印部分
        Call .setRepeat(cp_RepeatView_All)
        '设置表格填充空行
        '.blnEmptyRow = True
        '设置表格最后行拉伸到满页
        '.blnExtenLastCol = True
        '设置表格自动调整列宽到满页
        .blnColumnForPage = True
        '设置汇总高度，视汇总行数而定
        .SubTotal_Height = 600
        '设置页高、页宽、行高及最大页数
        '.MaxRowsPerPage = 10
        '.Row_Height = 300
        .TopHeader_Height = 1
        .SubTotal_Height = 600
        .ParagraphInterRate = 0.4
        .PrintPaperSize = pprEnv9
        '设置打印信息保存位置
        .strPrintInfoName = "还书查询|" & Me.Caption
        
        .FormStart
        .Show vbModal
    End With
    Exit Sub
  Case "在借书查询"
   With p
        
        '标题
        .cqFirstTitle.Content = "在借书查询"
        .cqFirstTitle.FontSize = 18
        .cqFirstTitle.FontBold = True
        
        '表前叙述
                   
        .cqSayingAboveTable.Content = "打印于：|" & Format(Date, "yyyy-MM-dd")
        .cqSayingAboveTable.LayOut = "Body align=left cols=3 interwidth=50 |label align=left width=16|text align=left width=20"
                
       sqlstring = "SELECT IntMemberNo, ChrBookNo, ChrBookName, DatJSDate, Datediff('d', DatJSDate,now),ChrOperator,DatTSGHDate From BooksBorrow " & strQuery(0) & " order by DatJSDate desc"
       Set rstmp = New ADODB.Recordset
       rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        If rstmp.Recordcount > 0 Then
        arr = rstmp.GetRows
       End If
        
        .cqTable.Content = arr
        .cqTable.LayOut = " Format=^80|100|100|100|100|100" & _
                          " Header=会员卡号|书号|书名|借书日期|借阅天数|操作员"
                          
    
            
        '采用传句柄方式
        '.cqTable.Hwnd = Me.grdDetail.Hwnd
    End With
        
    With frm
        Set .PrintInfo = p
        '设置重复打印部分
        Call .setRepeat(cp_RepeatView_All)
        '设置表格填充空行
        '.blnEmptyRow = True
        '设置表格最后行拉伸到满页
        '.blnExtenLastCol = True
        '设置表格自动调整列宽到满页
        .blnColumnForPage = True
        '设置汇总高度，视汇总行数而定
        .SubTotal_Height = 600
        '设置页高、页宽、行高及最大页数
        '.MaxRowsPerPage = 10
        '.Row_Height = 300
        .TopHeader_Height = 1
        .SubTotal_Height = 600
        .ParagraphInterRate = 0.4
        .PrintPaperSize = pprEnv9
        '设置打印信息保存位置
        .strPrintInfoName = "在借书查询|" & Me.Caption
        
        .FormStart
        .Show vbModal
    End With
    Exit Sub
  End Select
  
err:
    MsgBox "打印出错！"
End Sub





Private Sub cmdSearch_Click(Index As Integer)
  Dim arrQuery
  Dim i As Integer
  
  Select Case Index
    Case 0
      Frame1(0).Visible = True
    Case 1
      Frame1(1).Visible = True
    Case 2
      Frame1(2).Visible = True
    Case 3
        Call g_CommonSelect("  会员卡号  |  姓名  |  级别  |  类型  ", "select IntMemberNo,ChrName,ChrLevel,ChrType from MemberData ", "0,1", , , , -1, arrQuery)
        If TypeName(arrQuery) = "Variant()" Then
              txtFields(0).Text = ""
              For i = 0 To UBound(arrQuery)
                 txtFields(0).Text = txtFields(0).Text & arrQuery(i, 0) & ","
              Next
              txtFields(0).Text = Mid(txtFields(0).Text, 1, Len(txtFields(0).Text) - 1)
        End If
    Case 4 '书号
        Call g_CommonSelect("  书号  |  书名  |  单价  |  折扣  |  供货商  |  出版社  |  出版日期  ", "select chrBookNo,chrBookName,DecPrice,DecAgio,ChrGHS,Chrbookconcern,DatPublishDate" & _
                               " from BookData where chrBookNo like '%" & txtFields(1).Text & "%'", "0,1", , , , -1, arrQuery)
        If TypeName(arrQuery) = "Variant()" Then
              txtFields(1).Text = arrQuery(0, 0)
            
        End If
    Case 5 '书名
        Call g_CommonSelect("  书号  |  书名  |  单价  |  折扣  |  供货商  |  出版社  |  出版日期  ", "select chrBookNo,chrBookName,DecPrice,DecAgio,ChrGHS,Chrbookconcern,DatPublishDate" & _
                               " from BookData where chrBookName like '%" & txtFields(2).Text & "%'", "0,1", , , , -1, arrQuery)
        If TypeName(arrQuery) = "Variant()" Then
              
              txtFields(2).Text = arrQuery(0, 0)
        End If
    Case 6 '书名
        Call g_CommonSelect("  书号  |  书名  |  单价  |  折扣  |  供货商  |  出版社  |  出版日期  ", "select chrBookNo,chrBookName,DecPrice,DecAgio,ChrGHS,Chrbookconcern,DatPublishDate" & _
                               " from BookData where chrBookName like '%" & txtFields(5).Text & "%'", "0,1", , , , -1, arrQuery)
        If TypeName(arrQuery) = "Variant()" Then
              txtFields(5).Text = arrQuery(0, 0)
            
        End If
    Case 7 '书号
        Call g_CommonSelect("  书号  |  书名  |  单价  |  折扣  |  供货商  |  出版社  |  出版日期  ", "select chrBookNo,chrBookName,DecPrice,DecAgio,ChrGHS,Chrbookconcern,DatPublishDate" & _
                               " from BookData where chrBookNo like '%" & txtFields(4).Text & "%'", "0,1", , , , -1, arrQuery)
        If TypeName(arrQuery) = "Variant()" Then
            
              txtFields(4).Text = arrQuery(0, 0)
        End If
    Case 8 '会员卡号
        Call g_CommonSelect("  会员卡号  |  姓名  |  级别  |  类型  ", "select IntMemberNo,ChrName,ChrLevel,ChrType from MemberData ", "0,1", , , , -1, arrQuery)
        If TypeName(arrQuery) = "Variant()" Then
              txtFields(3).Text = ""
              For i = 0 To UBound(arrQuery)
                 txtFields(3).Text = txtFields(3).Text & arrQuery(i, 0) & ","
              Next
              txtFields(3).Text = Mid(txtFields(3).Text, 1, Len(txtFields(3).Text) - 1)
        End If
    Case 9
        Call g_CommonSelect("  会员卡号  |  姓名  |  级别  |  类型  ", "select IntMemberNo,ChrName,ChrLevel,ChrType from MemberData ", "0,1", , , , -1, arrQuery)
        If TypeName(arrQuery) = "Variant()" Then
              txtFields(6).Text = ""
              For i = 0 To UBound(arrQuery)
                 txtFields(6).Text = txtFields(6).Text & arrQuery(i, 0) & ","
              Next
              txtFields(6).Text = Mid(txtFields(6).Text, 1, Len(txtFields(6).Text) - 1)
        End If
    
   
  End Select
End Sub





Private Sub Form_Activate()
  SetToolBar ("0000X00X011X111")
End Sub

Private Sub Form_Load()
  Dim sqlstring As String
  Dim rstmp As New ADODB.Recordset
  Dim rsNewTmp As New ADODB.Recordset
  Dim strFoot As String
  
   dtpDate(0).Value = Format(Date, "yyyy-mm-dd")
  dtpDate(1).Value = Format(Date, "yyyy-mm-dd")
  dtpDate(4).Value = Format(Date, "yyyy-mm-dd")
  dtpDate(5).Value = Format(Date, "yyyy-mm-dd")
  
    Frame1(0).Visible = True
    Frame1(1).Visible = True
    Frame1(2).Visible = True
  
'  '借书查询
'   sqlstring = "SELECT IntMemberNo, ChrBookNo, ChrBookName, DatJSDate, Datediff('d', DatJSDate,now),ChrOperator,DatTSGHDate From BooksBorrow " & strQuery(0) & ""
'  Set rstmp = New ADODB.Recordset
'  rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
'  Set tdbQuery(0).DataSource = rstmp
'
'  Call SetGridheader("会员卡号|书号|书名|借书日期|借阅天数|操作员|图书归还日期", 0, "10|10|28|15|10|20|15", strFoot)
'
'  '还书查询
'  sqlstring = "SELECT IntMemberNo, ChrBookNo, ChrBookName, DatJSDate, Datediff('d', DatJSDate,DatTSGHDate),ChrOperator,DatTSGHDate From BooksBorrow" & strQuery(1) & ""
'  Set rstmp = New ADODB.Recordset
'  rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
'  Set tdbQuery(1).DataSource = rstmp
'
'  Call SetGridheader("会员卡号|书号|书名|借书日期|借阅天数|操作员|图书归还日期", 1, "10|10|28|15|10|20|15", strFoot)
'
'
'  '在借书查询
'  sqlstring = "SELECT IntMemberNo, ChrBookNo, ChrBookName, DatJSDate, Datediff('d', DatJSDate,now),ChrOperator From BooksBorrow " & strQuery(2) & ""
'  Set rstmp = New ADODB.Recordset
'  rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
'  Set tdbQuery(2).DataSource = rstmp
'
'  Call SetGridheader("会员卡号|书号|书名|借书日期|借阅天数|操作员", 2, "10|10|28|15|10|20", strFoot)
'
End Sub

Private Sub Form_Unload(Cancel As Integer)
  SetToolBar ("0000X00X001X111")
End Sub


'设置TDBGRID的列头
Public Sub SetGridheader(ByVal strHeader As String, intNo As Integer, strColWidth As String, strFooter As String)
  On Error Resume Next
  Dim arrHeader() As String
  Dim arrFooter() As String
  Dim arrWidth() As String
  Dim i As Integer
  
  arrHeader = Split(strHeader, "|", -1, vbTextCompare)
  arrWidth = Split(strColWidth, "|", -1, vbTextCompare)
  arrFooter = Split(strFooter, "|", -1, vbTextCompare)
  
  tdbQuery(intNo).FooterForeColor = vbBlue
  
  For i = 0 To UBound(arrHeader)
     tdbQuery(intNo).Columns(i).Caption = arrHeader(i)
     tdbQuery(intNo).Columns(i).FooterText = arrFooter(i)
     Select Case UCase(Mid(tdbQuery(intNo).Columns(i).DataField, 1, 3))
       Case "CHR"
           tdbQuery(intNo).Columns(i).Alignment = dbgCenter
       Case "INT"
           tdbQuery(intNo).Columns(i).Alignment = dbgRight
           tdbQuery(intNo).Columns(i).NumberFormat = "#,##0"
           tdbQuery(intNo).Columns(i).ForeColor = vbBlue
       Case "DEC"
           tdbQuery(intNo).Columns(i).Alignment = dbgRight
           tdbQuery(intNo).Columns(i).NumberFormat = "#,##0.00"
           tdbQuery(intNo).Columns(i).ForeColor = vbRed
       Case "DAT"
           tdbQuery(intNo).Columns(i).Alignment = dbgCenter
           tdbQuery(intNo).Columns(i).NumberFormat = "yyyy-mm-dd"
           tdbQuery(intNo).Columns(i).ForeColor = vbBlue
       Case Else
     End Select

     '自定义宽度
     tdbQuery(intNo).Columns(i).Width = CInt(arrWidth(i) * 100)
  Next i
  
End Sub

Private Sub clearAll()          '清除所有可填数据的位置
    Dim i As Integer
    
    For i = 0 To txtFields.UBound
        Select Case i
          Case 0, 1, 2, 3, 4, 5, 6
              txtFields(i).Text = ""
        End Select
    Next i
    
End Sub



Private Sub txtFields_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        SendKeys "{TAB}"
        Exit Sub
    End If
End Sub