#INCLUDE ONCE "gdiplus.inc"

' Supported Font Families

%FONT_ARIAL                         = 1
%FONT_TIMESNEWROMAN                 = 2

' Font Attributes

%PDF_FONT_NORMAL                    = 1
%PDF_FONT_BOLD                      = 2
%PDF_FONT_ITALIC                    = 3
%PDF_FONT_BOLDITALIC                = 4

%FONT_UNDERLINE                     = 1

' Paper sizes

%PDF_PAPER_A0                       = 1
%PDF_PAPER_A1                       = 2
%PDF_PAPER_A2                       = 3
%PDF_PAPER_A3                       = 4
%PDF_PAPER_A4                       = 5
%PDF_PAPER_A5                       = 6
%PDF_PAPER_A6                       = 7
%PDF_PAPER_A7                       = 8
%PDF_PAPER_A8                       = 9
%PDF_PAPER_B0                       = 10
%PDF_PAPER_B1                       = 11
%PDF_PAPER_B2                       = 12
%PDF_PAPER_B3                       = 13
%PDF_PAPER_B4                       = 14
%PDF_PAPER_B5                       = 15
%PDF_PAPER_B6                       = 16
%PDF_PAPER_B7                       = 17
%PDF_PAPER_B8                       = 18
%PDF_PAPER_B9                       = 19
%PDF_PAPER_B10                      = 20
%PDF_PAPER_C2                       = 21
%PDF_PAPER_C3                       = 22
%PDF_PAPER_C4                       = 23
%PDF_PAPER_C5                       = 24
%PDF_PAPER_C6                       = 25
%PDF_PAPER_LETTER                   = 26
%PDF_PAPER_LEGAL                    = 27
%PDF_PAPER_LEDGER                   = 28
%PDF_PAPER_TABLOID                  = 29
%PDF_PAPER_EXECUTIVE                = 30
%PDF_PAPER_ANSI_C                   = 31
%PDF_PAPER_ANSI_D                   = 32
%PDF_PAPER_ANSI_E                   = 33
%PDF_PAPER_FOOLSCAP                 = 34
%PDF_PAPER_SMALLCAP                 = 35
%PDF_PAPER_SHEET_ONETHIRD           = 36
%PDF_PAPER_SHEET_ONEHALF            = 37
%PDF_PAPER_DEMY                     = 38
%PDF_PAPER_LARGEPOST                = 39
%PDF_PAPER_SMALLMEDIUM              = 40
%PDF_PAPER_MEDIUM                   = 41
%PDF_PAPER_SMALLROYAL               = 42
%PDF_PAPER_ROYAL                    = 43
%PDF_PAPER_IMPERIAL                 = 44
%PDF_PAPER_METRIC_CROWN_QUARTO      = 45
%PDF_PAPER_METRIC_CROWN_OCTAVO      = 46
%PDF_PAPER_METRIC_LARGECROWN_QUARTO = 47
%PDF_PAPER_METRIC_LARGECROWN_OCTAVO = 48
%PDF_PAPER_METRIC_DEMY_QUARTO       = 49
%PDF_PAPER_METRIC_DEMY_OCTAVO       = 50
%PDF_PAPER_METRIC_ROYAL_QUARTO      = 51
%PDF_PAPER_METRIC_ROYAL_OCTAVO      = 52

' Page Orientations

%PDFPAGE_PORTRAIT                   = 1
%PDFPAGE_LANDSCAPE                  = 2

' PDF Measurement Units per Inch

%PDF_MEASUREMENT                    = 72
%PDF_MM_TO_POINTS                   = 1
%PDF_INCHES_TO_POINTS               = 2
%PDF_POINTS_TO_MM                   = 3
%PDF_POINTS_TO_INCHES               = 4
%PDF_ONE_QUARTER_INCH               = 18

' Line Characterists

%PDF_LINECAP_BUTT                   = 0
%PDF_LINECAP_ROUND                  = 1
%PDF_LINECAP_PROJECTING_SQUARE      = 2

%PDF_LINEJOIN_MITER                 = 0
%PDF_LINEJOIN_ROUND                 = 1
%PDF_LINEJOIN_BEVEL                 = 2

' Text Control

%TEXT_NEXT_LINE                     = 1
%TEXT_JUSTIFY_LEFT                  = 2
%TEXT_JUSTIFY_CENTER                = 3
%TEXT_JUSTIFY_RIGHT                 = 4

' Viewer Preferences

%PDF_ZOOM_NONE                      = 0
%PDF_ZOOM_FULLPAGE                  = 1
%PDF_ZOOM_FULLWIDTH                 = 2
%PDF_ZOOM_REAL                      = 3

%PDF_LAYOUT_NONE                    = 0
%PDF_LAYOUT_SINGLE                  = 1
%PDF_LAYOUT_CONTINUOUS              = 2
%PDF_LAYOUT_TWOCOLUMN               = 3

%PDF_VIEWER_USE_THUMBNAILS          = 1

%PDF_VIEWER_HIDEMENUBAR             = 1
%PDF_VIEWER_HIDETOOLBAR             = 1
%PDF_VIEWER_SHOWTITLE               = 1
%PDF_VIEWER_HIDEWINDOWUI            = 1
%PDF_VIEWER_CENTER_WINDOW           = 1
%PDF_VIEWER_FIT_WINDOW              = 1

TYPE PageCanvas
    Width               AS DOUBLE
    Height              AS DOUBLE
    LeftMargin          AS DOUBLE
    TopMargin           AS DOUBLE
    RightMargin         AS DOUBLE
    BottomMargin        AS DOUBLE
    Orientation         AS LONG
    ObjectNumber        AS LONG
    StreamObject        AS LONG
    StreamComplete      AS LONG
END TYPE

TYPE FontDescriptor
    FontName                AS ASCIIZ * 30
    FontID                  AS LONG
    FontStyle               AS LONG
    FontReferenced          AS LONG
    FontAscent              AS LONG
    FontCapHeight           AS LONG
    FontDescent             AS LONG
    FontFlags               AS LONG
    FontRectLeft            AS LONG
    FontRectTop             AS LONG
    FontRectRight           AS LONG
    FontRectBottom          AS LONG
    FontItalicAngle         AS DOUBLE
    FontStemV               AS LONG
    FontWeight              AS LONG
    FontUnderlineThickness  AS LONG
    FontUnderlinePosition   AS LONG
    FontObject              AS LONG
    FontWidthObject         AS LONG
    FontDescriptorObject    AS LONG
END TYPE

TYPE ImageAttributes
    HorizontalResolution    AS SINGLE
    VerticalResolution      AS SINGLE
    ImagePixelHeight        AS LONG
    ImagePixelWidth         AS LONG
    ImageHeight             AS DOUBLE
    ImageWidth              AS DOUBLE
    ImageSize               AS LONG
    ImageDescriptorObject   AS LONG
END TYPE


MACRO PI                    = 3.141592653589793##

CLASS cPDF                             ' Name of PDF class

INSTANCE CurrentObjectNumber        AS LONG:
INSTANCE ObjectOffsetList           AS ILINKLISTCOLLECTION
INSTANCE PageCanvasList             AS ILINKLISTCOLLECTION
INSTANCE PageStreamList             AS ILINKLISTCOLLECTION
INSTANCE FontList                   AS IPOWERCOLLECTION
INSTANCE FontWidths                 AS IPOWERCOLLECTION
INSTANCE ImageDescriptor            AS IPOWERCOLLECTION
INSTANCE ImageStream                AS IPOWERCOLLECTION
INSTANCE sPDFStream                 AS STRING:
INSTANCE sTempStream                AS STRING:
INSTANCE sProducer                  AS STRING:
INSTANCE sAuthor                    AS STRING:
INSTANCE sCreator                   AS STRING:
INSTANCE sSubject                   AS STRING:
INSTANCE sTitle                     AS STRING:
INSTANCE sKeywords                  AS STRING:
INSTANCE sDefaultFontID             AS STRING:
INSTANCE nDefaultFontSize           AS LONG:
INSTANCE nDefaultFontColor          AS LONG
INSTANCE nBezierMagic               AS DOUBLE
INSTANCE nPDF_ZOOM                  AS LONG:
INSTANCE nPDF_LAYOUT                AS LONG:
INSTANCE nPDF_VIEWER_USE_THUMBNAILS AS LONG:
INSTANCE nPDF_VIEWER_HIDEMENUBAR    AS LONG:
INSTANCE nPDF_VIEWER_HIDETOOLBAR    AS LONG:
INSTANCE nPDF_VIEWER_SHOWTITLE      AS LONG:
INSTANCE nPDF_VIEWER_HIDEWINDOWUI   AS LONG:
INSTANCE nPDF_VIEWER_CENTER_WINDOW  AS LONG:
INSTANCE nPDF_VIEWER_FIT_WINDOW     AS LONG:


  CLASS METHOD CREATE

    LET PageCanvasList = CLASS "LinkListCollection"
    LET PageStreamList = CLASS "LinkListCollection"
    LET ObjectOffsetList = CLASS "LinkListCollection"
    LET FontList = CLASS "PowerCollection"
    LET FontWidths = CLASS "PowerCollection"
    LET ImageDescriptor = CLASS "PowerCollection"
    LET ImageStream = CLASS "PowerCollection"
    nDefaultFontSize = 12
    nDefaultFontColor = %BLACK
    nBezierMagic = ((SQR(2) - 1) / 3) * 4
    nPDF_ZOOM = %PDF_ZOOM_FULLPAGE
    nPDF_LAYOUT = %PDF_LAYOUT_SINGLE

' Add supported font families

    ME.GetSupportedFonts()

  END METHOD

  CLASS METHOD DESTROY

    PageCanvasList = NOTHING
    PageStreamList = NOTHING
    ObjectOffsetList = NOTHING
    FontList = NOTHING
    FontWidths = NOTHING
    ImageDescriptor = NOTHING
    ImageStream = NOTHING

  END METHOD

  CLASS METHOD GetSupportedFonts()

LOCAL cFonts            AS iPDFFonts
LOCAL nIndex            AS LONG
LOCAL nTotalFonts       AS LONG
LOCAL vFontDescriptor   AS VARIANT
LOCAL vFontWidths       AS VARIANT
LOCAL sFontID           AS WSTRING

    cFonts = CLASS "cPDFFonts"

    nTotalFonts = cFonts.TotalFonts

    FOR nIndex = 1 TO nTotalFonts

        cFonts.GetFont(nIndex,sFontID,vFontDescriptor,vFontWidths)
        FontList.Add(sFontID,vFontDescriptor)
        FontWidths.Add(sFontID,vFontWidths)

    NEXT

    cFonts = NOTHING

  END METHOD

  INTERFACE iPDF                       ' Name of PDF interface
   INHERIT IUNKNOWN                    ' What our interface inherits from

   PROPERTY SET PDFFontSize(BYVAL nFontSize AS LONG)

    IF nFontSize > 0 THEN

       nDefaultFontSize = nFontSize

    END IF

    END PROPERTY

    PROPERTY SET PDFZoom (BYVAL nZoom AS LONG)

        SELECT CASE nZoom

            CASE %PDF_ZOOM_NONE TO %PDF_ZOOM_REAL

                nPDF_ZOOM = nZoom

        END SELECT

    END PROPERTY

    PROPERTY SET PDFLayout (BYVAL nLayout AS LONG)

        SELECT CASE nLayout

            CASE %PDF_LAYOUT_NONE TO %PDF_LAYOUT_TWOCOLUMN

                nPDF_LAYOUT = nLayout

        END SELECT

    END PROPERTY

   PROPERTY SET PDFFontColor(BYVAL nRGB AS LONG)

    nDefaultFontColor = nRGB

   END PROPERTY

   PROPERTY SET PDFProducer(BYVAL sPDFProducer AS STRING)

    sProducer = sPDFProducer

   END PROPERTY

   PROPERTY SET PDFAuthor(BYVAL sPDFAuthor AS STRING)

    sAuthor = sPDFAuthor

   END PROPERTY

   PROPERTY SET PDFCreator(BYVAL sPDFCreator AS STRING)

    sCreator = sPDFCreator

   END PROPERTY

   PROPERTY SET PDFSubject(BYVAL sPDFSubject AS STRING)

    sSubject = sPDFSubject

   END PROPERTY

   PROPERTY SET PDFTitle(BYVAL sPDFTitle AS STRING)

    sTitle = sPDFTitle

   END PROPERTY

   PROPERTY SET PDFKeywords(BYVAL sPDFKeywords AS STRING)

    sKeywords = sPDFKeywords

   END PROPERTY

   PROPERTY GET PDFCurrentFontID() AS STRING

    PROPERTY = sDefaultFontID

   END PROPERTY

   METHOD PDFViewerPreferences(BYVAL nThumbnails AS LONG, _
                               BYVAL nHideMenuBar AS LONG, _
                               BYVAL nHideToolBar AS LONG, _
                               BYVAL nShowTitle AS LONG, _
                               BYVAL nHideWindowUI AS LONG, _
                               BYVAL nCenterWindow AS LONG, _
                               BYVAL nFitWindow AS LONG)
    SELECT CASE nThumbnails

        CASE 0,1

            nPDF_VIEWER_USE_THUMBNAILS = nThumbnails

    END SELECT

    SELECT CASE nHideToolBar

        CASE 0,1

            nPDF_VIEWER_HIDETOOLBAR = nHideToolBar

    END SELECT

    SELECT CASE nHideMenuBar

        CASE 0,1

            nPDF_VIEWER_HIDEMENUBAR = nHideMenuBar

    END SELECT

    SELECT CASE nShowTitle

        CASE 0,1

            nPDF_VIEWER_SHOWTITLE = nShowTitle

    END SELECT

    SELECT CASE nHideWindowUI

        CASE 0,1

            nPDF_VIEWER_HIDEWINDOWUI = nHideWindowUI

    END SELECT

    SELECT CASE nCenterWindow

        CASE 0,1

            nPDF_VIEWER_CENTER_WINDOW = nCenterWindow

    END SELECT

    SELECT CASE nFitWindow

        CASE 0,1

            nPDF_VIEWER_FIT_WINDOW = nFitWindow

    END SELECT

   END METHOD

   METHOD AddImage(BYVAL sImageFile AS STRING) AS STRING

