Platforms to show: All Mac Windows Linux Cross-Platform
/Images/LargePicture/Tiff Load and Save
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.xojo_binary_project"
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:
The items on this page are in the following plugins: MBS Images Plugin.