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