Create pdf files version 1.3 (Acrobat 4.0)

doctorized · Post by **doctorized** » Tue Sep 01, 2009 1:07 pm

Here is a code that creates pdf files version 1.3. Because of some problems with this forum, I posted the code here:

http://kc2000labs.110mb.com/pb/zips/4.31/pdf_1.3.zip

The original code was writen for Visual Basic 6.0 by Luigi Micco. According to him, we are free to use this code in our programs, as long as we insert a note of copyright like this (or similar): "Porting of clsPDFCreator - Luigi Micco <http://www.luigimicco.altervista.org>".

doctorized · Post by **doctorized** » Tue Sep 01, 2009 2:36 pm

To avoid any kind of misunderstanding, the code comes with NO kind of license. You do not have to contact with the author or do something more than to write a simple line in you project saying that the code for the pdf file creation belongs to Luigi Micco. That is all.

luis · Post by **luis** » Tue Sep 08, 2009 10:54 am

Thanks for sharing it

Kcc · Post by **Kcc** » Tue Sep 15, 2009 12:56 pm

Thanks a lot

Post by **Andre** » Fri Dec 31, 2010 3:05 pm

A good start for coding a PDF output in PureBasic!

As I tried to make it runnable on my MacBook I came up with this extended/modified code, which should run on Windows and MacOS (and probably on Linux too). Any improvements are welcome!

Code - 1st part:

Code: Select all

; English forum: http://www.purebasic.fr/english/viewtopic.php?t=38879
; Author: doctorized (reworked by Andre to work on MacOS)
; Date: 31. December 2010
; OS: Windows, MacOS
; Demo: No


; File settings:
; ----------------------------------------------------------
strFile.s  = "test.pdf"
bmpImage.s = "heart_016.bmp"   ; set your own file name here!

CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
  CompilerIf #PB_Compiler_Debugger = 1   ; Debugger is on
    path$ = #PB_Compiler_FilePath
  CompilerElse   ; Debugger is off (executable)
    path$ = RemoveString(GetPathPart(ProgramFilename()),"PDF1.3.app/Contents/MacOS/")  ; /Users/geoworld/GeoWorld2/Developing/PureBasic0.app/Contents/MacOS/
  CompilerEndIf
CompilerElse   ; Windows (Linux not tested)
  path$ = GetPathPart(ProgramFilename())
CompilerEndIf

strFile  = path$ + strFile
bmpImage = path$ + bmpImage

If Not FileSize(bmpImage)
  MessageRequester("Warning", "The given BMP-image" + Chr(10) + bmpImage + Chr(10) + "couldn't be found, this will probably cause problems with the created PDF-file!")
EndIf  

; ----------------------------------------------------------


; The original code was writen for Visual Basic 6.0 by Luigi Micco. According to him, we are free 
; to use this code in our programs, as long as we insert a note of copyright like this (or similar):
; "Porting of clsPDFCreator - Luigi Micco <http://www.luigimicco.altervista.org>".

#PDF_VERSION = "%PDF-1.3"
#AUTOR = "eLLeMMe / translated for PureBasic 4.31 by doctorized (kc2000labs@yahoo.com)"
#CREATOR = "clsPDFCreator FREE Version";write your own here
#COPYRIGHT = "© 2003-2005 eLLeMMe";write your own here

; Enum
Enumeration ;pdfPathOptions
 #Nil = 0
 #Stroked = 1
 #Closed = 2
 #Filled = 4
EndEnumeration

Enumeration ;pdfColorSpace
 #pdfRGB = 0
 #pdfGrayScale = 1
EndEnumeration

Enumeration ;pdfFontStyle
 #pdfNormal = 0
 #pdfBold = 1
 #pdfItalic = 2
 #pdfBoldItalic = 3
EndEnumeration

Enumeration ;pdfTextAlign
 #pdfAlignLeft = 0
 #pdfAlignRight = 1
 #pdfCenter = 2
EndEnumeration

Enumeration ;pdfPaperSize
  #pdfA4 = 0
  #pdfA3 = 1
  #pdf85x11 = 2
  #pdf85x12 = 3
  #pdfUser = $FF
EndEnumeration

Enumeration ;pdfScaleMode
  #pdf72PxInch = 0
  #pdfInch = 1
  #pdfMillimeter = 2
  #pdfCentimeter = 3
EndEnumeration

Enumeration ;pdfPageOrientation
  #pdfPortrait = 0
  #pdfLandscape = 1
EndEnumeration

Enumeration ;pdfObjectType
  #pdfNull = $0
  #pdfFirstPage = $1
  #pdfEvenPages = $2
  #pdfOddPages = $4
  #pdfNotFirstPage = $8
  #pdfAllPages = #pdfEvenPages | #pdfOddPages | #pdfFirstPage
EndEnumeration


;Internal Variables
Global mvarTitle.s
Global mvarPaperSize.i; As pdfPaperSize
Global mvarPageWidth.f
Global mvarPageHeight.f
Global mvarScaleMode.i; As pdfScaleMode
Global mvarOrientation.i; As pdfPageOrientation
Global mvarPages.w
Global mvarMargin.f
Global mvarFileName.s ;Local Copy.
Global mvarEncodeASCII85.l
Global strPage.s
Global strFont.s
Global strFontname.s
Global strImg.s
Global strObject.s
Global strObjectForPage.s
Global intResource.w
Global intPages.w
Global intObject.w
Global intMaxObject.l
Global intOffsetTemp.l
Global intUsedFont.w
Global Dim ImgBuf.b(1)
Global Dim ImgColor.b(1)
Global mvarCharSpacing.f
Global mvarWordSpacing.f
Global mvarTextScaling.f

Structure FontDescriptor
  BaseFont.s{30}
  FirstChar.b
  LastChar.b
  Param.s{1024}
  Widths.l[256]
  MissingWidth.l
EndStructure

Structure ObjDescriptor
  Name.s
  Options.i;pdfObjectType
EndStructure

;Data Arrays
Global Dim arrXREF.s(1)
Global Dim arrOBJECT.ObjDescriptor(1)
Global Dim arrFONT.FontDescriptor(1)
Global vFONT.FontDescriptor

Declare Title(New_Title.s)
Declare EndObj()
Declare.f ToSpace(Valore.f)
Declare WriteObj(strTemp.s)
Declare.w InitObj(intObj.w=0)
Declare.s ToPdfStr(Temp.s)
Declare.s ToStr(Valore.f, Dec.w = 3)
Declare.f Length(Phrase.s, FontName.s, Fontsize.f)
Declare.f ToSpace(Valore.f)
Declare InsertObjectOnPage()
Declare Curve(x1.f, y1.f, X2.f, Y2.f, X3.f, Y3.f, Options.l = #Stroked)
Declare.l LeggeBMP(FileName.s, Array ImgBuf.b(1), Array ImgColor.b(1), *ImgWidth.l, *ImgHeight.l, *ImgBPP.b, ColorSpace.l = #pdfRGB)
Declare LoadImgFromArray(Name.s, Array ImgBuf.b(1), Array ImgColor.b(1), ImgWidth.l, ImgHeight.l, ImgBPP.b, ColorSpace,l = #pdfRGB)
Declare ToASCII85(Array InBuf.b(1))
Declare CreateFontCourier(Style.l)
Declare CreateFontArial(Style.l)
Declare CreateFontTimes(Style.l)
Declare CreateFontSymbol(Style.l)
Procedure Class_Initialize()
  xTemp.i;pdfFontStyle
  i.w
  
  mvarEncodeASCII85 = #False
  Title("senza titolo")
  mvarScaleMode = #pdf72PxInch
  PaperSize = #pdfA4
  mvarOrientation = #pdfPortrait
  mvarMargin = 0
  mvarPages = 0
  intUsedFont = 0
EndProcedure


;
Procedure EncodeASCII85(vData.l)
  mvarEncodeASCII85 = vData
EndProcedure

;
Procedure Margin(vData.f)
  mvarMargin = ToSpace(vData)
EndProcedure

;
Procedure PaperWidth(vData.f)
  If mvarPaperSize <> #pdfUser: mvarPaperSize = #pdfUser: EndIf
  mvarPageWidth = ToSpace(vData)
EndProcedure

;
Procedure PaperHeight(vData.f)
  If mvarPaperSize <> pdfUser: mvarPaperSize = pdfUser: EndIf
  mvarPageHeight = ToSpace(vData)
EndProcedure

;
Procedure.w Pages()
  ProcedureReturn mvarPages
EndProcedure

;
Procedure ScaleMode(New_ScaleMode.i);pdfScaleMode)
  mvarScaleMode = New_ScaleMode
EndProcedure

;
Procedure PaperSize(New_PaperSize.i);pdfPaperSize)

  mvarPaperSize = New_PaperSize
  Select mvarPaperSize
    Case #pdf85x12     ;Letter, 8 1/2 x 12 in.
        mvarPageWidth = 612
        mvarPageHeight = 864
    
    Case #pdf85x11     ;Letter, 8 1/2 x 11 in.
        mvarPageWidth = 612
        mvarPageHeight = 792
    
    Case #pdfA3 ;A3, 297 x 420 mm
        mvarPageWidth = 842
        mvarPageHeight = 1190.5
    
    Case #pdfA4 ;A4, 210 x 297 mm
        mvarPageWidth = 595.2
        mvarPageHeight = 842
    
    Case #pdfUser ;User-defined
  
  EndSelect
    
EndProcedure

;
Procedure Orientation(NewOrientation.i);pdfPageOrientation)
  mvarOrientation = NewOrientation
EndProcedure

;
Procedure Title(New_Title.s)
  mvarTitle = New_Title
EndProcedure

