0

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.

Edited by Begginnerdev: n/a

''' <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
3
Contributors
2
Replies
28
Views
5 Years
Discussion Span
Last Post by Lolatorres
-1

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

Edited by peter_budo: Do not post any affiliate links or links to off-site ecommerce sites or auctions

Have something to contribute to this discussion? Please be thoughtful, detailed and courteous, and be sure to adhere to our posting rules.