Platforms to show: All Mac Windows Linux Cross-Platform
Required plugins for this example: MBS Images Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Images/Tiff/TIFF Split
This example is the version from Thu, 31th Jul 2019.
Project "TIFF Split.xojo_binary_project"
Class App Inherits Application
Const kEditClear = "&Löschen"
Const kFileQuit = "Beenden"
Const kFileQuitShortcut = ""
EventHandler Sub Open()
dim f as FolderItem = GetOpenFolderItem(FileTypes1.ImageXTiff)
if f <> nil then
Split f
end if
AutoQuit = true
End EventHandler
Sub Split(f as FolderItem)
if not f.Exists then
LogWindow.List.Addrow "Source file not found: "+f.NativePath
else
dim st as new MyTiff
st.name="(Source) "
if not st.Open(f) then
LogWindow.List.Addrow "Open Tiff failed!"
else
dim n as integer = 1
do
dim d as FolderItem = SpecialFolder.Desktop.Child( "image"+str(n)+".tif")
dim dt as new MyTiff
dt.name="(Dest "+str(n)+") "
if not dt.Create(d) then
LogWindow.List.Addrow "Failed to create the destination file "+d.NativePath
else
// first
dt.Width=st.Width
dt.Height=st.Height
'dt.tileWidth=st.TileWidth
'dt.TileHeight=st.TileHeight
dt.BitsPerSample=st.BitsPerSample
dt.SamplesPerPixel=st.SamplesPerPixel
dt.Photometric=st.Photometric
dt.PlanarConfig=st.PlanarConfig
dim compression as integer = st.Compression
if compression = st.kCompressionPackBits then // Had trouble with that
compression = st.kCompressionNone
end if
dt.Compression = compression
// LogWindow.List.AddRow str(st.PlanarConfig)
dt.RowsPerStrip=st.RowsPerStrip
dt.FillOrder=st.FillOrder
// later
dt.Copyright=st.Copyright
dt.DateTime=st.DateTime
dt.DocumentName=st.DocumentName
dt.ExtraSamples=st.ExtraSamples
dt.HorizontalPosition=st.HorizontalPosition
dt.HorizontalResolution=st.HorizontalResolution
dt.HostComputer=st.HostComputer
dt.ImageDescription=st.ImageDescription
dt.Make=st.Make
dt.Model=st.Model
dt.Orientation=st.Orientation
dt.PageName=st.PageName
dt.ResolutionUnit=st.ResolutionUnit
dt.Software=st.Software
dt.VerticalPosition=st.VerticalPosition
dt.VerticalResolution=st.VerticalResolution
dim h as integer =st.Height-1
dim m as MemoryBlock
for row as integer =0 to h
m = st.Scanline(row)
if m <> nil then
dt.Scanline(row) = m
if dt.waserror then
LogWindow.List.Addrow "Error on Copy!"
exit
end if
else
LogWindow.List.AddRow "Read error on line "+str(row+1)
end if
next
dt.Close
end if
n = n + 1
loop until not st.NextImage
st.Close
end if
end if
Exception
MsgBox "exception?"
quit
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
FileTypes1
Filetype image/x-tiff
End FileTypes1
Class LogWindow Inherits Window
Control List Inherits ListBox
ControlInstance List Inherits ListBox
End Control
End Class
Class MyTiff Inherits TiffPictureMBS
EventHandler Sub Error(libModule as string, message as string)
LogWindow.List.Addrow name+"Module: "+libmodule+", "+message
waserror=true
End EventHandler
EventHandler Sub Warning(libModule as string, message as string)
LogWindow.List.Addrow name+"Module: "+libmodule+", "+message
End EventHandler
Property name As string
Property waserror As boolean
End Class
End Project
See also:
The items on this page are in the following plugins: MBS Images Plugin.