Platforms to show: All Mac Windows Linux Cross-Platform
/DynaPDF/Web Edition/WebPDF Web
Function:
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/Web Edition/WebPDF Web
This example is the version from Mon, 16th Jan 2022.
Function:
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/Web Edition/WebPDF Web
This example is the version from Mon, 16th Jan 2022.
Project "WebPDF Web.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.
