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 Combine
This example is the version from Thu, 31th Jul 2019.
Project "Tiff Combine.xojo_binary_project"
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.NativePath
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
FileTypes1
Filetype image/x-tiff
End FileTypes1
End Project
See also:
The items on this page are in the following plugins: MBS Images Plugin.