preview.cls

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

Public Property Let Container(LhWnd As Long)
    If (LhWnd = m_lContainer) Then
        AdjustClient
    Else
        If (LhWnd = 0) Then
            Call SetParent(m_oPreview.hWnd, m_oForm.hWnd)
            Buttons(ClosePreview).Enabled = True
        Else
            If IsWindowLocal(LhWnd) Then
                m_lOldParent = SetParent(m_oPreview.hWnd, LhWnd)
            Else
                Me.RaiseErr ecNoExternalWindow, "Container[Let]"
            End If
        End If
        m_lContainer = GetParent(m_oPreview.hWnd)
        Buttons(ClosePreview).Enabled = (m_lContainer = m_oForm.hWnd)
        AdjustClient
    End If
End Property

Public Property Get Container() As Long
    Container = m_lContainer
End Property

Private Sub prvButtonClick(iButton As ButtonIndex)
    Select Case iButton
        Case [Print Pages]
            PrintPages
        Case PageFirst, PagePrevious, PageNext, PageLast, PageGoto
            prvNavigateTo iButton
        Case ZoomPreview, PreviewTools
            Dim LrPoint As POINTAPI
        
            With LrPoint
                .X = Buttons(iButton).Left
                .Y = PN_BUTTON_SIDE
            End With
            ClientToScreen m_lContainer, LrPoint
            ScreenToClient m_oForm.hWnd, LrPoint
            With m_oForm
                If (iButton = ZoomPreview) Then
                    .PopupMenu .mnuZoom, , LrPoint.X, LrPoint.Y
                ElseIf (iButton = PreviewTools) Then
                    .PopupMenu .mnuTools, , LrPoint.X, LrPoint.Y
                Else
                    .PopupMenu .mnuExport, , LrPoint.X, LrPoint.Y
                End If
            End With
        Case CustomCommand
            RaiseEvent UserCommand
        Case ClosePreview
            m_oForm.Hide
            'Unload m_oForm
    End Select
End Sub

Private Sub prvLoadImages()
    Dim LnIdx As Integer
    
    With m_oImgLst
        .Create m_oForm.picImages.hDC, Size16
        .Clear
        For LnIdx = 0 To 12
            .AddFromPictureBox m_oForm.picImages.hDC, m_oForm.picImages, (LnIdx * 16)
        Next
        'Debug.Print .ImageCount & " Images."
    End With
End Sub

Private Sub prvNavigateTo(iAction As ButtonIndex)
    Select Case iAction
        Case PageFirst, PagePrevious, PageNext, PageLast
            m_oPages.NavigateTo iAction
        Case PageGoto
            Dim LsPrompt As String
            
            If (m_oPages.Count = 0) Then
                Buttons(PageGoto).Enabled = False
                prvDrawToolbar PageGoto
                LsPrompt = "There are not created pages yet"
                MsgBox LsPrompt, vbOKOnly Or vbInformation
            Else
                Dim LnPage As Long
                
                LsPrompt = "Please enter the page number you want to go to" & vbCrLf & _
                    "(a valid number between 1 to " & m_oPages.Count & ")"
                LnPage = Val(InputBox(LsPrompt, "ActiveReporter"))
                m_oPages.SelectPage LnPage
            End If
    End Select
End Sub

