frmkcfx.frm

来自「通用书店管理系统」· FRM 代码 · 共 1,479 行 · 第 1/5 页

        
        '表前叙述
                   
        .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"
                

       If Trim(strQuery(0)) <> "" Then
    
            sqlstring = "SELECT t1.ChrBookNo, t1.ChrBookName, t1.DecPrice, t1.DecAgio,t1.ChrCB, t1.IntBagCount, sum(t1.IntAmount) " & _
                        "FROM OutstorageInformation t2 left JOIN OutstorageInformation_List t1 ON t2.ChrCKDH = t1.ChrCKDH  " & strQuery(2) & "  group by t1.ChrBookNo, " & _
                        "t1.ChrBookName, t1.DecPrice, t1.DecAgio,t1.ChrCB, t1.IntBagCount order by sum(t1.IntAmount) desc"
      Else

            sqlstring = "SELECT t1.ChrBookNo, t1.ChrBookName, t1.DecPrice, t1.DecAgio,t1.ChrCB, t1.IntBagCount, sum(t1.IntAmount) " & _
                        "FROM OutstorageInformation t2 left JOIN OutstorageInformation_List t1 ON t2.ChrCKDH = t1.ChrCKDH group by t1.ChrBookNo, " & _
                        "t1.ChrBookName, t1.DecPrice, t1.DecAgio,t1.ChrCB, t1.IntBagCount order by sum(t1.IntAmount) desc"

      End If
       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;#,##0.00|100;#,##0.00|100|100;#,##0|100;#,##0" & _
                          " Header=书号|书名|单价|折扣|册/包|包数|出库数量" & _
                          " Subtotal=2\页总计\1\6\6\1\#,##0\2-1\1;1\总计\1\6\6\1\#,##0\2-1\2;" & _
                                   "2\页总计\1\7\7\1\#,##0\2-1\1;1\总计\1\7\7\1\#,##0\2-1\2"
        
        '采用传句柄方式
        '.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 If
err:
    MsgBox "打印出错！"
End Sub

Private Sub cmdSearch_Click(Index As Integer)
'  Dim arrQuery
'  Dim i As Integer
'
'  Select Case Index
'    Case 0 '书号
'        Call g_CommonSelect("  书号  |  书名  |  单价  |  折扣  |  出版日期  ", "select chrBookNo,chrBookName,DecPrice,DecAgio,DatPublishDate" & _
'                               " from BookData where chrBookNo like '%" & txtFields(0).Text & "%'", "0,1", , , , -1, arrQuery)
'        If TypeName(arrQuery) = "Variant()" Then
'              txtFields(0).Text = arrQuery(0, 0)
'
'        End If
'    Case 1 '书名
'        Call g_CommonSelect("  书号  |  书名  |  单价  |  折扣  |  出版日期  ", "select chrBookNo,chrBookName,DecPrice,DecAgio,DatPublishDate" & _
'                               " from BookData where chrBookName like '%" & txtFields(1).Text & "%'", "0,1", , , , -1, arrQuery)
'        If TypeName(arrQuery) = "Variant()" Then
'              txtFields(1).Text = arrQuery(0, 1)
'
'        End If
'  End Select
End Sub

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

Private Sub Form_Load()
  Dim File As Node
  Dim Recordcount As Integer
  Dim strNo As String
  Dim sqlstring As String
  Dim rstmp As New ADODB.Recordset

  On Error Resume Next
  
  dtpDate(0).Value = Format(Date, "yyyy-mm-dd")
  dtpDate(1).Value = Format(Date, "yyyy-mm-dd")
  dtpDate(2).Value = Format(Date, "yyyy-mm-dd")
  dtpDate(3).Value = Format(Date, "yyyy-mm-dd")
  dtpDate(4).Value = Format(Date, "yyyy-mm-dd")
  
  
    '图书类型
   sqlstring = "select * from BookType order by ChrBookTypeNo"
   Set rstmp = New ADODB.Recordset
   rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
   cmbFields(1).Text = "保险"
   Do While Not rstmp.EOF
      cmbFields(1).AddItem rstmp.Fields("ChrBookType")
      rstmp.MoveNext
   Loop
   
    X.ReDim 0, -1, 0, 1
    Set TdbStorage.Array = X

    X.ReDim 0, -1, 0, 9
    Set tdbInStorage.Array = X

    X.ReDim 0, -1, 0, 6
    Set tdbOutStorage.Array = X

'  Frame1.Visible = True
  
End Sub

