Platforms to show: All Mac Windows Linux Cross-Platform

/Images/Tiff/RotateBitmapTIFF


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/RotateBitmapTIFF

This example is the version from Fri, 8th Nov 2018.

Project "RotateBitmapTIFF.xojo_binary_project"
Class App Inherits Application
Const kEditClear = "&Delete"
Const kFileQuit = "&Quit"
Const kFileQuitShortcut = ""
EventHandler Sub Open() // register MBS Plugins here End EventHandler
EventHandler Function UnhandledException(error As RuntimeException) As Boolean If Not (error = Nil) Then Dim type As String = Introspection.GetType(error).Name Dim s As String = (type + EndOfLine + error.Message + EndOfLine + Join(error.Stack, EndOfLine)) Dim desc,err As String desc = "App.UnhandledException" err = ": " + s MsgBox(desc+err) End If End EventHandler
End Class
Class Window_Rotate Inherits Window
Control PushButton_SelectTiff Inherits PushButton
ControlInstance PushButton_SelectTiff Inherits PushButton
EventHandler Sub Action() Dim dlg As OpenDialog Dim f As FolderItem dlg = New OpenDialog dlg.InitialDirectory = SpecialFolder.Desktop dlg.Title = "Select a TIFF file" dlg.Filter = MyFileTypes.ImageTiff f = dlg.ShowModal If f <> Nil Then InputFile = f TextField_TiffName.Text = InputFile.Name If Degrees > 0 Then PushButton_Rotate.Enabled = True End If Else //User Cancelled End If End EventHandler
End Control
Control PopupMenu_Degree Inherits PopupMenu
ControlInstance PopupMenu_Degree Inherits PopupMenu
EventHandler Sub Change() Select Case Me.ListIndex Case 0 Degrees = 0 Case 1 Degrees = 90 Case 2 Degrees = 180 Case 3 Degrees = 270 End Select If Not (InputFile = Nil) And InputFile.Exists Then PushButton_Rotate.Enabled = True End If End EventHandler
EventHandler Sub Open() Me.AddRow("0") Me.AddRow("90") Me.AddRow("180") Me.AddRow("270") End EventHandler
End Control
Control PushButton_Rotate Inherits PushButton
ControlInstance PushButton_Rotate Inherits PushButton
EventHandler Sub Action() ProgressWheel1.Visible = True PushButton_Rotate.Enabled = False PushButton_SelectTiff.Enabled = False PopupMenu_Degree.Enabled = False RotateBitmap End EventHandler
End Control
Control TextField_TiffName Inherits TextField
ControlInstance TextField_TiffName Inherits TextField
End Control
Control List Inherits ListBox
ControlInstance List Inherits ListBox
End Control
Control ProgressWheel1 Inherits ProgressWheel
ControlInstance ProgressWheel1 Inherits ProgressWheel
End Control
End Class
Module Globals
Sub RotateBitmap() RotateTiff = New RotateTiffThread RotateTiff.Run End Sub
Sub RotateDone() TiffDone = New Timer_Done TiffDone.Period = 100 TiffDone.Mode = 1 End Sub
Property Degrees As Integer
Property InputFile As FolderItem
Property Messages() As String
Property RotateTiff As RotateTiffThread
Property TiffDone As Timer_Done
End Module
Class RotateTiffThread Inherits Thread
EventHandler Sub Run() Me.Sleep(500) Dim desc,err As String Dim DestFldr As FolderItem = SpecialFolder.Desktop Dim n As Integer Dim oldname,newname,nameparts() As String oldname = InputFile.Name nameparts = Split(oldname,".") For n = 0 To UBound(nameparts) -1 If n = 0 Then newname = nameparts(n) Else newname = newname + "." + nameparts(n) End If Next n = UBound(nameparts) newname = newname + "." + Str(Degrees) + "." + nameparts(n) Dim OutputFile As FolderItem = SpecialFolder.Desktop.Child(newname) Dim InputTIFF As New MyTIFF Dim OutputTIFF As New MyTIFF If InputTIFF.Open(InputFile) Then If OutputTIFF.Create(OutputFile) Then Dim d As Date Dim y,m,dy,hh,mm,ss As String d = New Date y = Right(Str(d.Year),2) m = Format(d.Month,"0#") dy = Format(d.Day,"0#") hh =Format(d.Hour,"0#") mm = Format(d.Minute,"0#") ss =Format(d.Second,"0#") // Determine orientation If Degrees mod 180 = 90 or Degrees mod 180 = -90 then // Swap orientation OutputTIFF.Height = InputTIFF.Width OutputTIFF.Width = InputTIFF.Height Else // Same orientation OutputTIFF.Width = InputTIFF.Width OutputTIFF.Height = InputTIFF.Height End If OutputTIFF.BitsPerSample = InputTIFF.BitsPerSample OutputTIFF.SamplesPerPixel = InputTIFF.SamplesPerPixel OutputTIFF.Compression = InputTIFF.Compression OutputTIFF.PlanarConfig = InputTIFF.PlanarConfig OutputTIFF.Photometric = InputTIFF.Photometric OutputTIFF.RowsPerStrip = InputTIFF.RowsPerStrip OutputTIFF.FillOrder = InputTIFF.FillOrder OutputTIFF.Copyright = InputTIFF.Copyright OutputTIFF.DateTime = y + ":" + m + ":" + dy + " " + hh + ":" + mm + ":" + ss OutputTIFF.DocumentName=InputTIFF.DocumentName OutputTIFF.ExtraSamples=InputTIFF.ExtraSamples OutputTIFF.SampleFormat = InputTIFF.SampleFormat OutputTIFF.HorizontalPosition = InputTIFF.HorizontalPosition OutputTIFF.HorizontalResolution = InputTIFF.HorizontalResolution OutputTIFF.HostComputer = InputTIFF.HostComputer OutputTIFF.ImageDescription = InputTIFF.ImageDescription OutputTIFF.Make = InputTIFF.Make OutputTIFF.Model = InputTIFF.Model OutputTIFF.Orientation = InputTIFF.Orientation OutputTIFF.PageName=InputTIFF.PageName OutputTIFF.ResolutionUnit = InputTIFF.ResolutionUnit OutputTIFF.Software = InputTIFF.Software OutputTIFF.VerticalPosition = InputTIFF.VerticalPosition OutputTIFF.VerticalResolution = InputTIFF.VerticalResolution Dim inMB as MemoryBlock = InputTIFF.Scanlines(0,InputTIFF.Height) Dim outMB as new MemoryBlock(OutputTIFF.BytesPerRow * (OutputTIFF.Height+7)) // output buffer with a bit of safeguard space on the end. Dim b as Boolean Dim m1 as Double = Microseconds b = BitRotateMBS(Degrees,inMB,outMB, InputTIFF.Width, InputTIFF.Height, InputTIFF.BytesPerRow, OutputTIFF.BytesPerRow) dim m2 as Double = Microseconds if b then OutputTIFF.Scanlines(0,OutputTIFF.Height) = outMB if OutputTIFF.waserror then Messages.Append("Error on Copy!") end if InputTIFF.Close OutputTIFF.Close Messages.Append(str(Degrees)+" Okay: "+Format((m2-m1) / 1000000,"#,###,##0.00") + " seconds") else Messages.Append("Rotate failed.") end if Else // Error Messages.Append("The OutputTIFF could not be created. ") End If Else // Error Messages.Append("The TIFF could not be opened. ") End If RotateDone End EventHandler
End Class
Class MyTIFF Inherits TiffPictureMBS
EventHandler Sub Error(libModule as string, message as string) Messages.Append(name + "Module: " + libmodule + ", " + message) waserror = true End EventHandler
EventHandler Sub Warning(libModule as string, message as string) Messages.Append(name+"Module: " + libmodule + ", " + message) End EventHandler
Property name As string
Property waserror As boolean
End Class
Class Timer_Done Inherits Timer
EventHandler Sub Action() Me.Mode = 0 If Messages.Ubound >= 0 Then For i As Integer = 0 To Messages.Ubound Window_Rotate.List.AddRow(Messages(i)) Next Window_Rotate.ProgressWheel1.Visible = False Window_Rotate.PushButton_Rotate.Enabled = True Window_Rotate.PushButton_SelectTiff.Enabled = True Window_Rotate.PopupMenu_Degree.Enabled = True Redim Messages(-1) End If End EventHandler
End Class
MyFileTypes
Filetype image/tiff
End MyFileTypes
MenuBar MainMenuBar
MenuItem FileMenu = "&File"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Edit"
MenuItem EditUndo = "&Undo"
MenuItem EditSeparator1 = "-"
MenuItem EditCut = "Cu&t"
MenuItem EditCopy = "&Copy"
MenuItem EditPaste = "&Paste"
MenuItem EditClear = "#App.kEditClear"
MenuItem EditSeparator2 = "-"
MenuItem EditSelectAll = "Select &All"
End MenuBar
End Project

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


The biggest plugin in space...