Platforms to show: All Mac Windows Linux Cross-Platform

/DynaPDF/Web Edition/WebPDF Web2
Function:
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /DynaPDF/Web Edition/WebPDF Web2
This example is the version from Mon, 16th Jan 2022.
Project "WebPDF Web2.xojo_binary_project"
Class App Inherits WebApplication
EventHandler Sub Opening(args() as String) 'RegisterDynaPDF Dim uploadFolder As FolderItem = FindFolder("uploads") Dim samplesFolder As FolderItem = FindFolder("samples") If uploadFolder = Nil Then uploadFolder = New folderitem("uploads") uploadFolder.CreateAsFolder End If If samplesFolder = Nil Then samplesFolder = new folderitem("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
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:

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

Feedback: Report problem or ask question.

The biggest plugin in space...