Xojo Conferences
XDCMay2019MiamiUSA

Platforms to show: All Mac Windows Linux Cross-Platform

/Images/LargePicture/Tiff Load and Save
Function:
Required plugins for this example: MBS Images Plugin, MBS Main Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Images/LargePicture/Tiff Load and Save
This example is the version from Sun, 17th Mar 2012.
Project "Tiff Load and Save.rbp"
FileTypes
Filetype image/tiff
End FileTypes
Class Window1 Inherits Window
Control Canvas1 Inherits Canvas
ControlInstance Canvas1 Inherits Canvas
End Control
Control PushButton2 Inherits PushButton
ControlInstance PushButton2 Inherits PushButton
EventHandler Sub Action() dim p as Picture p=LogoMBS(500) current=new PictureMBS(p) run End EventHandler
End Control
Control PushButton3 Inherits PushButton
ControlInstance PushButton3 Inherits PushButton
EventHandler Sub Action() dim p as Picture dim q as PictureMBS p=LogoMBS(500) q=new PictureMBS(p) current=new PictureMBS(p.Width, p.Height, picturembs.ImageFormatG) call Current.CopyPixels(q) run End EventHandler
End Control
Control PushButton1 Inherits PushButton
ControlInstance PushButton1 Inherits PushButton
EventHandler Sub Action() SaveRGB End EventHandler
End Control
Control PushButton4 Inherits PushButton
ControlInstance PushButton4 Inherits PushButton
EventHandler Sub Action() SaveBW End EventHandler
End Control
Control PushButton5 Inherits PushButton
ControlInstance PushButton5 Inherits PushButton
EventHandler Sub Action() OpenTiff End EventHandler
End Control
Control PushButton6 Inherits PushButton
ControlInstance PushButton6 Inherits PushButton
EventHandler Sub Action() Current=nil run End EventHandler
End Control
Control PushButton7 Inherits PushButton
ControlInstance PushButton7 Inherits PushButton
EventHandler Sub Action() OpenAnyTiff End EventHandler
End Control
Protected Sub OpenAnyTiff() dim f as FolderItem dim t as TiffPictureMBS // this can only open images which fit into memory // (fit two times as CopyPicture later makes a copy) f=GetopenFolderItem("image/tiff") if f<>Nil then Current=nil t=f.OpenAsTiffMBS if t<>nil then dim m as MemoryBlock dim error as string m=t.ReadRGB(error) if m=nil then MsgBox error else if TargetLittleEndian then current=new picturembs(m, t.Width, t.Height, picturembs.ImageFormatRGBX, t.Width*4) current.VMirror elseif TargetBigEndian then current=new picturembs(m, t.Width, t.Height, picturembs.ImageFormatXBGR, t.Width*4) current.VMirror else MsgBox "error!" end if end if end if run end if End Sub
Protected Sub OpenTiff() dim f as FolderItem dim t as TiffPictureMBS f=GetopenFolderItem("image/tiff") if f<>Nil then Current=nil t=f.OpenAsTiffMBS ReadTiff(t) run end if End Sub
Protected Sub ReadTiff(t as TiffPictureMBS) // this reads only the tiff formats we support here, but of any size // so this method can handle a 10 GB tif file, but the CopyPicture method later will fail to make you a RB picture. if t=Nil then return // all tiff photometrics: const PHOTOMETRIC_MINISWHITE = 0 // min value is white const PHOTOMETRIC_MINISBLACK = 1 // min value is black const PHOTOMETRIC_RGB = 2 // RGB color model const PHOTOMETRIC_PALETTE = 3 // color map indexed const PHOTOMETRIC_MASK = 4 // $holdout mask const PHOTOMETRIC_SEPARATED = 5 // !color separations const PHOTOMETRIC_YCBCR = 6 // !CCIR 601 const PHOTOMETRIC_CIELAB = 8 // !1976 CIE L*a*b* const PHOTOMETRIC_ICCLAB = 9 // ICC L*a*b* [Adobe TIFF Technote 4] const PHOTOMETRIC_ITULAB = 10 // ITU L*a*b* const PHOTOMETRIC_LOGL = 32844 // CIE Log2(L) const PHOTOMETRIC_LOGLUV = 32845 // CIE Log2(L) (u',v') const PLANARCONFIG_CONTIG=1 const FILLORDER_MSB2LSB=1 const ORIENTATION_TOPLEFT=1 dim w as integer = t.Width dim h as integer = t.Height dim n as integer = h-1 dim i as integer dim p as PictureMBS // this example does not support a lot of things... if t.PlanarConfig<>PLANARCONFIG_CONTIG then MsgBox "This type of PlanarConfig is not supported in this example project: "+str(t.PlanarConfig) Return end if if t.FillOrder<>FILLORDER_MSB2LSB then MsgBox "This type of FillOrder is not supported in this example project: "+str(t.FillOrder) Return end if if t.Orientation<>ORIENTATION_TOPLEFT then MsgBox "This type of Orientation is not supported in this example project: "+str(t.Orientation) // accept, but the image will be rotated end if if t.BitsPerSample<>8 then MsgBox "This type of BitsPerSample is not supported in this example project: "+str(t.BitsPerSample) Return end if Select case t.Photometric case PHOTOMETRIC_MINISBLACK if t.SamplesPerPixel=1 then p=new PictureMBS(w, h, pictureMBS.ImageFormatRGB) for i=0 to n p.RowInFormat(i,pictureMBS.ImageFormatG)=t.Scanline(i) next Current=p Return else MsgBox "This type of SamplesPerPixel is not supported in this example project: "+str(t.SamplesPerPixel) Return end if case PHOTOMETRIC_RGB if t.SamplesPerPixel=3 then p=new PictureMBS(w, h, pictureMBS.ImageFormatRGB) for i=0 to n p.RowInFormat(i,pictureMBS.ImageFormatRGB)=t.Scanline(i) next Current=p Return else MsgBox "This type of SamplesPerPixel is not supported in this example project: "+str(t.SamplesPerPixel) Return end if else MsgBox "This type of Photometric is not supported in this example project: "+str(t.Photometric) return end Select End Sub
Protected Sub SaveBW() dim f as FolderItem dim t as TiffPictureMBS f=GetsaveFolderItem("image/tiff","test.tiff") if f<>Nil then t=new TiffPictureMBS if t.Create(f) then const PLANARCONFIG_CONTIG=1 const PHOTOMETRIC_MINISBLACK=1 const FILLORDER_MSB2LSB=1 const RESUNIT_INCH=2 const ORIENTATION_TOPLEFT=1 const COMPRESSION_NONE=1 t.Height=current.Height t.Width=Current.Width t.RowsPerStrip=1 t.PlanarConfig=PLANARCONFIG_CONTIG t.Photometric=PHOTOMETRIC_MINISBLACK t.BitsPerSample=8 t.SamplesPerPixel=1 t.FillOrder=FILLORDER_MSB2LSB t.Orientation=ORIENTATION_TOPLEFT t.ResolutionUnit=RESUNIT_INCH t.VerticalResolution=72.0 t.HorizontalResolution=72.0 t.Compression=COMPRESSION_NONE dim h as integer=Current.Height-1 for i as integer=0 to h t.Scanline(i)=Current.RowInFormat(i, PictureMBS.ImageFormatG) next t.Close end if end if End Sub
Protected Sub SaveRGB() dim f as FolderItem dim t as TiffPictureMBS f=GetsaveFolderItem("image/tiff","test.tiff") if f<>Nil then t=new TiffPictureMBS if t.Create(f) then const PLANARCONFIG_CONTIG=1 const PHOTOMETRIC_RGB=2 const FILLORDER_MSB2LSB=1 const RESUNIT_INCH=2 const ORIENTATION_TOPLEFT=1 const COMPRESSION_NONE=1 t.Height=current.Height t.Width=Current.Width t.RowsPerStrip=1 t.PlanarConfig=PLANARCONFIG_CONTIG t.Photometric=PHOTOMETRIC_RGB t.BitsPerSample=8 t.SamplesPerPixel=3 t.FillOrder=FILLORDER_MSB2LSB t.Orientation=ORIENTATION_TOPLEFT t.ResolutionUnit=RESUNIT_INCH t.VerticalResolution=72.0 t.HorizontalResolution=72.0 t.Compression=COMPRESSION_NONE dim h as integer=Current.Height-1 for i as integer=0 to h t.Scanline(i)=Current.RowInFormat(i, PictureMBS.ImageFormatRGB) next t.Close end if end if End Sub
Protected Sub run() if Current=nil then canvas1.Backdrop=nil else Canvas1.Backdrop=current.CopyPicture end if End Sub
Property Protected current As PictureMBS
End Class
MenuBar Menu
MenuItem UntitledMenu3 = ""
MenuItem UntitledMenu2 = "File"
MenuItem FileQuit = "Quit"
MenuItem UntitledMenu0 = "Edit"
MenuItem EditUndo = "Undo"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "Cut"
MenuItem EditCopy = "Copy"
MenuItem EditPaste = "Paste"
MenuItem EditClear = "Clear"
End MenuBar
Class App Inherits Application
End Class
End Project

See also:

Feedback, Comments & Corrections

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




Links
MBS Xojo blog