' Add a jpeg image
' If return string is blank, an error occurred

   LOCAL sImageID           AS WSTRING
   LOCAL hStatus            AS LONG
   LOCAL nPixelFormat       AS LONG
   LOCAL hToken             AS DWORD
   LOCAL StartupInput       AS GdiplusStartupInput
   LOCAL pImage             AS DWORD
   LOCAL szImageFile        AS WSTRINGZ * %MAX_PATH
   LOCAL ImageGUID          AS GUID
   LOCAL uImageAttributes   AS ImageAttributes
   LOCAL nFile              AS INTEGER
   LOCAL nFileSize          AS LONG
   LOCAL sFileContents      AS STRING
   LOCAL nTotalImages       AS LONG
   LOCAL nWidth             AS LONG
   LOCAL nHeight            AS LONG

    sImageID = ""
    szImageFile = sImageFile

' Startup GDI+

    StartupInput.GdiplusVersion = 1
    hStatus = GdiplusStartup(hToken, StartupInput, BYVAL %NULL)

    IF hStatus <> %S_OK THEN

       MSGBOX "Unable to start graphics subsystem."
       METHOD = ""
       EXIT METHOD

    END IF

' Check if image file is valid

    IF NOT ISFILE(szImageFile) THEN

       MSGBOX szImageFile + " not found."
       METHOD = ""
       EXIT METHOD

    END IF

' Load Image file

    hStatus = GdipLoadImageFromFile(szImageFile, pImage)

    IF hStatus <> %S_OK THEN

       MSGBOX szImageFile + " is not a recognized image file."
       GOTO AddImageExit

    END IF

' Check if image format if JPEG

    hStatus = GdipGetImageRawFormat(pImage,ImageGUID)

    IF ImageGUID <> $ImageFormatJPEG THEN

       MSGBOX szImageFile + " is not a JPEG image file."
       GdipDisposeImage pImage
       GOTO AddImageExit

    END IF

' Check color depth

    hStatus = GdipGetImagePixelFormat(pImage,nPixelFormat)

    IF nPixelFormat <> %PixelFormat24bppRGB THEN

       MSGBOX "JPEG color depth is not supported."
       GdipDisposeImage pImage
       GOTO AddImageExit

    END IF

    GdipGetImageHorizontalResolution(pImage,uImageAttributes.HorizontalResolution)
    GdipGetImageVerticalResolution(pImage,uImageAttributes.VerticalResolution)
    GdipGetImageWidth(pImage,uImageAttributes.ImagePixelWidth)
    GdipGetImageHeight(pImage,uImageAttributes.ImagePixelHeight)
    uImageAttributes.ImageWidth = uImageAttributes.ImagePixelWidth * %PDF_MEASUREMENT / uImageAttributes.HorizontalResolution
    uImageAttributes.ImageHeight = uImageAttributes.ImagePixelHeight * %PDF_MEASUREMENT / uImageAttributes.VerticalResolution

' Release GDI+ Image

    GdipDisposeImage pImage

' Get file size and raw stream

    nFile = FREEFILE
    OPEN szImageFile FOR BINARY AS nFile

    uImageAttributes.ImageSize = LOF(nFile)
    GET$ nFile, uImageAttributes.ImageSize, sFileContents

    CLOSE nFile

' Save Image for reference

    nTotalImages = ImageDescriptor.Count
    INCR nTotalImages

    sImageID = "I" + FORMAT$(nTotalImages)

    ImageDescriptor.Add(sImageID,uImageAttributes AS STRING)
    ImageStream.Add(sImageID,sFileContents)

    AddImageExit:

' Shutdown GDI+

    GdiplusShutdown hToken

    METHOD = sImageID

   END METHOD

   METHOD PDFWriteImage(BYVAL sImageID AS WSTRING, BYVAL nX AS DOUBLE, BYVAL nY AS DOUBLE, _
                        OPT BYVAL nScalingPercent AS DOUBLE, OPT BYVAL nXSkewPercent AS DOUBLE, _
                        OPT BYVAL nYSkewPercent AS DOUBLE)

    LOCAL udtCanvas         AS PageCanvas
    LOCAL uImageAttributes  AS ImageAttributes
    LOCAL nImageIndex       AS LONG
    LOCAL vObject           AS VARIANT

    nImageIndex = ImageDescriptor.Contains(sImageID)

    IF nImageIndex < 1 THEN

       EXIT METHOD

    END IF

    ImageDescriptor.Entry(nImageIndex, sImageID, vObject)
    uImageAttributes = VARIANT$(BYTE, vObject)

    ME.GetCurrentCanvas(udtCanvas)
    ME.DrawingPoints(udtCanvas,nX,nY)

    ME.SaveGraphicsState()

' Image Scaling Percentage

    IF nScalingPercent = 0 THEN

       nScalingPercent = 1.000

    END IF

    ME.BuildObject(sTempStream,ME.FormatPoint(uImageAttributes.ImageWidth * nScalingPercent) + " 0 0 " + _
                               ME.FormatPoint(uImageAttributes.ImageHeight * nScalingPercent) + " " + _
                               ME.FormatPoint(nX) + " " + _
                               ME.FormatPoint(nY) + " cm")


' Image Skewing Percentage

    IF nXSkewPercent < 1 THEN

       nXSkewPercent = 0

    END IF

    IF nYSkewPercent < 1 THEN

       nYSkewPercent = 0

    END IF

'    ME.BuildObject(sTempStream,ME.FormatPoint(uImageAttributes.ImageWidth * (nScalingPercent / 100)) + " " + _
'                               ME.FormatPoint(uImageAttributes.ImageWidth * (nXSkewPercent / 100)) + " " + _
'                               ME.FormatPoint(uImageAttributes.ImageHeight * (nScalingPercent / 100)) + " " + _
'                               ME.FormatPoint(uImageAttributes.ImageHeight * (nYSkewPercent / 100)) + " " + _
'                               ME.FormatPoint(nX) + " " + _
'                               ME.FormatPoint(nY) + " cm")

    ME.BuildObject(sTempStream,"/" + sImageID + " Do")

    ME.RestoreGraphicsState()

   END METHOD

   METHOD PDFFont(BYVAL nFontFamily AS LONG, BYVAL nFontStyle AS LONG)

    LOCAL uDescriptor       AS FontDescriptor
    LOCAL nTotalItems       AS LONG
    LOCAL nIndex            AS LONG
    LOCAL vObject           AS VARIANT
    LOCAL sFontKey          AS WSTRING

    nTotalItems = FontList.Count

    FOR nIndex = 1 TO nTotalItems

        FontList.Entry(nIndex, sFontKey, vObject)

        uDescriptor = VARIANT$(BYTE, vObject)

        IF uDescriptor.FontID = nFontFamily THEN

           IF uDescriptor.FontStyle = nFontStyle THEN

              sDefaultFontID = sFontKey
              uDescriptor.FontReferenced = 1
              FontList.Replace(sFontKey,uDescriptor AS STRING)

              EXIT FOR

           END IF

       END IF

    NEXT

   END METHOD

   METHOD PDFGetFontMetrics (BYVAL sFontID AS WSTRING, _
                             BYREF uDescriptor AS FontDescriptor)

   LOCAL nIndex         AS LONG
   LOCAL vFontObject    AS VARIANT

   nIndex = FontList.Contains(sFontID)

   IF nIndex > 0 THEN

    FontList.Entry(nIndex,sFontID,vFontObject)
    uDescriptor = VARIANT$(BYTE,vFontObject)

   END IF

   END METHOD

   METHOD PDFEndDocument(BYREF sDocument AS STRING) AS LONG

' Close out content streaming, create the PDF document if a name is provided, else
' return the completed document

LOCAL udtCanvas         AS PageCanvas
LOCAL uDescriptor       AS FontDescriptor
LOCAL uImageAttributes  AS ImageAttributes
LOCAL sFontID           AS WSTRING
LOCAL sImageID          AS WSTRING
LOCAL vImageObject      AS VARIANT
LOCAL vImageStream      AS VARIANT
LOCAL sImageStream      AS STRING
LOCAL sStreamObject     AS STRING
LOCAL vFontObject       AS VARIANT
LOCAL vOffset           AS VARIANT
LOCAL vWidthObject      AS VARIANT
LOCAL nPageNumber       AS LONG
LOCAL nIndex            AS LONG
LOCAL nTotalPages       AS LONG
LOCAL nPageTreeObject   AS LONG
LOCAL nProcSetObject    AS LONG
LOCAL nCatalogObject    AS LONG
LOCAL nRowIndex         AS LONG
LOCAL nColumnIndex      AS LONG
LOCAL nFile             AS INTEGER
LOCAL nReturn           AS LONG
DIM arWidths(0)         AS LOCAL LONG

' Close out current page content if necessary

    ME.EndStream()

    nTotalPages = PageCanvasList.Count()

' Create page content streams

    FOR nIndex = 1 TO nTotalPages

        sTempStream = VARIANT$(PageStreamList.Item(nIndex))
        ME.GetCanvas(nIndex,udtCanvas)

' Look for the special comment tag %tpages and replace it with the total pages number

        ME.StringReplace(sTempStream,"%tpages",TRIM$(FORMAT$(nTotalPages,"###,###")))

        INCR CurrentObjectNumber
        sStreamObject = ""

        ME.BuildObject(sStreamObject,FORMAT$(CurrentObjectNumber) + " 0 obj")
        ME.BuildObject(sStreamObject,"<< /Length " + FORMAT$(LEN(sTempStream)) + " >>")
        ME.BuildObject(sStreamObject,"stream")

        sStreamObject = sStreamObject + sTempStream

        ME.BuildObject(sStreamObject,"endstream")
        ME.BuildObject(sStreamObject,"endobj" + $CRLF)

        ME.SaveOffset(LEN(sStreamObject))
        sPDFStream = sPDFStream + sStreamObject

        udtCanvas.StreamComplete = 1
        udtCanvas.StreamObject = CurrentObjectNumber
        ME.UpdateCanvas(nIndex,udtCanvas)

    NEXT

    sTempStream = ""

    FOR nIndex = 1 TO FontList.Count

        FontList.Entry(nIndex,sFontID,vFontObject)
        uDescriptor = VARIANT$(BYTE,vFontObject)

        IF uDescriptor.FontReferenced <> 1 THEN

           ITERATE FOR

        END IF

        INCR CurrentObjectNumber
        uDescriptor.FontDescriptorObject = CurrentObjectNumber
        ME.BuildObject(sTempStream,FORMAT$(CurrentObjectNumber) + " 0 obj")

