Bitmap to JPEG with compression settings

S

Smokey Grindel

I have a bitmap object I want to return as a JPEG image with a compression
set at 90% and progressive passes enabled, how can I do this in .NET 2.0?
Progressive passes are not necessary but the compression ratio is.. thanks!
 
G

Guest

You might find something useful in this class I created.

Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.IO
Imports MultiBoxControl

Public Class CvImage

Private codecs() As ImageCodecInfo

Public Sub New()
'Get the list of available encoders
Static Init As Boolean = True
If Init Then codecs = ImageCodecInfo.GetImageEncoders() : Init = False
End Sub
Public Function ImageToJpeg(ByVal img As Image, Optional ByVal quality
As Integer = 100) As Image
Dim ici As ImageCodecInfo = get_Codec("image/jpeg")
Dim ep As EncoderParameters = New EncoderParameters(1)
'Set Quality Parameter
ep.Param(0) = New EncoderParameter(Encoder.Quality, quality)
'Save to a Memory Stream
Dim s As New System.IO.MemoryStream
img.Save(s, ici, ep)
Return img.FromStream(s)
End Function

Public Function BmpToJpegToBytes(ByVal BitMapIn As Bitmap, ByVal Quality
As Integer, Optional ByVal CompressPct As Integer = -1) As Byte()
Return BmpToJpegToStream(BitMapIn, Quality).ToArray
End Function

Public Function BmpToJpegToImage(ByVal BitMapIn As Bitmap, ByVal Quality
As Integer) As Image
Return Image.FromStream(BmpToJpegToStream(BitMapIn, Quality))
End Function

Public Function BmpToJpegToStream(ByVal BitMapIn As Bitmap, ByVal
Quality As Integer, Optional ByVal CompressPct As Integer = -1) As
IO.MemoryStream
'find the encoder with the image/jpeg mime-type
Dim ici As ImageCodecInfo = get_Codec("image/jpeg")
'Create a collection of encoder parameters (we only need one in the
collection)
Dim ep As EncoderParameters = New EncoderParameters(1)
'Set Quality Parameter
ep.Param(0) = New EncoderParameter(Encoder.Quality, Quality)
'ep.Param(0) = New EncoderParameter(Encoder.Compression, CompressPct)

'Converting to a MemoryStream using GetBuffer
Dim s As New System.IO.MemoryStream
Dim byt() As Byte
'BitMapIn.Save(s, Imaging.ImageFormat.Jpeg)
BitMapIn.Save(s, ici, ep)

'Converting to a MemoryStream using Read
'Dim ms As New System.IO.MemoryStream
'BitMapIn.Save(ms, ici, ep)
'Dim byt(CInt(s.Length() - 1)) As Byte
's.Position = 0L
's.Read(byt, 0, byt.Length)

'Converting to a File
'BitMapIn.Save("c:\testbitmap.jpg", ici, ep)
'Dim fs As New System.IO.FileStream("c:\testbitmap.jpg",
IO.FileMode.Open, IO.FileAccess.Read)
'Dim byt(CInt(fs.Length() - 1)) As Byte
'fs.Read(byt, 0, byt.Length)
'fs.Close()
Return s
End Function

Public Function IconToBitmap(ByVal in_colour As Color, ByVal in_icon As
Icon) As Bitmap
Dim g As Graphics
Dim b As Bitmap
Dim c As Color
b = New Bitmap(in_icon.Width, in_icon.Height,
System.Drawing.Imaging.PixelFormat.Format32bppPArgb)
g = Graphics.FromImage(b)
g.FillRectangle(New SolidBrush(Color.Transparent), New Rectangle(0,
0, b.Width, b.Height))
g.DrawIcon(in_icon, 0, 0)
g.Dispose()
Return b
End Function

Public Function GetNewImgSize(ByVal OldImage As Image, ByVal MxSz As
Size) As Size
Dim w As Integer = OldImage.Width
Dim h As Integer = OldImage.Height
Dim nw, nh As Integer
Dim pctw, pcth As Double
If w < MxSz.Width Then
pctw = 1
Else
pctw = MxSz.Width / w
End If
If h < MxSz.Height Then
pcth = 1
Else
pcth = MxSz.Height / h
End If
If pctw < pcth Then
nw = CInt(pctw * w)
nh = CInt(pctw * h)
Else
nw = CInt(pcth * w)
nh = CInt(pcth * h)
End If
Return New Size(nw, nh)
End Function
Public Function ConvImageBytesToMemoryStream(ByVal origimgbytes() As
Byte, ByVal NewType As String, Optional ByVal qualitypct As Integer = 100) As
MemoryStream
Dim ici As ImageCodecInfo = get_Codec(newtype)
Dim img As Image
If ici Is Nothing Then Return Nothing
Dim s As New System.IO.MemoryStream
Dim os As New System.IO.MemoryStream(origimgbytes)
Try
Dim ep As EncoderParameters = New EncoderParameters(1)
'Set Quality Parameter
ep.Param(0) = New EncoderParameter(Encoder.Quality, qualitypct)
'Save to a Memory Stream
img = Image.FromStream(os)
'Convert and save to image
img.Save(s, ici, ep)
Return s
Catch ex As Exception
Throw New Exception(ex.Message)
Finally
os.Close()
End Try
End Function
Public Function ConvImageBytesToBytes(ByVal origimgbytes() As Byte,
ByVal NewType As String, Optional ByVal qualitypct As Integer = 100) As Byte()
Dim s As MemoryStream = ConvImageBytesToMemoryStream(origimgbytes,
NewType, qualitypct)
Dim b(CInt(s.Length - 1)) As Byte
b = s.GetBuffer()
s.Close()
Return b
End Function

