Platforms to show: All Mac Windows Linux Cross-Platform

/DynaPDF/Create PDF with text styles


Required plugins for this example: MBS DynaPDF Plugin

You find this example project in your Plugins Download as a Xojo project file within the examples folder: /DynaPDF/Create PDF with text styles

This example is the version from Mon, 16th Jan 2022.

Project "Create PDF with text styles.xojo_binary_project"
FileTypes
Filetype text
End FileTypes
MenuBar MenuBar1
MenuItem UntitledMenu1 = ""
MenuItem FileMenu = "&File"
MenuItem FileQuit = "Quit"
MenuItem UntitledMenu5 = ""
MenuItem EditMenu = "&Edit"
MenuItem EditUndo = "&Undo"
MenuItem UntitledMenu0 = "-"
MenuItem EditCut = "Cu&t"
MenuItem EditCopy = "&Copy"
MenuItem EditPaste = "&Paste"
MenuItem EditClear = "Clear"
MenuItem UntitledMenu4 = ""
MenuItem UntitledMenu3 = ""
MenuItem UntitledMenu2 = ""
End MenuBar
Class App Inherits Application
End Class
Class MyDynaPDFMBS Inherits DynaPDFMBS
EventHandler Function Error(ErrorCode as integer, ErrorMessage as string, ErrorType as integer) As integer // output all messages on the console: System.DebugLog str(ErrorCode)+": "+ErrorMessage // and display dialog: Dim d as New MessageDialog //declare the MessageDialog object Dim b as MessageDialogButton //for handling the result d.icon=MessageDialog.GraphicCaution //display warning icon d.ActionButton.Caption="Continue" d.CancelButton.Visible=True //show the Cancel button // a warning or an error? if BitAnd(ErrorType, me.kE_WARNING) = me.kE_WARNING then // if user decided to ignore, we'll ignore if IgnoreWarnings then Return 0 d.Message="A warning occurred while processing your PDF code." // we add a third button to display all warnings d.AlternateActionButton.Caption = "Ignore warnings" d.AlternateActionButton.Visible = true else d.Message="An error occurred while processing your PDF code." end if d.Explanation = str(ErrorCode)+": "+ErrorMessage b=d.ShowModal //display the dialog Select Case b //determine which button was pressed. Case d.ActionButton Return 0 // ignore Case d.AlternateActionButton IgnoreWarnings = true Return 0 // ignore Case d.CancelButton Return -1 // stop End select End EventHandler
Property IgnoreWarnings As Boolean
End Class
Class MainWindow Inherits Window
Control itext Inherits TextArea
ControlInstance itext Inherits TextArea
EventHandler Sub SelChange() BButton.Value = me.SelBold IButton.Value = me.SelItalic UButton.Value = me.SelUnderline CP.SetColor me.SelTextColor Select case itext.SelAlignment case itext.AlignDefault, itext.AlignLeft CButton.Value = false LButton.Value = true RButton.Value = false case itext.AlignCenter CButton.Value = true LButton.Value = false RButton.Value = false case itext.AlignRight CButton.Value = false LButton.Value = false RButton.Value = true end Select End EventHandler
End Control
Control CreateButton Inherits PushButton
ControlInstance CreateButton Inherits PushButton
EventHandler Sub Action() run End EventHandler
End Control
Control UButton Inherits BevelButton
ControlInstance UButton Inherits BevelButton
EventHandler Sub Action() itext.SelUnderline = me.Value End EventHandler
End Control
Control IButton Inherits BevelButton
ControlInstance IButton Inherits BevelButton
EventHandler Sub Action() itext.SelItalic = me.Value End EventHandler
End Control
Control BButton Inherits BevelButton
ControlInstance BButton Inherits BevelButton
EventHandler Sub Action() itext.SelBold = me.Value End EventHandler
End Control
Control CP Inherits ColorPanel
ControlInstance CP Inherits ColorPanel
EventHandler Sub Changed() itext.SelTextColor = me.current End EventHandler
End Control
Control LButton Inherits BevelButton
ControlInstance LButton Inherits BevelButton
EventHandler Sub Action() if me.Value then itext.SelAlignment = itext.AlignLeft CButton.Value = false RButton.Value = false end if End EventHandler
End Control
Control CButton Inherits BevelButton
ControlInstance CButton Inherits BevelButton
EventHandler Sub Action() if me.Value then itext.SelAlignment = itext.AlignCenter LButton.Value = false RButton.Value = false end if End EventHandler
End Control
Control RButton Inherits BevelButton
ControlInstance RButton Inherits BevelButton
EventHandler Sub Action() if me.Value then itext.SelAlignment = itext.AlignRight CButton.Value = false LButton.Value = false end if End EventHandler
End Control
Control otext Inherits TextArea
ControlInstance otext Inherits TextArea
End Control
Control MySplitter Inherits Splitter
ControlInstance MySplitter Inherits Splitter
End Control
Control FontButton Inherits BevelButton
ControlInstance FontButton Inherits BevelButton
EventHandler Sub Action() if me.MenuValue>=0 then dim fontname as string = me.List(me.MenuValue) itext.SelTextFont = fontname end if End EventHandler
EventHandler Sub Open() dim u as integer = FontCount-1 dim list() as string for i as integer = 0 to u list.Append font(i) next // sort list.sort for each l as string in list me.AddRow l next End EventHandler
End Control
EventHandler Sub Open() MySplitter.topControl = itext MySplitter.bottomControl = otext If XojoVersion >= 2018.03 And IsDarkMode Then MsgBox "Please be aware that in dark mode the white text may be hard to see on white paper." End If End EventHandler
Function ConvertText(d as DynaPDFMBS) As string // here we convert the text // pick the text dim s as StyledText = itext.StyledText dim lastalignment as integer = -1 // this array takes the text fragments and is later joined for the result text dim result(-1) as string 'if DebugBuild then '// list Paragraphs 'dim pc as integer = s.ParagraphCount-1 'for pi as integer = 0 to pc 'dim p as Paragraph = s.Paragraph(pi) ' 'System.DebugLog "Paragraph: "+str(pi) 'System.DebugLog "Alignment: "+str(p.Alignment) 'System.DebugLog "StartPos: "+str(p.StartPos) 'System.DebugLog "EndPos: "+str(p.EndPos) 'next 'end if dim pos as integer = 0 dim c as integer = s.StyleRunCount-1 for i as integer = 0 to c dim sr as StyleRun = s.StyleRun(i) dim ra as Range = s.StyleRunRange(i) if DebugBuild then System.DebugLog "i: "+str(i) System.DebugLog "ra.StartPos: "+str(Ra.StartPos) System.DebugLog "ra.EndPos: "+str(Ra.EndPos) System.DebugLog "ra.Length: "+str(Ra.Length) System.DebugLog "sr.Text: "+str(sr.Text) end if // check the alignment using the Paragraph list dim alignment as integer = 0 dim pc as integer = s.ParagraphCount-1 for pi as integer = 0 to pc dim p as Paragraph = s.Paragraph(pi) if p.StartPos<=ra.StartPos then alignment = p.Alignment end if next // go with the position pos = pos + len(sr.Text) if DebugBuild then System.DebugLog "alignment: "+str(alignment) end if // apply alignment if lastalignment<>alignment then lastalignment = alignment // check alignment Select case alignment case itext.AlignCenter result.Append "\ce#" case itext.AlignRight result.Append "\re#" else result.Append "\le#" end Select end if // now check the text color dim co as color = sr.TextColor dim size as Double = sr.Size dim fcol as integer = d.RGB(co.Red, co.Green, co.Blue) result.Append "\FC["+str(fcol)+"]\FS["+str(size,"0")+"]" // now be check the fontname, style and size dim style as integer if sr.Bold then Style = style + d.kfsBold end if if sr.Italic then Style = style + d.kfsItalic end if Dim Font As String = sr.Font dim text as string = sr.Text Dim fh As Integer = d.SetFont(Font, style, Size, False, d.kcpUnicode) If fh < 0 Then // found not found, switch to Arial Unicode MS fh = d.SetFont("Arial Unicode MS", style, Size, False, d.kcpUnicode) If fh < 0 Then // style not available, try again? fh = d.SetFont("Arial Unicode MS", 0, Size, False, d.kcpUnicode) End If End If Dim TestPos As Integer = d.TestGlyphs(fh, Text) If TestPos >= 0 Then // one character not found, so we switch font fh = d.SetFont("Arial Unicode MS", style, Size, False, d.kcpUnicode) If fh < 0 Then // style not available, try again? fh = d.SetFont("Arial Unicode MS", 0, Size, False, d.kcpUnicode) End If End If result.Append "\FT["+str(Fh)+"]" // underline is handled extra if sr.Underline then result.Append "\ul#" end if // and append the text result.Append Text if sr.Underline then result.Append "\ul#" end if next Return Join(result, "") End Function
Sub run() Dim pdf As New MyDynapdfMBS dim text as string dim height as double pdf.SetLicenseKey "Starter" // For this example you can use a Starter, Lite, Pro or Enterprise License dim f as FolderItem = SpecialFolder.Desktop.Child("Create PDF with text styles.pdf") call pdf.CreateNewPDF f call pdf.SetViewerPreferences pdf.kvpDisplayDocTitle,pdf.kavNone call pdf.SetDocInfo pdf.kdiAuthor, "Christian Schmitz" call pdf.SetDocInfo pdf.kdiSubject, "My first Xojo output" call pdf.SetDocInfo pdf.kdiProducer, "Xojo test application" call pdf.SetDocInfo pdf.kdiTitle, "My first Xojo output" // We want to use top-down coordinates call pdf.SetPageCoords pdf.kpcTopDown call pdf.Append call pdf.SetFont "Times", pdf.kfsItalic, 20.0, true, pdf.kcpUnicode call pdf.SetTextRect(50, 50, pdf.GetPageWidth-100, pdf.GetPageHeight-100) // old way 'Text = ConvertText(pdf) // new way using built-in functions in DynaPDFMBS Text = pdf.ConvertStyledText(itext.StyledText) otext.Text = Text // or better call WriteStyledText directy Call pdf.WriteFText(pdf.ktaLeft, Text) height = pdf.GetPageHeight - pdf.GetLastTextPosY - 50 'call pdf.Rectangle( 50, 50, 150, height, pdf.kfmStroke) call pdf.EndPage Call pdf.CloseFile f.Launch End Sub
End Class
Class ColorPanel Inherits Canvas
Event Changed() End Event
EventHandler Function MouseDown(X As Integer, Y As Integer) As Boolean Return true End EventHandler
EventHandler Sub MouseUp(X As Integer, Y As Integer) dim c as color = Current if SelectColor(c, "Select text color:") then current = c redraw Changed end if End EventHandler
EventHandler Sub Paint(g As Graphics, areas() As REALbasic.Rect) draw g End EventHandler
Sub SetColor(c as color) current = c redraw End Sub
Sub draw(g as Graphics) g.ForeColor = current g.FillRect 0, 0, g.Width, g.Height End Sub
Sub redraw() self.Invalidate End Sub
Note "Readme"
A very simply control to select a color
Property current As color
End Class
Class Splitter Inherits Canvas
EventHandler Function MouseDown(X As Integer, Y As Integer) As Boolean y = self.TrueWindow.MouseY LastY = Y Return true End EventHandler
EventHandler Sub MouseDrag(X As Integer, Y As Integer) y = self.TrueWindow.MouseY dim dy as integer = LastY - Y if topControl.Height - dy < 40 then dy = topControl.Height - 40 end if if bottomControl.Height + dy < 40 then dy = bottomControl.Height - 40 end if me.top = me.top - dy topControl.Height = topControl.Height - dy bottomControl.top = bottomControl.top - dy bottomControl.Height = bottomControl.Height + dy LastY = Y End EventHandler
EventHandler Sub Paint(g As Graphics, areas() As REALbasic.Rect) dim mx as integer = g.Width/2 dim my as integer = g.Height/2 g.ForeColor = DarkBevelColor g.DrawLine mx - 20, my-2, mx + 20, my-2 g.DrawLine mx - 20, my, mx + 20, my g.DrawLine mx - 20, my+2, mx + 20, my+2 End EventHandler
Property LastY As Integer
Property bottomControl As RectControl
Property topControl As RectControl
End Class
End Project

See also:

The items on this page are in the following plugins: MBS DynaPDF Plugin.


The biggest plugin in space...