'Build the font descriptor object

        ME.BuildObject(sTempStream, _
                       "<< /Ascent " + FORMAT$(uDescriptor.FontAscent) + " /CapHeight " + _
                       FORMAT$(uDescriptor.FontCapHeight) + " /Descent " + _
                       FORMAT$(uDescriptor.FontDescent) + " /Flags " + _
                       FORMAT$(uDescriptor.FontFlags) + " /FontBBox [ " + _
                       FORMAT$(uDescriptor.FontRectLeft) + " " + _
                       FORMAT$(uDescriptor.FontRectTop) + " " + _
                       FORMAT$(uDescriptor.FontRectRight) + " " + _
                       FORMAT$(uDescriptor.FontRectBottom) + " ] /FontName /" + _
                       uDescriptor.FontName + " /ItalicAngle " + _
                       FORMAT$(uDescriptor.FontItalicAngle,"##.0#") + " /StemV " + _
                       FORMAT$(uDescriptor.FontStemV) + " /FontWeight " + _
                       FORMAT$(uDescriptor.FontWeight) + " " + $CRLF + "/Type /FontDescriptor")
        ME.BuildObject(sTempStream,">>")
        ME.BuildObject(sTempStream,"endobj" + $CRLF)
        ME.SaveOffset(LEN(sTempStream))
        sPDFStream = sPDFStream + sTempStream
        sTempStream = ""

' Build the font widths object

        vWidthObject = FontWidths.Item(sFontID)
        LET arWidths() = vWidthObject
        INCR CurrentObjectNumber
        uDescriptor.FontWidthObject = CurrentObjectNumber
        ME.BuildObject(sTempStream,FORMAT$(CurrentObjectNumber) + " 0 obj")
        sTempStream = sTempStream + "[ "

        FOR nRowIndex = 1 TO 16

            FOR nColumnIndex = 0 TO 15

                sTempStream = sTempStream + FORMAT$(arWidths ((nRowIndex * 16 - 16) + nColumnIndex)) + " "

            NEXT nColumnIndex

            sTempStream = sTempStream + $CRLF

       NEXT nRowIndex

       ME.BuildObject(sTempStream," ]")
       ME.BuildObject(sTempStream,"endobj" + $CRLF)
       ME.SaveOffset(LEN(sTempStream))
       sPDFStream = sPDFStream + sTempStream
       sTempStream = ""

' Build font object

       INCR CurrentObjectNumber
       uDescriptor.FontObject = CurrentObjectNumber
       ME.BuildObject(sTempStream,FORMAT$(CurrentObjectNumber) + " 0 obj")
       ME.BuildObject(sTempStream,"<< /BaseFont /" + uDescriptor.FontName)
       ME.BuildObject(sTempStream,"/Name /" + sFontID)
       ME.BuildObject(sTempStream,"/Encoding /WinAnsiEncoding")
       ME.BuildObject(sTempStream,"/FirstChar 0")
       ME.BuildObject(sTempStream,"/FontDescriptor " + FORMAT$(uDescriptor.FontDescriptorObject) + " 0 R")
       ME.BuildObject(sTempStream,"/LastChar 255")
       ME.BuildObject(sTempStream,"/Subtype /TrueType")
       ME.BuildObject(sTempStream,"/Type /Font")
       ME.BuildObject(sTempStream,"/Widths " + FORMAT$(uDescriptor.FontWidthObject) + " 0 R")
       ME.BuildObject(sTempStream,">>")
       ME.BuildObject(sTempStream,"endobj" + $CRLF)

' Update the font descriptor object

       FontList.Replace(sFontID,uDescriptor AS STRING)
       ME.SaveOffset(LEN(sTempStream))
       sPDFStream = sPDFStream + sTempStream
       sTempStream = ""

    NEXT nIndex

    sTempStream = ""

' Build Image Objects

    IF ImageDescriptor.Count > 0 THEN

       FOR nIndex = 1 TO ImageDescriptor.Count

           ImageDescriptor.Entry(nIndex,sImageID,vImageObject)
           uImageAttributes = VARIANT$(BYTE,vImageObject)
           vImageStream = ImageStream.Item(sImageID)
           sImageStream = VARIANT$(vImageStream)

           INCR CurrentObjectNumber
           uImageAttributes.ImageDescriptorObject = CurrentObjectNumber
           ME.BuildObject(sTempStream,FORMAT$(CurrentObjectNumber) + " 0 obj")
           ME.BuildObject(sTempStream,"<<")
           ME.BuildObject(sTempStream,"/Type /XObject")
           ME.BuildObject(sTempStream,"/Subtype /Image")
           ME.BuildObject(sTempStream,"/Filter /DCTDecode")
           ME.BuildObject(sTempStream,"/ColorSpace /DeviceRGB")
           ME.BuildObject(sTempStream,"/Width " + FORMAT$(uImageAttributes.ImagePixelWidth))
           ME.BuildObject(sTempStream,"/Height " + FORMAT$(uImageAttributes.ImagePixelHeight))
           ME.BuildObject(sTempStream,"/BitsPerComponent 8")
           ME.BuildObject(sTempStream,"/Length " + FORMAT$(uImageAttributes.ImageSize))
           ME.BuildObject(sTempStream,">>")
           ME.BuildObject(sTempStream,"stream")
           ME.BuildObject(sTempStream,sImageStream)
           ME.BuildObject(sTempStream,"endstream")
           ME.BuildObject(sTempStream,"endobj" + $CRLF)

' Update the image descriptor object

           ImageDescriptor.Replace(sImageID,uImageAttributes AS STRING)
           ME.SaveOffset(LEN(sTempStream))
           sPDFStream = sPDFStream + sTempStream
           sTempStream = ""

       NEXT

    END IF

    INCR CurrentObjectNumber
    nPageTreeObject = CurrentObjectNumber
    INCR CurrentObjectNumber
    nProcSetObject = CurrentObjectNumber

' Assign the page object numbers

' We will be creating the page tree node and the procedure set array
' objects before the page objects

    FOR nIndex = 1 TO PageCanvasList.Count()

        INCR CurrentObjectNumber

        ME.GetCanvas(nIndex,udtCanvas)
        udtCanvas.ObjectNumber = CurrentObjectNumber
        ME.UpdateCanvas(nIndex,udtCanvas)

    NEXT

' Create Page Tree Node

    sTempStream = ""

    ME.BuildObject(sTempStream,FORMAT$(nPageTreeObject) + " 0 obj")
    ME.BuildObject(sTempStream,"<< /Type /Pages")
    ME.BuildObject(sTempStream,"/Kids [")

    FOR nIndex = 1 TO PageCanvasList.Count()

        ME.GetCanvas(nIndex,udtCanvas)
        ME.BuildObject(sTempStream,FORMAT$(udtCanvas.ObjectNumber) + " 0 R")

    NEXT

    ME.BuildObject(sTempStream,"]")
    ME.BuildObject(sTempStream,"/Count " + FORMAT$(PageCanvasList.Count()))
    ME.BuildObject(sTempStream,">>")
    ME.BuildObject(sTempStream,"endobj" + $CRLF)

    ME.SaveOffset(LEN(sTempStream))
    sPDFStream = sPDFStream + sTempStream

' Create Procedure Set Array

    sTempStream = ""

    ME.BuildObject(sTempStream,FORMAT$(nProcSetObject) + " 0 obj")
    ME.BuildObject(sTempStream,"<< /ProcSet [ /PDF /Text /ImageC]")
    ME.BuildObject(sTempStream,"/XObject <<")

    IF ImageDescriptor.Count > 0 THEN

       FOR nIndex = 1 TO ImageDescriptor.Count

           ImageDescriptor.Entry(nIndex,sImageID,vImageObject)
           uImageAttributes = VARIANT$(BYTE,vImageObject)

           ME.BuildObject(sTempStream,"/" + sImageID +  " " + FORMAT$(uImageAttributes.ImageDescriptorObject) + " 0 R ")

       NEXT

    END IF

    ME.BuildObject(sTempStream,">>")

    ME.BuildObject(sTempStream,"/Font <<")

    FOR nIndex = 1 TO FontList.Count

        FontList.Entry(nIndex,sFontID,vFontObject)
        uDescriptor = VARIANT$(BYTE,vFontObject)

        IF uDescriptor.FontReferenced = 1 THEN

           ME.BuildObject(sTempStream,"/" + sFontID +  " " + FORMAT$(uDescriptor.FontObject) + " 0 R ")

        END IF

    NEXT

    ME.BuildObject(sTempStream,">>")

' End of Procedure Set

    ME.BuildObject(sTempStream,">>")
    ME.BuildObject(sTempStream,"endobj" + $CRLF)
    ME.SaveOffset(LEN(sTempStream))
    sPDFStream = sPDFStream + sTempStream

' Create Page Objects

    FOR nIndex = 1 TO PageCanvasList.Count()

        ME.GetCanvas(nIndex,udtCanvas)

        sTempStream = ""

        ME.BuildObject(sTempStream,FORMAT$(udtCanvas.ObjectNumber) + " 0 obj")
        ME.BuildObject(sTempStream,"<< /Type /Page")
        ME.BuildObject(sTempStream,"/Parent " + FORMAT$(nPageTreeObject) + " 0 R")
        ME.BuildObject(sTempStream,"/MediaBox [ 0 0 " + ME.FormatPoint(udtCanvas.Width) + " " & ME.FormatPoint(udtCanvas.Height) + "]")
        ME.BuildObject(sTempStream,"/Resources " + FORMAT$(nProcSetObject) + " 0 R")


        ME.BuildObject(sTempStream,"/Contents " + FORMAT$(udtCanvas.StreamObject) + " 0 R")
        ME.BuildObject(sTempStream,">>")
        ME.BuildObject(sTempStream,"endobj" + $CRLF)

        ME.SaveOffset(LEN(sTempStream))
        sPDFStream = sPDFStream + sTempStream

    NEXT

' Create Catalog Object

    INCR CurrentObjectNumber
    nCatalogObject = CurrentObjectNumber
    sTempStream = ""

    ME.BuildObject(sTempStream,FORMAT$(CurrentObjectNumber) + " 0 obj")
    ME.BuildObject(sTempStream,"<<")
    ME.BuildObject(sTempStream,"/Type /Catalog")
    ME.BuildObject(sTempStream,"/Pages " + FORMAT$(nPageTreeObject) + " 0 R")

    SELECT CASE nPDF_ZOOM

        CASE %PDF_ZOOM_NONE

        CASE ELSE

            sTempStream = sTempStream + "/OpenAction [3 0 R /"

            IF nPDF_ZOOM = %PDF_ZOOM_FULLPAGE THEN
                ME.BuildObject(sTempStream,"Fit]")
            ELSE
                IF nPDF_ZOOM = %PDF_ZOOM_FULLWIDTH THEN
                    ME.BuildObject(sTempStream,"FitH null]")
                ELSE
                    ME.BuildObject(sTempStream,"XYZ null null 1]")
                END IF
            END IF

    END SELECT

    SELECT CASE nPDF_LAYOUT

        CASE %PDF_LAYOUT_NONE

        CASE ELSE

            sTempStream = sTempStream + "/PageLayout /

            IF nPDF_LAYOUT = %PDF_LAYOUT_SINGLE THEN
                ME.BuildObject(sTempStream,"SinglePage")
            ELSE
                IF nPDF_LAYOUT = %PDF_LAYOUT_CONTINUOUS THEN
                    ME.BuildObject(sTempStream,"OneColumn")
                ELSE
                    ME.BuildObject(sTempStream,"TwoColumnLeft")
                END IF
            END IF

    END SELECT

    IF nPDF_VIEWER_USE_THUMBNAILS = %PDF_VIEWER_USE_THUMBNAILS THEN
        ME.BuildObject(sTempStream,"/PageMode /UseThumbs")
    END IF

    IF nPDF_VIEWER_HIDEMENUBAR = %PDF_VIEWER_HIDEMENUBAR THEN
        ME.BuildObject(sTempStream,"/HideMenubar true")
    END IF

    IF nPDF_VIEWER_HIDETOOLBAR = %PDF_VIEWER_HIDETOOLBAR THEN
        ME.BuildObject(sTempStream,"/HideToolbar true")
    END IF

    IF nPDF_VIEWER_SHOWTITLE = %PDF_VIEWER_SHOWTITLE THEN
        ME.BuildObject(sTempStream,"/DisplayDocTitle true")
    END IF

    IF nPDF_VIEWER_HIDEWINDOWUI = %PDF_VIEWER_HIDEWINDOWUI THEN
        ME.BuildObject(sTempStream,"/HideWindowUI true")
    END IF

    IF nPDF_VIEWER_CENTER_WINDOW = %PDF_VIEWER_CENTER_WINDOW THEN
        ME.BuildObject(sTempStream,"/CenterWindow true")
    END IF

    IF nPDF_VIEWER_FIT_WINDOW = %PDF_VIEWER_FIT_WINDOW THEN
        ME.BuildObject(sTempStream,"/FitWindow true")
    END IF

    ME.BuildObject(sTempStream,">>")
    ME.BuildObject(sTempStream,"endobj" + $CRLF)

    ME.SaveOffset(LEN(sTempStream))
    sPDFStream = sPDFStream + sTempStream

