preview.cls

VB做的报表设计源程序,非常不错,可以自定义模版

End Sub

Private Sub m_oForm_GotoPage()
    prvButtonClick PageGoto
End Sub

Private Sub m_oForm_ToolSelected(iToolIndex As Integer)
    Select Case iToolIndex
        Case 0 'Choose printer
            Dim LoPrnSel As clsPrintDialog
            
            Set LoPrnSel = New clsPrintDialog
            With LoPrnSel
                .Min = 1
                .Max = 1000
                .Flags = cdlPDNoPageNums Or cdlPDNoSelection
                '.FromPage = m_oRange.RangeMin
                '.ToPage = m_oRange.RangeMax
                .hWndOwner = m_lContainer
                .ShowPrinter
            End With
        Case 1 'Select pages
            With Pages
                .Selection = InputBox("Enter pages range separated with commas." & vbCrLf & _
                    "(i.e. '1,3-5,7-*'), '*' for all pages.", , .Selection)
                m_oPage_Paint
            End With
    End Select
End Sub

Private Sub m_oPage_DragDrop(Source As Control, X As Single, Y As Single)
    Dim LnDifference As Long
    Dim LnNewValue As Long
    Dim LrPos As POINTAPI
    
    LockWindowUpdate m_oViewPort.hWnd
    m_bLockWndRedraw = True
    GetCursorPos LrPos
    With m_oForm.VScroll1
        If .Enabled Then
            LnDifference = (LrPos.Y - m_rDragPos.Y)
            If (.Max < 0) Then
                LnNewValue = .Value + LnDifference
                If (LnNewValue > .Min) Then
                    LnNewValue = .Min
                ElseIf (LnNewValue < .Max) Then
                    LnNewValue = .Max
                End If
            Else
            End If
            .Value = LnNewValue
        End If
    End With
    With m_oForm.HScroll1
        If .Enabled Then
            LnDifference = (LrPos.X - m_rDragPos.X)
            If (.Max < 0) Then
                LnNewValue = .Value + LnDifference
                If (LnNewValue > .Min) Then
                    LnNewValue = .Min
                ElseIf (LnNewValue < .Max) Then
                    LnNewValue = .Max
                End If
            Else
            End If
            .Value = LnNewValue
        End If
    End With
    m_oPage.Drag vbEndDrag
    m_bDragging = False
    m_bLockWndRedraw = False
    LockWindowUpdate 0
End Sub

Private Sub m_oPage_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If (Button = vbLeftButton) Then
        If m_oPage.MousePointer = vbCustom Then
            GetCursorPos m_rDragPos
            m_oPage.Drag vbBeginDrag
            m_bDragging = True
        End If
    Else
        m_bDragging = False
    End If
End Sub

Private Sub m_oPage_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If m_bDragging Then
        m_oPage_DragDrop m_oPage, X, Y
    End If
End Sub

Private Sub m_oPage_Paint()
    With m_oPage
        If (.Visible And Not (Pages.ActivePage Is Nothing)) Then
            m_oMemDC.BlitImage .hDC, 0, 0, .ScaleWidth, _
                .ScaleHeight, Pages.ActivePage.Enabled
        End If
    End With
End Sub

Private Sub m_oPages_Cleared()
    prvDisableButtons
    m_lPage = 0
    m_oForm.lblPageIndex = "No pages"
    m_oPage.Visible = False
End Sub

Private Sub m_oPages_PageAdded(iCount As Long)
    prvEnableButtons
    m_oForm.lblPageIndex = "Page " & m_lPage & "/" & iCount
End Sub

Private Sub m_oPages_PageSelected(ByVal lPage As Long, lCount As Long)
    Dim LnIdx As Integer
    
    m_lPage = lPage
    m_oPages_PageAdded lCount
    prvBuildPageImage
End Sub

Private Sub m_oPreview_Click()
    If (m_iLastButton > 0) Then
        If Buttons(m_iLastButton).Enabled Then
            prvButtonClick m_iLastButton
        End If
    End If
End Sub

Private Sub m_oPreview_KeyDown(KeyCode As Integer, Shift As Integer)
    'Debug.Print "KeyCode:" & KeyCode
    Select Case KeyCode
        Case 27 ' Escape
            prvButtonClick ClosePreview
        Case 33 ' Page Up
            prvButtonClick PagePrevious
        Case 34 ' Page Down
            prvButtonClick PageNext
        Case 35 ' End
            prvButtonClick PageLast
        Case 36 ' Home
            prvButtonClick PageFirst
    End Select
End Sub

Private Sub m_oPreview_KeyPress(KeyAscii As Integer)
    'Debug.Print "KeyAscii:" & KeyAscii
    Select Case KeyAscii
        Case 43 ' + key
'            If (m_iZoomLevel < [25%]) Then
'                prvSetZoomRatio (m_iZoomLevel - 1)
'            ElseIf (m_iZoomLevel > [25%]) Then
'                prvSetZoomRatio [Full Page]
'            End If
        Case 45 ' - key
'            If (m_iZoomLevel > [100%]) Then
'                prvSetZoomRatio (m_iZoomLevel + 1)
'            ElseIf (m_iZoomLevel > [25%]) Then
'                prvSetZoomRatio [Full Page]
'            End If
    End Select
End Sub

Private Sub m_oPreview_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    m_iLastButton = prvButtonFromPoint(X)
    If (m_iLastButton > 0) Then
        If Buttons(m_iLastButton).Enabled Then
            prvDrawToolbar m_iLastButton, True
        End If
    End If
End Sub