Private Sub prvSetZoomRatio(ByVal iRatio As ZoomRatio)
    If (m_oPages.Count = 0) Then Exit Sub
    Dim LnZoomRatio As Single
    Dim LrPage As RECT
    Dim LrClient As RECT
    Dim LnCurFlag As Byte
    
    GetClientRect m_oViewPort.hWnd, LrClient
    InflateRect LrClient, -4, -4
    OffsetRect LrClient, -(LrClient.Left), -(LrClient.Top)
    m_iZoomLevel = iRatio
    Select Case m_iZoomLevel
        Case [100%]
            LnZoomRatio = 1
        Case [75%]
            LnZoomRatio = 0.75
        Case [50%]
            LnZoomRatio = 0.5
        Case [25%]
            LnZoomRatio = 0.25
        Case [Page Width]
            LnZoomRatio = (LrClient.Right / m_lPageWidth)
        Case [Full Page]
            Dim LnCRatio As Single
            Dim LnPRatio As Single
            
            With LrClient
                LnCRatio = (.Bottom / .Right)
                'In case preview is being destroyed
                If ((m_lPageHeight = 0) Or (m_lPageWidth = 0)) Then
                    prvBuildPageImage
                    Exit Sub
                End If
                LnPRatio = (m_lPageHeight / m_lPageWidth)
                If (LnCRatio > LnPRatio) Then
                    LnZoomRatio = (LrClient.Right / m_lPageWidth)
                Else
                    LnZoomRatio = (LrClient.Bottom / m_lPageHeight)
                End If
            End With
        Case [Custom Ratio]
            Dim LnUsrRatio As Single
            
            LnUsrRatio = Val(InputBox("Enter a zoom ratio between 10 and 100"))
            If ((LnUsrRatio < 10) Or (LnUsrRatio > 100)) Then
                Exit Sub
            Else
                LnZoomRatio = (LnUsrRatio / 100)
                m_iZoomLevel = LnUsrRatio
            End If
        Case [Hide Page]
            m_oPage.Visible = False
            m_oForm.VScroll1.Enabled = False
            m_oForm.HScroll1.Enabled = False
            Buttons(ZoomPreview).Caption = "Zoom Level"
            prvDrawToolbar ZoomPreview
            Exit Sub
        Case Else
            LnZoomRatio = (m_iZoomLevel / 100)
    End Select
    If (LnZoomRatio < 0.1) Then
        LnZoomRatio = 0.1
    End If
    Buttons(ZoomPreview).Caption = Format(LnZoomRatio, "##0.0#%")
    prvDrawToolbar ZoomPreview
    m_oPage.MousePointer = vbDefault
    With LrPage
        .Right = (m_lPageWidth * LnZoomRatio)
        .Bottom = (m_lPageHeight * LnZoomRatio)
        If (.Right > LrClient.Right) Then
            .Left = 4
            With m_oForm.HScroll1
                .Enabled = True
                .Min = 4
                .Max = (LrClient.Right - LrPage.Right)
                .LargeChange = LrPage.Bottom
                .SmallChange = (.LargeChange / 5)
                m_oPage.MousePointer = vbCustom
                m_bLockWndRedraw = True
                .Value = .Min
                LnCurFlag = 1
            End With
        Else
            .Left = ((LrClient.Right - .Right) / 2) + 4
            m_oForm.HScroll1.Enabled = False
        End If
        If (.Bottom > LrClient.Bottom) Then
            .Top = 4
            With m_oForm.VScroll1
                .Enabled = True
                .Min = 4
                .Max = (LrClient.Bottom - LrPage.Bottom)
                .LargeChange = LrPage.Right
                .SmallChange = (.LargeChange / 5)
                m_oPage.MousePointer = vbCustom
                m_bLockWndRedraw = True
                .Value = .Min
                LnCurFlag = LnCurFlag Or 2
            End With
        Else
            .Top = ((LrClient.Bottom - .Bottom) / 2) + 4
            m_oForm.VScroll1.Enabled = False
        End If
    End With
    Select Case LnCurFlag
        Case 1 ' Horizontal only
            m_oPage.DragIcon = LoadResPicture(HandClosedLeftRight, vbResCursor)
        Case 2 ' Vertical only
            m_oPage.DragIcon = LoadResPicture(HandClosedUpDown, vbResCursor)
        Case 3 ' Both
            m_oPage.DragIcon = LoadResPicture(HandClosedArrows, vbResCursor)
    End Select
    LockWindowUpdate m_oViewPort.hWnd
    With LrPage
        MoveWindow m_oPageBack.hWnd, .Left + 5, .Top + 5, .Right, .Bottom, True
        MoveWindow m_oPage.hWnd, .Left, .Top, .Right, .Bottom, True
    End With
    With m_oPage
        .Visible = True
        m_oMemDC.BlitImage .hDC, 0, 0, .ScaleWidth, .ScaleHeight, .Enabled
    End With
    m_oPageBack.Visible = True
    If (Not m_bLockRedraw) Then
        LockWindowUpdate 0
        m_bLockWndRedraw = False
    End If
