Xojo Conferences

Platforms to show: All Mac Windows Linux Cross-Platform

/Images/Tiff/Tiff Combine
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 Combine
This example is the version from Mon, 5th May 2019.
Project "Tiff Combine.rbp"
Class App Inherits Application
Const kEditClear = "&Löschen"
Const kFileQuit = "Beenden"
Const kFileQuitShortcut = ""
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
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
Class LogWindow Inherits Window
Control List Inherits ListBox
ControlInstance List Inherits ListBox
End Control
End Class
Class MainWindow Inherits Window
Control List Inherits Listbox
ControlInstance List Inherits Listbox
End Control
Control AddButton Inherits PushButton
ControlInstance AddButton Inherits PushButton
EventHandler Sub Action() dim o as new OpenDialog o.Filter = FileTypes1.ImageXTiff o.MultiSelect = true call o.ShowModalWithin(Self) dim u as integer = o.Count-1 for i as integer = 0 to u dim f as FolderItem = o.Item(i) if f<>Nil then List.AddRow f.DisplayName List.Celltag(List.LastIndex,0)=f end if next End EventHandler
End Control
Control CombineButton Inherits PushButton
ControlInstance CombineButton Inherits PushButton
EventHandler Sub Action() dim d as FolderItem = SpecialFolder.Desktop.Child( "Merged.tif") dim dt as new MyTiff dt.name="(Dest) " if not dt.Create(d) then LogWindow.List.Addrow "Failed to create the destination file "+d.AbsolutePath else dim lc as integer = List.ListCount-1 for li as integer = 0 to lc dim f as FolderItem = List.CellTag(li, 0) dim st as new MyTiff st.name="(Source) " if not st.Open(f) then LogWindow.List.Addrow "Open Tiff failed!" else do // 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.PlanarConfig=st.PlanarConfig dt.Photometric=st.Photometric 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 call dt.SaveImage loop until not st.NextImage end if next end if Exception MsgBox "exception?" quit End EventHandler
End Control
End Class
Filetype image/x-tiff
End FileTypes1
End Project

See also:

Feedback, Comments & Corrections

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

MBS FileMaker blog