' Create Cross Reference Table

    INCR CurrentObjectNumber
    sTempStream = ""

    ME.BuildObject(sTempStream,"xref")
    ME.BuildObject(sTempStream,"0 " + FORMAT$(CurrentObjectNumber))
    ME.BuildObject(sTempStream,"0000000000 65535 f")

    FOR nIndex = 1 TO CurrentObjectNumber - 1

        vOffset = ObjectOffsetList.Item(nIndex)
        ME.BuildObject(sTempStream,FORMAT$(VARIANT#(vOffset),"0000000000") + " 00000 n")

    NEXT I

    ME.BuildObject(sTempStream,"trailer")
    ME.BuildObject(sTempStream,"<< /Size " + FORMAT$(CurrentObjectNumber))
    ME.BuildObject(sTempStream,"/Root " + FORMAT$(nCatalogObject) + " 0 R")
    ME.BuildObject(sTempStream,"/Info 1 0 R")
    ME.BuildObject(sTempStream,">>")
    ME.BuildObject(sTempStream,"startxref")
    nIndex = CurrentObjectNumber
    vOffset = ObjectOffsetList.Item(nIndex)
    ME.BuildObject(sTempStream,FORMAT$(VARIANT#(vOffset)))

    sPDFStream = sPDFStream + sTempStream + "%%EOF"

' At this point sPDFStream contains the full document
' Check if a document name was provided and save it or
' just return the full stream

    IF LEN(sDocument) = 0 THEN
        sDocument = sPDFStream
        METHOD = 1
        EXIT METHOD
    END IF

    nFile = FREEFILE

    ON ERROR GOTO ErrorExit

    OPEN sDocument FOR BINARY AS nFile
    PUT$ nFile, sPDFStream

ErrorExit:

    nReturn = ERRCLEAR
    ON ERROR GOTO 0

    CLOSE nFile

    METHOD = IIF(nReturn = 0,1,nReturn)

   END METHOD

  METHOD PDFWriteText(BYVAL nAngle AS DOUBLE, _
                      BYVAL nJustify AS LONG, _
                      BYVAL nNewLine AS LONG, _
                      BYVAL nX AS DOUBLE, _
                      BYVAL nY AS DOUBLE, _
                      BYVAL nUnderline AS LONG, _
                      BYVAL nLineColor AS LONG, _
                      BYVAL sText AS STRING)

LOCAL udtCanvas         AS PageCanvas
LOCAL nTextX            AS DOUBLE
LOCAL nTextY            AS DOUBLE
LOCAL nTextSize         AS DOUBLE
LOCAL nLineThickness    AS DOUBLE
LOCAL nLineX            AS DOUBLE
LOCAL uDescriptor       AS FontDescriptor

    nTextSize = ME.PDFMeasureString(sDefaultFontID,sText,nDefaultFontSize)

    nLineX = nX

    ME.GetCurrentCanvas(udtCanvas)

    ME.PDFBeginText()

' Justify Center, nX is the center point sText
' Justify Right, nX is the end point for sText

    SELECT CASE nJustify

        CASE = %TEXT_JUSTIFY_CENTER

            nx = ME.PDFCenterString(sText, nX, udtCanvas.LeftMargin)

        CASE = %TEXT_JUSTIFY_RIGHT

            nX = nX - nTextSize - udtCanvas.LeftMargin

    END SELECT

    ME.SetNonStrokingColor(nDefaultFontColor)

    ME.PDFTextFont()

    nTextX = nX
    nTextY = nY
    ME.PDFTextLocation(nTextX,nTextY,nAngle)

    ME.PDFAddText(sText,0,nNewLine)

    ME.PDFEndText()

    IF nUnderline = %FONT_UNDERLINE THEN

' Get current font metrics for vertical displacement and thickness

        ME.PDFGetFontMetrics(sDefaultFontID,uDescriptor)
        nY = nY - ((uDescriptor.FontUnderlinePosition * nDefaultFontSize) / 1000)
        nLineThickness = (uDescriptor.FontUnderlineThickness * nDefaultFontSize) / 1000
        ME.PDFStartLine(nX,nY,nLineColor,nLineThickness,%PDF_LINECAP_BUTT,%PDF_LINEJOIN_ROUND)
        ME.PDFMoveTo(nX + nTextSize,nY)
        ME.PDFDrawLine()

    END IF

   END METHOD

   METHOD PDFDrawLine()

    ME.BuildObject(sTempStream,"S")
    ME.RestoreGraphicsState()

   END METHOD

   METHOD PDFTextFont()

    ME.BuildObject(sTempStream,"/" + sDefaultFontID + " " + FORMAT$(nDefaultFontSize) + " Tf")

   END METHOD

   METHOD PDFBeginText()

' Start a text stream

    ME.SaveGraphicsState()
    ME.BuildObject(sTempStream,"BT")

   END METHOD

   METHOD PDFEndText()

' End a text stream

    ME.BuildObject(sTempStream,"ET")
    ME.RestoreGraphicsState()

   END METHOD

' Add text to current stream

   METHOD PDFAddText(BYVAL sText AS STRING,BYVAL nX AS LONG,BYVAL nNewLine AS LONG)

LOCAL sEscapedText      AS STRING

' Escape PDF special characters

    sEscapedText = sText
    ME.StringReplace(sEscapedText,"\","\\")
    ME.StringReplace(sEscapedText,"\\","\\\\")
    ME.StringReplace(sEscapedText,"(","\(")
    ME.StringReplace(sEscapedText,")","\)")

    IF nX <> 0 THEN

        ME.BuildObject(sTempStream,FORMAT$(nX) + " 0 Td")

    END IF

    ME.BuildObject(sTempStream,"(" + sEscapedText + ") Tj")

    IF nNewLine = %TEXT_NEXT_LINE THEN

        ME.BuildObject(sTempStream,"T*")

    END IF

   END METHOD

' Set next text location with optional rotation

   METHOD PDFTextLocation(BYVAL nX AS DOUBLE, nY AS DOUBLE, BYVAL nAngle AS LONG)

LOCAL udtCanvas         AS PageCanvas

    ME.GetCurrentCanvas(udtCanvas)

    ME.DrawingPoints(udtCanvas,nX,nY)

    IF nAngle = 0 THEN
        ME.BuildObject(sTempStream,ME.FormatPoint(nX) + " " + ME.FormatPoint(nY) + " Td")
    ELSE
        ME.BuildObject(sTempStream,ME.RotateStream(nAngle,nX,nY))
    END IF

   END METHOD

   METHOD PDFTextState(BYVAL nCharacterSpacing AS LONG, _
                       BYVAL nWordSpacing AS LONG, _
                       BYVAL nHorizontalScaling AS LONG, _
                       BYVAL nLeading AS LONG, _
                       BYVAL nRendering AS LONG, _
                       BYVAL nRise AS LONG)

' Set the text state - the state stays active for the current page unless changed

' Set the character spacing

    IF nCharacterSpacing >= 0 THEN

        ME.BuildObject(sTempStream,FORMAT$(nCharacterSpacing) + " Tc")

    END IF

' Set the word spacing

    IF nWordSpacing >= 0 THEN

        ME.BuildObject(sTempStream,FORMAT$(nWordSpacing) + " Tw")

    END IF

' Set scaling percentage from 1 to 100

    IF nHorizontalScaling > 0 THEN

        IF nHorizontalScaling <= 100 THEN

            ME.BuildObject(sTempStream,FORMAT$(nHorizontalScaling) + " Tz")

        END IF

    END IF

' Set the text leading

    IF nLeading >= 0 THEN

        ME.BuildObject(sTempStream,FORMAT$(nLeading) + " TL")

    END IF

' Set the text rendering

    IF nRendering >= 0 THEN

        ME.BuildObject(sTempStream,FORMAT$(nRendering) + " Tr")

    END IF

' Set the text rise, useful for sub/super scripting

    ME.BuildObject(sTempStream,FORMAT$(nRise) + " Ts")

   END METHOD

   METHOD PDFRectangle(BYVAL nX AS DOUBLE, _
                       BYVAL nY AS DOUBLE, _
                       BYVAL nHeight AS DOUBLE, _
                       BYVAL nWidth AS DOUBLE, _
                       BYVAL nOutlineColor AS LONG, _
                       BYVAL nFillColor AS LONG)

LOCAL udtCanvas         AS PageCanvas
LOCAL nLowerX           AS DOUBLE

    ME.GetCurrentCanvas(udtCanvas)

    ME.SaveGraphicsState()

    nFillColor = IIF(nFillColor >= 0,nFillColor,0)
    ME.SetNonStrokingColor(nFillColor)

    ME.SetStrokingColor(nOutlineColor)

    nY = nY + nHeight
    ME.DrawingPoints(udtCanvas,nX,nY)

    ME.BuildObject(sTempStream, _
                   TRIM$(FORMAT$(nX,"#####.0####")) + " " + TRIM$(FORMAT$(nY,"#####.0####")) + " " + _
                   TRIM$(FORMAT$(nWidth,"#####.0####")) + " " + TRIM$(FORMAT$(nHeight,"#####.0####")) + " re")

    ME.BuildObject(sTempStream,"B")
    ME.RestoreGraphicsState()

   END METHOD

   METHOD PDFEllispe(BYVAL nX AS DOUBLE, _
                     BYVAL nY AS DOUBLE, _
                     BYVAL nHeight AS DOUBLE, _
                     BYVAL nWidth AS DOUBLE, _
                     BYVAL nOutlineColor AS LONG, _
                     BYVAL nFillColor AS LONG)

' Draw an ellispe centered at nX, nY

LOCAL udtCanvas         AS PageCanvas
LOCAL nXRadius          AS DOUBLE
LOCAL nYRadius          AS DOUBLE
LOCAL nStartX           AS DOUBLE
LOCAL nStartY           AS DOUBLE
LOCAL nX1Control        AS DOUBLE
LOCAL nY1Control        AS DOUBLE
LOCAL nX2Control        AS DOUBLE
LOCAL nY2Control        AS DOUBLE
LOCAL nXEnd             AS DOUBLE
LOCAL nYEnd             AS DOUBLE
LOCAL nXBezier          AS DOUBLE
LOCAL nYBezier          AS DOUBLE

    ME.GetCurrentCanvas(udtCanvas)

    ME.SaveGraphicsState()

    nFillColor = IIF(nFillColor >= 0,nFillColor,0)
    ME.SetNonStrokingColor(nFillColor)

    ME.SetStrokingColor(nOutlineColor)

    nYRadius = nHeight / 2
    nXRadius = nWidth / 2
    nXBezier = nXRadius * nBezierMagic
    nYBezier = nYRadius * nBezierMagic

' Start the drawing from the top midpoint

    nY = nY - nYRadius
    nStartX = nX
    nStartY = nY

' Set the current point

    ME.DrawingPoints(udtCanvas,nX,nY)
    ME.BuildObject(sTempStream,ME.FormatPoint(nX) + " " + _
                               ME.FormatPoint(nY) + " m")

' Draw the ellispe counterclock wise

    nX1Control = nStartX - nXBezier
    nY1Control = nStartY
    nXEnd = nStartX - nXRadius
    nYEnd = nStartY + nYRadius
    nX2Control = nXEnd
    nY2Control = nYEnd - nYBezier

    ME.PDFCurve(nX1Control,nY1Control,nX2Control,nY2Control,nXEnd,nYEnd)

    nStartX = nXEnd
    nStartY = nYEnd

    nX1Control = nStartX
    nY1Control = nStartY + nYBezier
    nXEnd = nStartX + nXRadius
    nYEnd = nStartY + nYRadius
    nX2Control = nXEnd - nXBezier
    nY2Control = nYEnd

    ME.PDFCurve(nX1Control,nY1Control,nX2Control,nY2Control,nXEnd,nYEnd)

    nStartX = nXEnd
    nStartY = nYEnd

    nX1Control = nStartX + nXBezier
    nY1Control = nStartY
    nXEnd = nStartX + nXRadius
    nYEnd = nStartY - nYRadius
    nX2Control = nXEnd
    nY2Control = nYEnd + nYBezier

    ME.PDFCurve(nX1Control,nY1Control,nX2Control,nY2Control,nXEnd,nYEnd)

    nStartX = nXEnd
    nStartY = nYEnd

    nX1Control = nStartX
    nY1Control = nStartY - nYBezier
    nXEnd = nStartX - nXRadius
    nYEnd = nStartY - nYRadius
    nX2Control = nXEnd + nXBezier
    nY2Control = nYEnd

    ME.PDFCurve(nX1Control,nY1Control,nX2Control,nY2Control,nXEnd,nYEnd)

    ME.BuildObject(sTempStream,"B")

    ME.RestoreGraphicsState()

   END METHOD

   METHOD PDFCurve(BYVAL nX1Control AS DOUBLE, _
                   BYVAL nY1Control AS DOUBLE, _
                   BYVAL nX2Control AS DOUBLE, _
                   BYVAL nY2Control AS DOUBLE, _
                   BYVAL nXEnd AS DOUBLE, _
                   BYVAL nYEnd AS DOUBLE)

' Draw a curved bezier arc from the current point

LOCAL udtCanvas         AS PageCanvas

    ME.GetCurrentCanvas(udtCanvas)

    ME.DrawingPoints(udtCanvas,nX1Control,nY1Control)
    ME.DrawingPoints(udtCanvas,nX2Control,nY2Control)
    ME.DrawingPoints(udtCanvas,nXEnd,nYEnd)

    ME.BuildObject(sTempStream,ME.FormatPoint(nX1Control) + " " + _
                               ME.FormatPoint(nY1Control) + " " + _
                               ME.FormatPoint(nX2Control) + " " + _
                               ME.FormatPoint(nY2Control) + " " + _
                               ME.FormatPoint(nXEnd) + " " + _
                               ME.FormatPoint(nYEnd) + " c")

   END METHOD

   METHOD PDFStartLine(BYVAL nX AS DOUBLE, _
                       BYVAL nY AS DOUBLE, _
                       BYVAL nColor AS LONG, _
                       BYVAL nLineWidth AS DOUBLE, _
                       BYVAL nLineCap AS LONG, _
                       BYVAL nLineJoin AS LONG)

LOCAL udtCanvas         AS PageCanvas

    ME.GetCurrentCanvas(udtCanvas)

    ME.DrawingPoints(udtCanvas,nX,nY)

    ME.SaveGraphicsState()

    ME.SetStrokingColor(nColor)

    ME.BuildObject(sTempStream,TRIM$(FORMAT$(nLineWidth,"###.0####")) + " w")

    SELECT CASE nLineCap

        CASE < %PDF_LINECAP_BUTT

        CASE > %PDF_LINECAP_PROJECTING_SQUARE

        CASE ELSE

            ME.BuildObject(sTempStream,FORMAT$(nLineCap) + " J")

    END SELECT

    SELECT CASE nLineJoin

        CASE < %PDF_LINEJOIN_MITER

        CASE > %PDF_LINEJOIN_BEVEL

        CASE ELSE

            ME.BuildObject(sTempStream,FORMAT$(nLineJoin) + " j")

    END SELECT

    ME.BuildObject(sTempStream,TRIM$(FORMAT$(nX,"#####.0####")) + " " + TRIM$(FORMAT$(nY,"#####.0####")) + " m")

   END METHOD

   METHOD PDFMoveTo(BYVAL nX AS DOUBLE, _
                    BYVAL nY AS DOUBLE)

LOCAL udtCanvas         AS PageCanvas

    ME.GetCurrentCanvas(udtCanvas)

    ME.DrawingPoints(udtCanvas,nX,nY)

    ME.BuildObject(sTempStream,TRIM$(FORMAT$(nX,"#####.0####")) + " " + TRIM$(FORMAT$(nY,"#####.0####")) + " l")

   END METHOD

   METHOD PDFCenterString(BYREF sString AS STRING, _
                          BYVAL nPoint AS DOUBLE, _
                          BYVAL nLeftMargin AS DOUBLE) AS DOUBLE

' Center a string on point nPoint and return the canvas page point

LOCAL nStringSize       AS DOUBLE

     nStringSize = ME.PDFMeasureString(sDefaultFontID,sString,nDefaultFontSize)

     METHOD = nPoint - (nStringSize / 2) - nLeftMargin

   END METHOD

   METHOD PDFMeasureString(BYVAL sFontID AS WSTRING, _
                           BYREF sString AS STRING, _
                           BYVAL nFontSize AS LONG) AS DOUBLE

' Calculate the length of a string

    DIM arWidths(0)     AS LOCAL LONG
    LOCAL vObject       AS VARIANT
    LOCAL nTotalWidth   AS LONG
    LOCAL nStringLength AS LONG
    LOCAL nIndex        AS LONG

    vObject = FontWidths.Item(sFontID)
    LET arWidths() = vObject
    nTotalWidth = 0
    nStringLength = LEN(sString)

    IF nStringLength > 0 THEN

       FOR nIndex = 1 TO nStringLength

           nTotalWidth = nTotalWidth + arWidths(ASC(MID$(sString,nIndex,1)))

       NEXT

    END IF

    METHOD = (nTotalWidth * nFontSize) / 1000

   END METHOD

   METHOD PDFConvertMeasurement(BYVAL dUnit AS DOUBLE,BYVAL nType AS LONG) AS DOUBLE

' Convert one unit of measure to another

    LOCAL dResult   AS DOUBLE

    SELECT CASE nType

        CASE = %PDF_MM_TO_POINTS

            dResult = (dUnit / 25.4) * %PDF_MEASUREMENT

        CASE = %PDF_INCHES_TO_POINTS

            dResult = dUnit * %PDF_MEASUREMENT

        CASE = %PDF_POINTS_TO_MM

            dResult = (dUnit / %PDF_MEASUREMENT) * 25.4

        CASE = %PDF_POINTS_TO_INCHES

            dResult = dUnit / %PDF_MEASUREMENT

        CASE ELSE

            dResult = dUnit

    END SELECT

    METHOD = dResult

   END METHOD

   METHOD PDFNewPage(BYVAL nPaperID AS LONG, _
                     BYVAL nPaperOrientation AS LONG, _
                     BYVAL nTopMargin AS DOUBLE, _
                     BYVAL nLeftMargin AS DOUBLE, _
                     BYVAL nBottomMargin AS DOUBLE, _
                     BYVAL nRightMargin AS DOUBLE)

' Begin a new page

LOCAL udtCanvas         AS PageCanvas
LOCAL sPaperName        AS STRING
LOCAL nPaperHeight      AS DOUBLE
LOCAL nPaperWidth       AS DOUBLE

' Ensure current page is finished

    ME.PDFEndPage()

' Get current page and clone setup

    ME.GetCurrentCanvas(udtCanvas)

    udtCanvas.ObjectNumber = 0
    udtCanvas.StreamObject = 0
    udtCanvas.StreamComplete = 0

    ME.PDFPageMetrics(nPaperID,sPaperName,nPaperHeight,nPaperWidth)

    IF nTopMargin < 0 THEN

        nTopMargin = %PDF_ONE_QUARTER_INCH

    END IF

    IF nLeftMargin < 0 THEN

        nLeftMargin = %PDF_ONE_QUARTER_INCH

    END IF

    IF nBottomMargin < 0 THEN

        nBottomMargin = %PDF_ONE_QUARTER_INCH

    END IF

    IF nRightMargin < 0 THEN

        nRightMargin = %PDF_ONE_QUARTER_INCH

    END IF

    IF nPaperOrientation = %PDFPAGE_LANDSCAPE THEN

        SWAP nPaperHeight, nPaperWidth

    END IF

    udtCanvas.Width = nPaperWidth
    udtCanvas.Height = nPaperHeight
    udtCanvas.Orientation = nPaperOrientation
    udtCanvas.LeftMargin = nLeftMargin
    udtCanvas.TopMargin = nTopMargin
    udtCanvas.RightMargin = nRightMargin
    udtCanvas.BottomMargin = nBottomMargin

    ME.CreateCanvas(udtCanvas)

' Start a stream object for the page

    ME.StartStream()

   END METHOD

   METHOD PDFCreateDocument(BYVAL nPaperID AS LONG, _
                            BYVAL nPaperOrientation AS LONG, _
                            BYVAL nTopMargin AS DOUBLE, _
                            BYVAL nLeftMargin AS DOUBLE, _
                            BYVAL nBottomMargin AS DOUBLE, _
                            BYVAL nRightMargin AS DOUBLE)

    LOCAL cTime         AS IPOWERTIME
    LOCAL cTImeUTC      AS IPOWERTIME
    LOCAL sTime         AS STRING
    LOCAL nSign         AS LONG
    LOCAL sSign         AS STRING
    LOCAL nHours        AS LONG
    LOCAL nMinutes      AS LONG
    LOCAL udtCanvas     AS PageCanvas
    LOCAL sContent      AS STRING
    LOCAL uDescriptor   AS FontDescriptor
    LOCAL nTotalItems   AS LONG
    LOCAL nIndex        AS LONG
    LOCAL vObject       AS VARIANT
    LOCAL sFontKey      AS WSTRING

    PageCanvasList.Clear
    PageStreamList.Clear
    ObjectOffsetList.Clear

    nDefaultFontSize = 12
    nDefaultFontColor = %BLACK

' Reset Fontlist so that only Arial Normal is flagged for use

    nTotalItems = FontList.Count

    FOR nIndex = 1 TO nTotalItems

        FontList.Entry(nIndex, sFontKey, vObject)

        uDescriptor = VARIANT$(BYTE, vObject)
        uDescriptor.FontReferenced = 0

        SELECT CASE uDescriptor.FontID

            CASE %FONT_ARIAL

                IF uDescriptor.FontStyle = %PDF_FONT_NORMAL THEN

                    uDescriptor.FontReferenced = 1
                    sDefaultFontID = sFontKey

                END IF

        END SELECT

        FontList.Replace(sFontKey,uDescriptor AS STRING)

    NEXT

' Setup Page Metrics

    ME.PageSetup(udtCanvas, _
                 nPaperID, _
                 nPaperOrientation, _
                 nTopMargin, _
                 nLeftMargin, _
                 nBottomMargin, _
                 nRightMargin)

    udtCanvas.ObjectNumber = 0
    udtCanvas.StreamObject = 0
    udtCanvas.StreamComplete = 0

    ME.CreateCanvas(udtCanvas)

    sTempStream = ""

' PDF Header

    sPDFStream = "%PDF-1.5" + $CRLF + CHR$(4) + CHR$(5) + CHR$(6) + CHR$(7) + $CRLF
    ME.SaveOffset(LEN(sPDFStream))

' PDF Documentation Information

    LET cTime = CLASS "PowerTime"
    LET cTimeUTC = CLASS "PowerTime"
    cTime.Now
    cTimeUTC.NowUTC
    cTime.TimeDiff(cTimeUTC,nSign,BYVAL 0,nHours,nMinutes,BYVAL 0,BYVAL 0,BYVAL 0)

    SELECT CASE nSign

        CASE = 0

            sSign = "Z"

        CASE > 0

            sSign = "+"

        CASE ELSE

            sSign = "-"

    END SELECT

    sTime = FORMAT$(cTime.Year,"0000") _
          + FORMAT$(cTime.Month,"00") _
          + FORMAT$(cTime.Day,"00") _
          + FORMAT$(cTime.Hour,"00") _
          + FORMAT$(cTime.Minute,"00") _
          + FORMAT$(cTime.Second,"00") _
          + sSign _
          + FORMAT$(nHours,"00") _
          + "'" _
          + FORMAT$(nMinutes,"00") _
          + "'"


    CurrentObjectNumber = 1
    sContent = ""

    ME.BuildObject(sContent,"1 0 obj")
    ME.BuildObject(sContent,"<<")
    ME.BuildObject(sContent,"/Producer (" + sProducer + ")")
    ME.BuildObject(sContent,"/Author (" + sAuthor + ")")
    ME.BuildObject(sContent,"/CreationDate (D:" + sTime + ")")
    ME.BuildObject(sContent,"/Creator (" + sCreator + ")")
    ME.BuildObject(sContent,"/Keywords (" + sKeywords + ")")
    ME.BuildObject(sContent,"/Subject (" + sSubject + ")")
    ME.BuildObject(sContent,"/Title (" + sTitle + ")")
    ME.BuildObject(sContent,"/ModDate (D:" + sTime + ")")
    ME.BuildObject(sContent,">>")
    ME.BuildObject(sContent,"endobj" + $CRLF)

    ME.SaveOffset(LEN(sContent))
    sPDFStream = sPDFStream + sContent

' Start a stream object for the first page

    ME.StartStream()

   END METHOD

   METHOD PageSetup(BYREF udtCanvas AS PageCanvas, _
                    BYVAL nPaperID AS LONG, _
                    BYVAL nPaperOrientation AS LONG, _
                    BYVAL nTopMargin AS DOUBLE, _
                    BYVAL nLeftMargin AS DOUBLE, _
                    BYVAL nBottomMargin AS DOUBLE, _
                    BYVAL nRightMargin AS DOUBLE)

LOCAL sPaperName        AS STRING
LOCAL nPaperHeight      AS DOUBLE
LOCAL nPaperWidth       AS DOUBLE

    ME.PDFPageMetrics(nPaperID,sPaperName,nPaperHeight,nPaperWidth)

    IF nTopMargin < 0 THEN

        nTopMargin = %PDF_ONE_QUARTER_INCH

    END IF

    IF nLeftMargin < 0 THEN

        nLeftMargin = %PDF_ONE_QUARTER_INCH

    END IF

    IF nBottomMargin < 0 THEN

        nBottomMargin = %PDF_ONE_QUARTER_INCH

    END IF

    IF nRightMargin < 0 THEN

        nRightMargin = %PDF_ONE_QUARTER_INCH

    END IF

    IF nPaperOrientation = %PDFPAGE_LANDSCAPE THEN

        SWAP nPaperHeight, nPaperWidth

    END IF

    udtCanvas.Width = nPaperWidth
    udtCanvas.Height = nPaperHeight
    udtCanvas.Orientation = nPaperOrientation
    udtCanvas.LeftMargin = nLeftMargin
    udtCanvas.TopMargin = nTopMargin
    udtCanvas.RightMargin = nRightMargin
    udtCanvas.BottomMargin = nBottomMargin

   END METHOD

   METHOD PDFPageMetrics(BYVAL nPaperID AS LONG, _
                         BYREF sPaperName AS STRING, _
                         BYREF nPaperHeight AS DOUBLE, _
                         BYREF nPaperWidth AS DOUBLE)

' Data is in groups of 3: Name, Height, Width and
' nPaperID is the starting index for retrieval

    SELECT CASE nPaperID

        CASE < 1

            nPaperID = %PDF_PAPER_A4

        CASE > DATACOUNT / 3

            nPaperID = %PDF_PAPER_A4

    END SELECT

    nPaperID = (nPaperID * 3) - 2

    sPaperName = READ$(nPaperID)
    nPaperHeight = VAL(READ$(nPaperID + 1))
    nPaperWidth = VAL(READ$(nPaperID + 2))

' ISO Paper Sizes

DATA "A0","3370","2384"
DATA "A1","2384","1684"
DATA "A2","1684","1190"
DATA "A3","1190","842"
DATA "A4","842","595"
DATA "A5","595","420"
DATA "A6","420","298"
DATA "A7","298","210"
DATA "A8","210","148"
DATA "B0","4008","2835"
DATA "B1","2835","2004"
DATA "B2","2004","1417"
DATA "B3","1417","1001"
DATA "B4","1001","709"
DATA "B5","709","499"
DATA "B6","499","354"
DATA "B7","354","249"
DATA "B8","249","176"
DATA "B9","176","125"
DATA "B10","125","88"

' C-sizes are used for envelopes to match the A-series paper. Unrealistic sizes like
' C0 (imagine an envelope measuring 917 by 1297 millimetres) have been omitted.

DATA "C2","578","1837"
DATA "C3","919","578"
DATA "C4","649","919"
DATA "C5","459","649"
DATA "C6","323","459"

' American paper sizes

DATA "Letter","792","612"
DATA "Legal","1008","612"
DATA "Ledger","1224","792"
DATA "Tabloid","792","1224"
DATA "Executive","756","522"
DATA "ANSI C","1224","1584"
DATA "ANSI D","1584","2448"
DATA "ANSI E","2448","3168"

' English paper sizes

DATA "Foolscap","1188","954"
DATA "Small Post","1332","1044"
DATA "Sheet and 1/3 cap","1584","954"
DATA "Sheet and 1/2 cap","1782","954"
DATA "Demy","1440","1116"
DATA "Large Post","1512","1188"
DATA "Small medium","1584","1260"
DATA "Medium","1656","1296"
DATA "Small Royal","1728","1368"
DATA "Royal","1800","1440"
DATA "Imperial","2160","1584"

' UK metric book printing sizes

DATA "Metric Crown Quarto","697","536"
DATA "Metric Crown Octavo","527","349"
DATA "Metric Large Crown Quarto","731","570"
DATA "Metric Large Crown Octavo","561","366"
DATA "Metric Demy Quarto","782","621"
DATA "Metric Demy Octavo","612","391"
DATA "Metric Royal Quarto","884","672"
DATA "Metric Royal Octavo","561","366"

   END METHOD

   METHOD PDFEndPage()

' Close out current page content if necessary

    ME.EndStream()

   END METHOD

   METHOD StartStream()

' Begin the stream object for current page content

LOCAL udtCanvas         AS PageCanvas

    ME.GetCurrentCanvas(udtCanvas)

    udtCanvas.StreamComplete = 0

    ME.UpdateCurrentCanvas(udtCanvas)

    sTempStream = ""

   END METHOD

    METHOD EndStream()

' Close out content stream for the current page

LOCAL udtCanvas         AS PageCanvas
LOCAL sStreamObject     AS STRING

    ME.GetCurrentCanvas(udtCanvas)

    IF udtCanvas.StreamComplete <> 1 THEN

' Look for the special comment tag %pageno and replace it with the current page number

        ME.StringReplace(sTempStream,"%pageno",TRIM$(FORMAT$(PageCanvasList.Count(),"###,###")))

' Save the page content stream

        PageStreamList.Replace(PageCanvasList.Count(),sTempStream)

        udtCanvas.StreamComplete = 1

        ME.UpdateCurrentCanvas(udtCanvas)

    END IF

    sTempStream = ""

   END METHOD

   METHOD GetCurrentCanvas(BYREF udtCanvas AS PageCanvas)

    ME.GetCanvas(PageCanvasList.Count(),udtCanvas)

   END METHOD

   METHOD GetCanvas(BYVAL nIndex AS LONG,BYREF udtCanvas AS PageCanvas)

    TYPE SET udtCanvas = VARIANT$(BYTE,PageCanvasList.Item(nIndex))

   END METHOD

   METHOD UpdateCurrentCanvas(BYREF udtCanvas AS PageCanvas)

    ME.UpdateCanvas(PageCanvasList.Count(),udtCanvas)

   END METHOD

   METHOD UpdateCanvas(BYVAL nIndex AS LONG,BYREF udtCanvas AS PageCanvas)

    PageCanvasList.Replace(nIndex,udtCanvas AS STRING)

   END METHOD

   METHOD CreateCanvas(BYREF udtCanvas AS PageCanvas)

    PageCanvasList.Add(udtCanvas AS STRING)
    PageStreamList.Add("")

   END METHOD

   METHOD BuildObject(BYREF sObject AS STRING, BYVAL sObjectPart AS STRING)

' Add single line of new content to the referenced object

    sObject = sObject + sObjectPart + $CRLF

   END METHOD

   METHOD SaveOffset(BYVAL nOffset AS LONG)

' Maintain table of object offsets

    LOCAL nCurrentOffset    AS LONG
    LOCAL nLastIndex        AS LONG

    nLastIndex = ObjectOffsetList.Count
    nCurrentOffset = 0

    IF nLastIndex > 0 THEN
        nCurrentOffset = VARIANT#(ObjectOffsetList.Item(nLastIndex))
    END IF

    ObjectOffsetList.Add(nCurrentOffset + nOffset)

   END METHOD

   METHOD FormatPoint(BYVAL nPoint AS DOUBLE) AS STRING

    LOCAL sPoint    AS STRING

    sPoint = TRIM$(FORMAT$(nPoint + .000005,"#####0.0####"))

    ME.StringReplace(sPoint,".00000","")

    METHOD = sPoint

   END METHOD

   METHOD StringReplace(BYREF sText AS STRING,BYVAL sMatch AS STRING,BYVAL sReplace AS STRING)

    REPLACE sMatch WITH sReplace IN sText

   END METHOD

' Set the PDF non stroking color

   METHOD SetNonStrokingColor(BYVAL nColor AS LONG)

    ME.BuildObject(sTempStream,ME.RGB2PDFColor(nColor) + " rg")

   END METHOD

' Set the PDF non stroking color

   METHOD SetStrokingColor(BYVAL nColor AS LONG)

    ME.BuildObject(sTempStream,ME.RGB2PDFColor(nColor) + " RG")

   END METHOD

   METHOD RGB2PDFColor(BYVAL nRGB AS LONG) AS STRING

    LOCAL pRGB      AS BYTE POINTER
    LOCAL nRed      AS LONG
    LOCAL nGreen    AS LONG
    LOCAL nBlue     AS LONG

    pRGB = VARPTR(nRGB)
    nRed = @pRGB[0]
    nGreen = @pRGB[1]
    nBlue = @pRGB[2]

    METHOD = TRIM$(FORMAT$((nRed / 255) + .000005,"0.0000#")) _
           + " " _
           + TRIM$(FORMAT$((nGreen / 255) + .000005,"0.0000#")) _
           + " " _
           + TRIM$(FORMAT$((nBlue / 255) + .000005,"0.0000#"))

   END METHOD

   METHOD RotateStream(BYVAL nAngle AS DOUBLE,BYVAL nX AS DOUBLE,BYVAL nY AS DOUBLE) AS STRING

' Insert Text Metric a b c d x y

' a=Horizontal Scaling
' b=Horizontal Rotation
' c=Vertical Scaling
' d=Vertical Rotation
' x=Vertical point location in the user space
' y=Horizontal point location in the user space

LOCAL nA        AS DOUBLE
LOCAL nB        AS DOUBLE
LOCAL nC        AS DOUBLE
LOCAL nD        AS DOUBLE

    nAngle = (nAngle * -1) * PI / 180       ' Convert to radians
    nA = COS(nAngle)
    nC = SIN(nAngle)
    nB = nC * -1
    nD = nA

    METHOD = TRIM$(FORMAT$(nA,"#####.0####")) + " " _
           + TRIM$(FORMAT$(nB,"#####.0####")) + " " _
           + TRIM$(FORMAT$(nC,"#####.0####")) + " " _
           + TRIM$(FORMAT$(nD,"#####.0####")) + " " _
           + ME.FormatPoint(nX) + " " _
           + ME.FormatPoint(nY) + " Tm"

   END METHOD

   METHOD DrawingPoints(BYREF udtCanvas AS PageCanvas, _
                        BYREF nX AS DOUBLE, _
                        BYREF nY AS DOUBLE)

' Adjust x,y for page margins and top down placement

    nX = nX + udtCanvas.LeftMargin
    nY = udtCanvas.Height - nY - udtCanvas.TopMargin - udtCanvas.BottomMargin

   END METHOD

   METHOD SaveGraphicsState()

    ME.BuildObject(sTempStream,"q")

   END METHOD

   METHOD RestoreGraphicsState()

    ME.BuildObject(sTempStream,"Q")

   END METHOD

  END INTERFACE                         ' End of interface
END CLASS

' ########################################################################################
' Microsoft Windows
' File: cPDFFonts.inc
' Copyright (c) 2014 Rick Kelly
'
' Released into the public domain for private and public use without restriction.
' This code is provided as is without warranty of any kind, either expressed or implied,
' including and not limited to any implied warranties, merchantability, or fitness for
' a particular purpose.

' ########################################################################################
' cPDFFonts Class
' ########################################################################################

CLASS cPDFFonts                     ' Name of PDF Fonts class

INSTANCE FontList                   AS IPOWERCOLLECTION
INSTANCE FontWidths                 AS IPOWERCOLLECTION

  CLASS METHOD CREATE

    LET FontList = CLASS "PowerCollection"
    LET FontWidths = CLASS "PowerCollection"

' =====================================================================================
' Create all supported font families
' =====================================================================================

    ME.CreateArialFont()
    ME.CreateTimesNewRomanFont()

  END METHOD

  CLASS METHOD DESTROY

    FontList = NOTHING
    FontWidths = NOTHING

  END METHOD

' =====================================================================================
' Create Font Class Arial
' =====================================================================================

   CLASS METHOD CreateArialFont()

LOCAL uDescriptor       AS FontDescriptor
LOCAL sFontKey          AS WSTRING
DIM arWidths(0)         AS LOCAL LONG
LOCAL nIndex            AS LONG
LOCAL vObject           AS VARIANT

' Arial Normal

    uDescriptor.FontName = "Arial"
    uDescriptor.FontID = %FONT_ARIAL
    uDescriptor.FontStyle = %PDF_FONT_NORMAL
    uDescriptor.FontReferenced = 0
    uDescriptor.FontAscent = 905
    uDescriptor.FontCapHeight = 728
    uDescriptor.FontDescent = -212
    uDescriptor.FontFlags = 32
    uDescriptor.FontRectLeft = -664
    uDescriptor.FontRectTop = -325
    uDescriptor.FontRectRight = 2028
    uDescriptor.FontRectBottom = 1037
    uDescriptor.FontItalicAngle = 0
    uDescriptor.FontStemV = 44
    uDescriptor.FontWeight = 400
    uDescriptor.FontUnderlineThickness = 73
    uDescriptor.FontUnderlinePosition = -106

' Add to font list

   sFontKey = "F" + FORMAT$(FontList.Count + 1)

   FontList.Add(sFontKey,uDescriptor AS STRING)

' Add the character widths

   REDIM arWidths(0 TO 255)

   FOR nIndex = 0 TO 255

    arWidths(nIndex) = ME.ArialNormalWidths(nIndex)

   NEXT

   LET vObject = arWidths()

   FontWidths.Add(sFontKey,vObject)

' Arial Bold

    uDescriptor.FontName = "Arial,Bold"
    uDescriptor.FontID = %FONT_ARIAL
    uDescriptor.FontStyle = %PDF_FONT_BOLD
    uDescriptor.FontReferenced = 0
    uDescriptor.FontAscent = 905
    uDescriptor.FontCapHeight = 728
    uDescriptor.FontDescent = -212
    uDescriptor.FontFlags = 32
    uDescriptor.FontRectLeft = -627
    uDescriptor.FontRectTop = -376
    uDescriptor.FontRectRight = 2034
    uDescriptor.FontRectBottom = 1048
    uDescriptor.FontItalicAngle = 0
    uDescriptor.FontStemV = 47
    uDescriptor.FontWeight = 700
    uDescriptor.FontUnderlineThickness = 105
    uDescriptor.FontUnderlinePosition = -106

' Add to font list

   sFontKey = "F" + FORMAT$(FontList.Count + 1)

   FontList.Add(sFontKey,uDescriptor AS STRING)

' Add the character widths

   REDIM arWidths(0 TO 255)

   FOR nIndex = 0 TO 255

    arWidths(nIndex) = ME.ArialBoldWidths(nIndex)

   NEXT

   LET vObject = arWidths()

   FontWidths.Add(sFontKey,vObject)

' Arial Italic

    uDescriptor.FontName = "Arial,Italic"
    uDescriptor.FontID = %FONT_ARIAL
    uDescriptor.FontStyle = %PDF_FONT_ITALIC
    uDescriptor.FontReferenced = 0
    uDescriptor.FontAscent = 905
    uDescriptor.FontCapHeight = 728
    uDescriptor.FontDescent = -212
    uDescriptor.FontFlags = 32
    uDescriptor.FontRectLeft = -517
    uDescriptor.FontRectTop = -325
    uDescriptor.FontRectRight = 1082
    uDescriptor.FontRectBottom = 1025
    uDescriptor.FontItalicAngle = -12
    uDescriptor.FontStemV = 44
    uDescriptor.FontWeight = 400
    uDescriptor.FontUnderlineThickness = 73
    uDescriptor.FontUnderlinePosition = -106

' Add to font list

   sFontKey = "F" + FORMAT$(FontList.Count + 1)

   FontList.Add(sFontKey,uDescriptor AS STRING)

' Add the character widths

   REDIM arWidths(0 TO 255)

   FOR nIndex = 0 TO 255

    arWidths(nIndex) = ME.ArialItalicWidths(nIndex)

   NEXT

   LET vObject = arWidths()

   FontWidths.Add(sFontKey,vObject)

' Arial Bold Italic

    uDescriptor.FontName = "Arial,BoldItalic"
    uDescriptor.FontID = %FONT_ARIAL
    uDescriptor.FontStyle = %PDF_FONT_BOLDITALIC
    uDescriptor.FontReferenced = 0
    uDescriptor.FontAscent = 905
    uDescriptor.FontCapHeight = 728
    uDescriptor.FontDescent = -212
    uDescriptor.FontFlags = 32
    uDescriptor.FontRectLeft = -560
    uDescriptor.FontRectTop = -376
    uDescriptor.FontRectRight = 1157
    uDescriptor.FontRectBottom = 1031
    uDescriptor.FontItalicAngle = -12
    uDescriptor.FontStemV = 47
    uDescriptor.FontWeight = 700
    uDescriptor.FontUnderlineThickness = 105
    uDescriptor.FontUnderlinePosition = -106

' Add to font list

   sFontKey = "F" + FORMAT$(FontList.Count + 1)

   FontList.Add(sFontKey,uDescriptor AS STRING)

' Add the character widths

   REDIM arWidths(0 TO 255)

   FOR nIndex = 0 TO 255

    arWidths(nIndex) = ME.ArialBoldItalicWidths(nIndex)

   NEXT

   LET vObject = arWidths()

   FontWidths.Add(sFontKey,vObject)

   END METHOD

   CLASS METHOD ArialNormalWidths(BYVAL nChar AS LONG) AS LONG

' Character Widths

    METHOD = VAL(READ$(nChar + 1))

DATA 750,750,750,750,750,750,750,750,750,750,750,750,750,750,750,750
DATA 750,750,750,750,750,750,750,750,750,750,750,750,750,750,750,750
DATA 278,278,368,603,569,889,704,204,357,357,414,588,278,362,278,338
DATA 568,556,563,571,568,576,570,571,572,572,278,278,589,588,589,566
DATA 1039,728,674,743,729,673,625,778,722,278,500,725,581,833,722,793
DATA 684,801,769,675,651,722,719,993,721,719,646,322,338,278,503,627
DATA 333,574,575,551,556,574,373,556,556,222,222,556,222,833,556,579
DATA 576,556,407,521,331,556,548,774,553,551,539,371,260,366,602,750
DATA 601,750,222,590,348,1000,575,577,381,1042,675,333,1028,750,646,750
DATA 750,225,222,354,348,361,614,1060,390,1000,521,333,967,750,539,719
DATA 278,333,565,588,576,613,260,570,364,798,411,556,588,362,798,627
DATA 400,571,376,375,349,576,601,278,333,333,402,556,879,876,879,611
DATA 728,728,728,728,728,728,1005,743,673,673,673,673,278,309,353,336
DATA 729,722,793,793,793,793,793,584,801,722,722,722,722,719,684,640
DATA 574,574,574,574,574,574,908,551,574,574,574,574,278,332,361,338
DATA 576,556,579,579,579,579,579,571,611,556,556,556,556,551,576,551

   END METHOD

   CLASS METHOD ArialBoldWidths(BYVAL nChar AS LONG) AS LONG

' Character Widths

    METHOD = VAL(READ$(nChar + 1))

DATA 750,750,750,750,750,750,750,750,750,750,750,750,750,750,750,750
DATA 750,750,750,750,750,750,750,750,750,750,750,750,750,750,750,750
DATA 278,333,484,604,572,902,766,254,361,341,428,602,278,361,278,339
DATA 567,556,566,573,593,586,581,572,571,570,333,333,597,602,598,625
DATA 1032,778,733,731,732,677,624,778,722,278,556,780,641,833,722,798
DATA 681,825,777,678,650,722,726,1003,726,728,652,374,339,333,587,621
DATA 333,582,632,591,611,576,422,611,611,278,278,606,278,889,611,635
DATA 634,611,462,568,381,611,604,837,607,600,539,423,280,416,611,750
DATA 585,750,278,618,500,1000,577,577,392,1060,678,359,1029,750,652,750
DATA 750,283,278,502,500,381,614,1060,392,1000,568,359,963,750,539,728
DATA 278,333,590,601,591,611,280,581,391,804,406,560,602,361,804,621
DATA 414,585,369,373,373,586,611,278,345,333,412,565,884,869,884,623
DATA 778,778,778,778,778,778,1012,731,677,677,677,677,278,333,370,366
DATA 733,722,798,798,798,798,798,590,810,722,722,722,722,728,681,636
DATA 582,582,582,582,582,582,902,591,576,576,576,576,278,343,366,365
DATA 634,611,635,635,635,635,635,584,638,611,611,611,611,600,634,600

   END METHOD

   CLASS METHOD ArialItalicWidths(BYVAL nChar AS LONG) AS LONG

' Character Widths

    METHOD = VAL(READ$(nChar + 1))

DATA 750,750,750,750,750,750,750,750,750,750,750,750,750,750,750,750
DATA 750,750,750,750,750,750,750,750,750,750,750,750,750,750,750,750
DATA 278,325,450,564,594,889,672,280,434,333,389,584,278,355,278,432
DATA 586,556,583,578,563,593,589,616,585,572,286,283,584,584,584,582
DATA 1015,667,676,751,733,732,681,787,775,323,557,762,556,893,778,793
DATA 719,794,751,692,726,775,778,1083,790,794,658,412,294,350,469,588
DATA 333,556,556,532,619,556,429,585,556,289,288,575,285,834,556,561
DATA 556,573,440,522,342,579,580,798,559,582,533,466,260,334,584,750
DATA 666,750,222,556,333,1000,604,609,409,1024,692,335,1065,750,658,750
DATA 750,302,298,434,438,350,575,1021,445,1000,525,333,944,750,533,794
DATA 278,333,556,628,556,688,260,576,430,759,430,558,584,355,759,588
DATA 400,549,422,421,393,593,630,278,333,375,433,556,872,848,886,611
DATA 667,667,667,667,667,667,1064,751,732,732,732,732,361,410,428,435
DATA 733,778,793,793,793,793,793,584,797,775,775,775,775,794,688,611
DATA 556,556,556,562,556,556,889,532,556,556,556,556,331,370,393,399
DATA 567,556,561,561,561,561,561,549,611,579,579,579,579,582,556,582

   END METHOD

   CLASS METHOD ArialBoldItalicWidths(BYVAL nChar AS LONG) AS LONG

' Character Widths

    METHOD = VAL(READ$(nChar + 1))

DATA 750,750,750,750,750,750,750,750,750,750,750,750,750,750,750,750
DATA 750,750,750,750,750,750,750,750,750,750,750,750,750,750,750,750
DATA 278,325,450,564,594,889,672,280,434,333,389,584,278,355,278,432
DATA 586,556,583,578,563,593,589,616,585,572,286,283,584,584,584,582
DATA 1015,667,676,751,733,732,681,787,775,323,557,762,556,893,778,793
DATA 719,794,751,692,726,775,778,1083,790,794,658,412,294,350,469,588
DATA 333,556,556,532,619,556,429,585,556,289,288,575,285,834,556,561
DATA 556,573,440,522,342,579,580,798,559,582,533,466,260,334,584,750
DATA 666,750,222,556,333,1000,604,609,409,1024,692,335,1065,750,658,750
DATA 750,302,298,434,438,350,575,1021,445,1000,525,333,944,750,533,794
DATA 278,333,556,628,556,688,260,576,430,759,430,558,584,355,759,588
DATA 400,549,422,421,393,593,630,278,333,375,433,556,872,848,886,611
DATA 667,667,667,667,667,667,1064,751,732,732,732,732,361,410,428,435
DATA 733,778,793,793,793,793,793,584,797,775,775,775,775,794,688,611
DATA 556,556,556,562,556,556,889,532,556,556,556,556,331,370,393,399
DATA 567,556,561,561,561,561,561,549,611,579,579,579,579,582,556,582

   END METHOD

' =====================================================================================
' Create Font Class Times New Roman
' =====================================================================================

   CLASS METHOD CreateTimesNewRomanFont()

LOCAL uDescriptor       AS FontDescriptor
LOCAL sFontKey          AS WSTRING
DIM arWidths(0)         AS LOCAL LONG
LOCAL nIndex            AS LONG
LOCAL vObject           AS VARIANT

' Times New Roman Normal

    uDescriptor.FontName = "Times#20New#20Roman"
    uDescriptor.FontID = %FONT_TIMESNEWROMAN
    uDescriptor.FontStyle = %PDF_FONT_NORMAL
    uDescriptor.FontReferenced = 0
    uDescriptor.FontAscent = 891
    uDescriptor.FontCapHeight = 693
    uDescriptor.FontDescent = -216
    uDescriptor.FontFlags = 32
    uDescriptor.FontRectLeft = -568
    uDescriptor.FontRectTop = -307
    uDescriptor.FontRectRight = 2028
    uDescriptor.FontRectBottom = 1007
    uDescriptor.FontItalicAngle = 0
    uDescriptor.FontStemV = 40
    uDescriptor.FontWeight = 400
    uDescriptor.FontUnderlineThickness = 49
    uDescriptor.FontUnderlinePosition = -109

' Add to font list

   sFontKey = "F" + FORMAT$(FontList.Count + 1)

   FontList.Add(sFontKey,uDescriptor AS STRING)

' Add the character widths

   REDIM arWidths(0 TO 255)

   FOR nIndex = 0 TO 255

    arWidths(nIndex) = ME.TimesNewRomanNormalWidths(nIndex)

   NEXT

   LET vObject = arWidths()

   FontWidths.Add(sFontKey,vObject)

' Times New Roman Bold

    uDescriptor.FontName = "Times#20New#20Roman,Bold"
    uDescriptor.FontID = %FONT_TIMESNEWROMAN
    uDescriptor.FontStyle = %PDF_FONT_BOLD
    uDescriptor.FontReferenced = 0
    uDescriptor.FontAscent = 891
    uDescriptor.FontCapHeight = 677
    uDescriptor.FontDescent = -216
    uDescriptor.FontFlags = 32
    uDescriptor.FontRectLeft = -556
    uDescriptor.FontRectTop = -307
    uDescriptor.FontRectRight = 2034
    uDescriptor.FontRectBottom = 1026
    uDescriptor.FontItalicAngle = 0
    uDescriptor.FontStemV = 42
    uDescriptor.FontWeight = 700
    uDescriptor.FontUnderlineThickness = 95
    uDescriptor.FontUnderlinePosition = -109

' Add to font list

   sFontKey = "F" + FORMAT$(FontList.Count + 1)

   FontList.Add(sFontKey,uDescriptor AS STRING)

' Add the character widths

   REDIM arWidths(0 TO 255)

   FOR nIndex = 0 TO 255

    arWidths(nIndex) = ME.TimesNewRomanBoldWidths(nIndex)

   NEXT

   LET vObject = arWidths()

   FontWidths.Add(sFontKey,vObject)

' Times New Roman Italic

    uDescriptor.FontName = "Times#20New#20Roman,Italic"
    uDescriptor.FontID = %FONT_TIMESNEWROMAN
    uDescriptor.FontStyle = %PDF_FONT_ITALIC
    uDescriptor.FontReferenced = 0
    uDescriptor.FontAscent = 891
    uDescriptor.FontCapHeight = 694
    uDescriptor.FontDescent = -216
    uDescriptor.FontFlags = 32
    uDescriptor.FontRectLeft = -498
    uDescriptor.FontRectTop = -307
    uDescriptor.FontRectRight = 1120
    uDescriptor.FontRectBottom = 1023
    uDescriptor.FontItalicAngle = -17.3
    uDescriptor.FontStemV = 40
    uDescriptor.FontWeight = 400
    uDescriptor.FontUnderlineThickness = 49
    uDescriptor.FontUnderlinePosition = -109

' Add to font list

   sFontKey = "F" + FORMAT$(FontList.Count + 1)

   FontList.Add(sFontKey,uDescriptor AS STRING)

' Add the character widths

   REDIM arWidths(0 TO 255)

   FOR nIndex = 0 TO 255

    arWidths(nIndex) = ME.TimesNewRomanItalicWidths(nIndex)

   NEXT

   LET vObject = arWidths()

   FontWidths.Add(sFontKey,vObject)

' Times New Roman Bold Italic

    uDescriptor.FontName = "Times,BoldItalic"   '"Times#20New#20Roman,BoldItalic"
    uDescriptor.FontID = %FONT_TIMESNEWROMAN
    uDescriptor.FontStyle = %PDF_FONT_BOLDITALIC
    uDescriptor.FontReferenced = 0
    uDescriptor.FontAscent = 891
    uDescriptor.FontCapHeight = 677
    uDescriptor.FontDescent = -216
    uDescriptor.FontFlags = 32
    uDescriptor.FontRectLeft = -547
    uDescriptor.FontRectTop = -307
    uDescriptor.FontRectRight = 1206
    uDescriptor.FontRectBottom = 1032
    uDescriptor.FontItalicAngle = -17.3
    uDescriptor.FontStemV = 41
    uDescriptor.FontWeight = 700
    uDescriptor.FontUnderlineThickness = 95
    uDescriptor.FontUnderlinePosition = -109


' Add to font list

   sFontKey = "F" + FORMAT$(FontList.Count + 1)

   FontList.Add(sFontKey,uDescriptor AS STRING)

' Add the character widths

   REDIM arWidths(0 TO 255)

   FOR nIndex = 0 TO 255

    arWidths(nIndex) = ME.TimesNewRomanBoldItalicWidths(nIndex)

   NEXT

   LET vObject = arWidths()

   FontWidths.Add(sFontKey,vObject)

   END METHOD

   CLASS METHOD TimesNewRomanNormalWidths(BYVAL nChar AS LONG) AS LONG

' Character Widths

    METHOD = VAL(READ$(nChar + 1))

DATA 778,778,778,778,778,778,778,778,778,778,778,778,778,778,778,778
DATA 778,778,778,778,778,778,778,778,778,778,778,778,778,778,778,778
DATA 250,333,408,503,500,833,778,180,333,333,500,565,250,333,250,301
DATA 500,500,500,500,500,500,500,500,500,500,278,278,565,566,564,444
DATA 921,732,667,667,722,611,556,729,723,333,404,751,611,889,729,722
DATA 556,722,697,556,611,732,731,957,731,729,611,333,301,333,472,530
DATA 333,463,500,444,523,444,456,503,515,278,278,527,278,794,517,500
DATA 500,521,360,389,300,520,512,734,509,515,449,480,200,480,563,778
DATA 503,778,333,509,444,1000,500,500,333,1000,556,333,889,778,611,778
DATA 778,333,333,444,444,350,529,1030,344,984,389,333,722,778,449,729
DATA 250,333,500,500,507,521,200,500,333,760,295,500,566,333,760,530
DATA 400,559,302,300,333,576,476,250,333,300,319,500,754,750,754,444
DATA 732,732,732,732,732,732,889,667,611,611,611,611,333,333,333,333
DATA 722,729,722,722,722,722,722,564,722,732,732,732,732,729,556,500
DATA 463,463,463,463,463,463,667,444,444,444,444,444,278,278,302,300
DATA 500,517,500,500,500,500,500,559,502,520,520,520,520,515,500,515

   END METHOD

   CLASS METHOD TimesNewRomanBoldWidths(BYVAL nChar AS LONG) AS LONG

' Character Widths

    METHOD = VAL(READ$(nChar + 1))

DATA 778,778,778,778,778,778,778,778,778,778,778,778,778,778,778,778
DATA 778,778,778,778,778,778,778,778,778,778,778,778,778,778,778,778
DATA 250,333,555,517,505,1000,833,278,358,333,500,590,254,346,250,318
DATA 500,500,500,500,500,500,507,513,502,501,333,333,590,591,590,500
DATA 945,748,669,722,722,667,618,805,797,403,531,826,668,963,736,779
DATA 618,780,768,556,668,742,749,1028,752,748,686,338,318,333,581,546
DATA 333,520,556,458,571,457,444,519,564,304,333,602,305,844,564,501
DATA 556,573,466,391,360,561,528,749,521,528,465,394,220,394,588,778
DATA 521,778,333,537,500,1000,500,500,361,1008,556,333,1000,778,686,778
DATA 778,333,333,500,500,353,545,1046,362,1042,391,333,731,778,465,748
DATA 250,333,500,516,528,536,220,500,360,759,345,519,591,346,759,546
DATA 404,579,313,308,352,596,579,250,333,300,343,520,767,762,767,500
DATA 748,748,748,748,748,748,1000,722,667,667,667,667,403,403,403,403
DATA 722,736,779,779,779,779,779,570,779,742,742,742,742,748,614,556
DATA 520,520,520,520,520,520,730,458,457,457,457,457,304,326,333,335
DATA 501,564,501,501,501,501,501,579,504,561,561,561,561,528,556,528

   END METHOD

   CLASS METHOD TimesNewRomanItalicWidths(BYVAL nChar AS LONG) AS LONG

' Character Widths

    METHOD = VAL(READ$(nChar + 1))

DATA 778,778,778,778,778,778,778,778,778,778,778,778,778,778,778,778
DATA 778,778,778,778,778,778,778,778,778,778,778,778,778,778,778,778
DATA 250,338,473,503,510,838,778,282,463,333,500,675,250,333,250,402
DATA 515,500,500,500,508,500,546,544,510,512,333,333,675,675,675,500
DATA 920,611,611,725,726,653,689,746,832,431,568,750,556,945,783,739
DATA 642,738,611,563,670,835,744,965,762,688,632,492,278,389,481,530
DATA 358,500,500,449,562,451,494,542,500,293,301,511,318,722,500,500
DATA 500,500,424,389,321,500,463,683,460,461,413,536,275,400,563,778
DATA 607,778,333,509,556,889,542,525,407,1007,567,333,990,778,632,778
DATA 778,376,360,580,570,350,529,919,429,984,433,333,669,778,433,688
DATA 250,389,500,545,507,644,275,531,430,760,397,503,675,333,760,530
DATA 400,559,354,345,381,576,523,250,333,325,414,500,750,750,750,500
DATA 611,639,642,688,690,627,930,725,653,653,653,653,431,431,442,467
DATA 732,783,739,739,739,739,739,675,758,835,835,835,835,688,626,519
DATA 500,500,500,512,515,500,673,449,451,451,464,489,297,355,363,388
DATA 502,512,500,500,500,512,515,559,510,500,500,500,503,461,500,471

   END METHOD

   CLASS METHOD TimesNewRomanBoldItalicWidths(BYVAL nChar AS LONG) AS LONG

' Character Widths

    METHOD = VAL(READ$(nChar + 1))

DATA 778,778,778,778,778,778,778,778,778,778,778,778,778,778,778,778
DATA 778,778,778,778,778,778,778,778,778,778,778,778,778,778,778,778
DATA 250,389,580,501,521,833,778,335,456,333,530,574,250,343,250,436
DATA 520,500,504,500,523,525,531,575,512,514,333,333,574,575,574,500
DATA 929,667,667,742,723,701,711,768,883,488,619,768,611,995,832,739
DATA 665,739,667,604,714,830,797,1023,784,738,700,450,278,368,570,529
DATA 336,500,500,459,566,463,528,538,556,319,320,534,339,778,556,500
DATA 500,504,423,391,334,556,465,684,529,465,416,501,220,365,572,778
DATA 620,778,333,521,500,1000,531,529,405,1003,604,333,979,778,700,778
DATA 778,367,369,560,560,350,530,1030,419,1026,424,333,738,778,439,738
DATA 250,389,500,546,512,635,220,551,422,747,388,514,606,343,747,665
DATA 447,563,365,357,426,576,563,257,333,344,396,500,750,750,750,500
DATA 667,758,706,728,742,678,979,742,701,701,701,701,488,547,489,507
DATA 729,832,739,739,739,739,739,570,748,830,830,830,830,738,624,527
DATA 500,504,500,502,507,500,737,459,463,557,463,481,292,382,361,380
DATA 507,556,500,522,500,502,507,563,506,556,556,556,556,489,500,465

   END METHOD

  INTERFACE iPDFFonts                  ' Name of PDF Fonts interface
   INHERIT IUNKNOWN                    ' What our interface inherits from

' =====================================================================================
' Total number of fonts created (usually normal,bold,italic,bold italic per family)
' =====================================================================================

    PROPERTY GET TotalFonts() AS LONG

        PROPERTY = FontList.Count

    END PROPERTY

' =====================================================================================
' Retrieve requested font descriptor and character widths
' =====================================================================================

    METHOD GetFont(BYVAL nFontIndex AS LONG, _
                   BYREF sFontID AS WSTRING, _
                   BYREF vFontDescriptor AS VARIANT, _
                   BYREF vFontWidths AS VARIANT)

        FontList.Entry(nFontIndex,sFontID,vFontDescriptor)
        vFontWidths = FontWidths.Item(sFontID)

    END METHOD

  END INTERFACE                         ' End of interface
END CLASS

