frmqryreport.frm

一套鞋厂的销售管理系统

Public Sub AddImage(ByVal vImage As StdPicture, vBeginPage As String, vEndPage As String, vTop As Long, vLeft As Long, vHeight As Long, vWidth As Long, vHL As String)
    ImageCount = ImageCount + 1
    ReDim Preserve pImage(1 To ImageCount)
    Set pImage(ImageCount) = vImage
    ReDim Preserve ImageGX(1 To 7, 1 To ImageCount)
    ImageGX(1, ImageCount) = vBeginPage
    ImageGX(2, ImageCount) = vEndPage
    ImageGX(3, ImageCount) = vTop
    ImageGX(4, ImageCount) = vLeft
    ImageGX(5, ImageCount) = vHeight
    ImageGX(6, ImageCount) = vWidth
    ImageGX(7, ImageCount) = vHL
End Sub

Public Sub AddSql(ByVal vSql As String, ByVal vHead As String, ByVal vAlignMent As String, ByVal vWidth As String, ByVal vGx As String, ByVal vBorderType As Long)
    If vbRst Then
    Else
        Set RptRst = New ADODB.Recordset
        RptRst.Open vSql, GetConnect, adOpenStatic, adLockReadOnly
        RstGX(1) = vHead
        RstGX(2) = vAlignMent
        RstGX(3) = vWidth
        RstGX(4) = vGx
        RstGX(5) = vBorderType
        vbRst = True
    End If
End Sub

Public Sub AddRst(vRst As ADODB.Recordset, ByVal vHead As String, ByVal vAlignMent As String, ByVal vWidth As String, ByVal vGx As String, ByVal vBorderType As Long)
    If vbRst Then
    Else
        Set RptRst = vRst
        RstGX(1) = vHead
        RstGX(2) = vAlignMent
        RstGX(3) = vWidth
        RstGX(4) = vGx
        RstGX(5) = vBorderType
        vbRst = True
    End If
End Sub

Public Sub AddFZ(ByVal vFzKey As String, ByVal vFzText As String, ByVal vGx As String)
    FZCount = FZCount + 1
    ReDim Preserve FZ(1 To 3, 1 To FZCount)
    FZ(1, FZCount) = vFzKey
    FZ(2, FZCount) = vFzText
    FZ(3, FZCount) = vGx
End Sub

Public Sub AddFlex(vFx As vsFlexGrid)
    Set pGrid = vFx
End Sub

'==================================================================================

Private Function TextDone(ByVal vText As String) As String
    Dim i As Long, j As Long, X As Boolean
    TextDone = ""
    i = Len(vText)
    For j = 1 To i
        If Mid(vText, j, 1) = "^" Then
            If X Then
                X = False
                TextDone = Left(TextDone, Len(TextDone) - 1)
                j = j + 1
                Select Case Mid(vText, j, 1)
                    Case "D"
                        TextDone = TextDone & Date
                    Case "T"
                        TextDone = TextDone & Time
                    Case "P"
                        TextDone = TextDone & "%d"
                    Case "A"
                        TextDone = TextDone & Vp.PageCount
                    Case Else
                End Select
            Else
                X = True
                TextDone = TextDone & Mid(vText, j, 1)
            End If
        Else
            X = False
            TextDone = TextDone & Mid(vText, j, 1)
        End If
    Next
End Function

Private Sub GXDone(vGx As String, Optional vHead As Boolean = False)
    KillString vGx
    Vp.HdrFont.Name = "宋体"
    Vp.Font.Name = "宋体"
    If QuickTranCount > 0 Then
        If QuickTranArray(1) = "" Then
        Else
            If vHead Then
                Vp.HdrFont.Name = QuickTranArray(1)
            Else
                Vp.Font.Name = QuickTranArray(1)
            End If
        End If
    End If
    Vp.HdrFont.Size = 9
    Vp.Font.Size = 9
    If QuickTranCount > 1 Then
        If QuickTranArray(2) = "" Then
        Else
            If vHead Then
                Vp.HdrFont.Size = Val(QuickTranArray(2))
            Else
                Vp.Font.Size = Val(QuickTranArray(2))
            End If
        End If
    End If
    Vp.TextColor = vbBlack
    If QuickTranCount > 2 Then
        If QuickTranArray(3) = "" Then
        Else
            Vp.TextColor = Val(QuickTranArray(3))
        End If
    End If
