frmqryreport.frm

一套鞋厂的销售管理系统

    scrlPage_Change
End Sub

Private Sub cmdGoto_Click()
    On Error GoTo err_1
    Dim mGoto As Long
    
    
    With Vp
    
        mGoto = InputBox("请录入要移至的页数", "", Vp.PreviewPage)
        If mGoto > Vp.PageCount Or mGoto < 0 Then Exit Sub
        
        scrlPage.Value = mGoto
        scrlPage_Change
    
    End With
    
err_1:
    Exit Sub
    
End Sub

Private Sub cmdLast_Click()
    If scrlPage.Value < scrlPage.Max Then scrlPage.Value = scrlPage.Max
    scrlPage_Change
End Sub

Private Sub CmdLoadSet_Click()
    Vp.PaperSize = GetSetting(App.Title, Vp.DocName, "PaperSize", Vp.PaperSize)
    If Vp.PaperSize = 256 Then
        Vp.PaperWidth = GetSetting(App.Title, Vp.DocName, "PaperWidth ", Vp.PaperWidth)
        Vp.PaperWidth = GetSetting(App.Title, Vp.DocName, "PaperHeight ", Vp.PaperHeight)
    End If
    Vp.MarginTop = GetSetting(App.Title, Vp.DocName, "MarginTop", Vp.MarginTop)
    Vp.MarginBottom = GetSetting(App.Title, Vp.DocName, "MarginBottom", Vp.MarginBottom)
    Vp.MarginLeft = GetSetting(App.Title, Vp.DocName, "MarginLeft", Vp.MarginLeft)
    Vp.MarginRight = GetSetting(App.Title, Vp.DocName, "MarginRight", Vp.MarginRight)
    Vp.Orientation = GetSetting(App.Title, Vp.DocName, "Orientation", Vp.Orientation)
    DoDocument
    'Vp.Orientation = orPortrait
'    rptPurchase.Printer.DeviceName = GetSetting("Purchase", "RptPurchase", "Printer", rptPurchase.Printer.DeviceName)
'    rptPurchase.Printer.PaperSize = GetSetting("Purchase", "RptPurchase", "PaperSize", rptPurchase.Printer.PaperSize)
End Sub

Private Sub cmdNext_Click()
    If scrlPage.Value < scrlPage.Max Then scrlPage.Value = scrlPage.Value + 1
    scrlPage_Change
End Sub

Private Sub cmdPageSetup_Click()
    
    Vp.PrintDialog pdPageSetup
    
    '------------------------------------------------------------
    ' refresh document
    '------------------------------------------------------------
    DoDocument

End Sub

Private Sub cmdPrevious_Click()
    If scrlPage.Value > scrlPage.Min Then scrlPage.Value = scrlPage.Value - 1
    scrlPage_Change
End Sub

Private Sub cmdPrint_Click()
    On Error Resume Next
    If Vp.PageCount > 0 Then Vp.PrintDoc , Val(Me.PageBegin), Val(Me.PageEnd)
    
    
End Sub

Private Sub cmdPrinterSetup_Click()
    
    Vp.PrintDialog pdPrinterSetup
    
    ' refresh document
    DoDocument

End Sub

Private Sub CmdSaveSet_Click()
    SaveSetting App.Title, Vp.DocName, "PaperSize", Vp.PaperSize
    If Vp.PaperSize = 256 Then
        SaveSetting App.Title, Vp.DocName, "PaperWidth", Vp.PaperWidth
        SaveSetting App.Title, Vp.DocName, "PaperHeight", Vp.PaperHeight
    End If
    SaveSetting App.Title, Vp.DocName, "MarginTop", Vp.MarginTop
    SaveSetting App.Title, Vp.DocName, "MarginBottom", Vp.MarginBottom
    SaveSetting App.Title, Vp.DocName, "MarginLeft", Vp.MarginLeft
    SaveSetting App.Title, Vp.DocName, "MarginRight", Vp.MarginRight
    SaveSetting App.Title, Vp.DocName, "Orientation", Vp.Orientation
    
End Sub

Private Sub Form_Activate()
    cmbPercent.ListIndex = 0
    cmbZoomMode.ListIndex = 3
    CmdLoadSet_Click
    DoDocument
End Sub

