使用编码参数合并TIFF文件

时间:2014-01-10 18:41:11

标签: vb.net visual-studio gdi+ tiff

编辑:我发现了另一个创建编码器参数的示例,我得到了与befoer完全相同的错误:“GDI +中发生了一般错误”

           Dim info As ImageCodecInfo = Nothing
            Dim ice As ImageCodecInfo
            For Each ice In ImageCodecInfo.GetImageEncoders()

                If ice.MimeType = "image/tiff" Then
                    info = ice

                End If

            Next ice 'use the save encoder
            Dim enc As Encoder = Encoder.SaveFlag
            Dim ep As New EncoderParameters(1)
            ep.Param(0) = New EncoderParameter(enc, CLng(EncoderValue.MultiFrame))

原始邮寄

VB.Net,Visual Studio 2012,.Net 4.5

我一直在尝试编写,借用或窃取将多个TIFF文件合并到一个tiff文件中的代码。每个例子,无论是我写的还是从某个地方获取它都会在同一行上失败,例外情况是“GDI +中发生了一般错误”。导致问题的行是DestinationImage.SaveAdd(img,imagePararms)。关于一般错误的通用错误消息还不够。有没有人经历过这个?

格雷格

Public Sub mergeTiffPages(str_DestinationPath As String, sourceFiles As String())

    Dim codec As System.Drawing.Imaging.ImageCodecInfo = Nothing

    For Each cCodec As System.Drawing.Imaging.ImageCodecInfo In System.Drawing.Imaging.ImageCodecInfo.GetImageEncoders()
        If cCodec.CodecName = "Built-in TIFF Codec" Then
            codec = cCodec
        End If
    Next

    Try

        Dim imagePararms As New System.Drawing.Imaging.EncoderParameters(1)
        imagePararms.Param(0) = New System.Drawing.Imaging.EncoderParameter(System.Drawing.Imaging.Encoder.SaveFlag, CLng(System.Drawing.Imaging.EncoderValue.MultiFrame))

        If sourceFiles.Length = 1 Then

            System.IO.File.Copy(DirectCast(sourceFiles(0), String), str_DestinationPath, True)
        ElseIf sourceFiles.Length >= 1 Then
            Dim DestinationImage As System.Drawing.Image = DirectCast(New System.Drawing.Bitmap(DirectCast(sourceFiles(0), String)), System.Drawing.Image)

            DestinationImage.Save(str_DestinationPath, codec, imagePararms)

            imagePararms.Param(0) = New System.Drawing.Imaging.EncoderParameter(System.Drawing.Imaging.Encoder.SaveFlag, CLng(System.Drawing.Imaging.EncoderValue.FrameDimensionPage))


            For i As Integer = 0 To sourceFiles.Length - 2
                Dim img As System.Drawing.Image = DirectCast(New System.Drawing.Bitmap(DirectCast(sourceFiles(i), String)), System.Drawing.Image)

                DestinationImage.SaveAdd(img, imagePararms)
                img.Dispose()
            Next

            imagePararms.Param(0) = New System.Drawing.Imaging.EncoderParameter(System.Drawing.Imaging.Encoder.SaveFlag, CLng(System.Drawing.Imaging.EncoderValue.Flush))
            DestinationImage.SaveAdd(imagePararms)
            imagePararms.Dispose()

            DestinationImage.Dispose()

        End If
    Catch ex As Exception
        MsgBox(ex.Message)
    End Try


End Sub

2 个答案:

答案 0 :(得分:0)

虽然我没有找到这个代码的解决方案,但我确实找到了有效的代码。 John http://www.vbdotnetforums.com/的主持人在此主题http://www.vbdotnetforums.com/graphics-gdi/22113-create-multipage-tiff-loop.html

中发布了以下代码

它对我有用。我在顶部添加了几行来说明我是如何调用它的。

格雷格

'Example: Combine 4 tiff images in a new file called FinishedTiff.tiff
'Dim oNewImage As Image

'oNewImage = Image.FromFile("C:\IRISScan\Week of Jan 6 no SSN_Page_1.tif")
'SaveAddTiff(oNewImage, "C:\IRISScan\FinishedTiff.tif")

'oNewImage = Image.FromFile("C:\IRISScan\Week of Jan 6 no SSN_Page_2.tif")
'SaveAddTiff(oNewImage, "C:\IRISScan\FinishedTiff.tif")

'oNewImage = Image.FromFile("C:\IRISScan\Document3_Page_1.tif")
'SaveAddTiff(oNewImage, "C:\IRISScan\FinishedTiff.tif")

'oNewImage = Image.FromFile("C:\IRISScan\Document3_Page_2.tif")
'SaveAddTiff(oNewImage, "C:\IRISScan\FinishedTiff.tif")
Imports System.Drawing.Imaging

Module modTiff
'

Sub SaveAddTiff(ByVal img As Image, ByVal filename As String)
    If Not IO.File.Exists(filename) Then
        img.Save(filename, Imaging.ImageFormat.Tiff)
    Else
        Dim frames As List(Of Image) = getFrames(filename)
        frames.Add(img)
        SaveMultiTiff(frames.ToArray, filename)
    End If
    img.Dispose()
End Sub

Sub SaveMultiTiff(ByVal frames() As Image, ByVal filename As String)
    Dim codec As ImageCodecInfo = getTiffCodec()
    Dim enc As Encoder = Encoder.SaveFlag
    Dim ep As New EncoderParameters(2)
    ep.Param(0) = New EncoderParameter(enc, CLng(EncoderValue.MultiFrame))
    ep.Param(1) = New EncoderParameter(Encoder.Compression, CLng(EncoderValue.CompressionNone))
    Dim tiff As Image = frames(0)
    tiff.Save(filename, codec, ep)
    ep.Param(0) = New EncoderParameter(enc, CLng(EncoderValue.FrameDimensionPage))
    For i As Integer = 1 To frames.Length - 1
        tiff.SaveAdd(frames(i), ep)
        frames(i).Dispose()
    Next
    ep.Param(0) = New EncoderParameter(enc, CLng(EncoderValue.Flush))
    tiff.SaveAdd(ep)
    tiff.Dispose()
End Sub

Function getTiffCodec() As ImageCodecInfo
    For Each ice As ImageCodecInfo In ImageCodecInfo.GetImageEncoders()
        If ice.MimeType = "image/tiff" Then
            Return ice
        End If
    Next
    Return Nothing
End Function

Function getFrames(ByVal filename) As List(Of Image)
    Dim frames As New List(Of Image)
    Dim img As Image = Image.FromFile(filename)
    For i As Integer = 0 To img.GetFrameCount(Imaging.FrameDimension.Page) - 1
        img.SelectActiveFrame(Imaging.FrameDimension.Page, i)
        Dim tmp As New Bitmap(img.Width, img.Height)
        Dim g As Graphics = Graphics.FromImage(tmp)
        g.CompositingQuality = Drawing2D.CompositingQuality.HighQuality
        g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
        g.PixelOffsetMode = Drawing2D.PixelOffsetMode.HighQuality
        g.SmoothingMode = Drawing2D.SmoothingMode.HighQuality
        g.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAliasGridFit
        g.DrawImageUnscaled(img, 0, 0)
        frames.Add(tmp)
        g.Dispose()
    Next
    img.Dispose()
    Return frames
End Function

结束模块

答案 1 :(得分:0)

我替换了

g.DrawImageUnscaled(img, 0, 0)

g.DrawImageUnscaledAndClipped(img, New Rectangle(0, 0, img.Width, img.Height))

它解决了缩放问题,它会将图像缩小到原始大小的四分之一