;
Procedure InitPDFFile(strFileName.s="")

  If strFileName = "": strFileName = GetPathPart(ProgramFilename()) + "\~" + Hex(Val(FormatDate("%d%hh%mm%ss",Date()) + Trim(Str((Random(1000) * 10))))) + ".pdf": EndIf

  mvarFileName = strFileName
  CreateFile(0, mvarFileName)
  
  WriteObj (#PDF_VERSION)
   
  ; inizializza gli oggetti
  intMaxObject = 0
    
    ; 1 Attribute
  InitObj (1)
  WriteObj("<<" + Chr(10) + "/Title (" + ToPdfStr(mvarTitle) + ")" + Chr(10) + "/Author (" + ToPdfStr(#AUTOR) + ")" + Chr(10) + "/Creator  (" + ToPdfStr(#CREATOR) + ")" + Chr(10) + "/Producer (" + ToPdfStr(#COPYRIGHT) + ")" + Chr(10) + "/CreationDate (D:" + FormatDate("%yyyy%mm%dd%hh%mm%ss", Date()) + "+01'00')" + Chr(10) + ">>")
  EndObj()
  
  ; 2 Catalog
  InitObj (2)
  WriteObj("<<" + Chr(10) + "/Type /Catalog" + Chr(10) + "/Pages 3 0 R" + Chr(10) + "/PageLayout /OneColumn" + Chr(10) + "/PageMode /UseNone" + Chr(10) + "/Lang (it) " + Chr(10) + "/ViewerPreferences << /HideToolbar false " + "/DisplayDocTitle true " + "/HideWindowUI false >>" + Chr(10) + ">>")
  EndObj ()
  
  ; Lascia spazio per gli oggetti 3, 4
  intMaxObject = 4

EndProcedure

Procedure ClosePDFFile()
  i.w
  intTemp.l

  ; 4 Resource
  intResource = InitObj(4)
  tmp.s = "<<" + Chr(10)
  If strFont <> "": tmp + "/Font <<" + Chr(10) + strFont + ">>" + Chr(10): EndIf
  tmp + "/ProcSet [/PDF /Text"
  If strImg <> "": tmp + " /ImageB /ImageC /ImageI": EndIf
  tmp + " ]" + Chr(10)
  If (strImg <> "") Or (strObject <> ""): tmp + "/XObject <<" + Chr(10) + strImg + Chr(10) + strObject + ">>" + Chr(10): EndIf
  tmp + ">>"
  WriteObj(tmp)
  EndObj()
  
  ; 3 Page
  intPages = InitObj(3)
  tmp = "<<" + Chr(10)
  tmp +         "/Type /Pages" + Chr(10)
  tmp +         "/Count " + Str(mvarPages) + Chr(10)
  tmp +         "/MediaBox [0 0 "
  tmp +                    ToStr(mvarPageWidth) + " "
  tmp +                    ToStr(mvarPageHeight) + "]" + Chr(10)
  tmp +         "/CropBox [" + ToStr(mvarMargin) + " "
  tmp +                   ToStr(mvarMargin) + " "
  tmp +                  ToStr(mvarPageWidth - mvarMargin) + " "
  tmp +                   ToStr(mvarPageHeight - mvarMargin) + "]" + Chr(10)
  If mvarOrientation = #pdfLandscape: tmp + "/Rotate 90": EndIf
  tmp +        	"/Kids [" + strPage + " ]" + Chr(10)
  tmp +         "/Resources " + Str(intResource) + " 0 R" + Chr(10)
  tmp +         ">>"
  WriteObj(tmp)
  EndObj()
  
  intTemp = Loc(0) - 1
  WriteObj ("xref")
  WriteObj ("0 " + Str(intMaxObject + 1))
  WriteObj ("0000000000 65535 f")
  For i = 1 To intMaxObject
    WriteObj (arrXREF(i))
  Next
  
  tmp = "trailer" + Chr(10)
  tmp +         "<<" + Chr(10)
  tmp +         "/Size " + Str(intMaxObject) + Chr(10)
  tmp +         "/Info 1 0 R" + Chr(10)
  tmp +         "/Root 2 0 R" + Chr(10)
  tmp +         ">>"
  WriteObj(tmp)
  WriteObj ("startxref" + Chr(10)+ Str(intTemp))
           
  WriteStringN(mvarFileNumber, "%%EOF" + Chr(10))
  CloseFile(mvarFileNumber)
EndProcedure

Procedure.w InitObj(intObj.w=0)
  
  If intObj = 0: intObj = intMaxObject + 1: EndIf
  If intObj > intMaxObject: intMaxObject = intObj: EndIf
  ReDim arrXREF.s(intMaxObject+1)
  
  arrXREF(intObj) = Right("0000000000" + Str(Loc(0) - 1), 10) + " 00000 n"
  WriteObj (Str(intObj) + " 0 obj")
  ProcedureReturn intObj
EndProcedure

Procedure EndObj()
  WriteStringN(0, "endobj")
EndProcedure

Procedure WriteObj(strTemp.s)
  WriteStringN(0, strTemp)
EndProcedure

Procedure.w BeginPage()
  intPage.w
  
  mvarPages + 1
  intPage = InitObj()
  tmp.s = "<<" + Chr(13)
  tmp +         "/Type /Page" + Chr(13)
  tmp +         "/Parent 3 0 R" + Chr(13)
  tmp +         "/Contents " + Str(intPage + 1) + " 0 R" + Chr(13)
  tmp +         ">>"
  WriteObj(tmp)
  EndObj()
  
  strPage = strPage + Str(intPage) + " 0 R "
     
  InitObj (intPage + 1)
  WriteObj ("<< /Length " + Str(intPage + 2) + " 0 R >>" + Chr(13) + "stream")
  intOffsetTemp = Loc(0)
 
  ; Verifica se ci sono oggetti comuni da inserire sullo sfondo della pagina
  InsertObjectOnPage()

  mvarCharSpacing = 0
  mvarWordSpacing = 0
  mvarTextScaling = 100
  ProcedureReturn mvarPages
EndProcedure

;
Procedure EndPage()
  
  intOffsetTemp = Loc(0) - intOffsetTemp
  WriteObj ("endstream")
  EndObj()
  
  ; Scrive la lunghezza
  InitObj()
  WriteObj (Str(intOffsetTemp))
  EndObj()
EndProcedure

;
Procedure SetWordSpacing(W.f)
  mvarWordSpacing = W
  WriteObj (ToStr(mvarWordSpacing) + " Tw")
EndProcedure

;
Procedure SetCharSpacing(W.f)
  mvarCharSpacing = W
  WriteObj (ToStr(mvarCharSpacing) + " Tc")
EndProcedure

;
Procedure SetTextHorizontalScaling(W.f)
  mvarTextScaling = W
  WriteObj (ToStr(mvarTextScaling) + " Tz")
EndProcedure

;
Procedure SetTextRenderingMode(W.f)
  If (W >= 0) And (W <= 2): WriteObj (ToStr(W) + " Tr"): EndIf
EndProcedure

;
Procedure DrawTxt(x.f, y.f, strTemp.s, FontName.s, Fontsize.f, Align.l= #pdfAlignLeft, Rotate.f = 0)
  rad.f
  PI.f
  sTeta.f
  cTeta.f
  C.f
  l.f
  
  Select Align
    Case pdfAlignLeft
    
    Case pdfAlignRight
      l = Length(strTemp, FontName, Fontsize)
      x = x - l
    Case pdfCenter
      l = Length(strTemp, FontName, Fontsize)
      x = x - l / 2
  EndSelect
  
  WriteObj ("BT")
  WriteObj ("/" + FontName + " " + ToStr(Fontsize) + " Tf")
  If Rotate <> 0
    PI = 3.141592
    C = PI / 180
    sTeta = Sin(C * Rotate)
    cTeta = Cos(C * Rotate)
    tmp.s = ToStr(cTeta) + " " + ToStr(sTeta) + " "
    tmp +         ToStr(-sTeta) + " " + ToStr(cTeta)
    tmp +         " " + ToStr(ToSpace(x)) + " " + ToStr(ToSpace(y)) + " Tm"
    WriteObj(tmp)
  Else
    WriteObj (ToStr(ToSpace(x)) + " " + ToStr(ToSpace(y)) + " Td")
  EndIf
  
  WriteObj ("(" + ToPdfStr(strTemp) + ") Tj")
  WriteObj ("ET")
EndProcedure

;
Procedure SetColorStroke(rgb.l)
  R.w
  G.w
  B.w
  
  If (rgb <= 0) And (rgb >= -255)
    WriteObj (ToStr(-rgb / 255) + " G")
  Else
    R = (rgb % 256)
    G = (Int(rgb / 256) % 256)
    B = (Int(rgb / 65536) % 256)
    WriteObj (ToStr(R / 255) + " " + ToStr(G / 255) + " " + ToStr(B / 255) + " RG")
  EndIf
EndProcedure

;
Procedure SetColorFill(rgb.l)
  R.w
  G.w
  B.w
  
  If (rgb <= 0) And (rgb >= -255)
    WriteObj (ToStr(-rgb / 255) + " g")
  Else
    R = (rgb % 256)
    G = (Int(rgb / 256) % 256)
    B = (Int(rgb / 65536) % 256)
    WriteObj (ToStr(R / 255) + " " + ToStr(G / 255) + " " + ToStr(B / 255) + " rg")
  EndIf
EndProcedure

;
Procedure SetDash(dash_on.f, dash_off.f=0)
  If (dash_on = 0) And (dash_off = 0)
    WriteObj ("[ ] 0 d")
  Else
    WriteObj ("[" + ToStr(ToSpace(dash_on)) + " " + ToStr(ToSpace(dash_off)) + "] 0 d")
  EndIf
EndProcedure

;
Procedure SetLineWidth(W.f)
  WriteObj (ToStr(ToSpace(W)) + " w")
EndProcedure

;
Procedure SetLineCap(W.w)
  If (W >= 0) And (W <= 2): WriteObj (ToStr(W) + " J"): EndIf
EndProcedure

;
Procedure SetLineJoin(W.w)
  If (W >= 0) And (W <= 2): WriteObj (ToStr(W) + " j"): EndIf
EndProcedure

;
Procedure SetMiterLimit(W.f)
  If (W >= 1): WriteObj (ToStr(W) + " M"): EndIf
EndProcedure

;
Procedure MoveTo(x.f, y.f)
  WriteObj (ToStr(ToSpace(x)) + " " + ToStr(ToSpace(y)) + " m")
EndProcedure


Procedure Path(Options.l = #Nil)
  
  If (Options & (#Filled | #Stroked | #Closed)) = (#Filled | #Stroked | #Closed)
    WriteObj ("b")
  ElseIf (Options & (#Filled | #Stroked)) = (#Filled | #Stroked)
    WriteObj ("B")
  ElseIf (Options & #Filled) = #Filled
    WriteObj ("f")
  Else
    If (Options & #Closed) <> 0: WriteObj ("h"): EndIf
    If (Options & #Stroked) <> 0: WriteObj ("S"): EndIf
  EndIf

EndProcedure

Procedure LineTo(x.f, y.f, Options.l = #Stroked)
  WriteObj (ToStr(ToSpace(x)) + " " + ToStr(ToSpace(y)) + " l")
  Path(Options)
EndProcedure

;
Procedure Rectangle(x.f, y.f, xdim.f, ydim.f, Options.l = #Stroked, Ray.f=0)
  sR.f
                     
  WriteObj ("n")
  If Ray > 0
    If Ray > (xdim / 2): Ray = xdim / 2: EndIf
    If Ray > (ydim / 2): Ray = ydim / 2: EndIf
    sR = 0.55 * Ray
    MoveTo (x + Ray, y)
    LineTo (x + xdim - Ray, y, #Nil)
    Curve ((x + xdim - Ray + sR), y, x + xdim, y + Ray - sR, x + xdim, y + Ray, #Nil)
    LineTo (x + xdim, y + ydim - Ray, #Nil)
    Curve (x + xdim, y + ydim - Ray + sR, x + xdim - Ray + sR, y + ydim, x + xdim - Ray, y + ydim, #Nil)
    LineTo (x + Ray, y + ydim, #Nil)
    Curve (x + Ray - sR, y + ydim, x, y + ydim - Ray + sR, x, y + ydim - Ray, #Nil)
    LineTo (x, y + Ray, #Nil)
    Curve (x, y + Ray - sR, x + Ray - sR, y, x + Ray, y, #Nil)
  Else
    WriteObj (ToStr(ToSpace(x)) + " " + ToStr(ToSpace(y)) + " " + ToStr(ToSpace(xdim)) + " " + ToStr(ToSpace(ydim)) + " re")
  EndIf
  
  Path(Options)
EndProcedure

;
Procedure Curve(x1.f, y1.f, X2.f, Y2.f, X3.f, Y3.f, Options.l = #Stroked)
  tmp.s = ToStr(ToSpace(x1)) + " " + ToStr(ToSpace(y1)) + " "
  tmp +         ToStr(ToSpace(X2)) + " " + ToStr(ToSpace(Y2)) + " "
  tmp +         ToStr(ToSpace(X3)) + " " + ToStr(ToSpace(Y3)) + " c"
  WriteObj(tmp)
  Path(Options)
EndProcedure

;
Procedure DrawCircle(x.f, y.f, Ray.f, Options.l = #Stroked)
  MoveTo (x, y - Ray)
  Curve (x + 0.55 * Ray, y - Ray, x + Ray, y - 0.55 * Ray, x + Ray, y, #Nil)
  Curve (x + Ray, y + 0.55 * Ray, x + 0.55 * Ray, y + Ray, x, y + Ray, #Nil)
  Curve (x - 0.55 * Ray, y + Ray, x - Ray, y + 0.55 * Ray, x - Ray, y, #Nil)
  Curve (x - Ray, y - 0.55 * Ray, x - 0.55 * Ray, y - Ray, x, y - Ray, #Nil)
  Path(Options)
EndProcedure

;
Procedure Arc(x.f, y.f, Ray.f, StartAngle.f = 0, EndAngle.f = 360, Ratio.f = 1, Pie.l = #False, Rotate.f = 0, Quality.l = 1, Options.l = #Stroked)
  
  i.l
  rad.f
  PI.f
  sTeta.f
  cTeta.f
  C.f
  x1.f: X2.f
  y1.f: Y2.f
  
  WriteObj ("n")
  MoveTo (x, y)
  If Options & #Filled <> 0: Pie = #True: EndIf
  PI = 3.141592
  C = PI / 180
  sTeta = Sin(-C * Rotate)
  cTeta = Cos(-C * Rotate)
  
  For i = Int(StartAngle) To Int(EndAngle) ;Step Quality
    rad = C * i
    X2 = Ray * Cos(rad)
    Y2 = (Ray * Ratio) * Sin(rad)
    
    x1 = X2 * cTeta + Y2 * sTeta
    y1 = -X2 * sTeta + Y2 * cTeta
    If (i = StartAngle) And (Not Pie): MoveTo (x + x1, y + y1): EndIf
    LineTo (x + x1, y + y1, #Nil)
    i + Quality - 1; step keyword takes only numbers, not vars.
  Next
    
  If Pie: LineTo (x, y, #Nil): EndIf
  Path(Options)
EndProcedure

;
Procedure.l LoadImgFromBMPFile(Name.s, FileName.s, ColorSpace.l = #pdfRGB)
  blnFlag.l
  ImgWidth.l
  ImgHeight.l
  ImgBPP.b
  
  blnFlag = LeggeBMP(FileName, ImgBuf(), ImgColor(), @ImgWidth, @ImgHeight, @ImgBPP, ColorSpace)
  OpenFile(2, GetTemporaryDirectory() + "bytes.txt")    ; original: "c:\bytes.txt"
  For i.l=1 To ArraySize(imgbuf())-1
  WriteByte(2,imgbuf(i))
  Next
  CloseFile(2)
  If blnFlag: LoadImgFromArray (Name, ImgBuf(), ImgColor(), ImgWidth, ImgHeight, ImgBPP, ColorSpace): EndIf
  
  ReDim ImgBuf.b(1):ReDim ImgColor.b(1);clear the arrays for possible future use, for more than one images in pdf file.
  ProcedureReturn blnFlag
EndProcedure


;
Procedure LoadImgFromArray(Name.s, Array *ImgBuf.b(1), Array *ImgColor.b(1), ImgWidth.l, ImgHeight.l, ImgBPP.b, ColorSpace,l = #pdfRGB)
                   
  BitPerPixel.b
  sPixel.s
  sColor.s
  lngGray.l
  i.w
  ii.l
  y.l
  
  strDevice.s
  BPP.b
  
  BPP = 8 / ImgBPP
  
  i = InitObj()
  tmp.s = "<<" + Chr(10) 
  tmp +         "/Type /XObject" + Chr(10)
  tmp +         "/Subtype /Image" + Chr(10)
  tmp +         "/Name /" + Name + Chr(10)
  tmp +         "/Width " + Str(ImgWidth) + Chr(10)
  tmp +         "/Height " + Str(ImgHeight)
  If mvarEncodeASCII85: tmp + Chr(10) + "/Filter /ASCII85Decode": EndIf
  WriteObj(tmp)
  If ColorSpace = #pdfRGB
  		strDevice = "DeviceRGB"
  Else
  		strDevice = "DeviceGray"
  EndIf
  
  Select ImgBPP
    Case 24
      WriteObj ("/BitsPerComponent 8" + Chr(10) + "/ColorSpace /" + strDevice + Chr(10) + "/Length " + Str(i + 1) + " 0 R")
    
    Case 8, 4, 1
      WriteObj ("/BitsPerComponent " + Str(ImgBPP) + Chr(10) + "/ColorSpace [/Indexed /" + strDevice + " " + Str(Pow(2, ImgBPP) - 1) + " " + Str(i + 2) + " 0 R]" + Chr(10) + "/Length " + Str(i + 1) + " 0 R")
    
  EndSelect
 
  WriteString(0,">>" + Chr(13) + "stream" + Chr(13))
  
  If mvarEncodeASCII85
  		ToASCII85(ImgBuf())
  Else
  		For ii=1 To ArraySize(ImgBuf())-1
    		WriteByte(0, (ImgBuf(ii) & 255))
   	Next
  EndIf

  WriteStringN(0, Chr(13) + "endstream")
  EndObj()
  
  strImg + "/" + Name + " " + Str(i) + " 0 R " + Chr(13)

  InitObj()
  If mvarEncodeASCII85
  		WriteObj (Str(ArraySize(ImgBuf()) -  2))
  Else
  		WriteObj (Str(ArraySize(ImgBuf())-1))
  EndIf
  EndObj()

  If ImgBPP <= 8
    InitObj()

    tmp.s = "<<"
    If mvarEncodeASCII85
    	tmp + "/Filter /ASCII85Decode" + Chr(13)
 		tmp + "/Length " + Str(ArraySize(ImgColor()) -  2) + " >>" + Chr(13)
 	 Else
 	 	tmp + "/Length " + Str(ArraySize(ImgColor())) + " >>" + Chr(13)
 	 EndIf
 	 tmp + "stream" + Chr(13)
 	 WriteString(0,tmp)
 	 If mvarEncodeASCII85
    	ToASCII85(ImgColor())
    Else
    	For ii=1 To ArraySize(ImgColor())-1
    		WriteByte(0, ImgColor(ii) & 255)
    	Next
    EndIf
 	 tmp = Chr(13) + "endstream"
    WriteObj(tmp)
    EndObj()
  EndIf

EndProcedure

;
Procedure DrawImg(Name.s, DestX.f, DestY.f, ImgWidth.f, ImgHeight.f)

  WriteObj ("q" + Chr(10) + ToStr(ToSpace(ImgWidth)) + " " + " 0 0 -" + ToStr(ToSpace(ImgHeight)) + " " + ToStr(ToSpace(DestX)) + " " + ToStr(ToSpace(DestY)) + " cm" + Chr(10) + "/" + Name + " Do" + Chr(10) + "Q")

EndProcedure

; Carica 1 dei 14 font base Tipo1
Procedure LoadFontStandard(Name.s, BaseFont.s, Options.l = #pdfNormal)
  i.w
  sTemp.s
  
  BaseFont = ReplaceString(BaseFont, " ", "")
  If Options = #pdfBold
    sTemp = ",Bold"
  ElseIf Options = #pdfBoldItalic
    sTemp = ",BoldItalic"
  ElseIf Options = #pdfItalic
    sTemp = ",Italic"
  EndIf
  
  i = InitObj()
  WriteObj ("<< /Type /Font " + "/Subtype /Type1 " + "/Name /" + Name + " " + "/BaseFont /" + BaseFont + sTemp + " " + "/Encoding /WinAnsiEncoding >>")
  EndObj()
  strFont = strFont + "/" + Name + " " + Str(i) + " 0 R " + Chr(10)
EndProcedure

; Carica un font tipo TrueType
Procedure LoadFnt(Name.s, BaseFont.s, Options.l = #pdfNormal)
  i.w
  j.w
  sTemp.s
  intUsedFont  + 1
  ReDim arrFONT.FontDescriptor(intUsedFont+1)
  
  BaseFont = UCase(ReplaceString(BaseFont, " ", ""))
  Select BaseFont
    Case "TIMESNEWROMAN"
    	CreateFontTimes(Options)
      CopyMemory(@vFONT, @arrFONT(intUsedFont), SizeOf(vFONT))
    Case "COURIERNEW"
    	CreateFontCourier(Options)
      CopyMemory(@vFONT, @arrFONT(intUsedFont), SizeOf(vFONT))
        
    Case "SYMBOL"
    	CreateFontSymbol(Options)
      CopyMemory(@vFONT, @arrFONT(intUsedFont), SizeOf(vFONT))
      
	 Default
    	CreateFontArial(Options)
      CopyMemory(@vFONT, @arrFONT(intUsedFont), SizeOf(vFONT))
  EndSelect

  With arrFONT(intUsedFont)
    i = InitObj()
    tmp.s = "<< /Type /Font " + Chr(10)
    tmp +         "/Subtype /TrueType" + Chr(10)
    tmp +         "/Name /" + Name + Chr(10)
    tmp +         "/BaseFont /" + \BaseFont + Chr(10)
    tmp +         "/FirstChar " + StrU(\FirstChar,#PB_Byte) + Chr(10)
    tmp +         "/LastChar " + StrU(\LastChar,#PB_Byte) + Chr(10)
    tmp +         "/FontDescriptor " + Str(i + 1) + " 0 R" + Chr(10)
    tmp +         "/Encoding /WinAnsiEncoding" + Chr(10) + "/Widths ["
    WriteObj(tmp)
    
    For j = \FirstChar To \LastChar & 255
      sTemp + Str(\Widths[j]) + " "
      If (((j - \FirstChar + 1) % 16) = 0) Or (j =\lastChar)
        WriteObj (sTemp)
        sTemp = ""
      EndIf
    Next
    
    WriteObj ("] >>")
    EndObj()
    strFont = strFont + "/" + Name + " " + Str(i) + " 0 R " + Chr(10)
    strFontname = strFontname + "<" + Name + ">" + Right("0000" + Str(intUsedFont), 4) + ";"
    
    i = InitObj()
    WriteObj ("<<" + Chr(10) + "/Type /FontDescriptor" + Chr(10) + "/FontName /" + \BaseFont + Chr(10) + \Param + Chr(10) + ">>")
    EndObj()
  EndWith
EndProcedure


Procedure StartObject(Name.s, Options.l = #pdfNull)
  i.w
  
  i = InitObj()
  tmp.s = "<<" + Chr(13)
  tmp +         "/Type /XObject" + Chr(13)
  tmp +         "/Subtype /Form" + Chr(13)
  tmp +         "/FormType 1" + Chr(13)
  tmp +         "/Name /" + Name + Chr(13)
  tmp +         "/BBox [" + ToStr(mvarMargin) + " "
  tmp +         ToStr(mvarMargin) + " "
  tmp +         ToStr(mvarPageWidth - mvarMargin) + " "
  tmp +         ToStr(mvarPageHeight - mvarMargin) + "]" + Chr(13)
  tmp +         "/Matrix [1 0 0 1 0 0]" + Chr(10)
  tmp +         "/Length " + Str(i + 1) + " 0 R >>" + Chr(13) + "stream"
  WriteObj(tmp)
  intOffsetTemp = Loc(0)

  strObject = strObject + "/" + Name + " " + Str(i) + " 0 R " + Chr(13)
  
  intObject + 1
  ReDim arrOBJECT.ObjDescriptor(intObject+1)
  With arrOBJECT(intObject)
    \Name = Name
    \Options = Options
  EndWith
 
EndProcedure

Procedure EndObject()
  intOffsetTemp = Loc(0) - intOffsetTemp
  WriteObj ("endstream")
  EndObj()
  
  ; Scrive la lunghezza
  InitObj()
  WriteObj (Str(intOffsetTemp))
  EndObj()
EndProcedure

;
Procedure DrawObject(Name.s)
  WriteObj ("/" + Name + " Do")
EndProcedure



; UTILITA;: Funzioni di utilita;
Procedure.f ToSpace(Valore.f)
  
  ; Convert value to 72 pixel per inch
  Select mvarScaleMode
    
    Case #pdf72PxInch
      ProcedureReturn Valore
     
    Case #pdfInch
      ProcedureReturn Valore * 72
      
    Case #pdfCentimeter
      ProcedureReturn (Valore * 72) / 2.54
      
    Case #pdfMillimeter
      ProcedureReturn (Valore * 72) / 25.4
       
  EndSelect
 
EndProcedure

Procedure.f ToUser(Valore.f)
  
  ; Convert value to 72 pixel per inch
  Select mvarScaleMode
    
    Case #pdf72PxInch
      ProcedureReturn Valore
     
    Case #pdfInch
      ProcedureReturn Valore / 72
      
    Case #pdfCentimeter
      ProcedureReturn 2.54 * (Valore / 72)
      
    Case #pdfMillimeter
      ProcedureReturn 25.4 * (Valore / 72)
       
  EndSelect
 
EndProcedure


Procedure.s ToStr(Valore.f, Dec.w = 3)
tmps.s = StrF(valore,3)
If FindString(tmps,".",1)
	For i=Len(tmps) To 1 Step -1
		If Right(tmps,1) = "0"
			tmps = Left(tmps,i-1)
		EndIf
	Next
EndIf
If Right(tmps,1)=".": tmps= Left(tmps, Len(tmps)-1):EndIf
 ProcedureReturn ReplaceString(tmps, ",", ".")
EndProcedure

Procedure.f Length(Phrase.s, FontName.s, Fontsize.f)

  k.f
  i.w
  C.b
  l.w
  j.f
  UsedFont.w
  Options.w
  
  k = 0
  l = Len(Phrase)
  j = 0
  
  
  k = FindString(strFontname, "<" + FontName + ">",1)
  If k > 0
    k + Len(FontName) + 2
    UsedFont = Val(Mid(strFontname, k, 4))
  
    With arrFONT(UsedFont)
      For i = 1 To l
        C = Asc(Mid(Phrase, i, 1))
        If (C >= \FirstChar) And (C <=\lastChar)
        		k +\widths[C]
        Else
        		k + \MissingWidth
        EndIf
        If C = 32: j + 1: EndIf ; conta gli spazi
      Next
    EndWith
    Length = ToUser(((k * Fontsize / 1000) + (j * mvarWordSpacing) + (l * mvarCharSpacing)) * (mvarTextScaling / 100))
  EndIf

EndProcedure


Procedure ToASCII85(Array InBuf.b(1));.s

  i.b
  
  m.d
  q.l
  l.l
  k.l
  j.l
  lngLen.l
      
  lngLen = ArraySize(InBuf())
  
  Dim arrASCII.b(Int(lngLen * 1.3) + 2)
    
  k = 1
  j = 1
  tt.l
  While k <= lngLen
    l = (lngLen - k) + 1
    m = 0
    
    For i = 1 To 4
      If i > l: Break: EndIf
      tt = (InBuf(k + i - 1) & 255)
      m  + tt * Pow(256, (4 - i))
    Next
        
    If (m = 0) And (l = 4)
      arrASCII(j) = Asc("z")
      j = j + 1
    Else
      
      For i = 1 To 4
        q = Int(m / Pow(85, (5 - i)))
        m = m - q * (Pow(85, (5 - i)))
        arrASCII(j + i - 1) = 33 + q
      Next
      
      arrASCII(j + 5 - 1) = 33 + m
      If l < 4
      	j + l + 1
      Else
      	j + 5
      EndIf
    EndIf
    
    k + 4
  Wend
    
  ReDim arrASCII.b(j+1)
  For ii.l=1 To ArraySize(arrASCII()) - 1
  		WriteByte(0, arrASCII(ii) & 255)
  Next
  WriteString(0,"~>")
EndProcedure

Post by **Andre** » Fri Dec 31, 2010 3:34 pm

Code - 2nd part:

Code: Select all

;
Procedure.l LeggeBMP(FileName.s, Array ImgBuf.b(1), Array ImgColor.b(1), *ImgWidth.l, *ImgHeight.l, *ImgBPP.b, ColorSpace.l = #pdfRGB)

  ; BITMAPFILEHEADER_Type
  bfType         .s{2}     ; The string 'BM' (hex value $424D).
  bfSize         .l           ; The size of the file, measured in [Bytes].
  bfDummy        .w        ; Not used, set to zero.
  bfOffBits      .l           ; The start offset of the bitmap data in the file.
  
  ; BITMAPINFOHEADER
  biSize           .l         ; 40 (the size of this structure).
  biWidth          .l         ; The width of the bitmap in pixels.
  biHeight         .l         ; The height of the bitmap in pixels.
  biPlanes         .w      ; 1 (DIBs always have one plane).
  biBitCount       .w      ; 1 for monochrome, 4 for 16 colors, 8 for 256 color, 24 for 24-bit RGB color.
  biCompression    .l         ; Specifies the type of compression for compressed
  biSizeImage      .l         ; The size of the image in bytes.
  biXPelsPerMeter  .l         ; Number of horizontal pixels per meter for
  biYPelsPerMeter  .l         ; Number of vertical pixels per meter for
  biClrUsed        .l         ; Number of entries in the DIB color table
  biClrImportant   .l         ; Number of entries in the DIB color table that
  
  
  C.l
  fb.w
  XBMP.l
  BPP.b
  i.l
  kk.l
  blnFlag.l
  Dim TempImg.b(1)
  Dim TempCol.b(1); RGBQUAD_Type
  lngGray.l
    
  LeggeBMPres.l = #False
  
  If OpenFile(1, FileName)
  
    ; BITMAPFILEHEADER
    ReadData(1,@bfType,2)
    bfSize = ReadLong(1)
    bfDummy = ReadWord(1)
    bfDummy = ReadWord(1)
    bfOffBits = ReadLong(1)
    
    If bfType = "BM"
      
      ; BITMAPINFOHEADER
      biSize = ReadLong(1)
      biWidth = ReadLong(1)
      biHeight = ReadLong(1)
      ; NOTE: at least on MacOS the biHeight value will be negative, so I do a conversion here,
      ;       but probably more modifications are needed, because the image will be drawn horizontally flipped in the PDF.
      CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
        biHeight = Abs(biHeight)
      CompilerEndIf
      biPlanes = ReadWord(1)
      biBitCount = ReadWord(1)
      biCompression = ReadLong(1)
      biSizeImage = ReadLong(1)
      biXPelsPerMeter = ReadLong(1)
      biYPelsPerMeter = ReadLong(1)
      biClrUsed = ReadLong(1)
      biClrImportant = ReadLong(1)
      
      BPP = biBitCount
  
      If BPP <= 8
        ttmp.l = Pow(2, BPP) * 4+1
        ; legge la palette di colori
        ReDim TempCol.b(ttmp+1)
        For i=1 To ttmp
        	TempCol(i) = ReadByte(1)
        Next
        If ColorSpace = #pdfRGB 
          ttmp = 3 * Pow(2,BPP)+1
          ReDim ImgColor.b(ttmp)
          For C = 0 To Pow(2,BPP) - 1
            ImgColor(C * 3 + 1) = TempCol(C * 4 + 1) ; red
            ImgColor(C * 3 + 2) = TempCol(C * 4 + 2) ; green
            ImgColor(C * 3 + 3) = TempCol(C * 4 + 3) ; blue
          Next
        Else
        	ttmp = Pow(2, BPP)+1
          ReDim ImgColor.b(ttmp+1)
          For C = 0 To Pow(2, BPP) - 1
            lngGray = (0.33 * TempCol(C * 4 + 1) + 0.59 * TempCol(C * 4 + 2) + 0.11 * TempCol(C * 4 + 3))
            If lngGray > 255
            		ImgColor(C + 1) = 255
            Else
            		ImgColor(C + 1) = lngGray
            EndIf
          Next
        EndIf
      EndIf
  
      XBMP = ((biWidth * BPP / 8) + 3) & $FFFFFFFC      ; [Bytes].
      
      PokeL(*ImgWidth, biWidth)
      PokeL(*ImgHeight, biHeight)
      PokeL(*ImgBPP, biBitCount)
   
      ReDim TempImg.b(biHeight * XBMP+1)
      FileSeek(1, bfOffBits)
      ReadData(1, @TempImg()+1, biHeight * XBMP)
      
      ReDim ImgBuf.b(biHeight * XBMP+1)
      kk = 0
      
      If BPP > 8
         If (biWidth % 4) <> 0
        	blnFlag = #True
         Else
         	blnFlag = #False
         EndIf
        If ColorSpace = #pdfRGB
          For C = 1 To ArraySize(TempImg())-1 Step 3
            ImgBuf(3 * kk + 1) = TempImg(C + 2)
            ImgBuf(3 * kk + 2) = TempImg(C + 1)
            ImgBuf(3 * kk + 3) = TempImg(C)
            If (((kk + 1) % biWidth) = 0) And blnFlag: C = C + (biWidth % 4): EndIf
            kk = kk + 1
          Next
        Else
          For C = 0 To ArraySize(TempImg()) - 1 Step 3
            lngGray = 0.33 * TempImg(C + 2) + 0.59 * TempImg(C + 1) + 0.11 * TempImg(C)
            If lngGray > 255
            	ImgBuf(kk + 1) = 255
            Else
            	ImgBuf(kk + 1) = lngGray
            EndIf          
            If (((kk + 1) % biWidth) = 0) And blnFlag: C = C + (biWidth % 4): EndIf
            kk = kk + 1
          Next
          ReDim ImgBuf.b(kk)
        EndIf
      ElseIf BPP <= 8
        If BPP = 8
        	tml.l = 4
        Else
        	tml = 8
        EndIf
        If biWidth % tml <>0
        	blnFlag = #True
        Else
        	blnFlag = #False
        EndIf
        
        For i = 0 To ArraySize(TempImg())
          ImgBuf(kk + 1) = TempImg(i)
          If ((kk + 1) % ((biWidth + (8 / BPP) - 1) / (8 / BPP))) = 0 And blnFlag
            i = i + (XBMP - (i % XBMP))
          EndIf
          kk = kk + 1
        Next
        ReDim ImgBuf.b(kk)
      EndIf
      LeggeBMPres.l = #True
    EndIf
  Else
    Debug "Loading of (bmp) image failed!"
  EndIf
  
  If LeggeBMPres = #True
  		ProcedureReturn 1
  Else 
  		ProcedureReturn 0
  EndIf

EndProcedure

Procedure.s ToPdfStr(Temp.s)
  ProcedureReturn ReplaceString(ReplaceString(ReplaceString(Temp, "\", "\\"), "(", "\("), ")", "\)")
EndProcedure

Procedure CreateFontCourier(Style.l)
  i.w
  Dim awTemp.l(224)
  fdTemp.FontDescriptor
  
  ; Courier New
  With fdTemp
    \BaseFont = "CourierNew"
    \FirstChar = 32
    \lastChar = 255
    \MissingWidth = 600
  EndWith
  
  Select Style
    Case #pdfNormal
      For i = 0 To 223
      	awTemp(i) = 600
      Next
      fdTemp\Param = "/Flags 34 /FontBBox [-250 -300 720 1000] " + "/MissingWidth 600 /StemV 109 " + "/StemH 109 /ItalicAngle 0 /CapHeight 833 /XHeight 417 " + "/Ascent 833 /Descent -300 /Leading 133 " + "/MaxWidth 600 /AvgWidth 600"

    Case #pdfBold
      fdTemp\BaseFont + ",Bold"
      For i = 0 To 223
      	awTemp(i) = 600
      Next
      fdTemp\Param = "/Flags 16418 /FontBBox [-250 -300 720 1000] " + "/MissingWidth 600 /StemV 191 " + "/StemH 191 /ItalicAngle 0 /CapHeight 833 /XHeight 417 " + "/Ascent 833 /Descent -300 /Leading 133 " + "/MaxWidth 600 /AvgWidth 600"

    Case #pdfItalic
      fdTemp\BaseFont + ",Italic"
      For i = 0 To 223
      	awTemp(i) = 600
      Next
      fdTemp\Param = "/Flags 98 /FontBBox [-250 -300 720 1000] " + "/MissingWidth 600 /StemV 109 " + "/StemH 109 /ItalicAngle -11 /CapHeight 833 /XHeight 417 " + "/Ascent 833 /Descent -300 /Leading 133 " + "/MaxWidth 600 /AvgWidth 600"

    Case #pdfBoldItalic
      fdTemp\BaseFont + ",BoldItalic"
      For i = 0 To 223
      	awTemp(i) = 600
      Next
      fdTemp\Param = "/Flags 16482 /FontBBox [-250 -300 720 1000] " + "/MissingWidth 600 /StemV 191 " + "/StemH 191 /ItalicAngle -11 /CapHeight 833 /XHeight 417 " + "/Ascent 833 /Descent -300 /Leading 133 " + "/MaxWidth 600 /AvgWidth 600"
  EndSelect
        
  For i = fdTemp\FirstChar To fdTemp\LastChar & 255
    fdTemp\Widths[i] = awTemp(i - fdTemp\FirstChar)
  Next
  
  CopyMemory(@fdTemp, @vFONT, SizeOf(vFONT))

EndProcedure

Procedure CreateFontTimes(Style.l)
  i.w
  Dim awTemp.l(224)
  fdTemp.FontDescriptor
  
  ; Times New Roman
  With fdTemp
    \BaseFont = "TimesNewRoman"
    \FirstChar = 32
    \lastChar = 255
    \MissingWidth = 333

  EndWith
  
   Select Style
    Case #pdfNormal
    	DataSection
    	TimesNormal: Data.l 250, 333, 408, 500, 500, 833, 778, 180, 333, 333, 500, 564, 250, 333, 250, 278, 500, 500, 500, 500, 500, 500, 500, 500, 500, 500, 278, 278, 564, 564, 564, 444, 921, 722, 667, 667, 722, 611, 556, 722, 722, 333, 389, 722, 611, 889, 722, 722, 556, 722, 667, 556, 611, 722, 722, 944, 722, 722, 611, 333, 278, 333, 469, 500
                   Data.l 333, 444, 500, 444, 500, 444, 333, 500, 500, 278, 278, 500, 278, 778, 500, 500, 500, 500, 333, 389, 278, 500, 500, 722, 500, 500, 444, 480, 200, 480, 541, 778, 500, 778, 333, 500, 444, 1000, 500, 500, 333, 1000, 556, 333, 889, 778, 611, 778, 778, 333, 333, 444, 444, 350, 500, 1000, 333, 980, 389, 333, 722, 778, 444, 722
                   Data.l 250, 333, 500, 500, 500, 500, 200, 500, 333, 760, 276, 500, 564, 333, 760, 500, 400, 549, 300, 300, 333, 576, 453, 250, 333, 300, 310, 500, 750, 750, 750, 444, 722, 722, 722, 722, 722, 722, 889, 667, 611, 611, 611, 611, 333, 333, 333, 333, 722, 722, 722, 722, 722, 722, 722, 564, 722, 722, 722, 722, 722, 722, 556, 500
                   Data.l 444, 444, 444, 444, 444, 444, 667, 444, 444, 444, 444, 444, 278, 278, 278, 278, 500, 500, 500, 500, 500, 500, 500, 549, 500, 500, 500, 500, 500, 500, 500, 500
      EndDataSection
      CopyMemory(?TimesNormal, @awTemp(), SizeOf(LONG)*224) 
      fdTemp\Param = "/Flags 34 /FontBBox [-250 -216 1200 1000] /MissingWidth 333 /StemV 73 /StemH 73 /ItalicAngle 0 /CapHeight 891 /XHeight 446 /Ascent 891 /Descent -216 /Leading 149 /MaxWidth 1000 /AvgWidth 401"

    Case #pdfBold
      fdTemp\BaseFont = fdTemp\BaseFont + ",Bold"
      
      DataSection
      TimesBold: Data.l 250, 333, 555, 500, 500, 1000, 833, 278, 333, 333, 500, 570, 250, 333, 250, 278, 500, 500, 500, 500, 500, 500, 500, 500, 500, 500, 333, 333, 570, 570, 570, 500, 930, 722, 667, 722, 722, 667, 611, 778, 778, 389, 500, 778, 667, 944, 722, 778, 611, 778, 722, 556, 667, 722, 722, 1000, 722, 722, 667, 333, 278, 333, 581, 500
                 Data.l 333, 500, 556, 444, 556, 444, 333, 500, 556, 278, 333, 556, 278, 833, 556, 500, 556, 556, 444, 389, 333, 556, 500, 722, 500, 500, 444, 394, 220, 394, 520, 778, 500, 778, 333, 500, 500, 1000, 500, 500, 333, 1000, 556, 333, 1000, 778, 667, 778, 778, 333, 333, 500, 500, 350, 500, 1000, 333, 1000, 389, 333, 722, 778, 444, 722
                 Data.l 250, 333, 500, 500, 500, 500, 220, 500, 333, 747, 300, 500, 570, 333, 747, 500, 400, 549, 300, 300, 333, 576, 540, 250, 333, 300, 330, 500, 750, 750, 750, 500, 722, 722, 722, 722, 722, 722, 1000, 722, 667, 667, 667, 667, 389, 389, 389, 389, 722, 722, 778, 778, 778, 778, 778, 570, 778, 722, 722, 722, 722, 722, 611, 556
                 Data.l 500, 500, 500, 500, 500, 500, 722, 444, 444, 444, 444, 444, 278, 278, 278, 278, 500, 556, 500, 500, 500, 500, 500, 549, 500, 556, 556, 556, 556, 500, 556, 500
      EndDataSection
      CopyMemory(?TimesBold, @awTemp(), SizeOf(LONG)*224) 
      
      fdTemp\Param = "/Flags 16418 /FontBBox [-250 -216 1201 1000] /MissingWidth 333 /StemV 136 /StemH 136 /ItalicAngle 0 /CapHeight 891 /XHeight 446 /Ascent 891 /Descent -216 /Leading 149 /MaxWidth 1001 /AvgWidth 401"

    Case #pdfItalic
      fdTemp\BaseFont = fdTemp\BaseFont + ",Italic"
      
      DataSection
      TimesItalic: Data.l 250, 333, 420, 500, 500, 833, 778, 214, 333, 333, 500, 675, 250, 333, 250, 278, 500, 500, 500, 500, 500, 500, 500, 500, 500, 500, 333, 333, 675, 675, 675, 500, 920, 611, 611, 667, 722, 611, 611, 722, 722, 333, 444, 667, 556, 833, 667, 722, 611, 722, 611, 500, 556, 722, 611, 833, 611, 556, 556, 389, 278, 389, 422, 500
                   Data.l 333, 500, 500, 444, 500, 444, 278, 500, 500, 278, 278, 444, 278, 722, 500, 500, 500, 500, 389, 389, 278, 500, 444, 667, 444, 444, 389, 400, 275, 400, 541, 778, 500, 778, 333, 500, 556, 889, 500, 500, 333, 1000, 500, 333, 944, 778, 556, 778, 778, 333, 333, 556, 556, 350, 500, 889, 333, 980, 389, 333, 667, 778, 389, 556
                   Data.l 250, 389, 500, 500, 500, 500, 275, 500, 333, 760, 276, 500, 675, 333, 760, 500, 400, 549, 300, 300, 333, 576, 523, 250, 333, 300, 310, 500, 750, 750, 750, 500, 611, 611, 611, 611, 611, 611, 889, 667, 611, 611, 611, 611, 333, 333, 333, 333, 722, 667, 722, 722, 722, 722, 722, 675, 722, 722, 722, 722, 722, 556, 611, 500
                   Data.l 500, 500, 500, 500, 500, 500, 667, 444, 444, 444, 444, 444, 278, 278, 278, 278, 500, 500, 500, 500, 500, 500, 500, 549, 500, 500, 500, 500, 500, 444, 500, 444
      EndDataSection
      CopyMemory(?TimesItalic, @awTemp(), SizeOf(LONG)*224) 
      
      fdTemp\Param = "/Flags 98 /FontBBox [-250 -216 1200 1000] /MissingWidth 333 /StemV 73 /StemH 73 /ItalicAngle -11 /CapHeight 891 /XHeight 446 /Ascent 891 /Descent -216 /Leading 149 /MaxWidth 1000 /AvgWidth 402"

    Case #pdfBoldItalic
      fdTemp\BaseFont = fdTemp\BaseFont + ",BoldItalic"
      
      DataSection
      TimesBoldItalic: Data.l 250, 389, 555, 500, 500, 833, 778, 278, 333, 333, 500, 570, 250, 333, 250, 278, 500, 500, 500, 500, 500, 500, 500, 500, 500, 500, 333, 333, 570, 570, 570, 500, 832, 667, 667, 667, 722, 667, 667, 722, 778, 389, 500, 667, 611, 889, 722, 722, 611, 722, 667, 556, 611, 722, 667, 889, 667, 611, 611, 333, 278, 333, 570, 500
                       Data.l 333, 500, 500, 444, 500, 444, 333, 500, 556, 278, 278, 500, 278, 778, 556, 500, 500, 500, 389, 389, 278, 556, 444, 667, 500, 444, 389, 348, 220, 348, 570, 778, 500, 778, 333, 500, 500, 1000, 500, 500, 333, 1000, 556, 333, 944, 778, 611, 778, 778, 333, 333, 500, 500, 350, 500, 1000, 333, 1000, 389, 333, 722, 778, 389, 611
                       Data.l 250, 389, 500, 500, 500, 500, 220, 500, 333, 747, 266, 500, 606, 333, 747, 500, 400, 549, 300, 300, 333, 576, 500, 250, 333, 300, 300, 500, 750, 750, 750, 500, 667, 667, 667, 667, 667, 667, 944, 667, 667, 667, 667, 667, 389, 389, 389, 389, 722, 722, 722, 722, 722, 722, 722, 570, 722, 722, 722, 722, 722, 611, 611, 500
                       Data.l 500, 500, 500, 500, 500, 500, 722, 444, 444, 444, 444, 444, 278, 278, 278, 278, 500, 556, 500, 500, 500, 500, 500, 549, 500, 556, 556, 556, 556, 444, 500, 444
      EndDataSection
      CopyMemory(?TimesBoldItalic, @awTemp(), SizeOf(LONG)*224) 
      
      fdTemp\Param = "/Flags 16482 /FontBBox [-250 -216 1200 1000] /MissingWidth 333 /StemV 131 /StemH 131 /ItalicAngle -11 /CapHeight 891 /XHeight 446 /Ascent 891 /Descent -216 /Leading 149 /MaxWidth 1000 /AvgWidth 412"
  EndSelect

  For i = fdTemp\FirstChar To fdTemp\LastChar & 255
    fdTemp\Widths[i] = awTemp(i - fdTemp\FirstChar)
  Next
  
  CopyMemory(@fdTemp, @vFONT, SizeOf(vFONT))
EndProcedure


Procedure CreateFontSymbol(Style.l)
  i.w
  Dim awTemp.l(224)
  fdTemp.FontDescriptor
  
  ; Symbol
  With fdTemp
    \BaseFont = "Symbol"
    \FirstChar = 30
    \lastChar = 255
    \MissingWidth = 332
  EndWith
  
  Select Style
    Case #pdfNormal
    	DataSection
      SymbolNormal: Data.l 600, 600, 250, 333, 713, 500, 549, 833, 778, 439, 333, 333, 500, 549, 250, 549, 250, 278, 500, 500, 500, 500, 500, 500, 500, 500, 500, 500, 278, 278, 549, 549, 549, 444, 549, 722, 667, 722, 612, 611, 763, 603, 722, 333, 631, 722, 686, 889, 722, 722, 768, 741, 556, 592, 611, 690, 439, 768, 645, 795, 611, 333, 863, 333
                    Data.l 658, 500, 500, 631, 549, 549, 494, 439, 521, 411, 603, 329, 603, 549, 549, 576, 521, 549, 549, 521, 549, 603, 439, 576, 713, 686, 493, 686, 494, 480, 200, 480, 549, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600
                    Data.l 600, 600, 600, 620, 247, 549, 167, 713, 500, 753, 753, 753, 753, 1042, 987, 603, 987, 603, 400, 549, 411, 549, 549, 713, 494, 460, 549, 549, 549, 549, 1000, 603, 1000, 658, 823, 686, 795, 987, 768, 768, 823, 768, 768, 713, 713, 713, 713, 713, 713, 713, 768, 713, 790, 790, 890, 823, 549, 250, 713, 603, 603, 1042, 987, 603
                    Data.l 987, 603, 494, 329, 790, 790, 786, 713, 384, 384, 384, 384, 384, 384, 494, 494, 494, 494, 600, 329, 274, 686, 686, 686, 384, 384, 384, 384, 384, 384, 494, 494, 494, 600
      EndDataSection
      CopyMemory(?SymbolNormal, @awTemp(), SizeOf(LONG)*224) 
                     
      fdTemp\Param = "/Flags 6 /FontBBox [-250 -220 1246 1005] /MissingWidth 332 /StemV 109 /StemH 109 /ItalicAngle 0 /CapHeight 1005 /XHeight 503 /Ascent 1005 /Descent -220 /Leading 225 /MaxWidth 1038 /AvgWidth 601"

    Case #pdfBold
    	fdTemp\BaseFont = fdTemp\BaseFont + ",Bold"
      
      DataSection
      SymbolBold: Data.l 600, 600, 250, 333, 713, 500, 549, 833, 778, 439, 333, 333, 500, 549, 250, 549, 250, 278, 500, 500, 500, 500, 500, 500, 500, 500, 500, 500, 278, 278, 549, 549, 549, 444, 549, 722, 667, 722, 612, 611, 763, 603, 722, 333, 631, 722, 686, 889, 722, 722, 768, 741, 556, 592, 611, 690, 439, 768, 645, 795, 611, 333, 863, 333
                  Data.l 658, 500, 500, 631, 549, 549, 494, 439, 521, 411, 603, 329, 603, 549, 549, 576, 521, 549, 549, 521, 549, 603, 439, 576, 713, 686, 493, 686, 494, 480, 200, 480, 549, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600
                  Data.l 600, 600, 600, 620, 247, 549, 167, 713, 500, 753, 753, 753, 753, 1042, 987, 603, 987, 603, 400, 549, 411, 549, 549, 713, 494, 460, 549, 549, 549, 549, 1000, 603, 1000, 658, 823, 686, 795, 987, 768, 768, 823, 768, 768, 713, 713, 713, 713, 713, 713, 713, 768, 713, 790, 790, 890, 823, 549, 250, 713, 603, 603, 1042, 987, 603
                  Data.l 987, 603, 494, 329, 790, 790, 786, 713, 384, 384, 384, 384, 384, 384, 494, 494, 494, 494, 600, 329, 274, 686, 686, 686, 384, 384, 384, 384, 384, 384, 494, 494, 494, 600
      EndDataSection
      CopyMemory(?SymbolBold, @awTemp(), SizeOf(LONG)*224) 
      
      fdTemp\Param = "/Flags 16390 /FontBBox [-250 -220 1246 1005] /MissingWidth 332 /StemV 191 /StemH 191 /ItalicAngle 0 /CapHeight 1005 /XHeight 503 /Ascent 1005 /Descent -220 /Leading 225 /MaxWidth 1038 /AvgWidth 600"

    Case #pdfItalic
      fdTemp\BaseFont = fdTemp\BaseFont + ",Italic"
      
      DataSection
      SymbolItalic: Data.l 600, 600, 250, 333, 713, 500, 549, 833, 778, 439, 333, 333, 500, 549, 250, 549, 250, 278, 500, 500, 500, 500, 500, 500, 500, 500, 500, 500, 278, 278, 549, 549, 549, 444, 549, 722, 667, 722, 612, 611, 763, 603, 722, 333, 631, 722, 686, 889, 722, 722, 768, 741, 556, 592, 611, 690, 439, 768, 645, 795, 611, 333, 863, 333
                    Data.l 658, 500, 500, 631, 549, 549, 494, 439, 521, 411, 603, 329, 603, 549, 549, 576, 521, 549, 549, 521, 549, 603, 439, 576, 713, 686, 493, 686, 494, 480, 200, 480, 549, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600
                    Data.l 600, 600, 600, 620, 247, 549, 167, 713, 500, 753, 753, 753, 753, 1042, 987, 603, 987, 603, 400, 549, 411, 549, 549, 713, 494, 460, 549, 549, 549, 549, 1000, 603, 1000, 658, 823, 686, 795, 987, 768, 768, 823, 768, 768, 713, 713, 713, 713, 713, 713, 713, 768, 713, 790, 790, 890, 823, 549, 250, 713, 603, 603, 1042, 987, 603
                    Data.l 987, 603, 494, 329, 790, 790, 786, 713, 384, 384, 384, 384, 384, 384, 494, 494, 494, 494, 600, 329, 274, 686, 686, 686, 384, 384, 384, 384, 384, 384, 494, 494, 494, 600
      EndDataSection
      CopyMemory(?SymbolItalic, @awTemp(), SizeOf(LONG)*224) 
      
      fdTemp\Param = "/Flags 70 /FontBBox [-250 -220 1246 1005] /MissingWidth 332 /StemV 109 /StemH 109 /ItalicAngle -11 /CapHeight 1005 /XHeight 503 /Ascent 1005 /Descent -220 /Leading 225 /MaxWidth 1038 /AvgWidth 600"

    Case #pdfBoldItalic
      fdTemp\BaseFont = fdTemp\BaseFont + ",BoldItalic"
    	
    	DataSection
      SymbolBoldItalic: Data.l 600, 600, 250, 333, 713, 500, 549, 833, 778, 439, 333, 333, 500, 549, 250, 549, 250, 278, 500, 500, 500, 500, 500, 500, 500, 500, 500, 500, 278, 278, 549, 549, 549, 444, 549, 722, 667, 722, 612, 611, 763, 603, 722, 333, 631, 722, 686, 889, 722, 722, 768, 741, 556, 592, 611, 690, 439, 768, 645, 795, 611, 333, 863, 333
                     	Data.l 658, 500, 500, 631, 549, 549, 494, 439, 521, 411, 603, 329, 603, 549, 549, 576, 521, 549, 549, 521, 549, 603, 439, 576, 713, 686, 493, 686, 494, 480, 200, 480, 549, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600
                     	Data.l 600, 600, 600, 620, 247, 549, 167, 713, 500, 753, 753, 753, 753, 1042, 987, 603, 987, 603, 400, 549, 411, 549, 549, 713, 494, 460, 549, 549, 549, 549, 1000, 603, 1000, 658, 823, 686, 795, 987, 768, 768, 823, 768, 768, 713, 713, 713, 713, 713, 713, 713, 768, 713, 790, 790, 890, 823, 549, 250, 713, 603, 603, 1042, 987, 603
                     	Data.l 987, 603, 494, 329, 790, 790, 786, 713, 384, 384, 384, 384, 384, 384, 494, 494, 494, 494, 600, 329, 274, 686, 686, 686, 384, 384, 384, 384, 384, 384, 494, 494, 494, 600
      EndDataSection
      CopyMemory(?SymbolBoldItalic, @awTemp(), SizeOf(LONG)*224) 
      
      fdTemp\Param = "/Flags 16454 /FontBBox [-250 -220 1246 1005] /MissingWidth 332 /StemV 191 /StemH 191 /ItalicAngle -11 /CapHeight 1005 /XHeight 503 /Ascent 1005 /Descent -220 /Leading 225 /MaxWidth 1038 /AvgWidth 600"
  EndSelect
        
  For i = fdTemp\FirstChar To fdTemp\LastChar & 255
    fdTemp\Widths[i] = awTemp(i - fdTemp\FirstChar)
  Next
  
  CopyMemory(@fdTemp, @vFONT, SizeOf(vFONT))
    
EndProcedure


Procedure CreateFontArial(Style.l)
  i.w
  Dim awTemp.l(224)
  fdTemp.FontDescriptor
  
  ; Arial
  With fdTemp
    \BaseFont = "Arial"
    \FirstChar = 32
    \lastChar = 255
    \MissingWidth = 272
  EndWith
  
  Select Style
    Case #pdfNormal
    	
    	DataSection
      ArialNormal: Data.l 278, 278, 355, 556, 556, 889, 667, 191, 333, 333, 389, 584, 278, 333, 278, 278, 556, 556, 556, 556, 556, 556, 556, 556, 556, 556, 278, 278, 584, 584, 584, 556, 1015, 667, 667, 722, 722, 667, 611, 778, 722, 278, 500, 667, 556, 833, 722, 778, 667, 778, 722, 667, 611, 722, 667, 944, 667, 667, 611, 278, 278, 278, 469, 556
                   Data.l 333, 556, 556, 500, 556, 556, 278, 556, 556, 222, 222, 500, 222, 833, 556, 556, 556, 556, 333, 500, 278, 556, 500, 722, 500, 500, 500, 334, 260, 334, 584, 750, 556, 750, 222, 556, 333, 1000, 556, 556, 333, 1000, 667, 333, 1000, 750, 611, 750, 750, 222, 222, 333, 333, 350, 556, 1000, 333, 1000, 500, 333, 944, 750, 500, 667
                   Data.l 278, 333, 556, 556, 556, 556, 260, 556, 333, 737, 370, 556, 584, 333, 737, 552, 400, 549, 333, 333, 333, 576, 537, 278, 333, 333, 365, 556, 834, 834, 834, 611, 667, 667, 667, 667, 667, 667, 1000, 722, 667, 667, 667, 667, 278, 278, 278, 278, 722, 722, 778, 778, 778, 778, 778, 584, 778, 722, 722, 722, 722, 667, 667, 611
                   Data.l 556, 556, 556, 556, 556, 556, 889, 500, 556, 556, 556, 556, 278, 278, 278, 278, 556, 556, 556, 556, 556, 556, 556, 549, 611, 556, 556, 556, 556, 500, 556, 500
      EndDataSection
      CopyMemory(?ArialNormal, @awTemp(), SizeOf(LONG)*224) 
      
      fdTemp\Param = "/Flags 32 /FontBBox [-250 -221 1190 1000] /MissingWidth 272 /StemV 80 /StemH 80 /ItalicAngle 0 /CapHeight 905 /XHeight 453 /Ascent 905 /Descent -212 /Leading 150 /MaxWidth 992 /AvgWidth 441"

    Case #pdfBold
      fdTemp\BaseFont = fdTemp\BaseFont + ",Bold"
      
      DataSection
      ArialBold: Data.l 278, 333, 474, 556, 556, 889, 722, 238, 333, 333, 389, 584, 278, 333, 278, 278, 556, 556, 556, 556, 556, 556, 556, 556, 556, 556, 333, 333, 584, 584, 584, 611, 975, 722, 722, 722, 722, 667, 611, 778, 722, 278, 556, 722, 611, 833, 722, 778, 667, 778, 722, 667, 611, 722, 667, 944, 667, 667, 611, 333, 278, 333, 584, 556
                   Data.l 333, 556, 611, 556, 611, 556, 333, 611, 611, 278, 278, 556, 278, 889, 611, 611, 611, 611, 389, 556, 333, 611, 556, 778, 556, 556, 500, 389, 280, 389, 584, 750, 556, 750, 278, 556, 500, 1000, 556, 556, 333, 1000, 667, 333, 1000, 750, 611, 750, 750, 278, 278, 500, 500, 350, 556, 1000, 333, 1000, 556, 333, 944, 750, 500, 667
                   Data.l 278, 333, 556, 556, 556, 556, 280, 556, 333, 737, 370, 556, 584, 333, 737, 552, 400, 549, 333, 333, 333, 576, 556, 278, 333, 333, 365, 556, 834, 834, 834, 611, 722, 722, 722, 722, 722, 722, 1000, 722, 667, 667, 667, 667, 278, 278, 278, 278, 722, 722, 778, 778, 778, 778, 778, 584, 778, 722, 722, 722, 722, 667, 667, 611
                   Data.l 556, 556, 556, 556, 556, 556, 889, 556, 556, 556, 556, 556, 278, 278, 278, 278, 611, 611, 611, 611, 611, 611, 611, 549, 611, 611, 611, 611, 611, 556, 611, 556
      EndDataSection
      CopyMemory(?ArialBold, @awTemp(), SizeOf(LONG)*224) 
      
      fdTemp\Param = "/Flags 16416 /FontBBox [-250 -212 1120 1000] /MissingWidth 311 /StemV 153 /StemH 153 /ItalicAngle 0 /CapHeight 905 /XHeight 453 /Ascent 905 /Descent -212 /Leading 150 /MaxWidth 933 /AvgWidth 479"
      fdTemp\MissingWidth = 311
                     

    Case #pdfItalic
      fdTemp\BaseFont = fdTemp\BaseFont + ",Italic"
      DataSection
      ArialItalic: Data.l 278, 278, 355, 556, 556, 889, 667, 191, 333, 333, 389, 584, 278, 333, 278, 278, 556, 556, 556, 556, 556, 556, 556, 556, 556, 556, 278, 278, 584, 584, 584, 556, 1015, 667, 667, 722, 722, 667, 611, 778, 722, 278, 500, 667, 556, 833, 722, 778, 667, 778, 722, 667, 611, 722, 667, 944, 667, 667, 611, 278, 278, 278, 469, 556
                   Data.l 333, 556, 556, 500, 556, 556, 278, 556, 556, 222, 222, 500, 222, 833, 556, 556, 556, 556, 333, 500, 278, 556, 500, 722, 500, 500, 500, 334, 260, 334, 584, 750, 556, 750, 222, 556, 333, 1000, 556, 556, 333, 1000, 667, 333, 1000, 750, 611, 750, 750, 222, 222, 333, 333, 350, 556, 1000, 333, 1000, 500, 333, 944, 750, 500, 667
                   Data.l 278, 333, 556, 556, 556, 556, 260, 556, 333, 737, 370, 556, 584, 333, 737, 552, 400, 549, 333, 333, 333, 576, 537, 278, 333, 333, 365, 556, 834, 834, 834, 611, 667, 667, 667, 667, 667, 667, 1000, 722, 667, 667, 667, 667, 278, 278, 278, 278, 722, 722, 778, 778, 778, 778, 778, 584, 778, 722, 722, 722, 722, 667, 667, 611
                   Data.l 556, 556, 556, 556, 556, 556, 889, 500, 556, 556, 556, 556, 278, 278, 278, 278, 556, 556, 556, 556, 556, 556, 556, 549, 611, 556, 556, 556, 556, 500, 556, 500
      EndDataSection
      CopyMemory(?ArialItalic, @awTemp(), SizeOf(LONG)*224) 
      
      fdTemp\Param = "/Flags 96 /FontBBox [-250 -212 1134 1000] /MissingWidth 259 /StemV 80 /StemH 80 /ItalicAngle -11 /CapHeight 905 /XHeight 453 /Ascent 905 /Descent -212 /Leading 150 /MaxWidth 945 /AvgWidth 441"
      fdTemp\MissingWidth = 259

    Case #pdfBoldItalic
      fdTemp\BaseFont = fdTemp\BaseFont + ",BoldItalic"
      DataSection
      ArialBoldITalic: Data.l 278, 333, 474, 556, 556, 889, 722, 238, 333, 333, 389, 584, 278, 333, 278, 278, 556, 556, 556, 556, 556, 556, 556, 556, 556, 556, 333, 333, 584, 584, 584, 611, 975, 722, 722, 722, 722, 667, 611, 778, 722, 278
      				 	  Data.l 556, 722, 611, 833, 722, 778, 667, 778, 722, 667, 611, 722, 667, 944, 667, 667, 611, 333, 278, 333, 584, 556, 333, 556, 611, 556, 611, 556, 333, 611, 611, 278, 278, 556, 278, 889, 611, 611, 611, 611, 389, 556
      				 	  Data.l 333, 611, 556, 778, 556, 556, 500, 389, 280, 389, 584, 750, 556, 750, 278, 556, 500, 1000, 556, 556, 333, 1000, 667, 333, 1000, 750, 611, 750, 750, 278, 278, 500, 500, 350, 556, 1000, 333, 1000, 556, 333, 944, 750
      				 	  Data.l 500, 667, 278, 333, 556, 556, 556, 556, 280, 556, 333, 737, 370, 556, 584, 333, 737, 552, 400, 549, 333, 333, 333, 576, 556, 278, 333, 333, 365, 556, 834, 834, 834, 611, 722, 722, 722, 722, 722, 722, 1000, 722
      				 	  Data.l 667, 667, 667, 667, 278, 278, 278, 278, 722, 722, 778, 778, 778, 778, 778, 584, 778, 722, 722, 722, 722, 667, 667, 611, 556, 556, 556, 556, 556, 556, 889, 556, 556, 556, 556, 556, 278, 278, 278, 278, 611, 611
      				 	  Data.l 611, 611, 611, 611, 611, 549, 611, 611, 611, 611, 611, 556, 611, 556
      EndDataSection
      CopyMemory(?ArialBoldItalic, @awTemp(), SizeOf(LONG)*224)
      
      fdTemp\Param = "/Flags 16480 /FontBBox [-250 -212 1120 1000] /MissingWidth 311 /StemV 153 /StemH 153 /ItalicAngle -11 /CapHeight 905 /XHeight 453 /Ascent 905 /Descent -212 /Leading 150 /MaxWidth 933 /AvgWidth 479"
      fdTemp\MissingWidth = 311
  EndSelect
  
  For i = fdTemp\FirstChar To fdTemp\LastChar & 255
    fdTemp\Widths[i] = awTemp(i - fdTemp\FirstChar)
  Next
 
  CopyMemory(@fdTemp, @vFONT, SizeOf(vFONT))
  
EndProcedure


Procedure InsertObjectOnPage()
  i.w
  
  If intObject > 0
    For i = 1 To intObject
      With arrOBJECT(i)
        If (((\Options & #pdfAllPages) = #pdfAllPages) Or (((\Options & #pdfEvenPages) <> 0) And ((mvarPages % 2) = 0)) Or (((\Options & #pdfOddPages) <> 0) And ((mvarPages % 2) <> 0)) And (Not (((\Options & #pdfNotFirstPage) <> 0) And (mvarPages = 1))))
          DrawObject(\Name)
        EndIf
      EndWith
    Next
  EndIf

EndProcedure



;These were the procedures. Call them like this:



If OpenWindow(0, 247, 267, 280, 111, "pdf creator",  #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget)
	OptionGadget(0, 90,10,200,20,"Use ASCII85 code")
	ButtonGadget(1, 60, 40, 150, 50, "Create pdf file")

Repeat
    Event = WaitWindowEvent()

    If Event = #PB_Event_CloseWindow
      Quit = 1
    ElseIf Event = #PB_Event_Gadget
    	If EventGadget() = 1;Button pressed
    	  ; strFile.s will be set at the start of the code!
	    	Title ("Demo clsPDFCreator")
			ScaleMode(#pdfCentimeter)
			PaperSize(#pdfA4)
			Margin(0)
			Orientation(#pdfPortrait)
			EncodeASCII85(GetGadgetState(0))
			InitPDFFile(strFile)
			LoadFnt("Fnt1", "Times New Roman")
			LoadFnt("Fnt2", "Arial",#pdfItalic)
			LoadFontStandard("Fnt3", "Arial",#pdfBold)
			LoadImgFromBMPFile ("Img1", bmpImage)   ; original: "c:\200x200x24.bmp")   ;use your own bmp image file here.
			
			StartObject ("Item1", #pdfAllPages)
			SetColorFill (-240)
			SetTextHorizontalScaling (120)
			DrawTxt (6, 4, "rotated text", "Fnt1", 120, #pdfAlignLeft, 60)
			SetColorFill (0)
			EndObject()
			
			BeginPage()
			DrawTxt (19, 1.5, "page " + Trim(Str(Pages())), "Fnt2", 12, #pdfAlignRight)
			DrawTxt (3, 27, "Simple Word Spacing", "Fnt1", 48, #pdfAlignLeft)
			SetWordSpacing(10)
			DrawTxt (1, 25, "Extended Word Spacing", "Fnt2", 48, #pdfAlignLeft)
			SetCharSpacing(10)
			DrawTxt (4.9, 23, "Char Spacing", "Fnt3", 48, #pdfAlignRight)
			Rectangle (1, 2, 19, 24.5, #Stroked)
			
			SetDash (0.5, 0.3)
			MoveTo (9, 2)
			LineTo (9, 10, #Nil)
			LineTo (1, 10, #Stroked)
			SetDash (0)
			
			Rectangle (5, 5, 2.5, 3, #Stroked, 0.5)
			SetColorFill (RGB(123, 45, 56))
			Rectangle (2, 3, 2.5, 3, #Filled, 0.5)
			SetColorFill (0)
			
			SetLineWidth (0.05)
			SetColorStroke (RGB(255, 0, 0))
			DrawCircle (13, 7, 2, #Stroked)
			SetColorStroke (RGB(0, 255, 0))
			DrawCircle (15, 7, 2, #Stroked)
			SetColorStroke (RGB(0, 0, 255))
			DrawCircle (15, 5, 2, #Stroked)
			SetColorStroke (0)
			DrawCircle (13, 5, 2, #Stroked)
			
			For i = 0 To 90 Step 10;
				SetColorStroke (RGB(255 - i, i, 255 - i))
				Arc (14.5, 15, 5, 0, 360, 0.5,#False , i)
			Next
			
			SetLineCap (0)
			SetLineWidth (0.8)
			SetColorStroke (RGB(255, 0, 0))
			MoveTo (4, 15)
			LineTo (4, 20)
			SetColorStroke (RGB(255, 255, 0))
			MoveTo (5, 15)
			LineTo (5, 17)
			SetColorStroke (RGB(0, 255, 255))
			SetLineCap (1)
			MoveTo (6, 15)
			LineTo (6, 20)
			SetColorStroke (RGB(130, 127, 80))
			SetLineCap (2)
			MoveTo (7, 15)
			LineTo (7, 18)
			SetColorStroke (0)
			SetLineWidth (0)
			SetLineCap (0)
			
			SetDash (0.2, 0.2)
			MoveTo (7, 18)
			Curve (6, 20, 5, 18, 4, 21)
			SetDash (0)
			
			MoveTo (8, 15)
			LineTo (3, 15, #Nil)
			LineTo (3, 19.5)
			EndPage()
			BeginPage()
			DrawTxt (19, 1.5, "page " + Trim(Str(Pages())), "Fnt1", 12, #pdfAlignRight)
			DrawTxt (6, 21.5, "Text Rotated", "Fnt2", 28, #pdfAlignRight,-50)
			
			DrawImg ("Img1", 14, 24, 3, 3)
			EndPage()
			ClosePDFFile()
			CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
				RunProgram("open", strFile, "")
			CompilerElse
				RunProgram(strFile)
			CompilerEndIf
		EndIf
    EndIf

  Until Quit = 1
  
EndIf

End

doctorized · Post by **doctorized** » Wed Jan 05, 2011 2:05 pm

Andre wrote:As I tried to make it runnable on my MacBook I came up with this extended/modified code, which should run on Windows and MacOS (and probably on Linux too).

What problem did you have with my initial code?

Post by **Andre** » Wed Jan 05, 2011 10:00 pm

doctorized wrote:
Andre wrote:As I tried to make it runnable on my MacBook I came up with this extended/modified code, which should run on Windows and MacOS (and probably on Linux too).
What problem did you have with my initial code?

There wasn't a problem on Windows, I'm sure.
But I downloaded the code and tested directly on MacOS with PB4.51.

If I remember right,
- I had to change/add several variable types (maybe older PB versions weren't so exactly checking, if all variable were declared before first use).
- Furthermore I had to add MacOS-specific code (see the CompilerIf section) to handle the different way of using files and paths on MacOS
- .... (maybe some more minor changes, I can't remember)

Post by **Kiffi** » Thu Jan 06, 2011 10:28 am

Hello André,

thank you for your Code!

With my Acrobat Reader 10 the first page looks good. But when i scroll
down to the second page, i get the following message:

Thx & Greetings ... Kiffi (Windows Vista Business SP2)

Progi1984 · Post by **Progi1984** » Thu Jan 06, 2011 12:23 pm

Small stupid question : have you changed the path of the image stored in bmpImage ?

Post by **Kiffi** » Thu Jan 06, 2011 12:54 pm

@Progi1984: Thanks for your hint! It was my fault.

Now it works as expected.

Greetings ... Kiffi

doctorized · Post by **doctorized** » Thu Jan 06, 2011 2:53 pm

Andre wrote:There wasn't a problem on Windows, I'm sure.
But I downloaded the code and tested directly on MacOS with PB4.51.

I tested my initial code and your code on Windows 7 x64 with both x86 and x64 PB 4.51 and they work fine.
What exactly do you want to do? Is there something specific that you need? I may be able to play a little and find something out.

Post by **Andre** » Thu Jan 06, 2011 11:49 pm

doctorized wrote: I tested my initial code and your code on Windows 7 x64 with both x86 and x64 PB 4.51 and they work fine.
What exactly do you want to do? Is there something specific that you need? I may be able to play a little and find something out.

@doctorized:
Thanks for your offer!

At first I just wanted to test your code also on MacOS.
So I removed the WinAPI-commands (e.g. ShellExecute_()) and changed the related code to PB-only commands. Furthermore I made several modifications needed on MacOS.

In the future I would like to use this code to create a PDF output for my GeoWorld applications, running on Windows and MacOS. The reason is simple: this is the first code for creating PDF files I've seen, which don't need any external files (DLL, userlibs). So I know it's able to run on Windows and MacOS (probably Linux too.)
When I run into problems, when integrating the code into my application later, I will contact you...

@All:
I've done small modifications in both posted code parts: in the first one I added a warning, if the 'bmpImage' couldn't be loaded (because this is causing an error message in Adobe Reader, like Kiffi showed us). In the second one I added different calls of RunProgram() for Windows/MacOS to start and load the created PDF in Adobe Reader.

doctorized · Post by **doctorized** » Fri Jan 07, 2011 12:28 am

Andre wrote:When I run into problems, when integrating the code into my application later, I will contact you...

It will be my pleasure to help you!

PureBasic Forums - English

Create pdf files version 1.3 (Acrobat 4.0)

Create pdf files version 1.3 (Acrobat 4.0)

Re: Create pdf files version 1.3 (Acrobat 4.0)

Re: Create pdf files version 1.3 (Acrobat 4.0)

Re: Create pdf files version 1.3 (Acrobat 4.0)

Re: Create pdf files version 1.3 (Acrobat 4.0)

Re: Create pdf files version 1.3 (Acrobat 4.0)

Re: Create pdf files version 1.3 (Acrobat 4.0)

Re: Create pdf files version 1.3 (Acrobat 4.0)

Re: Create pdf files version 1.3 (Acrobat 4.0)

Re: Create pdf files version 1.3 (Acrobat 4.0)

Re: Create pdf files version 1.3 (Acrobat 4.0)

Re: Create pdf files version 1.3 (Acrobat 4.0)

Re: Create pdf files version 1.3 (Acrobat 4.0)