Private Sub Form_Load()
    Vp.DocName = "XT Print"
    cmbZoomMode.AddItem "Percentage"
    cmbZoomMode.AddItem "Thumbnail"
    cmbZoomMode.AddItem "TwoPages"
    cmbZoomMode.AddItem "WholePage"
    cmbZoomMode.AddItem "PageWidth"
    cmbZoomMode.AddItem "Stretch"
    cmbPercent.AddItem "25%"
    cmbPercent.AddItem "50"
    cmbPercent.AddItem "75"
    cmbPercent.AddItem "100"
    cmbPercent.AddItem "150"
    cmbPercent.AddItem "200"
    cmbPercent.AddItem "400"

End Sub

Private Sub Form_Resize()
    If Me.Height < Me.cmdPrint.Top + Me.cmdPrint.Height Then
        Vp.Height = Me.cmdPrint.Top + Me.cmdPrint.Height - 500
    Else
        Vp.Height = Me.Height - 500
    End If
    If Me.Width < Me.Vp.Left * 2 Then
        Me.Vp.Width = Me.Vp.Left
    Else
        Me.Vp.Width = Me.Width - Me.Vp.Left - 150
    End If
End Sub

Private Sub PageBegin_LostFocus()
    On Error GoTo err_1
        Me.PageBegin = Val(Me.PageBegin)
        If Val(Me.PageBegin) > Val(Me.PageEnd) Then
            Me.PageBegin = Val(Me.PageEnd)
        End If
        If Val(Me.PageBegin) < 1 Then Me.PageBegin = 1
        Exit Sub
err_1:
        Me.PageBegin = "1"
End Sub

Private Sub PageEnd_LostFocus()
    On Error GoTo err_1
        Me.PageEnd = Val(Me.PageEnd)
        If Val(Me.PageEnd) < Val(Me.PageBegin) Then
            Me.PageEnd = Val(Me.PageBegin)
        End If
        If Val(Me.PageEnd) > scrlPage.Max Then Me.PageEnd = scrlPage.Max
        Exit Sub
err_1:
        Me.PageEnd = Me.scrlPage.Max
End Sub

Private Sub scrlPage_Change()
    Vp.PreviewPage = scrlPage.Value
    lblPage.Caption = Vp.PreviewPage & " of " & Vp.PageCount
End Sub

