Hello,
For people who are interested in a free text to pdf converter and people who don't know FBSL language, here's a good way to see how FBSL works with Classes and its syntax very closer to VB.
Here we go :
#Option Strict
#Uses "@|WIN32"
'// ::TEST::
Dim $szFileN = Command(1)
If szFileN = "" Then
szFileN = FBSL_GetFileName( "Open", "Text Files(*.txt,*.log,*.fbs,*.csv)|*.txt;*.log;*.fbs;*.csv|All Files(*.*)|*.*", FALSE )
End If
Dim DC = GetDC(Me)
Dim !progress = 0.001
Style_Remove( Me , WS_SIZEBOX + WS_MINIMIZEBOX + WS_MAXIMIZEBOX )
FBSL_SetText( Me, "==-Txt2Pdf converter 1.0-==" )
Resize( Me , 0, 0, 340, 40 )
Center( Me )
ReFresh( Me )
If szFileN <> "" Then
Show( Me )
Dim pdf As New TXT2PDF, $szOutPDF = Left( szFileN, -3 ) & "pdf"
pdf.Convert( szFileN, szOutPDF, "GEG", "Creator", "mots clefs", "sujet", "titre" )
Delete pdf
FBSL_SetText( Me, "Done at 100%" )
Sleep(1000)
FBSL_SetText( Me, Right(szOutPDF, -INSTRREV(szOutPDF,"\")) & " is OK !")
Sleep(2000)
End If
PostMessage( Me, WM_CLOSE, 0, 0 )
Begin Events
Select Case CBMSG
Case WM_CLOSE
DeleteDC( DC )
Sleep(200)
ExitProgram( 0 )
End Select
End Events
'// -----------------------------------------
'// ::- TXT2PDF CLASS -::
'// -----------------------------------------
Begin Class TXT2PDF
Public:
Sub Convert(ByVal $filename, $outputfile, $TextAuthor = "", $TextCreator = "", $TextKeywords = "", $TextSubject = "", _
$TextTitle = "", $FontName = "Courier", %FontSize = 10, $Rotation = "", !pwidth = 8.5, !pheight = 11)
ConvertToPDF(filename, outputfile, TextAuthor, TextCreator, TextKeywords, TextSubject, TextTitle, FontName, FontSize, Rotation, pwidth, pheight)
End Sub
Private:
#Define AppName "FBSL-PDFProducer"
Dim %Position, %pageNo, %lineNo, %pageHeight, %pageWidth
Dim %location[1 To 5000], %pageObj[1 To 5000]
Dim %lines, %obj, %Tpages, %encoding, %resources, $pages, $author, $creator, $keywords, $subject, $Title, $BaseFont
Dim !pointSize, !vertSpace, %rotate, %info, %root, !npagex, %npagey, $filetxt, $filepdf, %linelen, $cache, $cmdline
Sub ConvertToPDF($filename, $outputfile, TextAuthor, TextCreator, TextKeywords, TextSubject, _
TextTitle, FontName = "Courier", FontSize = 10, Rotation, pwidth = 8.5, pheight = 11)
If Not FileExist(filename) Then
? "File '" & filename & "' does not exist."
Exit Sub
ElseIf FileExist(outputfile) Then
DeleteF( outputfile )
End If
progress = 0
myInitialize( FontName, FontSize, Rotation, pwidth, pheight )
author = TextAuthor
creator = TextCreator
keywords = TextKeywords
subject = TextSubject
Title = TextTitle
filetxt = filename
filepdf = outputfile
Call WriteStart()
Call WriteHead()
Call WritePages()
Call endpdf()
End Sub
Sub myInitialize($FontName, %FontSize, %Rotation, !pwidth, !pheight)
pageHeight = 72 * pheight
pageWidth = 72 * pwidth
BaseFont = FontName ' Courier, Times-Roman, Arial
pointSize = FontSize ' Font Size; Don't change it
vertSpace = FontSize * 1.2 ' Vertical spacing
rotate = Rotation ' degrees to rotate; try setting 90,180,etc
lines = (pageHeight - 72) / vertSpace ' no of lines on one page
Select Case LCase(FontName)
Case "courier"
linelen = 1.5 * pageWidth / pointSize
Case "arial"
linelen = 2 * pageWidth / pointSize
'Case "Times-Roman"
' linelen = 2.2 * pageWidth / pointSize
Case Else
linelen = 2.2 * pageWidth / pointSize
End Select
obj = 0
npagex = pageWidth / 2
npagey = 25
pageNo = 0
Position = 0
cache = ""
End Sub
Sub writepdf($stre, flush = 0)
Position = Position + Len(stre)
cache = cache & stre & CR
If Len(cache) > 32000 OrElse flush Then
Dim %fp = FileOpen( filepdf, BINARY_APPEND )
FilePut( fp, cache )
FileClose( fp )
cache = ""
Sleep(0)
End If
End Sub
Sub WriteStart()
writepdf("%PDF-1.2")
writepdf("%âãÏÓ")
End Sub
Sub WriteHead()
Dim $CreationDate
CreationDate = "D:" & TIME(5) & TIME(6) & TIME(7) & TIME(1) & TIME(2) & TIME(3) '// YYYYMMDDHHNNSS
obj = obj + 1
location[obj] = Position
info = obj
writepdf(obj & " 0 obj")
writepdf("<<")
writepdf("/Author (" & author & ")")
writepdf("/CreationDate (" & CreationDate & ")")
writepdf("/Creator (" & creator & ")")
writepdf("/Producer (" & AppName & ")")
writepdf("/Title (" & Title & ")")
writepdf("/Subject (" & subject & ")")
writepdf("/Keywords (" & keywords & ")")
writepdf(">>")
writepdf("endobj")
obj = obj + 1
root = obj
obj = obj + 1
Tpages = obj
encoding = obj + 2
resources = obj + 3
obj = obj + 1
location[obj] = Position
writepdf(obj & " 0 obj")
writepdf("<<")
writepdf("/Type /Font")
writepdf("/Subtype /Type1")
writepdf("/Name /F1")
writepdf("/Encoding " & encoding & " 0 R")
writepdf("/BaseFont /" & BaseFont)
writepdf(">>")
writepdf("endobj")
obj = obj + 1
location[obj] = Position
writepdf(obj & " 0 obj")
writepdf("<<")
writepdf("/Type /Encoding")
writepdf("/BaseEncoding /WinAnsiEncoding")
writepdf(">>")
writepdf("endobj")
obj = obj + 1
location[obj] = Position
writepdf(obj & " 0 obj")
writepdf("<<")
writepdf(" /Font << /F1 " & obj - 2 & " 0 R >>")
writepdf(" /ProcSet [ /PDF /Text ]")
writepdf(">>")
writepdf("endobj")
End Sub
Sub WritePages()
Static CHR12 = Chr(12)
Dim %i, $szLine, $tmpline, $beginstream, vtLines[], %iCount = 0, %vCount = 0
vtLines = Array_FromFile( filetxt, (1024*32) )
vCount = Count( vtLines )
beginstream = StartPage()
lineNo = -1
ForEach szLine In vtLines
lineNo = lineNo + 1
iCount = iCount + 1
If NOT iCount MOD 777 Then
progress = (iCount/vCount)*100
FBSL_SetText( Me, "Done at " & Using("###.##", progress) & "%" )
DoEvents
Sleep(0)
End If
'page break
If lineNo >= lines OrElse Instr(szLine, CHR12) > 0 Then
writepdf("1 0 0 1 " & npagex & " " & npagey & " Tm")
writepdf("(" & pageNo & ") Tj")
writepdf("/F1 " & pointSize & " Tf")
endpage(beginstream)
beginstream = StartPage()
End If
szLine = Replace(Replace(szLine, "(", "\("), ")", "\)")
szLine = RTrim(szLine)
If Len(szLine) > linelen Then
'word wrap
Do While Len(szLine) > linelen
tmpline = Left(szLine, linelen)
For i = Len(tmpline) To Len(tmpline) \ 2 Step - 1
If Instr("*&^%$#,. ;<=>[])}!""", Mid(tmpline, i, 1)) Then
tmpline = Left(tmpline, i)
Exit For
End If
Next
szLine = Mid(szLine, Len(tmpline) + 1)
writepdf("T* (" & tmpline & CRLF & ") Tj")
lineNo = lineNo + 1
'page break
If lineNo >= lines OrElse Instr(szLine, CHR12) > 0 Then
writepdf("1 0 0 1 " & npagex & " " & npagey & " Tm")
writepdf("(" & pageNo & ") Tj")
writepdf("/F1 " & pointSize & " Tf")
endpage(beginstream)
beginstream = StartPage()
End If
Loop
lineNo = lineNo + 1
writepdf("T* (" & szLine & CRLF & ") Tj")
Else
writepdf("T* (" & szLine & CRLF & ") Tj")
End If
Next
writepdf("1 0 0 1 " & npagex & " " & npagey & " Tm")
writepdf("(" & pageNo & ") Tj")
writepdf("/F1 " & pointSize & " Tf")
endpage(beginstream)
Array_Clear( vtLines )
End Sub
Function StartPage()
Dim %strmpos
obj = obj + 1
location[obj] = Position
pageNo = pageNo + 1
pageObj[pageNo] = obj
writepdf(obj & " 0 obj")
writepdf("<<")
writepdf("/Type /Page")
writepdf("/Parent " & Tpages & " 0 R")
writepdf("/Resources " & resources & " 0 R")
obj = obj + 1
writepdf("/Contents " & obj & " 0 R")
writepdf("/Rotate " & rotate)
writepdf(">>")
writepdf("endobj")
location[obj] = Position
writepdf(obj & " 0 obj")
writepdf("<<")
writepdf("/Length " & obj + 1 & " 0 R")
writepdf(">>")
writepdf("stream")
strmpos = Position
writepdf("BT")
writepdf("/F1 " & pointSize & " Tf")
writepdf("1 0 0 1 50 " & pageHeight - 40 & " Tm")
writepdf(vertSpace & " TL")
Return strmpos
End Function
Function endpage(streamstart)
Dim %streamEnd
writepdf("ET")
streamEnd = Position
writepdf("endstream")
writepdf("endobj")
obj = obj + 1
location[obj] = Position
writepdf(obj & " 0 obj")
writepdf(streamEnd - streamstart)
writepdf("endobj")
lineNo = 0
End Function
Sub endpdf()
Dim $ty, %i, %xreF
location[root] = Position
writepdf(root & " 0 obj")
writepdf("<<")
writepdf("/Type /Catalog")
writepdf("/Pages " & Tpages & " 0 R")
writepdf(">>")
writepdf("endobj")
location[Tpages] = Position
writepdf(Tpages & " 0 obj")
writepdf("<<")
writepdf("/Type /Pages")
writepdf("/Count " & pageNo)
writepdf("/MediaBox [ 0 0 " & pageWidth & " " & pageHeight & " ]")
ty = ("/Kids [ ")
For i = 1 To pageNo
ty = ty & $pageObj[i] & " 0 R "
Next i
ty = ty & "]"
writepdf(ty)
writepdf(">>")
writepdf("endobj")
xreF = Position
writepdf("0 " & obj + 1)
writepdf("0000000000 65535 f ")
For i = 1 To obj
writepdf( lPad(location[i], 10, 0) & " 00000 n ")
Next i
writepdf("trailer")
writepdf("<<")
writepdf("/Size " & obj + 1)
writepdf("/Root " & root & " 0 R")
writepdf("/Info " & info & " 0 R")
writepdf(">>")
writepdf("startxref")
writepdf(xreF)
writepdf("%%EOF", TRUE)
End Sub
'Function ReplaceText(ByVal szText, ByVal TextToReplace, ByVal NewText)
' Return Replace(szText, TextToReplace, NewText)
'End Function
End Class