Xojo Conferences
MBSSep2018MunichDE
XDCMay2019MiamiUSA

Platforms to show: All Mac Windows Linux Cross-Platform

/DynaPDF/DynaPDF Graphics
Function:
Required plugins for this example: MBS DynaPDF Plugin, MBS Main Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /DynaPDF/DynaPDF Graphics
This example is the version from Wed, 2nd Dec 2014.
Project "DynaPDF Graphics.rbp"
Class App Inherits Application
Const kEditClear = "&Delete"
Const kFileQuit = "&Quit"
Const kFileQuitShortcut = ""
End Class
Class Window1 Inherits Window
Control PushButton1 Inherits PushButton
ControlInstance PushButton1 Inherits PushButton
EventHandler Sub Action() dim g as Graphics=OpenPrinterDialog if g=nil then Return end if draw new GraphicsWrapper(g) End EventHandler
End Control
Control PushButton2 Inherits PushButton
ControlInstance PushButton2 Inherits PushButton
EventHandler Sub Action() dim pdf as new MyDynapdfMBS dim f as FolderItem = SpecialFolder.Desktop.Child("DynaPDF Graphics.pdf") pdf.SetLicenseKey "Starter" // For this example you can use a Starter, Lite, Pro or Enterprise License if not pdf.CreateNewPDF(f) then Return end if dim g as new DynaPDFGraphics(pdf, 20.0, 20.0) draw g g=nil f.Launch true End EventHandler
End Control
Control PushButton3 Inherits PushButton
ControlInstance PushButton3 Inherits PushButton
EventHandler Sub Action() dim g as Graphics = Canvas1.Graphics draw new GraphicsWrapper(g) End EventHandler
End Control
Control EditField1 Inherits TextArea
ControlInstance EditField1 Inherits TextArea
End Control
Control Canvas1 Inherits Canvas
ControlInstance Canvas1 Inherits Canvas
End Control
Sub draw(g as GraphicsWrapper) // this is normal code as you would use with graphics class anyway // but we use GraphicsWrapper which can be DynaPDFGraphics, too. // so graphics can go to printer, window, picture or PDF! g.ForeColor=&c777777 g.DrawRect 0,0,g.Width-1,g.Height-1 g.ForeColor=&cFF0000 g.FillRect 100,100,200,200 g.DrawLine 0,0,100,100 g.ForeColor=&c000000 g.DrawString "Hello",150,150 g.DrawLine 100,100,200,200 g.ForeColor=&c00FF00 g.FillOval 100,0,100,100 g.ForeColor=&c0000FF g.DrawOval 100,0,100,100 g.ForeColor=&cFFFF00 g.FillRect 0,100,100,100 g.ForeColor=&c000000 g.DrawRect 0,100,100,100 g.ForeColor=&c00FF00 g.FillRoundRect 0,250,100,100,20,20 g.ForeColor=&c000000 g.DrawRoundRect 0,250,100,100,20,20 Dim Points(6) as Integer Points(1)=10 //X of Point 1 Points(2)=10 //Y of Point 1 Points(3)=75 //X of Point 2 Points(4)=30 //Y of Point 2 Points(5)=10 //X of Point 3 Points(6)=125 //Y of Point 3 g.ForeColor= RGB(100,200,255) g.FillPolygon Points g.ForeColor=&c000000 g.DrawPolygon Points g.TextFont = "Times" g.TextSize = 12 g.DrawString "Hello World", 200, 100 // test picture drawing dim logo as Picture = LogoMBS(200) g.DrawPicture logo, 200, 500 g.DrawPicture logo, 50, 500, 100, 200, 50, 50, 100, 100 // set a pixel g.Pixel(400,400)=&cFFFFFF dim stp as new StyledTextPrinterWrapper(EditField1, g, 200) stp.DrawBlock 200,500,250 End Sub
End Class
MenuBar MenuBar1
MenuItem FileMenu = "&File"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Edit"
MenuItem EditUndo = "&Undo"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "Cu&t"
MenuItem EditCopy = "&Copy"
MenuItem EditPaste = "&Paste"
MenuItem EditClear = "#App.kEditClear"
MenuItem UntitledMenu0 = "-"
MenuItem EditSelectAll = "Select &All"
End MenuBar
Class DynaPDFGraphics Inherits GraphicsWrapper
Function Bold() As boolean Return myBold End Function
Sub Bold(assigns b as boolean) myBold=b setFont End Sub
Sub Constructor(d as MyDynaPDFMBS, OffsetX as double, OffsetY as double) pdf=d call pdf.SetPageCoords(pdf.kpcTopDown) if pdf.Append then myPageOpen=true end if myTextSize=12 myFontname="Arial" myOffsetX=OffsetX myOffsetY=OffsetY SetFont End Sub
Sub Destructor() call pdf.EndPage call pdf.CloseFile End Sub
Sub DrawLine(x1 as double, y1 as double, x2 as double, y2 as double) call pdf.MoveTo(myOffsetX+x1,myOffsety+y1) call pdf.LineTo(myOffsetX+x2,myOffsety+y2) call pdf.StrokePath End Sub
Sub DrawOval(x as double, y as double, width as double, height as double) call pdf.Ellipse(myOffsetX+x,myOffsety+y,Width,Height,pdf.kfmStroke) End Sub
Sub DrawPicture(Image as Picture, X as Integer, Y as Integer) if image<>Nil then call pdf.InsertPicture(image, x, y, image.width, image.height) end if End Sub
Sub DrawPicture(Image as Picture, X as Integer, Y as Integer, DestWidth as Integer, DestHeight as Integer, SourceX as Integer, SourceY as Integer, SourceWidth as Integer, SourceHeight as Integer) if image<>Nil then dim pic as Picture = new Picture(DestWidth, DestHeight, 32) pic.Graphics.DrawPicture image, 0, 0, pic.Width, pic.Height, sourcex, sourcey, SourceWidth, SourceHeight call pdf.InsertPicture(pic, x, y, pic.width, pic.height) end if End Sub
Sub DrawPolygon(points() as integer) dim x,y as integer dim i,c as integer c=UBound(points) if c>=2 then x=points(1) y=points(2) call pdf.MoveTo(myOffsetX+x,myOffsety+y) for i=3 to c step 2 x=points(i) y=points(i+1) call pdf.LineTo(myOffsetX+x,myOffsety+y) next x=points(1) y=points(2) call pdf.LineTo(myOffsetX+x,myOffsety+y) call pdf.StrokePath end if End Sub
Sub DrawRect(x as double, y as double, width as double, height as double) call pdf.Rectangle(myOffsetX+x,myOffsety+y,Width,Height,pdf.kfmStroke) End Sub
Sub DrawRoundRect(x as double, y as double, width as double, height as double, ArcWidth as double, ArcHeight as double) call pdf.RoundRectex(myOffsetX+x,myOffsety+y,Width,Height,arcwidth/2.0, archeight/2.0, pdf.kfmStroke) End Sub
Sub DrawString(Text as String, X as Integer, Y as Integer, WrapWidth as Integer, Condense as Boolean = false) // condense not supported text = ReplaceAll(text, "\", "\\") // escape all backslashes if not pdf.WriteFTextEx(myOffsetX+x, myOffsety+y-myTextSize, WrapWidth, -1, pdf.ktaLeft, text) then Break end if End Sub
Sub DrawString(text as string, x as double, y as double) text = ReplaceAll(text, "\", "\\") // escape all backslashes if not pdf.WriteFTextEx(myOffsetX+x, myOffsety+y-myTextSize, pdf.GetPageWidth, -1, pdf.ktaLeft, text) then break end if End Sub
Sub FillOval(x as double, y as double, width as double, height as double) call pdf.Ellipse(myOffsetX+x,myOffsety+y,Width,Height,pdf.kfmFill) End Sub
Sub FillPolygon(points() as integer) dim x,y as integer dim i,c as integer c=UBound(points) if c>=2 then x=points(1) y=points(2) call pdf.MoveTo(myOffsetX+x,myOffsety+y) for i=3 to c step 2 x=points(i) y=points(i+1) call pdf.LineTo(myOffsetX+x,myOffsety+y) next call pdf.ClosePath(pdf.kfmFill) end if End Sub
Sub FillRect(x as double, y as double, width as double, height as double) call pdf.Rectangle(myOffsetX+x,myOffsety+y,Width,Height,pdf.kfmFill) End Sub
Sub FillRoundRect(x as double, y as double, width as double, height as double, arcwidth as double, archeight as double) call pdf.RoundRectex(myOffsetX+x,myOffsety+y,Width,Height,arcwidth/2.0, archeight/2.0, pdf.kfmFill) End Sub
Function ForeColor() As color Return myForeColor End Function
Sub ForeColor(assigns c as color) if pdf.SetColors(pdf.RGB(c.red,c.Green,c.Blue)) then myForeColor=c end if End Sub
Function GetPDF() As MyDynaPDFMBS Return pdf End Function
Function Height() As double Return pdf.GetPageHeight-myOffsety-myOffsety End Function
Function Italic() As boolean Return myItalic End Function
Sub Italic(assigns v as boolean) myItalic=v setFont End Sub
Sub NextPage() if pdf.EndPage then myPageOpen=false if pdf.Append then myPageOpen=true SetFont end if end if End Sub
Function PenHeight() As double Return pdf.GetLineWidth End Function
Sub PenHeight(assigns v as double) call pdf.SetLineWidth v End Sub
Function PenWidth() As double Return pdf.GetLineWidth End Function
Sub PenWidth(assigns v as double) call pdf.SetLineWidth v End Sub
Sub Pixel(x as integer, y as integer, assigns c as color) if pdf.SetColors(pdf.RGB(c.red,c.Green,c.Blue)) then DrawLine x,y,x,y call pdf.SetColors(pdf.RGB(myForeColor.red,myForeColor.Green,myForeColor.Blue)) end if End Sub
Sub SetFont() dim style as integer if mybold then Style=style+pdf.kfsBold end if if myUnderline then Style=style+pdf.kfsUnderlined end if if myitalic then Style=style+pdf.kfsItalic end if System.DebugLog "SetFont: "+myFontname+" "+str(Style)+" "+str(myTextSize) if pdf.SetFont(myFontname, Style, myTextSize, true, pdf.kcp1252) < 0 then Break end if End Sub
Function StringHeight(text as string) As double text = ReplaceAll(text, "\", "\\") // escape all backslashes Return pdf.GetFTextHeight(pdf.ktaLeft, text) End Function
Function StringHeight(text as string, wrapwidth as integer) As double text = ReplaceAll(text, "\", "\\") // escape all backslashes Return pdf.GetFTextHeightEx(wrapwidth, pdf.ktaLeft, text) End Function
Function StringWidth(text as string) As Double return pdf.GetTextWidth(text) End Function
Function TextAscent() As double Return pdf.GetAscent End Function
Function TextFont() As string Return myFontname End Function
Sub TextFont(assigns name as string) myFontname=name SetFont End Sub
Function TextHeight() As double Return pdf.GetCapHeight End Function
Function TextSize() As double Return myTextSize End Function
Sub TextSize(assigns v as double) myTextSize=v setfont End Sub
Function Underline() As boolean Return myUnderline End Function
Sub Underline(assigns v as boolean) myUnderline=v setFont End Sub
Function Width() As integer Return pdf.GetPageWidth-myOffsetx-myOffsetx End Function
Property Private myBold As boolean
Property Private myFontname As string
Property Private myForeColor As color
Property Private myItalic As boolean
Property Private myOffsetX As double
Property Private myOffsetY As double
Property Private myPageOpen As boolean
Property Private myTextSize As double
Property Private myUnderline As boolean
Property Private pdf As MyDynaPDFMBS
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
EventHandler Function PageBreak(LastPosX as double, LastPosY as double, PageBreak as boolean) As integer PageBreak = true Return -1 // stop End EventHandler
Property IgnoreWarnings As Boolean
Property PageBreak As Boolean
End Class
Class GraphicsWrapper
Function Bold() As boolean Return g.Bold End Function
Sub Bold(assigns b as boolean) g.Bold = b End Sub
Sub Constructor(g as Graphics) self.g = g End Sub
Sub Destructor() End Sub
Sub DrawLine(x1 as double, y1 as double, x2 as double, y2 as double) g.DrawLine x1,y1,x2,y2 End Sub
Sub DrawOval(x as double, y as double, width as double, height as double) g.DrawOval x,y,Width,Height End Sub
Sub DrawPicture(Image as Picture, X as Integer, Y as Integer) g.DrawPicture image, x,y End Sub
Sub DrawPicture(Image as Picture, X as Integer, Y as Integer, DestWidth as Integer, DestHeight as Integer, SourceX as Integer, SourceY as Integer, SourceWidth as Integer, SourceHeight as Integer) g.DrawPicture image, x, y, DestWidth, DestHeight, Sourcex, SourceY, SourceWidth, SourceHeight End Sub
Sub DrawPolygon(points() as integer) g.DrawPolygon Points End Sub
Sub DrawRect(x as double, y as double, width as double, height as double) g.DrawRect x,y,Width,Height End Sub
Sub DrawRoundRect(x as double, y as double, width as double, height as double, ArcWidth as double, ArcHeight as double) g.DrawRoundRect x,y,Width,Height, ArcWidth, ArcHeight End Sub
Sub DrawString(Text as String, X as Integer, Y as Integer, WrapWidth as Integer, Condense as Boolean = false) g.DrawString text, x, y, WrapWidth, Condense End Sub
Sub DrawString(text as string, x as double, y as double) g.DrawString text, x, y End Sub
Sub FillOval(x as double, y as double, width as double, height as double) g.FillOval x,y,Width,Height End Sub
Sub FillPolygon(points() as integer) g.FillPolygon points End Sub
Sub FillRect(x as double, y as double, width as double, height as double) g.FillRect x, y, Width, Height End Sub
Sub FillRoundRect(x as double, y as double, width as double, height as double, arcwidth as double, archeight as double) g.FillRoundRect x, y, Width, Height, arcwidth, archeight End Sub
Function ForeColor() As color Return g.ForeColor End Function
Sub ForeColor(assigns c as color) g.ForeColor=c End Sub
Function GetGraphics() As Graphics Return g End Function
Function Height() As double Return g.Height End Function
Function Italic() As boolean Return g.Italic End Function
Sub Italic(assigns v as boolean) g.Italic=v End Sub
Sub NextPage() g.NextPage End Sub
Function PenHeight() As double Return g.PenHeight End Function
Sub PenHeight(assigns v as double) g.PenHeight = v End Sub
Function PenWidth() As double Return g.PenWidth End Function
Sub PenWidth(assigns v as double) g.PenWidth = v End Sub
Sub Pixel(x as integer, y as integer, assigns c as color) g.Pixel(x,y)=c End Sub
Function StringHeight(text as string) As double Return g.StringHeight(text,0) End Function
Function StringHeight(text as string, wrapwidth as integer) As double Return g.StringHeight(text, wrapwidth) End Function
Function StringWidth(text as string) As Double return g.StringWidth(text) End Function
Function TextAscent() As double Return g.TextAscent End Function
Function TextFont() As string Return g.TextFont End Function
Sub TextFont(assigns name as string) g.TextFont = name End Sub
Function TextHeight() As double Return g.TextHeight End Function
Function TextSize() As double Return g.TextSize End Function
Sub TextSize(assigns v as double) g.TextSize=v End Sub
Function Underline() As boolean Return g.Underline End Function
Sub Underline(assigns v as boolean) g.Underline=v End Sub
Function Width() As integer Return g.Width End Function
Property Private g As Graphics
End Class
Class StyledTextPrinterWrapper
Sub Constructor(e as TextArea, g as GraphicsWrapper, wrapwidth as integer) // Please change parameter e to textarea for newer Real Studio version if g isa DynaPDFGraphics then dim d as DynaPDFGraphics = DynaPDFGraphics(g) self.pdfGraphics = d self.pdf = d.GetPDF self.wrapwidth = wrapwidth text = ConvertText(PDF, e.StyledText) else self.stp = e.styledTextPrinter(g.GetGraphics, wrapwidth) end if End Sub
Protected Function ConvertText(d as DynaPDFMBS, s as StyledText) As string // here we convert the text // pick the text 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 TextArea.AlignCenter result.Append "\ce#" case TextArea.AlignRight result.Append "\re#" else result.Append "\le#" end Select end if // now check the text color dim co as color = sr.TextColor dim fc as integer = d.RGB(co.Red, co.Green, co.Blue) result.Append "\FC["+str(fc)+"]" // now be check the fontname, style and size dim size as Double = sr.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 // fix bad font dim font as string = sr.Font dim m as MemoryBlock = font font = m if instr(font, chr(0)) > 0 then // unicode font = DefineEncoding(font, encodings.UTF16) else // ascii font = DefineEncoding(font, encodings.ASCII) end if if font <> "" then dim fh as integer = d.SetFont(font, style, Size, false, d.kcp1252) if fh < 0 then Break else result.Append "\FT["+str(Fh)+"]" end if end if // underline is handled extra if sr.Underline then result.Append "\ul#" end if // and append the text result.Append sr.Text if sr.Underline then result.Append "\ul#" end if next Return Join(result, "") End Function
Sub DrawBlock(x as Integer, y as Integer, Height as Integer) if stp<>Nil then stp.DrawBlock x, y, Height else pdf.PageBreak = false if pdfGraphics<>nil then pdfGraphics.SetFont end if call pdf.SetTextRect(x, y, wrapwidth, Height) if not pdf.WriteFText(pdf.ktaLeft, text) then Break end if mEOF = pdf.PageBreak end if End Sub
Function EOF() As Boolean if stp<>nil then return stp.EOF else Return mEOF end if End Function
Function Width() As integer if stp<>nil then Return stp.Width else Return wrapwidth end if End Function
Property Private mEOF As Boolean
Property Private pdf As MyDynaPDFMBS
Property Private pdfGraphics As DynaPDFGraphics
Property Private stp As StyledTextPrinter
Property Private text As string
Property Private wrapwidth As Integer
End Class
End Project

See also:

Feedback, Comments & Corrections

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





Links
MBS FileMaker tutorial videos