Platforms to show: All Mac Windows Linux Cross-Platform

/Images/LargePicture/Tiff Load To Channels


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 To Channels

This example is the version from Sun, 17th Mar 2012.

Project "Tiff Load To Channels.xojo_binary_project"
FileTypes
Filetype image/tiff
End FileTypes
Class Window1 Inherits Window
Control Canvas1 Inherits Canvas
ControlInstance Canvas1 Inherits Canvas
End Control
Control PushButton1 Inherits PushButton
ControlInstance PushButton1 Inherits PushButton
EventHandler Sub Action() SaveRGB End EventHandler
End Control
Control PushButton5 Inherits PushButton
ControlInstance PushButton5 Inherits PushButton
EventHandler Sub Action() OpenTiff End EventHandler
End Control
Control StaticText1 Inherits Label
ControlInstance StaticText1 Inherits Label
End Control
Control PopupMenu1 Inherits PopupMenu
ControlInstance PopupMenu1 Inherits PopupMenu
End Control
Control PopupMenu2 Inherits PopupMenu
ControlInstance PopupMenu2 Inherits PopupMenu
End Control
Control StaticText2 Inherits Label
ControlInstance StaticText2 Inherits Label
End Control
Control StaticText3 Inherits Label
ControlInstance StaticText3 Inherits Label
End Control
EventHandler Sub Open() dim p as Picture p=LogoMBS(500) current=new PictureMBS(p) run End EventHandler
Protected Sub OpenTiff() dim f as FolderItem dim t as TiffPictureMBS f=SpecialFolder.Desktop.Child("test.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_RGB if t.SamplesPerPixel=3 then p=new PictureMBS(w, h, pictureMBS.ImageFormatRGB) dim c as PictureMBS Select case PopupMenu2.ListIndex case 0 c=p.RedChannel case 1 c=p.GreenChannel case 2 c=p.BlueChannel else beep Return end Select dim mode as integer Select case PopupMenu1.ListIndex case 0 mode=pictureMBS.ImageFormatRofRGB case 1 mode=pictureMBS.ImageFormatGofRGB case 2 mode=pictureMBS.ImageFormatBofRGB else beep Return end Select for i=0 to n c.RowInFormat(i,mode)=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 SaveRGB() dim f as FolderItem dim t as TiffPictureMBS f=SpecialFolder.Desktop.Child("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:

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


The biggest plugin in space...