Creating PDFs from PureBasic

Just starting out? Need help? Post your questions and find answers here.
Post Reply
User avatar
kpeters58
Enthusiast
Enthusiast
Posts: 341
Joined: Tue Nov 22, 2011 5:11 pm
Location: Kelowna, BC, Canada

Creating PDFs from PureBasic

Post by kpeters58 »

Found this post:

http://www.purebasic.fr/english/viewtopic.php?p=298151

Andre's modified code is exactly what I am after - supposedly runs on all platforms, which is an absolute must for me.

So I just grabbed it and tried to run it under 5.3/5.4 but it produces a number of errors, such as

[10:27:21] [COMPILER] Line 158: Native types can't be used with pointers.

syntax errors here (one of many)
DataSection
TimesNormal: Data.l 250, 333, 408, 500, 500, 833, 77...

and others.

Does someone have a copy of this code that runs under 5.3/4?

Any help, as always, greatly appreciated!
PB 5.73 on Windows 10 & OS X High Sierra
Top
IdeasVacuum
Always Here
Always Here
Posts: 6426
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:
Contact IdeasVacuum

Re: Creating PDFs from PureBasic

Post by IdeasVacuum »

The reason that code fails is because of a few, long established changes in PB v5x, most of which in this case are minor.
However, if you do not need cross-platform, there is a very comprehensive lib for windows from ABB Klaus:
PurePDF
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
Top
infratec
Always Here
Always Here
Posts: 7582
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: Creating PDFs from PureBasic

Post by infratec »

Hi,

in general it's simple:

remove all .x behind pointers.
*ImgWidth.l -> *ImgWidth

There are two pointers as Array.
Simply remove the *.
Array *ImgColor.b(1) -> Array ImgColor.b(1)

For the DataSection:
Simply press return after the lable.

Code: Select all

DataSection
TimesNormal: Data.l 250, 333, 408, 500, 500, 833, 77...
->

Code: Select all

DataSection
 TimesNormal: 
 Data.l 250, 333, 408, 500, 500, 833, 77...
Bernd
Top
User avatar
TI-994A
Addict
Addict
Posts: 2700
Joined: Sat Feb 19, 2011 3:47 am
Location: Singapore
Contact:
Contact TI-994A

Re: Creating PDFs from PureBasic

Post by TI-994A »

kpeters58 wrote:Does someone have a copy of this code that runs under 5.3/4?
Here you go (code listing broken into two parts due to forum post limitations):

Part 1:

Code: Select all

;
; adapted for PureBasic v5.31 - 23 September 2015
;
; 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, *ImgHeight, *ImgBPP, ColorSpace.l = #pdfRGB)
Declare LoadImgFromArray(Name.s, Array ImgBuf.b(1), Array ImgColor.b(1), ImgWidth, ImgHeight, ImgBPP, 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, ImgHeight, ImgBPP, 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
code listing continues...
Texas Instruments TI-99/4A Home Computer: the first home computer with a 16bit processor, crammed into an 8bit architecture. Great hardware - Poor design - Wonderful BASIC engine. And it could talk too! Please visit my YouTube Channel :D
Top
User avatar
TI-994A
Addict
Addict
Posts: 2700
Joined: Sat Feb 19, 2011 3:47 am
Location: Singapore
Contact:
Contact TI-994A

Re: Creating PDFs from PureBasic

Post by TI-994A »

Continued from previous post (code listing broken into two parts due to forum post limitations):

Part 2:

Code: Select all

Procedure.l LeggeBMP(FileName.s, Array ImgBuf.b(1), Array ImgColor.b(1), *ImgWidth, *ImgHeight, *ImgBPP, 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
Texas Instruments TI-99/4A Home Computer: the first home computer with a 16bit processor, crammed into an 8bit architecture. Great hardware - Poor design - Wonderful BASIC engine. And it could talk too! Please visit my YouTube Channel :D
Top
User avatar
kpeters58
Enthusiast
Enthusiast
Posts: 341
Joined: Tue Nov 22, 2011 5:11 pm
Location: Kelowna, BC, Canada

Re: Creating PDFs from PureBasic

Post by kpeters58 »

Thanks for all your help - much appreciated!
PB 5.73 on Windows 10 & OS X High Sierra
Top
IdeasVacuum
Always Here
Always Here
Posts: 6426
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:
Contact IdeasVacuum

Re: Creating PDFs from PureBasic

Post by IdeasVacuum »

The ToASCII85 procedure and calls need attention.

Also, if to be compiled to 64bit, some if not all of the longs should be ints

...and in procedure LoadImgFromBMPFile() what is the temp file for?
Last edited by IdeasVacuum on Wed Sep 23, 2015 10:06 pm, edited 1 time in total.
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
Top
User avatar
Andre
PureBasic Team
PureBasic Team
Posts: 2137
Joined: Fri Apr 25, 2003 6:14 pm
Location: Germany (Saxony, Deutscheinsiedel)
Contact:
Contact Andre

Re: Creating PDFs from PureBasic

Post by Andre »

By the way: I would prefer now the newly introduced (PB5.40) VectorDrawing library, which can also output to a PDF file. Unfortunately it doesn't support Windows (for now).
Bye,
...André
(PureBasicTeam::Docs & Support - PureArea.net | Order:: PureBasic | PureVisionXP)
Top
User avatar
singo
User
User
Posts: 35
Joined: Mon Apr 23, 2007 4:50 am
Location: Nabiac NSW Australia

Re: Creating PDFs from PureBasic

Post by singo »

IdeasVacuum wrote:The reason that code fails is because of a few, long established changes in PB v5x, most of which in this case are minor.
However, if you do not need cross-platform, there is a very comprehensive lib for windows from ABB Klaus:
PurePDF
I've been testing PurePDF on Windows, Linux & Mac and even though there is only a library for Windows X86, it also works as an include file for Win X64, Linux X64 & Mac X86 (I haven't yet tested Linux X32 or Mac X64).

Simply download the version for your compiler (I am using the lastest LTS versions on each) and inside the examples folder is the source code. All the examples I've tested work great (text or images).

Then add to the top of your code, with the appropriate path to the IncludeFile

Code: Select all

#PurePDF_Include=1
XIncludeFile "PurePDF.pb"
Fantastic work from ABB Klaus.
Singo
Win10, Win7, Debian x86 & OSX ~ PB 5.70 LTS
Minimbah NSW Australia
Top
Post Reply

Return to “Coding Questions”