Platforms to show: All Mac Windows Linux Cross-Platform
/DynaPDF/Web Edition/WebPDF Web
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
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 Opening()
'Me.ColumnStyle(1) = RightAlignStyle
End EventHandler
EventHandler Sub SelectionChanged(Rows() as Integer)
If Me.SelectedRowIndex < 0 Then
ClearPDF
Else
LoadPDF Me.RowTagAt(Me.SelectedRowIndex), Me.CellValueAt(Me.SelectedRowIndex,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, Bytes as UInt64, MimeType as String)
FileCount = FileCount + 1
UploadButton.Enabled = True
End EventHandler
EventHandler Sub FileRemoved(Filename As String)
FileCount = FileCount - 1
UploadButton.Enabled = FileCount > 0
End EventHandler
EventHandler Sub UploadFinished(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.CellValueAt(FileList.LastAddedRowIndex, 1) = Str(n)
FileList.RowTagAt(FileList.LastAddedRowIndex) = destfile
end if
end if
next
FileCount = 0
End EventHandler
End Control
Control Label2 Inherits WebLabel
ControlInstance Label2 Inherits WebLabel
End Control
Control View Inherits WebImageViewer
ControlInstance View Inherits WebImageViewer
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 Pressed()
me.Enabled = false
uploader.StartUpload
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 Closed()
ClearPDF
End EventHandler
EventHandler Sub Opening()
LoadSamples
ClearPDF
End EventHandler
EventHandler Sub Resized()
RenderView
End EventHandler
Sub ClearPDF()
if work<>Nil then
work.CancelClear
end if
view.Picture = nil
MySlider.Enabled = false
MySlider.Value = 1
MySlider.MaximumValue = 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.MaximumValue = 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.CellValueAt(FileList.LastAddedRowIndex, 1) = Str(app.SamplePageCount(i))
FileList.RowTagAt(FileList.LastAddedRowIndex) = 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 FileCount 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:
The items on this page are in the following plugins: MBS DynaPDF Plugin.