Private Function GetEncoderInfo(ByVal mimeType As String) As ImageCodecInfo
Dim j As Integer
Dim encoders As ImageCodecInfo()
encoders = ImageCodecInfo.GetImageEncoders()
For j = 0 To encoders.Length - 2
If encoders(j).MimeType = mimeType Then
Return encoders(j)
End If
Next j
Return Nothing
End Function
Private Sub AddPage(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
Dim multi As Bitmap
Dim page2 As Bitmap
Dim page3 As Bitmap
Dim myImageCodecInfo As ImageCodecInfo
Dim myEncoder As Encoder
Dim myEncoderParameter As EncoderParameter
Dim myEncoderParameters As EncoderParameters
' Create three Bitmap objects.
multi = New Bitmap("C:\multi.tiff")
page2 = New Bitmap("C:\two.bmp")
page3 = New Bitmap("C:\three.bmp")
' Get an ImageCodecInfo object that represents the TIFF codec.
myImageCodecInfo = GetEncoderInfo("C:\multi.tiff")
' Create an Encoder object based on the GUID
' for the SaveFlag parameter category.
myEncoder = Encoder.SaveFlag
' Create an EncoderParameters object.
' An EncoderParameters object has an array of EncoderParameter
' objects. In this case, there is only one
' EncoderParameter object in the array.
myEncoderParameters = New EncoderParameters(1)
' Save the first page (frame).
myEncoderParameter = New EncoderParameter(myEncoder, (CLng(EncoderValue.MultiFrame)))
myEncoderParameters.Param(0) = myEncoderParameter
multi.Save("C:\Multiframe.tiff", Imaging.ImageFormat.Tiff)
' Save the second page (frame).
myEncoderParameter = New EncoderParameter(myEncoder, (CLng(EncoderValue.FrameDimensionPage)))
myEncoderParameters.Param(0) = myEncoderParameter
multi.SaveAdd(page2, myEncoderParameters)
' Save the third page (frame).
myEncoderParameter = New EncoderParameter(myEncoder, (CLng(EncoderValue.FrameDimensionPage)))
myEncoderParameters.Param(1) = myEncoderParameter
multi.SaveAdd(page3, myEncoderParameters)
' Close the multiple-frame file.
myEncoderParameter = New EncoderParameter(myEncoder, (CLng(EncoderValue.Flush)))
myEncoderParameters.Param(1) = myEncoderParameter
multi.SaveAdd(myEncoderParameters)
End Sub