'    Vp.TextBackColor = vbBlack
'    If QuickTranCount > 3 Then
'        If QuickTranArray(4) = "" Then
'        Else
'            Vp.TextBackColor = Val(QuickTranArray(4))
'        End If
'    End If
    Vp.HdrFont.Underline = False
    Vp.HdrFont.Bold = False
    Vp.HdrFont.Italic = False
    Vp.Font.Underline = False
    Vp.Font.Bold = False
    Vp.Font.Italic = False
    If QuickTranCount > 4 Then
        If Val(QuickTranArray(5)) > 3 Then
            QuickTranArray(5) = Val(QuickTranArray(5)) - 4
            If vHead Then
                Vp.HdrFont.Italic = True
            Else
                Vp.Font.Italic = True
            End If
        End If
        If Val(QuickTranArray(5)) > 1 Then
            QuickTranArray(5) = Val(QuickTranArray(5)) - 2
            If vHead Then
                Vp.HdrFont.Bold = True
            Else
                Vp.Font.Bold = True
            End If
        End If
        If Val(QuickTranArray(5)) > 0 Then
            If vHead Then
                Vp.HdrFont.Underline = True
            Else
                Vp.Font.Underline = True
            End If
        End If
    End If
End Sub

Private Sub CellGXDone(vBeginRow As Long, vEndRow As Long, vBeginCol As Long, vEndCol As Long, vGx As String)
Dim i As Long, j As Long
    KillString vGx
    If QuickTranCount > 0 Then
        If QuickTranArray(1) = "" Then
        Else
            Vp.TableCell(tcFontName, vBeginRow, vBeginCol, vEndRow, vEndCol) = QuickTranArray(1)
        End If
    End If
    If QuickTranCount > 1 Then
        If QuickTranArray(2) = "" Then
        Else
            Vp.TableCell(tcFontSize, vBeginRow, vBeginCol, vEndRow, vEndCol) = QuickTranArray(2)
        End If
    End If
    If QuickTranCount > 2 Then
        If QuickTranArray(3) = "" Then
        Else
            Vp.TableCell(tcForeColor, vBeginRow, vBeginCol, vEndRow, vEndCol) = QuickTranArray(3)
        End If
    End If
    If QuickTranCount > 3 Then
        If QuickTranArray(4) = "" Then
        Else
            Vp.TableCell(tcBackColor, vBeginRow, vBeginCol, vEndRow, vEndCol) = QuickTranArray(4)
        End If
    End If
    If QuickTranCount > 4 Then
        If Val(QuickTranArray(5)) > 3 Then
            QuickTranArray(5) = Val(QuickTranArray(5)) - 4
            Vp.TableCell(tcFontItalic, vBeginRow, vBeginCol, vEndRow, vEndCol) = True
        End If
        If Val(QuickTranArray(5)) > 1 Then
            QuickTranArray(5) = Val(QuickTranArray(5)) - 2
            Vp.TableCell(tcFontBold, vBeginRow, vBeginCol, vEndRow, vEndCol) = True
        End If
        If Val(QuickTranArray(5)) > 0 Then
            Vp.TableCell(tcFontUnderline, vBeginRow, vBeginCol, vEndRow, vEndCol) = True
        End If
    End If
End Sub