'    If vbRst Then
'        If FZCount > 0 Then ReDim FzSum(1 To RptRst.Fields.Count, 1 To FZCount)
'        Vp.StartTable
'            ReDim fmt(1 To RptRst.Fields.Count)
'            KillString RstGX(2)
'            For i = 1 To RptRst.Fields.Count
'                If i <= QuickTranCount Then
'                    Select Case QuickTranArray(i)
'                        Case "C"
'                            fmt(i) = "^"
'                        Case "R"
'                            fmt(i) = ">"
'                        Case Else
'                            fmt(i) = "<"
'                    End Select
'                Else
'                    fmt(i) = "<"
'                End If
'            Next
'            KillString RstGX(3)
'            For i = 1 To RptRst.Fields.Count
'                If i <= QuickTranCount Then
'                    fmt(i) = fmt(i) & "+" & QuickTranArray(i) & "in"
'                Else
'                    fmt(i) = fmt(i) & "+0in"
'                End If
'            Next
'            s = ""
'            For i = 1 To RptRst.Fields.Count
'                s = s & fmt(i) & "|"
'            Next
'            s = Left(s, Len(s) - 1)
'            GXDone RstGX(4)
'            Vp.AddTable s, Left(RstGX(1), Len(RstGX(1)) - 1) & ";", ""
'            If RstGX(5) >= 0 And RstGX(5) < 11 Then
'                Vp.TableBorder = RstGX(5) ' tbColTopBottom
'            Else
'                Vp.TableBorder = 0 ' tbColTopBottom
'            End If
'
'            RptRst.MoveFirst
'            If FZCount > 0 Then
'                ReDim TblFzKey(1 To RptRst.Fields.Count, 1 To FZCount)
'                ReDim TblFzText(1 To RptRst.Fields.Count, 1 To FZCount)
'                ReDim FzSum(1 To RptRst.Fields.Count, 1 To FZCount)
'                ReDim vHZ(1 To FZCount)
'                For k = 1 To FZCount
'                    KillString FZ(1, k)
'                    For i = 1 To RptRst.Fields.Count
'                        If i <= QuickTranCount Then
'                            TblFzKey(i, k) = QuickTranArray(i)
'                            Select Case TblFzKey(i, k)
'                                Case 1, 2
'                                    FzSum(i, k) = RptRst.Fields(i - 1).Value
'                                Case 3
'                                    FzSum(i, k) = 0
'                                Case Else
'                                    FzSum(i, k) = TblFzKey(i, k)
'                            End Select
'                        Else
'                            TblFzKey(i, k) = 0
'                            FzSum(i, k) = 0
'                        End If
'                    Next
'                    KillString FZ(2, k)
'                    For i = 1 To RptRst.Fields.Count
'                        TblFzText(i, k) = QuickTranArray(i)
'                    Next
'                    vHZ(k) = False
'                Next
'            End If
'            c = 0
'            Do Until RptRst.EOF
'                For k = 1 To FZCount
'                    For i = 1 To RptRst.Fields.Count
'                        On Error GoTo err_1
'                        If TblFzKey(i, k) = "1" Then
'                            If FzSum(i, k) <> RptRst.Fields(i - 1).Value Then
'                                vHZ(k) = True
'                                Exit For
'                            End If
'                        End If
'err_1:
'                        On Error GoTo 0
'                    Next
'                    If vHZ(k) Then
'                        vHZ(k) = False
'                        s = ""
'                        For j = 1 To RptRst.Fields.Count
'                            Select Case TblFzKey(j, k)
'                                Case 1
'                                    s = s & TblFzText(j, k) & "|"
'                                    FzSum(j, k) = RptRst.Fields(j - 1).Value
'                                Case 2
'                                    s = s & FzSum(j, k) & "|"
'                                    FzSum(j, k) = RptRst.Fields(j - 1).Value
'                                Case 3
'                                    s = s & FzSum(j, k) & "|"
'                                    FzSum(j, k) = 0
'                                Case Else
'                                    s = s & TblFzText(j, k) & "|"
'                            End Select
'                        Next
'                        s = Left(s, Len(s) - 1) & ";"
'                        Vp.AddTable "", "", s
'                        c = c + 1
'                        CellGXDone c, c, 1, RptRst.Fields.Count, FZ(3, k)
'                    End If
'                Next
'                s = ""
'                For i = 1 To RptRst.Fields.Count
'                    s = s & RptRst.Fields(i - 1).Value & "|"
''                    For j = 1 To RptRst.Fields.Count
'                    For k = 1 To FZCount
'                        If TblFzKey(i, k) = "3" Then FzSum(i, k) = Val(FzSum(i, k)) + Val(RptRst.Fields(i - 1).Value)
'                    Next
' '                   Next
'                Next
'                s = Left(s, Len(s) - 1)
'                Vp.AddTable "", "", s
'                c = c + 1
''                CellGXDone c, c, 1, RptRst.Fields.Count, FZ(3, k)
'                RptRst.MoveNext
'            Loop
'            For k = 1 To FZCount
'                s = ""
'                For j = 1 To RptRst.Fields.Count
'                    Select Case TblFzKey(j, k)
'                        Case 1
'                            s = s & TblFzText(j, k) & "|"
'                        Case 2
'                            s = s & FzSum(j, k) & "|"
'                        Case 3
'                            s = s & FzSum(j, k) & "|"
'                        Case Else
'                            s = s & TblFzText(j, k) & "|"
'                    End Select
'                Next
'                s = Left(s, Len(s) - 1) & ";"
'                Vp.AddTable "", "", s
'                c = c + 1
'                CellGXDone c, c, 1, RptRst.Fields.Count, FZ(3, k)
'                KillString FZ(3, k)
'
'            Next
''-----------------------------------------------
'            KillString RstGX(4)
'            If QuickTranCount > 2 Then
'                Vp.TableCell(tcForeColor, 0, 1, 0, RptRst.Fields.Count) = QuickTranArray(3)
'            End If
'            If QuickTranCount > 3 Then
'                Vp.TableCell(tcBackColor, 0, 1, 0, RptRst.Fields.Count) = QuickTranArray(4)
'            End If
'        Vp.EndTable
'    End If
'