mjwpdf.cls

PDF生成原代码,本原代码解释了如何生成PDF文件!

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "mjwPDF"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_HelpID = 2005
'==============================================================================
' The original source code for this was posted online with no copyright info.
' I have since built upon it and made changes to create the mjwPDF class.
' I now copyright this Matthew West 2008. If you helped contribitute to the
' original source please email me ([e-mail]) and I will give you credit.
'
' This source was included with a tutorial posted at (www.vb6.us). Visit
' this site to see more PDF and other VB tutorials.
'
' This code can be used in any application as long as you notify me
' ([e-mail]).
'==============================================================================

Option Explicit

Private Const mjwPDF = "1.3"
Private Const mjwPDFVersion = "mjwPDF 1.0"

Private wsPathConfig As String
Private wsPathAdobe  As String

Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long

Private Declare Function PostMessage Lib "user32" _
    Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Function FindWindow Lib "user32" _
    Alias "FindWindowA" (ByVal szClass$, ByVal szTitle$) As Long
    Private Const WM_CLOSE = &H10

Private Declare Function PDFReadFile Lib "kernel32" Alias "ReadFile" _
        (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Declare Function PDFCreateFile Lib "kernel32" Alias "CreateFileA" _
        (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _
         ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long

Private Declare Function PDFGetFileSize Lib "kernel32" Alias "GetFileSize" _
        (ByVal hFile As Long, lpFileSizeHigh As Long) As Long

Private Declare Function PDFCloseHandle Lib "kernel32" Alias "CloseHandle" _
        (ByVal hObject As Long) As Long

Private Type oOutlines
    sText      As String
    iLevel     As Integer
    yPos       As Double
    iPageNb    As Integer
    bPrev      As Boolean
    bNext      As Boolean
    bFirst     As Boolean
    bLast      As Boolean
    iFirst     As Integer
    iNext      As Integer
    iPrev      As Integer
    iLast      As Integer
    iParent    As Integer
End Type

Private aOutlines()         As oOutlines
Private iOutlines           As Integer
Private aPage()             As Variant

Private Type PDFRGB
    in_r       As Integer
    in_g       As Integer
    in_b       As Integer
End Type

Private Fso                 As Object
Private Strm                As Object
Private sPDFName            As String

Private Arr_Font()          As Variant

Private in_offset           As Integer
Private in_FontNum          As Integer
Private in_PagesNum         As Integer
Private in_Ech              As Double
Private in_Canvas           As Integer
Private iWidthStr           As Double

Private in_xCurrent         As Double
Private in_yCurrent         As Double

Private ImgWidth            As Double
Private ImgHeight           As Double

Private xlink               As Double
Private yLink               As Double
Private strTLink            As String
Private strTyLink           As String
Private wRect               As Long

Private str_TmpFont         As String

Private PDFTextColor        As String
Private PDFLineColor        As String
Private PDFDrawColor        As String

Private PDFstrTextColor     As String
Private PDFstrLineColor     As String
Private PDFstrDrawColor     As String
Private PDFstrTempColor     As String
Private PDFstrTempAlign     As String
Private PDFstrTempBorder    As String
Private pTempAngle          As Double
Private PDFboTempFill       As Boolean

Private bPageBreak          As Boolean

Private PDFLnStyle          As String
Private PDFLnWidth          As Double

Private PDFDrawMode         As String

Private PDFZoomMode
Private PDFLayoutMode
Private PDFViewerPref
Private bPDFViewerPref      As Boolean
Private bPDFWatermark        As Boolean
Private sPDFWatermark        As String

Private PDFAngle            As Double
Private bAngle              As Double

Private PDFFontName         As String
Private PDFFontSize         As Integer
Private PDFFontNum          As Integer

Private boPDFUnderline      As Boolean
Private boPDFItalic         As Boolean
Private boPDFBold           As Boolean
Private boPDFConfirm        As Boolean
Private boPDFView           As Boolean
Private PDFboThumbs         As Boolean
Private PDFboOutlines       As Boolean
Private PDFboImage          As Boolean

Private PDFlMargin          As Integer ' Left Margin
Private PDFtMargin          As Integer ' Top Margin
Private PDFrMargin          As Integer ' Right Margin
Private PDFbMargin          As Integer ' Bottom Margin
Private PDFcMargin          As Integer ' Center Margin
Private PDFMargin           As Integer

Private FFileName           As String
Private FTitle              As String
Private FPageNumber         As Integer
Private FPageLink           As Integer

Private FOrientation        As String
Private FAuthor             As String
Private FCreator            As String
Private FKeywords           As String
Private FSubject            As String
Private FProducer           As String
Private FFileCompress       As Boolean

Private ParentNum, ContentNum, ResourceNum, FontNum, CatalogNum, _
        FontNumber, CurrentPDFSetPageObject, NumberofImages, iOutlineRoot As Integer

Private PDFCanvasWidth()
Private PDFCanvasHeight()
Private PDFCanvasOrientation()

Private CurrentObjectNum    As Integer
Private ObjectOffset        As Long
Private ObjectOffsetList    As Variant
Private PageNumberList      As Variant
Private PageLinksList(1 To 1000, 1 To 1000) As Variant
Private LinksList           As Variant
Private PageCanvasWidth     As Variant
Private PageCanvasHeight    As Variant
Private FontNumberList      As Variant

Private Type aIMG
    in_1    As Variant
    in_2    As Variant
    in_3    As Variant
    in_4    As Variant
    in_5    As Variant
    in_6    As Variant
    in_7    As Variant
    in_8    As Variant
End Type

Private ArrIMG()            As aIMG

Private boPageLinksList     As Variant
Private NbPageLinksList     As Variant

Private CRCounter           As Long

Private ColorSpace          As String
Private ColorCount          As Byte
Private ImageStream         As String
Private TempStream          As String
Private pTempStream         As String
Private sTempStream         As String
Private cTempStream         As String
Private dTempStream         As String

Private StreamSize1, StreamSize2 As Integer

Private bScanAdobe          As Boolean

Enum PDFStyleLgn
    pPDF_SOLID = 0
    pPDF_DASH = 1
    pPDF_DASHDOT = 2
    pPDF_DASHDOTDOT = 3
End Enum

Enum PDFFontStl
    FONT_NORMAL = 0
    FONT_ITALIC = 1
    FONT_BOLD = 2
    FONT_UNDERLINE = 3
End Enum

Enum PDFFontNme
    FONT_ARIAL = 0
    FONT_COURIER = 1
    FONT_TIMES = 2
    FONT_SYMBOL = 3
    FONT_ZAPFDINGBATS = 4
End Enum

Enum PDFZoomMd
    ZOOM_FULLPAGE = 0
    ZOOM_FULLWIDTH = 1
    ZOOM_REAL = 2
    ZOOM_DEFAULT = 3
End Enum
        
Enum PDFLayoutMd
    LAYOUT_SINGLE = 0
    LAYOUT_CONTINOUS = 1
    LAYOUT_TWO = 2
    LAYOUT_DEFAULT = 3
End Enum
        
Enum PDFUnitStr
    UNIT_PT = 0
    UNIT_MM = 1
    UNIT_CM = 2
End Enum

Enum PDFOrientationStr
    ORIENT_PAYSAGE = 0
    ORIENT_PORTRAIT = 1
End Enum
                
Enum PDFFormatPgStr
    FORMAT_A4 = 0
    FORMAT_A3 = 1
    FORMAT_A5 = 2
    FORMAT_LETTER = 3
    FORMAT_LEGAL = 4
End Enum

Enum PDFDrawMd
    DRAW_NORMAL = 0
    DRAW_DRAW = 1
    DRAW_DRAWBORDER = 2
End Enum

Enum PDFAlignValue
    ALIGN_CENTER = 0
    ALIGN_LEFT = 1
    ALIGN_RIGHT = 2
    ALIGN_FJUSTIFY = 3
End Enum

Enum PDFBorderValue
    BORDER_NONE = 0
    BORDER_ALL = 1
    BORDER_TOP = 2
    BORDER_BOTTOM = 3
    BORDER_LEFT = 4
    BORDER_RIGHT = 5
End Enum

Enum PDFViewerCst
    VIEW_HIDETOOLBAR = 1
    VIEW_HIDEMENUBAR = 2
    VIEW_HIDEWINDOWUI = 3
    VIEW_FITWINDOW = 4
    VIEW_CENTERWINDOW = 5
    VIEW_DISPLAYDOCTITLE = 6
End Enum
Property Let PDFPathConfiguration(sPathConfig As String)

    wsPathConfig = sPathConfig

End Property
Property Let PDFSetViewerPreferences(pViewerPref As PDFViewerCst)

    bPDFViewerPref = True
    PDFViewerPref = pViewerPref
    
End Property
Property Let PDFWatermark(sWatermark As String)

    bPDFWatermark = True
    sPDFWatermark = sWatermark

End Property
Private Sub PDFRotationText(x As Double, y As Double, sText As String, pAngle As Integer)

    PDFSetRotation = pAngle
        PDFTextOut sText, x, y
    PDFSetRotation = 0

End Sub
Private Sub PDFHeader()

Dim dH As Double
Dim dL As Double

    If bPDFWatermark Then
        PDFSetFont FONT_ARIAL, 50, FONT_BOLD
        PDFSetTextColor = Array(255, 192, 203)
        
        dH = (PDFGetPageHeight + PDFGetStringWidth(sPDFWatermark, "", 50) * Sin(45)) / 2.15
        dL = (PDFGetPageWidth - PDFGetStringWidth(sPDFWatermark, "", 50) * Cos(45)) / 2.75
        
        PDFRotationText dL, dH, sPDFWatermark, 45
    End If
    
End Sub
Property Let PDFSetZoomMode(pZoomMode As PDFZoomMd)
Attribute PDFSetZoomMode.VB_HelpID = 2009

    If pZoomMode = ZOOM_FULLPAGE Or pZoomMode = ZOOM_FULLWIDTH Or _
        pZoomMode = ZOOM_REAL Or pZoomMode = ZOOM_DEFAULT Or _
        (IsNumeric(pZoomMode) And (pZoomMode <> ZOOM_FULLPAGE Or _
                                    pZoomMode <> ZOOM_FULLWIDTH Or _
                                    pZoomMode <> ZOOM_REAL Or _
                                    pZoomMode <> ZOOM_DEFAULT)) Then
            If IsNumeric(pZoomMode) Then
                PDFZoomMode = Int(pZoomMode)
            Else
                PDFZoomMode = pZoomMode
            End If
    Else
        MsgBox "Incorrect Zoom Mode : " & pZoomMode & "." & _
                   vbNewLine & _
                   "Focus will be set to full-page zoom", vbCritical, "Zoom Mode - " & mjwPDFVersion
        PDFZoomMode = ZOOM_FULLPAGE
    End If

End Property
Property Get PDFGetZoomMode() As Variant
Attribute PDFGetZoomMode.VB_HelpID = 2010

    PDFGetZoomMode = PDFZoomMode

End Property
Property Let PDFUseThumbs(boThumbs As Boolean)
Attribute PDFUseThumbs.VB_HelpID = 2011

    PDFboThumbs = boThumbs

End Property
Property Let PDFUseOutlines(boOutlines As Boolean)
Attribute PDFUseOutlines.VB_HelpID = 2012

    PDFboOutlines = boOutlines

End Property
Property Let PDFSetLayoutMode(pLayoutMode As PDFLayoutMd)
Attribute PDFSetLayoutMode.VB_HelpID = 2013
    
    If pLayoutMode = LAYOUT_SINGLE Or pLayoutMode = LAYOUT_CONTINOUS Or _
        pLayoutMode = LAYOUT_TWO Or pLayoutMode = LAYOUT_DEFAULT Then
            PDFLayoutMode = pLayoutMode
    Else
        MsgBox "Layout incorrect : " & pLayoutMode & "." & _
                   vbNewLine & _
                   "Layout will be set to simple single page.", vbCritical, "Layout Mode - " & mjwPDFVersion
        PDFLayoutMode = LAYOUT_SINGLE
    End If

End Property