Private Sub m_oPreview_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim LnButton As Integer
    
    LnButton = prvButtonFromPoint(X)
    If (m_iLastButton <> LnButton) Then
        m_iLastButton = LnButton
    End If
    If (m_iLastButton > 0) Then
        m_oPreview.ToolTipText = Buttons(m_iLastButton).ToolTipText
    Else
        m_oPreview.ToolTipText = ""
    End If
End Sub

Private Function prvButtonFromPoint(X As Single) As ButtonIndex
    Dim LnIdx As Integer
    
    For LnIdx = 1 To m_iButtonCount
        If ((X >= Buttons(LnIdx).Left) And (X <= Buttons(LnIdx).Rigth)) Then
            prvButtonFromPoint = LnIdx
            Exit For
        End If
    Next
End Function

Private Sub prvCreateButtons()
    LnTPPX = Screen.TwipsPerPixelX
    prvAddButton "first", "", 0, "First Page", False
    prvAddButton "previous", "", 1, "Previous Page", False
    prvAddButton "goto", "", 2, "Go To Page", False
    prvAddButton "next", "", 3, "Next Page", False
    prvAddButton "last", "", 4, "Last Page", False
    prvAddButton "", "", , "", False, True
    prvAddButton "print", "Print", 7, "Send To Printer", False
    prvAddButton "", "", , "", False, True
    prvAddButton "zoom", "Zoom Level", 6, "Zoom Level", False
    prvAddButton "", "", , "", False, True
    prvAddButton "printer", "", 8, "Select Default Printer"
    prvAddButton "custom", "", 5, "Custom Command", False
    prvAddButton "", "", , "", False, True
    prvAddButton "close", "Close", , "Close Preview"
End Sub

Private Sub prvAddButton(Optional sKey As String, Optional sText As String, _
    Optional iImage As Integer = -1, Optional sTipText As String, _
    Optional bEnabled As Boolean = True, Optional bSeparator As Boolean)
    Static SnLastLeft As Long
    
    m_iButtonCount = m_iButtonCount + 1
    ReDim Preserve Buttons(1 To m_iButtonCount)
    With Buttons(m_iButtonCount)
        .Caption = sText
        .ImageIdx = iImage
        .IsSeparator = bSeparator
        .ToolTipText = sTipText
        .Enabled = bEnabled
        .Key = sKey
        .Left = SnLastLeft
        If .IsSeparator Then
            .Rigth = (.Left + 4)
        ElseIf (.ImageIdx = -1) Then
            .Rigth = (.Left + m_oPreview.TextWidth(sText) + 8)
        Else
            If (Len(sText) = 0) Then
                .Rigth = (.Left + PN_BUTTON_SIDE - 1)
            Else
                .Rigth = (.Left + PN_BUTTON_SIDE + m_oPreview.TextWidth(sText) + 4)
            End If
        End If
        SnLastLeft = (.Rigth + 1)
    End With
End Sub

Private Sub m_oPreview_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    prvDrawToolbar m_iLastButton
End Sub

Private Sub m_oPreview_Paint()
    prvDrawToolbar
End Sub

Private Sub prvDrawToolbar(Optional ByVal iButton As ButtonIndex, _
    Optional bDepressed As Boolean)
    If iButton Then
        Dim LnLTColor As Long
        Dim LnRBColor As Long
        Dim LnOffsetX As Long
        Dim LnOffsetY As Long
        Dim LnBottom As Long
        Dim LnTextW As Single
        
        If bDepressed Then
            LnLTColor = vbButtonShadow
            LnRBColor = vbWindowBackground
            LnOffsetX = 4
            LnOffsetY = 5
        Else
            LnLTColor = vbWindowBackground
            LnRBColor = vbButtonShadow
            LnOffsetX = 3
            LnOffsetY = 4
        End If
        LnBottom = (PN_BUTTON_SIDE - 2) '(LnTPPX * 2))
        With Buttons(iButton)
            If Not .IsSeparator Then
                ' Back
                m_oPreview.Line (.Left, 1)-(.Rigth, LnBottom), vbButtonFace, BF
                ' Top line.
                m_oPreview.Line (.Left, 1)-(.Rigth, 1), LnLTColor
                ' Left line.
                m_oPreview.Line (.Left, 1)-Step(0, LnBottom), LnLTColor
                ' Right line.
                m_oPreview.Line (.Rigth, 1)-Step(0, LnBottom), LnRBColor
                ' Bottom line
                m_oPreview.Line (.Left, LnBottom)-(.Rigth, LnBottom), LnRBColor
                ' Draw image
                m_oImgLst.DrawImage .ImageIdx, m_oPreview.hDC, .Left + LnOffsetX, LnOffsetY, , (Not .Enabled)
                ' Draw caption
                If .Enabled Then
                    m_oPreview.ForeColor = vbBlack
                Else
                    m_oPreview.ForeColor = vbButtonShadow
                End If
                LnTextW = m_oPreview.TextWidth(.Caption)
                m_oPreview.CurrentX = .Left + IIf(.ImageIdx = -1, 4, PN_BUTTON_SIDE) + 1
                If bDepressed Then
                    m_oPreview.CurrentY = 5
                Else
                    m_oPreview.CurrentX = .Left + IIf(.ImageIdx = -1, 4, PN_BUTTON_SIDE)
                    m_oPreview.CurrentY = 4
                End If
                m_oPreview.Print .Caption
            End If
        End With
    Else
        Dim LnIdx As Integer
        
        For LnIdx = 1 To m_iButtonCount
            prvDrawToolbar LnIdx
        Next
    End If
End Sub

Private Sub m_oPreview_Resize()
    prvSetZoomRatio m_iZoomLevel
End Sub

Private Sub m_oViewPort_DragDrop(Source As Control, X As Single, Y As Single)
    If (Source Is m_oPage) Then
        m_oPage_DragDrop m_oPage, 0, 0
    End If
End Sub