Xojo Conferences
XDCMay2019MiamiUSA

Platforms to show: All Mac Windows Linux Cross-Platform

/Images/Tiff/Compose huge tiff file
Function:
Required plugins for this example: MBS Barcode Plugin, MBS Images Plugin, MBS Util Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Images/Tiff/Compose huge tiff file
This example is the version from Sat, 7th Aug 2015.
Project "Compose huge tiff file.rbp"
Class App Inherits Application
Const kEditClear = "&Löschen"
Const kFileQuit = "Beenden"
Const kFileQuitShortcut = ""
End Class
Class Window1 Inherits Window
Control PushButton1 Inherits PushButton
ControlInstance PushButton1 Inherits PushButton
EventHandler Sub Action() CreateBig End EventHandler
End Control
Control PushButton2 Inherits PushButton
ControlInstance PushButton2 Inherits PushButton
EventHandler Sub Action() CreateSmall End EventHandler
End Control
Control PushButton3 Inherits PushButton
ControlInstance PushButton3 Inherits PushButton
EventHandler Sub Action() Merge End EventHandler
End Control
Control Label1 Inherits Label
ControlInstance Label1 Inherits Label
End Control
Sub CreateBig() // write big tiff row by row with a checkered pattern dim f as FolderItem = SpecialFolder.Desktop.Child("testbig.tif") if f<>Nil then dim t as new TiffPictureMBS if t.Create(f) then const x = 30000 // big size t.Height=x t.Width=x t.RowsPerStrip = 1 t.PlanarConfig = t.kPlanarConfigContig t.Photometric = t.kPhotometricMinIsBlack t.BitsPerSample = 1 t.SamplesPerPixel = 1 t.FillOrder = t.kFillOrderMSB2LSB t.Orientation = t.kOrientationTopLeft t.ResolutionUnit = t.kResUnitInch t.VerticalResolution = 72.0 t.HorizontalResolution = 72.0 t.Compression = T.kCompressionLZW dim row1 as MemoryBlock = NewMemoryBlock( t.BytesPerRow + 8 ) dim row2 as MemoryBlock = NewMemoryBlock( t.BytesPerRow + 8 ) dim u as integer = row1.size -1 for i as integer = 0 to u step 2 row1.UInt8Value(i ) = 0 row1.UInt8Value(i+1) = 255 row2.UInt8Value(i ) = 255 row2.UInt8Value(i+1) = 0 next dim h as integer = t.Height-1 for i as integer = 0 to h dim n as integer = i mod 16 if n > 7 then t.Scanline(i)=row2 else t.Scanline(i)=row1 end if next t.Close MsgBox "Wrote TIFF file." end if end if End Sub
Sub CreateSmall() // write small tiff row by row with a barcode dim z as new BarcodeGeneratorMBS z.Symbology = BarcodeGeneratorMBS.BarcodeUpca z.Encode "72527270270+12345" dim pic as Picture = z.picture dim f as FolderItem = SpecialFolder.Desktop.Child("testsmall.tif") if f<>Nil then dim t as new TiffPictureMBS if t.Create(f) then t.Height = pic.Height t.Width = pic.Width t.RowsPerStrip = 1 t.PlanarConfig = t.kPlanarConfigContig t.Photometric = t.kPhotometricMinIsBlack t.BitsPerSample = 1 t.SamplesPerPixel = 1 t.FillOrder = t.kFillOrderMSB2LSB t.Orientation = t.kOrientationTopLeft t.ResolutionUnit = t.kResUnitInch t.VerticalResolution = 72.0 t.HorizontalResolution = 72.0 t.Compression = T.kCompressionLZW dim r as RGBSurface = pic.RGBSurface dim row as MemoryBlock = NewMemoryBlock(t.RowsPerStrip + 8) dim w as integer = t.Width -1 dim h as integer = t.Height-1 for y as integer = 0 to h dim u as integer = row.size-7 for i as integer = 0 to u step 8 row.Int64Value(i) = 0 next dim pos as integer = 0 dim bit as integer = 128 for x as integer = 0 to w dim v as integer if r.Pixel(x, y).Red > 128 then // white v = 1 row.UInt8Value(pos) = row.UInt8Value(pos) + bit else v = 0 end if if bit = 1 then // next byte pos = pos + 1 bit = 128 else bit = Bitwise.ShiftRight(Bit, 1) end if next t.Scanline(y) = row next t.Close MsgBox "Wrote TIFF file." end if end if f = SpecialFolder.Desktop.Child("testsmall.png") pic.Save(f, pic.SaveAsPNG) End Sub
Sub Merge() // write big tiff row by row with a checkered pattern dim f1 as FolderItem = SpecialFolder.Desktop.Child("testbig.tif") dim f2 as FolderItem = SpecialFolder.Desktop.Child("testsmall.tif") dim f3 as FolderItem = SpecialFolder.Desktop.Child("testresult.tif") dim t1 as new TiffPictureMBS dim t2 as new TiffPictureMBS dim t3 as new TiffPictureMBS if t1.Open(f1) then if t2.Open(f2) then if t3.Create(f3) then dim t2h as integer = t2.Height t3.Height = t1.Height t3.Width = t1.Width t3.RowsPerStrip = t1.RowsPerStrip t3.PlanarConfig = t1.PlanarConfig t3.Photometric = t1.Photometric t3.BitsPerSample = t1.BitsPerSample t3.SamplesPerPixel = t1.SamplesPerPixel t3.FillOrder = t1.FillOrder t3.Orientation = t1.Orientation t3.ResolutionUnit = t1.ResolutionUnit t3.VerticalResolution = t1.VerticalResolution t3.HorizontalResolution = t1.HorizontalResolution t3.Compression = T1.kCompressionLZW dim row1 as MemoryBlock = NewMemoryBlock( t1.BytesPerRow) dim row2 as MemoryBlock = NewMemoryBlock( t2.BytesPerRow) dim h as integer = t1.Height-1 for y as integer = 0 to h // read call t1.Scanline(row1, y) if y < t2h then // put barcode on the huge tif call t2.Scanline(row2, y) // CopyBytesMBS(srcOfs as Integer, numBytes as Integer, destBlk as memoryBlock, destOfs as Integer) row2.CopyBytesMBS(0, row2.size, row1, 32) end if t3.Scanline(y) = row1 next t1.Close t2.Close t3.Close MsgBox "Wrote TIFF file." end if end if end if End Sub
End Class
MenuBar MenuBar1
MenuItem FileMenu = "&Ablage"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Bearbeiten"
MenuItem EditUndo = "&Rückgängig"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "&Ausschneiden"
MenuItem EditCopy = "&Kopieren"
MenuItem EditPaste = "&Einfügen"
MenuItem EditClear = "#App.kEditClear"
MenuItem UntitledMenu0 = "-"
MenuItem EditSelectAll = "&Alles auswählen"
End MenuBar
End Project

Feedback, Comments & Corrections

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




Links
MBS Xojo PDF Plugins