Public Function ConvImageToImage(ByVal img As Image, ByVal NewType As
String, Optional ByVal quality As Integer = 100) As Image
Dim ici As ImageCodecInfo = get_Codec(NewType)
If ici Is Nothing Then Return Nothing
Dim ep As EncoderParameters = New EncoderParameters(1)
'Set Quality Parameter
ep.Param(0) = New EncoderParameter(Encoder.Quality, quality)
'Save to a Memory Stream
Dim s As New System.IO.MemoryStream
Try
img.Save(s, ici, ep)
Return img.FromStream(s)
Catch ex As ExecutionEngineException
Throw New Exception(ex.Message)
Finally
s.Close() 'NOTE: may need to keep s open
End Try
End Function
Public Function ConvImageToBytes(ByVal img As Image, ByVal NewType As
String, Optional ByVal quality As Integer = 100) As Byte()

' Dim newimg As Image = ConvImageToImage(img, NewType, quality)
'dim b() as Byte = img.
End Function
Public Function ConvBytesToImage(ByVal b() As Byte) As Image
'Note that memorystream must remain open for the life of the image
Dim picbuffer As System.IO.MemoryStream = New
System.IO.MemoryStream(b)
Return Image.FromStream(picbuffer, False)
picbuffer.Close()
End Function
Private Function get_Codec(ByVal type As String) As ImageCodecInfo
Dim mime As String = SetMime(type)
If mime Is Nothing Then Return Nothing
For Each codec As ImageCodecInfo In codecs
If (codec.MimeType = mime) Then
Return codec
End If
Next
Return Nothing
End Function
Public Function SetMime(ByVal imagetype As String) As String
Select Case imagetype.ToLower.Trim
Case "jpg", "jpeg", "image/jpg", "image/jpeg"
Return "image/jpeg"
Case "bmp", "image/bmp"
Return "image/bmp"
Case "gif", "image/gif"
Return "image/gif"
Case "tif", "tiff", "image/tif", "image/tiff"
Return "image/tiff"
Case "png", "image/png"
Return "image/png"
Case Else
Return Nothing
End Select
End Function


Public Function SaveImageBytesToFile(ByVal b() As Byte, ByVal imagetype
As String, ByVal dialog As SaveFileDialog) As Boolean
'Returns True if saved, false if not
'Displays error message if not saved
'imagetype = "jpg", etc.
Dim fname As String
Dim typname As String
Dim t As String
Dim filterindex As Integer
Dim mime As String = SetMime(imagetype)

Select Case mime
Case "image/jpeg" : filterindex = 1
Case "image/bmp" : filterindex = 2
Case "image/gif" : filterindex = 3
Case "image/tiff" : filterindex = 4
Case "image/png" : filterindex = 5
Case Else : filterindex = 1
End Select
Dim fs As FileStream
Dim w As BinaryWriter
Try
'Get Picture File Name
With dialog
.Filter = "Joint Photographic Experts Group (*.jpeg)|*.jpg|"
& "BitMap (*.bmp)|*.bmp|" & "Graphics Interchange Format (*.gif)|*.gif|" &
"TagImage (*tif)|*.tif|" & "Portable Network Graphics (*png)|*.png"
.Title = "Select Picture File...:"
.FilterIndex = filterindex
.InitialDirectory = InitSet.PictureSourcePath
.CheckFileExists = False
.CheckPathExists = True
.OverwritePrompt = True
.AddExtension = True
.ValidateNames = True
End With
If dialog.ShowDialog() = DialogResult.OK Then
fname = dialog.FileName
Dim fi As New FileInfo(fname)
InitSet.PictureSourcePath = fi.DirectoryName
SerializeSettings()
t = SetMime(fi.Extension.Trim("."c).ToLower)
If t <> mime Then
If MultiBox.Show("Current Picture is in """ & mime & """
format...Wish to Change to """ & t & """ format?", "Change Format...",
MultiBoxButtons.YesNo, MultiBoxImage.Question) = MultiBoxResult.No Then
Return False
Else
b = ConvImageBytesToBytes(b, t, 100)
End If
End If
fs = New FileStream(fname, FileMode.OpenOrCreate)
fs.SetLength(b.Length)
w = New BinaryWriter(fs)
w.Write(b)
MultiBox.Show("Picture saved to """ & fname & """
successfully!", "Image Saved...", MultiBoxButtons.Ok,
MultiBoxImage.Information)

Else
fname = Nothing
End If
Catch ex As Exception
Throw New Exception("Image not saved due to error:" & DvbLF &
ex.Message)
Finally
If Not w Is Nothing Then w.Close()
If Not fs Is Nothing Then fs.Close()
If Not dialog Is Nothing Then dialog.Dispose()
End Try
End Function

End Class
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top