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

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

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