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.