End Sub

Friend Sub AdjustClient()
    Dim LrRect As RECT
    
    GetClientRect m_lContainer, LrRect
    With LrRect
        OffsetRect LrRect, (-.Left), (-.Top)
        MoveWindow m_oPreview.hWnd, 0, 0, .Right, .Bottom, True
    End With
    prvSetZoomRatio m_iZoomLevel
End Sub

Public Sub SetCustomCommand(sCaption As String)
    With Buttons(CustomCommand)
        .Enabled = (Len(sCaption) > 0)
        If .Enabled Then
            .ToolTipText = sCaption
        Else
            .ToolTipText = "Custom Command"
        End If
    End With
    prvDrawToolbar CustomCommand
End Sub

Public Sub Show()
    With m_oPages
        .FontMap.Create
        If (.Count > 0) Then
            .SelectPage 1
            m_bLockRedraw = False
            prvBuildPageImage
            prvSetZoomRatio [Full Page]
        End If
    End With
    If (m_lContainer = m_oForm.hWnd) Then
        Buttons(ZoomPreview).Caption = "Zoom Level"
        m_oForm.Start
    End If
End Sub

Public Sub PrintPages()
'////////////////////////////////////////////
'/// Send output to printer...
'////////////////////////////////////////////
    If (Printers.Count = 0) Then
        Me.RaiseErr ecNoPrintersDefined, "PrintPages"
    Else
        Dim LoPage As Page
        RaiseEvent Printing
        #If USE_LOG_FONT Then
        ' Recreates LOG_FONT objects to match with printer resolution
        Printer.Print ""
        m_oPages.FontMap.Create Printer.hDC
        Printer.KillDoc
        #End If
        For Each LoPage In m_oPages
            LoPage.PrintIt
        Next LoPage
        Printer.EndDoc
        #If USE_LOG_FONT Then
        ' Restores the LOG_FONT objects for screen usage
        m_oPages.FontMap.Create
        #End If
        RaiseEvent Done(arPrinter)
    End If
End Sub

Private Sub Class_Initialize()
    m_iPageSize = 1
    Set m_oPages = New Pages
    Set m_oPages.Parent = Me
    m_iZoomLevel = [Full Page]
    Set m_oMemDC = New clsMemDC
    Set m_oImgLst = New clsImageList
    prvLoadForm
    prvCreateButtons
    prvLoadImages
    
End Sub

Private Sub Class_Terminate()
    prvUnloadForm
End Sub

Private Sub m_oForm_ChangeZoomRatio(iRatioIndex As Integer)
    prvSetZoomRatio iRatioIndex
End Sub

Private Sub m_oForm_DoScroll(lValue As Long, bVertical As Boolean)
    Dim LrPage As RECT
    Dim LrPoint As POINTAPI
    
    GetWindowRect m_oPage.hWnd, LrPage
    ScreenToClient m_oViewPort.hWnd, LrPoint
    OffsetRect LrPage, LrPoint.X, LrPoint.Y
    LockWindowUpdate m_oViewPort.hWnd
'    Call SendMessage(m_oViewPort.hwnd, WM_SETREDRAW, False, 0)
    If bVertical Then
        With LrPage
            MoveWindow m_oPage.hWnd, .Left, lValue, (.Right - .Left), (.Bottom - .Top), True
        End With
    Else
        With LrPage
            MoveWindow m_oPage.hWnd, lValue, .Top, (.Right - .Left), (.Bottom - .Top), True
        End With
    End If
'    Call SendMessage(m_oViewPort.hwnd, WM_SETREDRAW, True, 0)
    If Not m_bLockWndRedraw Then LockWindowUpdate 0