Xojo Developer Conference
25/27th April 2018 in Denver.
MBS Xojo Conference
6/7th September 2018 in Munich, Germany.

Platforms to show: All Mac Windows Linux Cross-Platform

/DynaPDF/Web Edition/WebPDF
Function:
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /DynaPDF/Web Edition/WebPDF
This example is the version from Sun, 20th Jan 2018.
Project "WebPDF.rbp"
Class App Inherits WebApplication
EventHandler Sub Open() 'RegisterDynaPDF dim uploadFolder as FolderItem = FindFolder("uploads") dim samplesFolder as FolderItem = FindFolder("samples") if uploadFolder = nil then uploadFolder = FindFile("uploads") uploadFolder.CreateAsFolder end if if samplesFolder = nil then samplesFolder = FindFile("samples") samplesFolder.CreateAsFolder end if call GetObjectClassNameMBS(self) // init LoadSamples End EventHandler
EventHandler Function UnhandledException(Error As RuntimeException) As Boolean System.DebugLog "Unhandled "+GetObjectClassNameMBS(error)+": "+Error.Message End EventHandler
Function FindFile(name as string) As FolderItem // Look for file in parent folders from executable on dim parent as FolderItem = app.ExecutableFile.Parent while parent<>Nil dim file as FolderItem = parent.Child(name) if file<>Nil and file.Exists then Return file end if parent = parent.Parent wend End Function
Sub LoadSamples() System.DebugLog "Loading sample files..." dim f as FolderItem = FindFolder("samples") if f<>nil then dim c as integer = f.Count for i as integer = 1 to c dim g as FolderItem = f.TrueItem(i) if g<>nil and g.Visible and not g.Directory then dim n as integer = GetPDFPageCount(g) if n>0 then SampleNames.Append g.DisplayName SampleFiles.append g SamplePageCount.Append n end if end if next System.DebugLog "Samples loaded." else System.DebugLog "No samples found." end if End Sub
Property SampleFiles() As FolderItem
Property SampleNames() As string
Property SamplePageCount() As Integer
End Class
Class Session Inherits WebSession
Const ErrorDialogCancel = "Do Not Send"
Const ErrorDialogMessage = "This application has encountered an error and cannot continue."
Const ErrorDialogQuestion = "Please describe what you were doing right before the error occurred:"
Const ErrorDialogSubmit = "Send"
Const ErrorThankYou = "Thank You"
Const ErrorThankYouMessage = "Your feedback helps us make improvements."
Const NoJavascriptInstructions = "To turn Javascript on, please refer to your browser settings window."
Const NoJavascriptMessage = "Javascript must be enabled to access this page."
End Class
Class MainPage Inherits WebPage
Control FileList Inherits WebListBox
ControlInstance FileList Inherits WebListBox
EventHandler Sub Open() me.ColumnStyle(1) = RightAlignStyle End EventHandler
EventHandler Sub SelectionChanged() if me.ListIndex < 0 then ClearPDF else LoadPDF me.RowTag(me.ListIndex), me.Cell(me.ListIndex,0) end if End EventHandler
End Control
Control Label1 Inherits WebLabel
ControlInstance Label1 Inherits WebLabel
End Control
Control Uploader Inherits WebFileUploader
ControlInstance Uploader Inherits WebFileUploader
EventHandler Sub FileAdded(Filename As String) UploadButton.Enabled = me.FileCount>0 End EventHandler
EventHandler Sub FileRemoved(Filename As String) UploadButton.Enabled = me.FileCount>0 End EventHandler
EventHandler Sub UploadComplete(Files() As WebUploadedFile) dim uploadFolder as FolderItem = FindFolder("uploads") for each file as WebUploadedFile in files dim destfile as FolderItem = WriteUniqueFile(uploadFolder, file.Data, file.Name) if destfile<>Nil then dim n as integer = GetPDFPageCount(destfile) if n>0 then FileList.AddRow file.name FileList.Cell(FileList.LastIndex,1) = str(n) FileList.RowTag(FileList.LastIndex) = destfile end if end if next End EventHandler
End Control
Control Label2 Inherits WebLabel
ControlInstance Label2 Inherits WebLabel
End Control
Control View Inherits WebImageView
ControlInstance View Inherits WebImageView
EventHandler Sub Resized() RenderView End EventHandler
End Control
Control Label3 Inherits WebLabel
ControlInstance Label3 Inherits WebLabel
End Control
Control PDFINfo Inherits WebLabel
ControlInstance PDFINfo Inherits WebLabel
End Control
Control UploadButton Inherits WebButton
ControlInstance UploadButton Inherits WebButton
EventHandler Sub Action() me.Enabled = false uploader.Upload End EventHandler
End Control
Control MySlider Inherits WebSlider
ControlInstance MySlider Inherits WebSlider
EventHandler Sub ValueChanged() if me.Enabled and me.value<=PageCount then CurrentPage = me.Value // see how much we have rendered already dim s as string = "" if work<>nil then if work.WebPictureCache<>nil then dim n as integer = work.WebPictureCache.Count s = " Cached: "+Format(n/PageCount, "0%") end if end if PageInfo.text = str(CurrentPage)+" of "+str(pagecount)+s Title = CurrentFilename + " - "+str(CurrentPage)+" of "+str(pagecount) RenderView end if End EventHandler
End Control
Control Link1 Inherits WebLink
ControlInstance Link1 Inherits WebLink
End Control
Control Link2 Inherits WebLink
ControlInstance Link2 Inherits WebLink
End Control
Control PageInfo Inherits WebLabel
ControlInstance PageInfo Inherits WebLabel
End Control
EventHandler Sub Close() ClearPDF End EventHandler
EventHandler Sub Open() LoadSamples ClearPDF End EventHandler
Sub ClearPDF() if work<>Nil then work.CancelClear end if view.Picture = nil MySlider.Enabled = false MySlider.Value = 1 MySlider.Maximum = 1 End Sub
Sub LoadPDF(file as FolderItem, name as string) MySlider.Enabled = false if work<>Nil then work.CancelClear end if if CurrentPDF = nil then CurrentPDF = new MyDynaPDFMBS call CurrentPDF.CreateNewPDF(nil) call CurrentPDF.SetImportFlags(CurrentPDF.kifImportAsPage) call CurrentPDF.SetJPEGQuality(80) dim profiles as new DynaPDFColorProfilesMBS Profiles.DefInCMYK = nil // default Profiles.DefInGray = nil // default Profiles.DefInRGB = nil // default Profiles.DeviceProfile = nil // sRGB Profiles.SoftProof = nil // default call CurrentPDF.InitColorManagement(profiles, CurrentPDF.kcsDeviceRGB, CurrentPDF.kicmBPCompensation) end if if CurrentPDF.OpenImportFile(file, 0, "")>=0 then PageCount = CurrentPDF.GetInPageCount CurrentPage = 1 MySlider.Value = 1 MySlider.Maximum = PageCount MySlider.Enabled = true PageInfo.text = str(CurrentPage)+" of "+str(pagecount) CurrentFilename = name Title = CurrentFilename + " - "+str(CurrentPage)+" of "+str(pagecount) PDFINfo.text = CurrentFilename RenderView true end if End Sub
Sub LoadSamples() dim u as integer = UBound(app.SampleFiles) for i as integer = 0 to u FileList.AddRow app.SampleNames(i) FileList.Cell(FileList.LastIndex,1) = str(app.SamplePageCount(i)) FileList.RowTag(FileList.LastIndex) = app.SampleFiles(i) next End Sub
Sub RenderView(DocChanged as Boolean = false) if CurrentPDF<>Nil then if work = nil then work = new WorkThread(session) end if work.Render self, CurrentPDF, DocChanged end if End Sub
Property CurrentFilename As string
Property CurrentPDF As MyDynaPDFMBS
Property CurrentPage As Integer
Property PageCount As Integer
Property Work As WorkThread
End Class
Module Util
Function FindFolder(name as string) As FolderItem dim f as FolderItem = app.ExecutableFile.parent while f<>nil dim d as FolderItem = f.Child(name) if d<>nil and d.Exists then Return d end if f = f.Parent wend End Function
Function GetObjectClassNameMBS(o as Object) As string dim t as Introspection.TypeInfo = Introspection.GetType(o) Return t.FullName End Function
Function GetPDFPageCount(file as FolderItem) As integer dim result as integer = -1 dim d as new MyDynaPDFMBS if d.CreateNewPDF(nil) then if d.SetImportFlags(d.kifImportAsPage) then if d.OpenImportFile(file, 0, "")=0 then result = d.GetInPageCount call d.CloseImportFile end if end if call d.CloseFile end if Return result End Function
Function WriteFile(file as FolderItem, data as string) As Boolean #pragma DisableBackgroundTasks dim b as BinaryStream = BinaryStream.Create(file, false) if b<>Nil then b.Write data b.Close Return true end if Exception io as IOException Return false End Function
Function WriteUniqueFile(folder as FolderItem, data as string, name as string) As FolderItem #pragma DisableBackgroundTasks // simple case dim file as FolderItem = folder.Child(name) if file.Exists = false then if WriteFile(file,data) then Return file end if end if // now try a few other variants name = ReplaceAll(name, ".pdf", "") for n as integer = 1 to 99 dim newname as string = name+" "+str(n)+".pdf" file = folder.Child(newname) if file.Exists = false then if WriteFile(file,data) then Return file end if end if next // names all taken, try counting: for n as integer = 1 to 99 dim newname as string = str(n)+".pdf" file = folder.Child(newname) if file.Exists = false then if WriteFile(file,data) then Return file end if end if next // give up Return nil End Function
End Module
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 Return 0 // ignore End EventHandler
Property IgnoreWarnings As Boolean
End Class
Class RightAlignStyle Inherits WebStyle
End Class
Class WorkThread Inherits Thread
EventHandler Sub Run() while jobs<>Nil dim j as RenderJob = jobs jobs = nil RenderOneJob j wend Exception o as runtimeException System.DebugLog GetObjectClassNameMBS(o)+" on work thread: "+o.message End EventHandler
Sub CancelClear() System.DebugLog CurrentMethodName // abort current job jobs = nil cancel = true // wait for thread to finish while State = Running Sleep(1, true) wend // clear properties 'TargetSession = nil page = nil System.DebugLog CurrentMethodName+" done." End Sub
Sub Constructor(t as WebSession) #pragma DisableBackgroundTasks // Calling the overridden superclass constructor. 'Super.Constructor TargetSession = t Options = new DynaPDFRasterImageMBS Options.InitWhite = true Options.DefScale = options.kpsFitBest Options.FrameColor = &h777777 Options.DrawFrameRect = true PageDic = new Dictionary WebPictureCache = new Dictionary End Sub
Sub Render(p as MainPage, d as DynaPDFMBS, DocChanged as Boolean) #pragma DisableBackgroundTasks page = p pdf = d dim j as new RenderJob j.PageIndex = p.CurrentPage j.height = p.View.Height j.width = p.view.Width if DocChanged then PageDic.clear WebPictureCache.Clear end if jobs = j cancel = true if me.State <> me.Running then System.DebugLog "Starting work thread..." me.run end if End Sub
Sub RenderOneJob(j as RenderJob) dim ws as new WebSessionContext(TargetSession) if TargetSession = nil then Break end if System.DebugLog CurrentMethodName + ": "+str(j.PageIndex) cancel = false // do we need to create a new rasterizer? dim NeedNewRasterizer as Boolean if LastWidth <> j.width or LastHeight<>j.height then WebPictureCache.Clear else // maybe we rendered that page already? dim w as WebPicture = WebPictureCache.lookup(j.PageIndex, nil) if w<>Nil then System.DebugLog "Found picture in cache." self.page.view.picture = w Return end if end if LastWidth = j.width LastHeight = j.height if cancel then Return // we import page only one time dim PageIndex as integer = j.PageIndex dim page as DynaPDFPageMBS = PageDic.Lookup(PageIndex, nil) if page = nil then System.DebugLog "Import page with index "+str(PageIndex) if pdf.Append then if pdf.ImportPageEx(PageIndex, 1.0, 1.0)>=0 then if pdf.EndPage then page = pdf.GetPage(pdf.GetPageCount) PageDic.Value(PageIndex) = page end if else call pdf.EndPage end if end if else System.DebugLog "Found page in cache." end if if cancel then Return if page<>Nil then // render multithreaded System.DebugLog "Render page threaded... "+str(page.Page)+" "+str(j.PageIndex) dim cr as DynaPDFRectMBS = page.BBox(page.kpbCropBox) dim mr as DynaPDFRectMBS = page.BBox(page.kpbMediaBox) dim r as DynaPDFRectMBS if cr = nil then r = mr else r = cr end if dim PageWidth as integer = r.Right - r.left dim PageHeight as integer = abs(r.Bottom - r.top) // Calculate scale factor dim faktor as Double = min( j.Height / PageHeight, j.Width / PageWidth) // Calculate new size dim w as integer = PageWidth * faktor dim h as integer = PageHeight * faktor dim Flags as integer = DynaPDFRasterImageMBS.krfDefault dim PixFmt as integer = DynaPDFRasterizerMBS.kpxfRGB dim Filter as integer = DynaPDFMBS.kcfJPEG dim Format as integer = DynaPDFMBS.kifmJPEG dim p as integer = page.page if pdf.RenderPageToImageMT(p, nil, 0, w, h, Flags, PixFmt, Filter, Format) then System.DebugLog "Render page done: success" if not cancel then dim data as string = pdf.GetImageBuffer System.DebugLog "Render done." pdf.FreeImageBuffer dim ww as new WebPicture(data, Picture.FormatJPEG) WebPictureCache.Value(j.PageIndex) = ww // debug write image files to desktop #if DebugBuild and false then dim f as FolderItem = SpecialFolder.Desktop.Child(str(j.pageIndex)+".jpg") dim b as BinaryStream = BinaryStream.Create(f, true) b.Write data b.Close #endif self.page.view.picture = ww end if else System.DebugLog "Render page done: failed" end if end if System.DebugLog CurrentMethodName +" Done." End Sub
Property Jobs As RenderJob
Property LastHeight As Integer
Property LastWidth As Integer
Property PageDic As Dictionary
Property TargetSession As WebSession
Property WebPictureCache As Dictionary
Property cancel As Boolean
Property options As DynaPDFRasterImageMBS
Property page As MainPage
Property pdf As DynaPDFMBS
End Class
Class RenderJob
Property PageIndex As Integer
Property height As integer
Property width 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 Plugins