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