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
