This is a module that can be used to save tiff images pass in from a file dialog.
This module was translated from C# to VB.net, and the original project can be found here.
I do not claim rights to this code.
You can copy this code straight down into an empty module, without having to import any dlls. Everything uses direct library references.
Hope it helps some one.
''' <summary>
''' A module containg all of the functions and sub procedures needed to conver bitmaps to tiffs, and to save multipage tiffs.
''' </summary>
''' <remarks></remarks>
Module tiffModule
'A module written to compile a collection of tiffs into one multipage tiff.
'The module will append to an existing tiff also.
Public PanelContainer As ArrayList
Dim scannedImages As System.Drawing.Image()
'Get the files and store them in an array
''' <summary>
''' The user can pass a file path into the sub procedure.
''' The user can also call this procedure with empty parameters.
''' When empty parameters are present, the user will be prompted with a FileOpenDialog.
''' The fileOpenDialog MUST be added to form that is calling this sub procedure.
''' </summary>
''' <param name="fn"></param>
''' <remarks></remarks>
Public Sub getFiles(Optional fn As String = "")
'Use a OpenFileDialog to get the file.
'Must add the dialog to your form in the form designer.
'Toolbox -> Dialogs -> OpenFileDialog
PanelContainer = New ArrayList
'Declarations
Dim open As Windows.Forms.OpenFileDialog
Dim filename As String
open = New Windows.Forms.OpenFileDialog
Try
If fn = "" Then
If (open.ShowDialog() = Windows.Forms.DialogResult.OK) Then
filename = open.FileName.ToString
createPanel(filename)
End If
ElseIf fn <> "" Then
createPanel(fn)
End If
Catch ex As Exception
Windows.Forms.MessageBox.Show("Exception from: " & ex.Source & vbCrLf & ex.Message)
End Try
End Sub
'Creates a panel panel containing the picture that the user opened with the FileOpenDialog.
''' <summary>
''' A sub procedure the creates panels for viewing the images.
''' Is dependant on getFiles
''' </summary>
''' <param name="filename"></param>
Public Sub createPanel(ByVal filename As String)
'Program will pass in the value that is returned from the dialogbox.
Try
Dim firstpanel As Integer = 0
Dim loadImage As System.Drawing.Image
Dim p As Windows.Forms.Panel
Dim tpg As Windows.Forms.TabPage
tpg = New Windows.Forms.TabPage
loadImage = System.Drawing.Image.FromFile(filename)
p = New Windows.Forms.Panel
If firstpanel = 0 Then
p.BackColor = System.Drawing.Color.Gray
p.BorderStyle = Windows.Forms.BorderStyle.FixedSingle
p.Location = New System.Drawing.Point(15, 15)
p.Size = New System.Drawing.Size(762, 464)
firstpanel = 1
Else
p.BackColor = System.Drawing.Color.Gray
p.BorderStyle = Windows.Forms.BorderStyle.FixedSingle
p.Location = New System.Drawing.Point(15, 15)
p.Size = New System.Drawing.Size(762, 464)
End If
p.Visible = True
p.TabIndex = PanelContainer.Count
p.BackgroundImage = loadImage
p.BackgroundImageLayout = Windows.Forms.ImageLayout.Zoom
'**************THIS BLOCK VARIES BY APPLICATION**************'
'
'If using a panel to view all of the images, use the following.
' panel.Controls.Add(p)
' PanelContainer.Add(p)
'Where 'panel' is the name of the panel located on the form.
'Example: A panel is located on the form named, "ImagePanel"
' ImagePanel.Controls.Add(p)
' PanelContainer.Add(p)
'
'
'If using a tabcontrol to view all of the images use the following.
' tpg.Controls.Add(p)
' tpg.Text = "Image"
' tpg.ToolTipText = filename
' formname.tabcontrolname.TabPages.Add(tpg)
'Where formname is the name of the form you would like to post the picture on.
'Where tab control name is the name of the tab control on that form.
'Example:
' tpg.Controls.Add(p)
' tpg.Text = "Image"
' tpg.ToolTipText = filename
' Form1.TabControl1.TabPages.Add(tpg)
'By assigning the tooltip text to the file path, you will be able to delete the file by deleting the tab.
tpg.Controls.Add(p)
tpg.Text = "Image"
tpg.ToolTipText = filename
my_form.TabControl1.TabPages.Add(tpg)
'**************THIS BLOCK VARIES BY APPLICATION**************'
loadImage = Nothing
Catch ex As Exception
Windows.Forms.MessageBox.Show("Exception from: " & ex.Source & vbCrLf & ex.Message)
End Try
End Sub
'Saves a mulitpagetiff
''' <summary>
''' A function that saves a multipage tif. Takes (image,string,string) as arugments.
''' </summary>
''' <param name="bmp"></param>
''' <param name="location"></param>
''' <param name="type"></param>
''' <returns></returns>
''' <remarks></remarks>
Public Function saveMultipage(bmp As System.Drawing.Image(), location As String, type As String) As Boolean
If bmp IsNot Nothing Then
Try
Dim codecInfo As System.Drawing.Imaging.ImageCodecInfo = getCodecForstring(type)
For i As Integer = 0 To bmp.Length - 1
If bmp(i) Is Nothing Then
Exit For
End If
bmp(i) = DirectCast(ConvertToBitonal(DirectCast(bmp(i), System.Drawing.Bitmap)), System.Drawing.Image)
Next
If bmp.Length = 1 Then
Dim iparams As New System.Drawing.Imaging.EncoderParameters(1)
Dim iparam As System.Drawing.Imaging.Encoder = System.Drawing.Imaging.Encoder.Compression
Dim iparamPara As New System.Drawing.Imaging.EncoderParameter(iparam, CLng(System.Drawing.Imaging.EncoderValue.CompressionCCITT4))
iparams.Param(0) = iparamPara
bmp(0).Save(location, codecInfo, iparams)
ElseIf bmp.Length > 1 Then
Dim saveEncoder As System.Drawing.Imaging.Encoder
Dim compressionEncoder As System.Drawing.Imaging.Encoder
Dim SaveEncodeParam As System.Drawing.Imaging.EncoderParameter
Dim CompressionEncodeParam As System.Drawing.Imaging.EncoderParameter
Dim EncoderParams As New System.Drawing.Imaging.EncoderParameters(2)
saveEncoder = System.Drawing.Imaging.Encoder.SaveFlag
compressionEncoder = System.Drawing.Imaging.Encoder.Compression
' Save the first page (frame).
SaveEncodeParam = New System.Drawing.Imaging.EncoderParameter(saveEncoder, CLng(System.Drawing.Imaging.EncoderValue.MultiFrame))
CompressionEncodeParam = New System.Drawing.Imaging.EncoderParameter(compressionEncoder, CLng(System.Drawing.Imaging.EncoderValue.CompressionCCITT4))
EncoderParams.Param(0) = CompressionEncodeParam
EncoderParams.Param(1) = SaveEncodeParam
System.IO.File.Delete(location)
bmp(0).Save(location, codecInfo, EncoderParams)
For i As Integer = 1 To bmp.Length - 1
If bmp(i) Is Nothing Then
Exit For
End If
SaveEncodeParam = New System.Drawing.Imaging.EncoderParameter(saveEncoder, CLng(System.Drawing.Imaging.EncoderValue.FrameDimensionPage))
CompressionEncodeParam = New System.Drawing.Imaging.EncoderParameter(compressionEncoder, CLng(System.Drawing.Imaging.EncoderValue.CompressionCCITT4))
EncoderParams.Param(0) = CompressionEncodeParam
EncoderParams.Param(1) = SaveEncodeParam
bmp(0).SaveAdd(bmp(i), EncoderParams)
Next
SaveEncodeParam = New System.Drawing.Imaging.EncoderParameter(saveEncoder, CLng(System.Drawing.Imaging.EncoderValue.Flush))
EncoderParams.Param(0) = SaveEncodeParam
bmp(0).SaveAdd(EncoderParams)
End If
Return True
Catch ex As System.Exception
Throw New Exception("Exception from: " & ex.Source & vbCrLf & ex.Message)
End Try
Else
Return False
End If
End Function
'A function that grabs the codoc for tiffs
''' <summary>
''' A function that gets and returns the codec for tiffs.
''' Takes a string as arguments.
''' </summary>
''' <param name="type"></param>
''' <returns></returns>
''' <remarks></remarks>
Public Function getCodecForstring(type As String) As System.Drawing.Imaging.ImageCodecInfo
Dim info As System.Drawing.Imaging.ImageCodecInfo() = System.Drawing.Imaging.ImageCodecInfo.GetImageEncoders()
For i As Integer = 0 To info.Length - 1
Dim EnumName As String = type.ToString()
If info(i).FormatDescription.Equals(EnumName) Then
Return info(i)
End If
Next
Return Nothing
End Function
'GDI+ converts the file to a bitonal image, for saving as a tif.
''' <summary>
''' A function that takes an image in as a bitmap, then converts it to a bitonal image. Allows the user to save as tiff.
''' </summary>
''' <param name="original"></param>
''' <returns></returns>
''' <remarks></remarks>
Public Function ConvertToBitonal(original As System.Drawing.Bitmap) As System.Drawing.Bitmap
Dim source As System.Drawing.Bitmap = Nothing
' If original bitmap is not already in 32 BPP, ARGB format, then convert
If original.PixelFormat <> System.Drawing.Imaging.PixelFormat.Format32bppArgb Then
source = New System.Drawing.Bitmap(original.Width, original.Height, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
source.SetResolution(original.HorizontalResolution, original.VerticalResolution)
Using g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(source)
g.DrawImageUnscaled(original, 0, 0)
End Using
Else
source = original
End If
' Lock source bitmap in memory
Dim sourceData As System.Drawing.Imaging.BitmapData = source.LockBits(New System.Drawing.Rectangle(0, 0, source.Width, source.Height), System.Drawing.Imaging.ImageLockMode.[ReadOnly], System.Drawing.Imaging.PixelFormat.Format32bppArgb)
' Copy image data to binary array
Dim imageSize As Integer = sourceData.Stride * sourceData.Height
Dim sourceBuffer As Byte() = New Byte(imageSize - 1) {}
System.Runtime.InteropServices.Marshal.Copy(sourceData.Scan0, sourceBuffer, 0, imageSize)
' Unlock source bitmap
source.UnlockBits(sourceData)
' Create destination bitmap
Dim destination As New System.Drawing.Bitmap(source.Width, source.Height, System.Drawing.Imaging.PixelFormat.Format1bppIndexed)
' Lock destination bitmap in memory
Dim destinationData As System.Drawing.Imaging.BitmapData = destination.LockBits(New System.Drawing.Rectangle(0, 0, destination.Width, destination.Height), System.Drawing.Imaging.ImageLockMode.[WriteOnly], System.Drawing.Imaging.PixelFormat.Format1bppIndexed)
' Create destination buffer
imageSize = destinationData.Stride * destinationData.Height
Dim destinationBuffer As Byte() = New Byte(imageSize - 1) {}
Dim sourceIndex As Integer = 0
Dim destinationIndex As Integer = 0
Dim pixelTotal As Integer = 0
Dim destinationValue As Byte = 0
Dim pixelValue As Integer = 128
Dim height As Integer = source.Height
Dim width As Integer = source.Width
Dim threshold As Integer = 500
' Iterate lines
For y As Integer = 0 To height - 1
sourceIndex = y * sourceData.Stride
destinationIndex = y * destinationData.Stride
destinationValue = 0
pixelValue = 128
' Iterate pixels
For x As Integer = 0 To width - 1
' Compute pixel brightness (i.e. total of Red, Green, and Blue values)
pixelTotal = sourceBuffer(sourceIndex + 1) + sourceBuffer(sourceIndex + 2) + sourceBuffer(sourceIndex + 3)
If pixelTotal > threshold Then
destinationValue += CByte(pixelValue)
End If
If pixelValue = 1 Then
destinationBuffer(destinationIndex) = destinationValue
destinationIndex += 1
destinationValue = 0
pixelValue = 128
Else
pixelValue >>= 1
End If
sourceIndex += 4
Next
If pixelValue <> 128 Then
destinationBuffer(destinationIndex) = destinationValue
End If
Next
' Copy binary image data to destination bitmap
System.Runtime.InteropServices.Marshal.Copy(destinationBuffer, 0, destinationData.Scan0, imageSize)
' Unlock destination bitmap
destination.UnlockBits(destinationData)
' Return
Return destination
End Function
'Gets the current page number of the multipage tiff.
''' <summary>
''' Gets the current page number of an existing multipage tiff. Takes an image as an argument.
''' </summary>
''' <param name="img"></param>
''' <returns></returns>
''' <remarks></remarks>
Public Function getPageNumber(img As System.Drawing.Image) As Integer
Dim objGuid As Guid = img.FrameDimensionsList(0)
Dim objDimension As New System.Drawing.Imaging.FrameDimension(objGuid)
'Gets the total number of frames in the .tiff file
Dim PageNumber As Integer = img.GetFrameCount(objDimension)
Return PageNumber
End Function
'Saves images into an existing multipage tiff.
''' <summary>
''' Saves images into an existing multipage tiff.
''' </summary>
''' <param name="bmp"></param>
''' <param name="origionalFile"></param>
''' <param name="type"></param>
''' <param name="PageNumber"></param>
''' <param name="location"></param>
''' <remarks></remarks>
Public Sub saveImageExistingMultiplePage(bmp As System.Drawing.Image(), origionalFile As System.Drawing.Image, type As String, PageNumber As Integer, location As String)
Try
'Now load the Codecs
Dim codecInfo As System.Drawing.Imaging.ImageCodecInfo = getCodecForstring(type)
Dim saveEncoder As System.Drawing.Imaging.Encoder
Dim compressionEncoder As System.Drawing.Imaging.Encoder
Dim SaveEncodeParam As System.Drawing.Imaging.EncoderParameter
Dim CompressionEncodeParam As System.Drawing.Imaging.EncoderParameter
Dim EncoderParams As New System.Drawing.Imaging.EncoderParameters(2)
Dim pages As System.Drawing.Bitmap
Dim NextPage As System.Drawing.Bitmap
saveEncoder = System.Drawing.Imaging.Encoder.SaveFlag
compressionEncoder = System.Drawing.Imaging.Encoder.Compression
origionalFile.SelectActiveFrame(System.Drawing.Imaging.FrameDimension.Page, 0)
pages = New System.Drawing.Bitmap(origionalFile)
pages = ConvertToBitonal(pages)
' Save the first page (frame).
SaveEncodeParam = New System.Drawing.Imaging.EncoderParameter(saveEncoder, CLng(System.Drawing.Imaging.EncoderValue.MultiFrame))
CompressionEncodeParam = New System.Drawing.Imaging.EncoderParameter(compressionEncoder, CLng(System.Drawing.Imaging.EncoderValue.CompressionCCITT4))
EncoderParams.Param(0) = CompressionEncodeParam
EncoderParams.Param(1) = SaveEncodeParam
pages.Save(location, codecInfo, EncoderParams)
For i As Integer = 1 To PageNumber - 1
SaveEncodeParam = New System.Drawing.Imaging.EncoderParameter(saveEncoder, CLng(System.Drawing.Imaging.EncoderValue.FrameDimensionPage))
CompressionEncodeParam = New System.Drawing.Imaging.EncoderParameter(compressionEncoder, CLng(System.Drawing.Imaging.EncoderValue.CompressionCCITT4))
EncoderParams.Param(0) = CompressionEncodeParam
EncoderParams.Param(1) = SaveEncodeParam
origionalFile.SelectActiveFrame(System.Drawing.Imaging.FrameDimension.Page, i)
NextPage = New System.Drawing.Bitmap(origionalFile)
NextPage = ConvertToBitonal(NextPage)
pages.SaveAdd(NextPage, EncoderParams)
Next
For i As Integer = 0 To bmp.Length - 1
SaveEncodeParam = New System.Drawing.Imaging.EncoderParameter(saveEncoder, CLng(System.Drawing.Imaging.EncoderValue.FrameDimensionPage))
CompressionEncodeParam = New System.Drawing.Imaging.EncoderParameter(compressionEncoder, CLng(System.Drawing.Imaging.EncoderValue.CompressionCCITT4))
EncoderParams.Param(0) = CompressionEncodeParam
EncoderParams.Param(1) = SaveEncodeParam
bmp(i) = DirectCast(ConvertToBitonal(DirectCast(bmp(i), System.Drawing.Bitmap)), System.Drawing.Bitmap)
pages.SaveAdd(bmp(i), EncoderParams)
Next
SaveEncodeParam = New System.Drawing.Imaging.EncoderParameter(saveEncoder, CLng(System.Drawing.Imaging.EncoderValue.Flush))
EncoderParams.Param(0) = SaveEncodeParam
pages.SaveAdd(EncoderParams)
Catch ex As System.Exception
MsgBox("Exception from: " & ex.Source & vbCrLf & ex.Message)
End Try
End Sub
'Saves images over an existing single page tiff.
''' <summary>
''' Saves an image of an existing single page tiff.
''' </summary>
''' <param name="bmp"></param>
''' <param name="origionalFile"></param>
''' <param name="type"></param>
''' <param name="location"></param>
''' <remarks></remarks>
Public Sub saveImageExistingSinglePage(bmp As System.Drawing.Image(), origionalFile As System.Drawing.Image, type As String, location As String)
Try
'Now load the Codecs
Dim codecInfo As System.Drawing.Imaging.ImageCodecInfo = getCodecForstring(type)
Dim saveEncoder As System.Drawing.Imaging.Encoder
Dim compressionEncoder As System.Drawing.Imaging.Encoder
Dim SaveEncodeParam As System.Drawing.Imaging.EncoderParameter
Dim CompressionEncodeParam As System.Drawing.Imaging.EncoderParameter
Dim EncoderParams As New System.Drawing.Imaging.EncoderParameters(2)
saveEncoder = System.Drawing.Imaging.Encoder.SaveFlag
compressionEncoder = System.Drawing.Imaging.Encoder.Compression
' Save the first page (frame).
SaveEncodeParam = New System.Drawing.Imaging.EncoderParameter(saveEncoder, CLng(System.Drawing.Imaging.EncoderValue.MultiFrame))
CompressionEncodeParam = New System.Drawing.Imaging.EncoderParameter(compressionEncoder, CLng(System.Drawing.Imaging.EncoderValue.CompressionCCITT4))
EncoderParams.Param(0) = CompressionEncodeParam
EncoderParams.Param(1) = SaveEncodeParam
origionalFile = ConvertToBitonal(DirectCast(origionalFile, System.Drawing.Bitmap))
origionalFile.Save(location, codecInfo, EncoderParams)
For i As Integer = 0 To bmp.Length - 1
SaveEncodeParam = New System.Drawing.Imaging.EncoderParameter(saveEncoder, CLng(System.Drawing.Imaging.EncoderValue.FrameDimensionPage))
CompressionEncodeParam = New System.Drawing.Imaging.EncoderParameter(compressionEncoder, CLng(System.Drawing.Imaging.EncoderValue.CompressionCCITT4))
EncoderParams.Param(0) = CompressionEncodeParam
EncoderParams.Param(1) = SaveEncodeParam
origionalFile.SaveAdd(bmp(i), EncoderParams)
Next
SaveEncodeParam = New System.Drawing.Imaging.EncoderParameter(saveEncoder, CLng(System.Drawing.Imaging.EncoderValue.Flush))
EncoderParams.Param(0) = SaveEncodeParam
origionalFile.SaveAdd(EncoderParams)
Catch ex As System.Exception
MsgBox("Exception from: " & ex.Source & vbCrLf & ex.Message)
End Try
End Sub
'Saves the file into an existing file.
''' <summary>
''' Saves the file into an existing file.
''' </summary>
''' <param name="loc"></param>
''' <remarks></remarks>
Public Sub doExistingFileSave(loc As String)
If PanelContainer.Count > 0 Then
scannedImages = New System.Drawing.Image(PanelContainer.Count - 1) {}
Dim isSave As Boolean = False
Dim j As Integer = 0
Try
For Each p As Windows.Forms.Panel In PanelContainer
scannedImages(j) = p.BackgroundImage
j += 1
isSave = True
Next
Dim res As Boolean = False
If isSave Then
res = saveToExistingFile(loc, scannedImages, "TIFF")
End If
If res Then
Windows.Forms.MessageBox.Show("All Images saved successfully")
End If
Catch ex As System.Exception
MsgBox("Exception from: " & ex.Source & vbCrLf & ex.Message)
End Try
End If
End Sub
'Saves the file into an existing file.
''' <summary>
''' Saves the image into an existing tiff image.
''' </summary>
''' <param name="fileName"></param>
''' <param name="bmp"></param>
''' <param name="type"></param>
''' <returns></returns>
''' <remarks></remarks>
Public Function saveToExistingFile(fileName As String, bmp As System.Drawing.Image(), type As String) As Boolean
Try
'bmp[0] is containing Image from Existing file on which we will append newly scanned Images
'SO first we will dicide wheter existing file is single page or multipage
Dim origionalFile As System.Drawing.Image = Nothing
Dim fr As System.IO.FileStream = System.IO.File.Open(fileName, System.IO.FileMode.Open, System.IO.FileAccess.ReadWrite)
origionalFile = System.Drawing.Image.FromStream(fr)
Dim PageNumber As Integer = getPageNumber(origionalFile)
If bmp IsNot Nothing Then
For i As Integer = 0 To bmp.Length - 1
bmp(i) = DirectCast(ConvertToBitonal(DirectCast(bmp(i), System.Drawing.Bitmap)), System.Drawing.Image)
Next
If PageNumber > 1 Then
'Existing File is multi page tiff file
saveImageExistingMultiplePage(bmp, origionalFile, type, PageNumber, "shreeTemp.tif")
ElseIf PageNumber = 1 Then
'Existing file is single page file
saveImageExistingSinglePage(bmp, origionalFile, type, "shreeTemp.tif")
End If
Else
Throw New Exception("Please give existing File and newly scanned image")
End If
fr.Flush()
fr.Close()
System.IO.File.Replace("shreeTemp.tif", fileName, "Backup.tif", True)
Return True
Catch ex As System.Exception
MsgBox("Exception from: " & ex.Source & vbCrLf & ex.Message)
End Try
Return False
End Function
End Module
Hi, I am also testing about the related [Tiff processing programs]<URL SNIPPED> these days. Do you have any ideas about it? Or any good suggestion? Thanks in advance.
Best regards,
Arron
THANK YOU!
My cousin was searching this
regards
Lola
We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.