Xojo Conferences
MBSSep2018MunichDE
XDCMay2019MiamiUSA

Platforms to show: All Mac Windows Linux Cross-Platform

/Images/Tiff/TIFF Split
Function:
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 Fri, 27th Aug 2015.
Project "TIFF Split.rbp"
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.AbsolutePath 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.AbsolutePath 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:

Feedback, Comments & Corrections

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





Links
MBS Xojo blog