PLavelle
asked on
Resize JPEG
How can I resize a jpeg to 50% or 25% of its original size with VB.NET?
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Idle_Mind gives a good example, there is a framwork method which can do this but it often runs into prolems his code solves. The difference is that the framework method is intended to use MUCH less memory, it is quite good at making smaller versions of an image but if you are enlarging you will run into troubles. The method is Image.GetThumbnailImage() http://msdn.microsoft.com/library/default.asp?url=/library/en-us/cpref/html/frlrfsystemdrawingimageclassgetthumbnailimagetopic.asp includes an example and the scaling arithmetic should be the same. Just to be clear it is only usefull if you are shrinking an image as if the image has an embedded thumbnail it will use that as opposed to the full image.
Heres my take:
Imports System.Drawing
Imports System.Drawing.Imaging
Public Class ResizeImage
Private _CreateThumbnail As Boolean
Private _ThumbX, _ThumbY, _FullSizeX, _FullSizeY As Integer
Private UnacceptableImageFormats As ArrayList
Public Property CreateThumbnail() As Boolean
Get
Return _CreateThumbnail
End Get
Set(ByVal Value As Boolean)
_CreateThumbnail = Value
End Set
End Property
Public Property FullSizeX() As Integer
Get
Return _FullSizeX
End Get
Set(ByVal Value As Integer)
_FullSizeX = Value
End Set
End Property
Public Property FullSizeY() As Integer
Get
Return _FullSizeY
End Get
Set(ByVal Value As Integer)
_FullSizeY = Value
End Set
End Property
Public Property ThumbX() As Integer
Get
Return _ThumbX
End Get
Set(ByVal Value As Integer)
_ThumbX = Value
End Set
End Property
Public Property ThumbY() As Integer
Get
Return _ThumbY
End Get
Set(ByVal Value As Integer)
_ThumbY = Value
End Set
End Property
Public Sub New(ByVal CreateThumbnail As Boolean, ByVal FullSizeX As Integer, ByVal FullSizeY As Integer)
_CreateThumbnail = CreateThumbnail
_FullSizeX = FullSizeX
_FullSizeY = FullSizeY
UnacceptableImageFormats = New ArrayList(10)
With UnacceptableImageFormats
.Add(Imaging.PixelFormat.F ormat1bppI ndexed)
.Add(Imaging.PixelFormat.F ormat4bppI ndexed)
.Add(Imaging.PixelFormat.F ormat8bppI ndexed)
.Add(Imaging.PixelFormat.U ndefined)
.Add(Imaging.PixelFormat.D ontCare)
.Add(Imaging.PixelFormat.F ormat16bpp Argb1555)
.Add(Imaging.PixelFormat.F ormat16bpp GrayScale)
End With
End Sub
Public Function ResizeImage(ByVal ImageSource As String) As String
Dim IncomingImage As System.Drawing.Image
Dim OutputBitmap As Bitmap
Dim JpegCodec As ImageCodecInfo
Dim JpegEncodeParams As EncoderParameters
Dim NewSize As Size
Dim fiSource As New IO.FileInfo(ImageSource)
Dim fsSource As IO.FileStream
Dim fiDestination As New IO.FileInfo(ImageSource)
Dim NewFilename As String
fiSource.MoveTo(fiSource.D irectoryNa me & "\TEMP_" & fiSource.Name)
fsSource = fiSource.OpenRead()
IncomingImage = IncomingImage.FromStream(f sSource)
OutputBitmap = RedrawImage(IncomingImage, FullSizeX, FullSizeY)
If fiSource.Extension = ".gif" Then
NewFilename = fiDestination.Name
OutputBitmap.Save(fiDestin ation.Full Name)
Else
JpegCodec = ReturnJpegCodec()
JpegEncodeParams = ReturnEncoderParams()
NewFilename = fiDestination.Name.Replace (fiDestina tion.Exten sion, ".jpg")
OutputBitmap.Save(fiDestin ation.Full Name.Repla ce(fiDesti nation.Ext ension, ".jpg"), _
JpegCodec, JpegEncodeParams)
End If
If CreateThumbnail Then
OutputBitmap = RedrawImage(IncomingImage, ThumbX, ThumbY)
If fiSource.Extension = ".gif" Then
OutputBitmap.Save(fiDestin ation.Dire ctoryName & "/Thumbnails/" & fiDestination.Name)
Else
JpegCodec = ReturnJpegCodec()
JpegEncodeParams = ReturnEncoderParams()
OutputBitmap.Save(fiDestin ation.Dire ctoryName & "/Thumbnails/" & _
fiDestination.Name.Replace (fiDestina tion.Exten sion, ".jpg"), JpegCodec, JpegEncodeParams)
End If
End If
fsSource.Close()
OutputBitmap.Dispose()
IncomingImage.Dispose()
fiSource.Delete()
Return NewFilename
End Function
Private Function RedrawImage(ByVal IncomingImage As Image, ByVal MaximumX As Integer, _
ByVal MaximumY As Integer) As Bitmap
Dim ResizedX, ResizedY As Integer
Dim Bitmap As Bitmap
Dim Graphic As Graphics
Dim NewSize As Size
ResizedY = CInt((IncomingImage.Height * MaximumX) / IncomingImage.Width)
ResizedX = CInt((IncomingImage.Width * MaximumY) / IncomingImage.Height)
If ResizedY >= MaximumY Then
NewSize = New Size(ResizedX, MaximumY)
Else
NewSize = New Size(MaximumX, ResizedY)
End If
Bitmap = New Bitmap(IncomingImage, NewSize)
Bitmap.SetResolution(72, 72)
'Some graphic pixel formats prevent the image from being converted into an instance of Graphics.
' If this is the case, return just the resized bitmap without processing.
If UnacceptableImageFormats.C ontains(Bi tmap.Pixel Format) Then Return Bitmap
'All pixel formats that Microsoft says will generate exceptions have been loaded into the array
' above, yet some pixel formats are still throwing exceptions. Resorted to a Try / Catch block - AM
Try
Graphic = Graphics.FromImage(Bitmap)
Catch
Return Bitmap
End Try
Graphic.SmoothingMode = Drawing2D.SmoothingMode.Hi ghQuality
Graphic.InterpolationMode = Drawing2D.InterpolationMod e.HighQual ityBicubic
Graphic.PixelOffsetMode = Drawing2D.PixelOffsetMode. HighQualit y
Graphic.DrawImage(Bitmap, 0, 0)
Graphic.Dispose()
Return Bitmap
End Function
Private Function ReturnJpegCodec() As ImageCodecInfo
Dim codecs As Imaging.ImageCodecInfo() = ImageCodecInfo.GetImageEnc oders()
For Each codec As ImageCodecInfo In codecs
If codec.MimeType.Equals("ima ge/jpeg") Then Return codec
Next
End Function
Private Function ReturnEncoderParams() As EncoderParameters
Dim EncoderInstance As Encoder
Dim EncoderParametersInstance As New EncoderParameters(2)
Dim QualityParameter As EncoderParameter
Dim ColorParameter As EncoderParameter
EncoderInstance = Encoder.Quality
QualityParameter = New EncoderParameter(EncoderIn stance, 80L)
EncoderParametersInstance. Param(0) = QualityParameter
EncoderInstance = Encoder.ColorDepth
ColorParameter = New EncoderParameter(EncoderIn stance, 24L)
EncoderParametersInstance. Param(1) = ColorParameter
Return EncoderParametersInstance
End Function
End Class
Regards,
Aeros
Imports System.Drawing
Imports System.Drawing.Imaging
Public Class ResizeImage
Private _CreateThumbnail As Boolean
Private _ThumbX, _ThumbY, _FullSizeX, _FullSizeY As Integer
Private UnacceptableImageFormats As ArrayList
Public Property CreateThumbnail() As Boolean
Get
Return _CreateThumbnail
End Get
Set(ByVal Value As Boolean)
_CreateThumbnail = Value
End Set
End Property
Public Property FullSizeX() As Integer
Get
Return _FullSizeX
End Get
Set(ByVal Value As Integer)
_FullSizeX = Value
End Set
End Property
Public Property FullSizeY() As Integer
Get
Return _FullSizeY
End Get
Set(ByVal Value As Integer)
_FullSizeY = Value
End Set
End Property
Public Property ThumbX() As Integer
Get
Return _ThumbX
End Get
Set(ByVal Value As Integer)
_ThumbX = Value
End Set
End Property
Public Property ThumbY() As Integer
Get
Return _ThumbY
End Get
Set(ByVal Value As Integer)
_ThumbY = Value
End Set
End Property
Public Sub New(ByVal CreateThumbnail As Boolean, ByVal FullSizeX As Integer, ByVal FullSizeY As Integer)
_CreateThumbnail = CreateThumbnail
_FullSizeX = FullSizeX
_FullSizeY = FullSizeY
UnacceptableImageFormats = New ArrayList(10)
With UnacceptableImageFormats
.Add(Imaging.PixelFormat.F
.Add(Imaging.PixelFormat.F
.Add(Imaging.PixelFormat.F
.Add(Imaging.PixelFormat.U
.Add(Imaging.PixelFormat.D
.Add(Imaging.PixelFormat.F
.Add(Imaging.PixelFormat.F
End With
End Sub
Public Function ResizeImage(ByVal ImageSource As String) As String
Dim IncomingImage As System.Drawing.Image
Dim OutputBitmap As Bitmap
Dim JpegCodec As ImageCodecInfo
Dim JpegEncodeParams As EncoderParameters
Dim NewSize As Size
Dim fiSource As New IO.FileInfo(ImageSource)
Dim fsSource As IO.FileStream
Dim fiDestination As New IO.FileInfo(ImageSource)
Dim NewFilename As String
fiSource.MoveTo(fiSource.D
fsSource = fiSource.OpenRead()
IncomingImage = IncomingImage.FromStream(f
OutputBitmap = RedrawImage(IncomingImage,
If fiSource.Extension = ".gif" Then
NewFilename = fiDestination.Name
OutputBitmap.Save(fiDestin
Else
JpegCodec = ReturnJpegCodec()
JpegEncodeParams = ReturnEncoderParams()
NewFilename = fiDestination.Name.Replace
OutputBitmap.Save(fiDestin
JpegCodec, JpegEncodeParams)
End If
If CreateThumbnail Then
OutputBitmap = RedrawImage(IncomingImage,
If fiSource.Extension = ".gif" Then
OutputBitmap.Save(fiDestin
Else
JpegCodec = ReturnJpegCodec()
JpegEncodeParams = ReturnEncoderParams()
OutputBitmap.Save(fiDestin
fiDestination.Name.Replace
End If
End If
fsSource.Close()
OutputBitmap.Dispose()
IncomingImage.Dispose()
fiSource.Delete()
Return NewFilename
End Function
Private Function RedrawImage(ByVal IncomingImage As Image, ByVal MaximumX As Integer, _
ByVal MaximumY As Integer) As Bitmap
Dim ResizedX, ResizedY As Integer
Dim Bitmap As Bitmap
Dim Graphic As Graphics
Dim NewSize As Size
ResizedY = CInt((IncomingImage.Height
ResizedX = CInt((IncomingImage.Width * MaximumY) / IncomingImage.Height)
If ResizedY >= MaximumY Then
NewSize = New Size(ResizedX, MaximumY)
Else
NewSize = New Size(MaximumX, ResizedY)
End If
Bitmap = New Bitmap(IncomingImage, NewSize)
Bitmap.SetResolution(72, 72)
'Some graphic pixel formats prevent the image from being converted into an instance of Graphics.
' If this is the case, return just the resized bitmap without processing.
If UnacceptableImageFormats.C
'All pixel formats that Microsoft says will generate exceptions have been loaded into the array
' above, yet some pixel formats are still throwing exceptions. Resorted to a Try / Catch block - AM
Try
Graphic = Graphics.FromImage(Bitmap)
Catch
Return Bitmap
End Try
Graphic.SmoothingMode = Drawing2D.SmoothingMode.Hi
Graphic.InterpolationMode = Drawing2D.InterpolationMod
Graphic.PixelOffsetMode = Drawing2D.PixelOffsetMode.
Graphic.DrawImage(Bitmap, 0, 0)
Graphic.Dispose()
Return Bitmap
End Function
Private Function ReturnJpegCodec() As ImageCodecInfo
Dim codecs As Imaging.ImageCodecInfo() = ImageCodecInfo.GetImageEnc
For Each codec As ImageCodecInfo In codecs
If codec.MimeType.Equals("ima
Next
End Function
Private Function ReturnEncoderParams() As EncoderParameters
Dim EncoderInstance As Encoder
Dim EncoderParametersInstance As New EncoderParameters(2)
Dim QualityParameter As EncoderParameter
Dim ColorParameter As EncoderParameter
EncoderInstance = Encoder.Quality
QualityParameter = New EncoderParameter(EncoderIn
EncoderParametersInstance.
EncoderInstance = Encoder.ColorDepth
ColorParameter = New EncoderParameter(EncoderIn
EncoderParametersInstance.
Return EncoderParametersInstance
End Function
End Class
Regards,
Aeros
dim imgFile as image= Bitmap.FromFile("yourfilep
imgOut = ScaleByPercent(imgFile, 50) 'percent to scale
imgOut.Save(<filename/stre
Function ScaleByPercent(ByVal imgPhoto As Image, ByVal Percent As Integer) As Image
Dim nPercent As Single = (CType(Percent / 100, Single))
Dim sourceWidth As Integer = imgPhoto.Width
Dim sourceHeight As Integer = imgPhoto.Height
Dim sourceX As Integer = 0
Dim sourceY As Integer = 0
Dim destX As Integer = 0
Dim destY As Integer = 0
Dim destWidth As Integer = CType((sourceWidth * nPercent), Integer)
Dim destHeight As Integer = CType((sourceHeight * nPercent), Integer)
Dim bmPhoto As Bitmap
bmPhoto = New Bitmap(destWidth, destHeight, PixelFormat.Format24bppRgb
bmPhoto.SetResolution(imgP
Dim grPhoto As Graphics = Graphics.FromImage(bmPhoto
grPhoto.InterpolationMode = InterpolationMode.HighQual
grPhoto.SmoothingMode = SmoothingMode.HighQuality
grPhoto.PixelOffsetMode = PixelOffsetMode.HighQualit
grPhoto.DrawImage(imgPhoto
'bmPhoto.Save(Response.Out
grPhoto.Dispose()
Return bmPhoto
End Function
change the above
imgOut = ScaleByPercent(imgFile, 50) 'percent to scale
as
dim imgOut as image= ScaleByPercent(imgFile, 50) 'percent to scale
imgOut = ScaleByPercent(imgFile, 50) 'percent to scale
as
dim imgOut as image= ScaleByPercent(imgFile, 50) 'percent to scale
The same can be done with my first code posting:
Bitmap.SetResolution(72, 72) '''or anywhere else where the SetResolution property is available
Regards,
Aeros
Bitmap.SetResolution(72, 72) '''or anywhere else where the SetResolution property is available
Regards,
Aeros
ASKER
I'll try these out tonight and ask more questions or award points accordingly to the solution I use.
ASKER
Thanks for the help.
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=37649&lngWId=1
Or you can check out this EE question:
https://www.experts-exchange.com/questions/20567921/Resize-JPEG-files-in-VB.html