Private Sub Option1_Click(Index As Integer)
Select Case Index
  Case 0
     If Option1(0).Value = True Then
'        Frame1.Visible = True
        Frame2.Visible = True
        Frame3.Visible = False
        Frame4.Visible = False
        TdbStorage.Visible = True
        tdbInStorage.Visible = False
        tdbOutStorage.Visible = False
        Call clearAll
     End If
  Case 1
     If Option1(1).Value = True Then
'        Frame1.Visible = True
        Frame3.Visible = True
        Frame2.Visible = False
        Frame4.Visible = False
        tdbInStorage.Visible = True
        TdbStorage.Visible = False
        tdbOutStorage.Visible = False
        Call clearAll
    End If
  Case 2
    If Option1(2).Value = True Then
'       Frame1.Visible = True
       Frame4.Visible = True
       Frame2.Visible = False
       Frame3.Visible = False
       tdbOutStorage.Visible = True
       TdbStorage.Visible = False
       tdbInStorage.Visible = False
       Call clearAll
    End If
End Select

End Sub



'显示指定的制品记录
Private Function ShowExpRecord(ByVal rstmp As ADODB.Recordset, intFlag As Integer) As Boolean    'True for success
    On Error Resume Next
    Dim i As Integer
    Dim strSQL As String
    Dim intRow, intCol As Integer
    Dim Index As Integer
    
    ShowExpRecord = False
    

If Option1(0).Value = True Then
    If rstmp.EOF Then
        MsgBox "没有该图书、文具类型的记录", vbOKOnly, "警告"
    End If
    
   
    X.ReDim 0, rstmp.Recordcount - 1, 0, 1
    
    rstmp.MoveFirst
    intRow = 0
    Do While Not rstmp.EOF
        For intCol = 0 To 1

             X(intRow, intCol) = IIf(IsNull(rstmp.Fields(intCol).Value), "", rstmp.Fields(intCol).Value)
             
        Next intCol
        rstmp.MoveNext
        intRow = intRow + 1
    Loop
    
    TdbStorage.ReBind
    
    gUpperBound = X.UpperBound(1)
    
    DoEvents
    ShowExpRecord = True
End If

If Option1(1).Value = True Then
        If rstmp.EOF Then
             MsgBox "没有该图书、文具类型的记录", vbOKOnly, "警告"
    End If
    
   
    X.ReDim 0, rstmp.Recordcount - 1, 0, 9
    
    rstmp.MoveFirst
    intRow = 0
    Do While Not rstmp.EOF
        For intCol = 0 To 9

             X(intRow, intCol) = IIf(IsNull(rstmp.Fields(intCol).Value), "", rstmp.Fields(intCol).Value)
             
        Next intCol
        rstmp.MoveNext
        intRow = intRow + 1
    Loop
    
    tdbInStorage.ReBind
    
    gUpperBound = X.UpperBound(1)
    
    DoEvents
    ShowExpRecord = True
End If

If Option1(2).Value = True Then
    If rstmp.EOF Then
        MsgBox "没有该图书、文具类型的记录", vbOKOnly, "警告"
    End If
    
   
    X.ReDim 0, rstmp.Recordcount - 1, 0, 6
    
    rstmp.MoveFirst
    intRow = 0
    Do While Not rstmp.EOF
        For intCol = 0 To 6

             X(intRow, intCol) = IIf(IsNull(rstmp.Fields(intCol).Value), "", rstmp.Fields(intCol).Value)
             
        Next intCol
        rstmp.MoveNext
        intRow = intRow + 1
    Loop
    
    tdbOutStorage.ReBind
    
    gUpperBound = X.UpperBound(1)
    
    DoEvents
    ShowExpRecord = True
End If

End Function


Private Sub clearAll()          '清除所有可填数据的位置
    Dim i As Integer
    dtpDate(0).Value = Format(Date, "yyyy-mm-dd")
    dtpDate(1).Value = Format(Date, "yyyy-mm-dd")
    dtpDate(2).Value = Format(Date, "yyyy-mm-dd")
    dtpDate(3).Value = Format(Date, "yyyy-mm-dd")
    dtpDate(4).Value = Format(Date, "yyyy-mm-dd")

    tdbInStorage.Columns(6).FooterText = ""
    tdbInStorage.Columns(7).FooterText = ""
      

     X.ReDim 0, -1, 0, 1
    TdbStorage.ReBind

    X.ReDim 0, -1, 0, 7
    tdbInStorage.ReBind

    X.ReDim 0, -1, 0, 6
    tdbOutStorage.ReBind
    
End Sub


Privat