Private Sub DoDocument()
Dim i As Integer, j As Integer, FzSum() As String, s As String, k As Integer, c As Long
Dim s1 As String, s2 As String, s3 As String
Dim TblFzKey() As String, TblFzText() As String, vHZ() As Boolean
Vp.StartDoc
    Vp.PageBorder = pbColTopBottom
    
    For j = 1 To GXCount
        If GX(1, j) = "Top" Then
            GXDone GX(4, j), False
            Select Case GX(2, j)
                Case "C"
                    Vp.TextAlign = taCenterMiddle
                Case "R"
                    Vp.TextAlign = taRightMiddle
                Case Else
                    Vp.TextAlign = taLeftMiddle
            End Select
            Vp = TextDone(GX(3, j))
        End If
    Next
    
    
    
    s1 = ""
    s2 = ""
    j = 0
    For i = 1 To pGrid.Cols - 1
        If pGrid.ColWidth(i) > 100 Then
            j = j + pGrid.ColWidth(i)
            s2 = s2 & pGrid.Cell(flexcpText, 0, i) & "|"
        End If
    Next
    s2 = Left(s2, Len(s2) - 1) & ";"
    For i = 1 To pGrid.Cols - 1
        If pGrid.ColWidth(i) > 100 Then
            Select Case pGrid.ColAlignment(i)
                Case flexAlignCenterBottom, flexAlignCenterCenter, flexAlignCenterTop, flexAlignGeneral
                    s1 = s1 & "^"
                Case flexAlignLeftBottom, flexAlignLeftCenter, flexAlignLeftTop
                    s1 = s1 & "<"
                Case flexAlignRightBottom, flexAlignRightCenter, flexAlignRightTop
                    s1 = s1 & ">"
            End Select
            s1 = s1 & pGrid.ColWidth(i) / j * (Vp.PageWidth - Vp.MarginLeft - Vp.MarginRight) / 1440 & "in|"
        End If
    Next
    s1 = Left(s1, Len(s1) - 1) & ";"
    Vp.StartTable
    Vp.AddTable s1, s2, ""
    For i = 1 To pGrid.Rows - 1
        s3 = ""
        For j = 1 To pGrid.Cols - 1
            If pGrid.ColWidth(j) > 100 Then
                s3 = s3 & pGrid.Cell(flexcpTextDisplay, i, j) & "|"
            End If
        Next
        s3 = Left(s3, Len(s3) - 1) & ";"
        Vp.AddTable "", "", s3
    Next
    Vp.EndTable
    
    
    
    For j = 1 To GXCount
        If GX(1, j) = "Bottom" Then
            GXDone GX(4, j), False
            Select Case GX(2, j)
                Case "C"
                    Vp.TextAlign = taCenterMiddle
                Case "R"
                    Vp.TextAlign = taRightMiddle
                Case Else
                    Vp.TextAlign = taLeftMiddle
            End Select
            Vp = TextDone(GX(3, j))
        End If
    Next
    
    For j = 1 To GXCount
        If GX(1, j) = "Head" Then
            GXDone GX(4, j), True
            For i = 1 To Vp.PageCount
                Vp.StartOverlay i
                Vp.Header = TextDone(GX(3, j))
            Next
        End If
        If GX(1, j) = "Foot" Then
            GXDone GX(4, j), True
            For i = 1 To Vp.PageCount
                Vp.StartOverlay i
                Vp.Footer = TextDone(GX(3, j))
            Next
        End If
    Next

Vp.EndDoc
    scrlPage.Max = Vp.PageCount
    scrlPage.Value = Vp.PreviewPage
    scrlPage_Change
    Me.PageBegin = "1"
    Me.PageEnd = Vp.PageCount
End Sub

Private Sub cmbPercent_Click()
    Vp.Zoom = Val(cmbPercent.List(cmbPercent.ListIndex))
End Sub

Private Sub cmbZoomMode_Click()
    If cmbZoomMode.ListIndex = 0 Then
        cmbPercent_Click
        Me.cmbPercent.Enabled = True
    Else
        Me.cmbPercent.Enabled = False
        Vp.ZoomMode = cmbZoomMode.ListIndex
    End If
End Sub

Private Sub cmdFirst_Click()
    If scrlPage.Value > scrlPage.Min Then scrlPage.Value = scrlPage.Min