[FBSL] Text file to PDF Class converter

[Gérôme Guillemin]

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 :

Code Select Expand


#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