Xojo Conferences

Platforms to show: All Mac Windows Linux Cross-Platform

/Images/Tiff/Tiff Copy Test/Tiff Copy Test
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 Copy Test/Tiff Copy Test
This example is the version from Thu, 6th Apr 2016.
Project "Tiff Copy Test.rbp"
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 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 App Inherits Application
EventHandler Sub Open() dim s,d as FolderItem s=FindFile("CMYK8.tif") d=FindFile("CMYK8copy.tif") CopyFile s,d s=FindFile("CMYK16.tif") d=FindFile("CMYK16copy.tif") CopyFile s,d s=FindFile("Gray8.tif") d=FindFile("Gray8copy.tif") CopyFile s,d s=FindFile("Gray16.tif") d=FindFile("Gray16copy.tif") CopyFile s,d s=FindFile("Lab8.tif") d=FindFile("Lab8copy.tif") CopyFile s,d s=FindFile("Lab16.tif") d=FindFile("Lab16copy.tif") CopyFile s,d s=FindFile("RGB8.tif") d=FindFile("RGB8copy.tif") CopyFile s,d s=FindFile("RGB16.tif") d=FindFile("RGB16copy.tif") CopyFile s,d LogWindow.List.AddRow "Finished." End EventHandler
Sub CopyFile(s as folderitem, d as folderitem) dim st as MyTiff dim dt as MyTiff dim i,h as integer dim m as MemoryBlock if not s.Exists then LogWindow.List.Addrow "Source file not found: "+s.AbsolutePath else st=new MyTiff st.name="(Source) " if not st.Open(s) then LogWindow.List.Addrow "Open Tiff failed!" else dt=new MyTiff dt.name="(Dest) " 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.Compression=st.Compression dt.PlanarConfig=st.PlanarConfig dt.Photometric=st.Photometric // 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 dt.Scanlines(0,st.Height)=st.Scanlines(0,st.Height) if dt.waserror then LogWindow.List.Addrow "Error on Copy!" end if 'h=st.Height-1 ' 'for i=0 to h 'm=st.Scanline(i) 'if m<>nil then 'dt.Scanline(i)=m ' 'if dt.waserror then 'LogWindow.List.Addrow "Error on Copy!" 'exit 'end if ' 'else 'LogWindow.List.AddRow "Read error on line "+str(i+1) 'end if 'next st.Close dt.Close end if end if end if Exception MsgBox "exception?" quit End Sub
Function FindFile(name as string) As FolderItem // Look for file in parent folders from executable on dim parent as FolderItem = app.ExecutableFile.Parent while parent<>Nil dim file as FolderItem = parent.Child(name) if file<>Nil and file.Exists then Return file end if parent = parent.Parent wend End Function
End Class
Class LogWindow Inherits Window
Control List Inherits Listbox
ControlInstance List Inherits Listbox
End Control
End Class
End Project

See also:

Feedback, Comments & Corrections

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

MBS Xojo blog