Solved

Resize JPEG

Posted on 2004-08-06
9
1,939 Views
Last Modified: 2008-02-01
How can I resize a jpeg to 50% or 25% of its original size with VB.NET?
0
Comment
Question by:PLavelle
  • 2
  • 2
  • 2
  • +3
9 Comments
 
LVL 4

Expert Comment

by:srcalc
ID: 11739804
0
 
LVL 85

Accepted Solution

by:
Mike Tomlinson earned 500 total points
ID: 11739889
There are several ways to do it....here is one:

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        OpenFileDialog1.Filter = "Image Files(*.BMP;*.JPG;*.GIF)|*.BMP;*.JPG;*.GIF|All files (*.*)|*.*"
        If OpenFileDialog1.ShowDialog = DialogResult.OK Then
            PictureBox1.Image = scaleImage(OpenFileDialog1.FileName, 50)
        End If
    End Sub

    Private Function scaleImage(ByVal imageFileName As String, ByVal reducedPercentage As Byte) As Bitmap
        If System.IO.File.Exists(imageFileName) Then
            If reducedPercentage > 0 And reducedPercentage <= 100 Then
                Try
                    Dim factor As Single = reducedPercentage / 100

                    Dim origImage As New Bitmap(imageFileName)
                    Dim targetimage As Bitmap = New Bitmap(origImage, origImage.Width * factor, origImage.Height * factor)
                    origImage.Dispose()
                    Return targetimage
                Catch ex As Exception
                    MsgBox(ex.Message, MsgBoxStyle.Critical, "Error Scaling Image")
                End Try
            End If
        Else
            MsgBox(imageFileName, MsgBoxStyle.Information, "File Not Found")
        End If
    End Function

If you need to save the file back to the drive again then use the Save method of the returned bitmap object like this:

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        OpenFileDialog1.Filter = "Image Files(*.BMP;*.JPG;*.GIF)|*.BMP;*.JPG;*.GIF|All files (*.*)|*.*"
        If OpenFileDialog1.ShowDialog = DialogResult.OK Then
            Dim tempBitmap As Bitmap
            tempBitmap = scaleImage(OpenFileDialog1.FileName, 50)
            tempBitmap.Save(OpenFileDialog1.FileName, Imaging.ImageFormat.Jpeg)
            tempBitmap.Dispose()
        End If
    End Sub

Regards,

Idle_Mind
0
 
LVL 37

Expert Comment

by:gregoryyoung
ID: 11739998
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.
0
 
LVL 17

Expert Comment

by:AerosSaga
ID: 11740110
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.Format1bppIndexed)
            .Add(Imaging.PixelFormat.Format4bppIndexed)
            .Add(Imaging.PixelFormat.Format8bppIndexed)
            .Add(Imaging.PixelFormat.Undefined)
            .Add(Imaging.PixelFormat.DontCare)
            .Add(Imaging.PixelFormat.Format16bppArgb1555)
            .Add(Imaging.PixelFormat.Format16bppGrayScale)
        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.DirectoryName & "\TEMP_" & fiSource.Name)
        fsSource = fiSource.OpenRead()
        IncomingImage = IncomingImage.FromStream(fsSource)

        OutputBitmap = RedrawImage(IncomingImage, FullSizeX, FullSizeY)
        If fiSource.Extension = ".gif" Then
            NewFilename = fiDestination.Name
            OutputBitmap.Save(fiDestination.FullName)
        Else
            JpegCodec = ReturnJpegCodec()
            JpegEncodeParams = ReturnEncoderParams()
            NewFilename = fiDestination.Name.Replace(fiDestination.Extension, ".jpg")
            OutputBitmap.Save(fiDestination.FullName.Replace(fiDestination.Extension, ".jpg"), _
                JpegCodec, JpegEncodeParams)
        End If

        If CreateThumbnail Then
            OutputBitmap = RedrawImage(IncomingImage, ThumbX, ThumbY)
            If fiSource.Extension = ".gif" Then
                OutputBitmap.Save(fiDestination.DirectoryName & "/Thumbnails/" & fiDestination.Name)
            Else
                JpegCodec = ReturnJpegCodec()
                JpegEncodeParams = ReturnEncoderParams()
                OutputBitmap.Save(fiDestination.DirectoryName & "/Thumbnails/" & _
                    fiDestination.Name.Replace(fiDestination.Extension, ".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.Contains(Bitmap.PixelFormat) 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.HighQuality
        Graphic.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
        Graphic.PixelOffsetMode = Drawing2D.PixelOffsetMode.HighQuality

        Graphic.DrawImage(Bitmap, 0, 0)
        Graphic.Dispose()

        Return Bitmap
    End Function

    Private Function ReturnJpegCodec() As ImageCodecInfo
        Dim codecs As Imaging.ImageCodecInfo() = ImageCodecInfo.GetImageEncoders()

        For Each codec As ImageCodecInfo In codecs
            If codec.MimeType.Equals("image/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(EncoderInstance, 80L)
        EncoderParametersInstance.Param(0) = QualityParameter

        EncoderInstance = Encoder.ColorDepth
        ColorParameter = New EncoderParameter(EncoderInstance, 24L)
        EncoderParametersInstance.Param(1) = ColorParameter

        Return EncoderParametersInstance
    End Function

End Class

Regards,

Aeros
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 7

Expert Comment

by:ramesh12
ID: 11754164

dim imgFile as image= Bitmap.FromFile("yourfilepath")


                    imgOut = ScaleByPercent(imgFile, 50)                           'percent to scale
                    imgOut.Save(<filename/stream>, ImageFormat.Jpeg)

    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(imgPhoto.HorizontalResolution, imgPhoto.VerticalResolution)

        Dim grPhoto As Graphics = Graphics.FromImage(bmPhoto)
        grPhoto.InterpolationMode = InterpolationMode.HighQualityBicubic
        grPhoto.SmoothingMode = SmoothingMode.HighQuality
        grPhoto.PixelOffsetMode = PixelOffsetMode.HighQuality
        grPhoto.DrawImage(imgPhoto, New Rectangle(destX, destY, destWidth, destHeight), New Rectangle(sourceX, sourceY, sourceWidth, sourceHeight), GraphicsUnit.Pixel)

        'bmPhoto.Save(Response.OutputStream, ImageFormat.Jpeg)
        grPhoto.Dispose()
        Return bmPhoto
    End Function
0
 
LVL 7

Expert Comment

by:ramesh12
ID: 11754180
change the above

imgOut = ScaleByPercent(imgFile, 50)                           'percent to scale

 as

dim imgOut as image= ScaleByPercent(imgFile, 50)                           'percent to scale
0
 
LVL 17

Expert Comment

by:AerosSaga
ID: 11754715
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
0
 

Author Comment

by:PLavelle
ID: 11754738
I'll try these out tonight and ask more questions or award points accordingly to the solution I use.
0
 

Author Comment

by:PLavelle
ID: 11787724
Thanks for the help.
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Article by: jpaulino
XML Literals are a great way to handle XML files and the community doesn’t use it as much as it should.  An XML Literal is like a String (http://msdn.microsoft.com/en-us/library/system.string.aspx) Literal, only instead of starting and ending with w…
1.0 - Introduction Converting Visual Basic 6.0 (VB6) to Visual Basic 2008+ (VB.NET). If ever there was a subject full of murkiness and bad decisions, it is this one!   The first problem seems to be that people considering this task of converting…
This Micro Tutorial hows how you can integrate  Mac OSX to a Windows Active Directory Domain. Apple has made it easy to allow users to bind their macs to a windows domain with relative ease. The following video show how to bind OSX Mavericks to …
This is used to tweak the memory usage for your computer, it is used for servers more so than workstations but just be careful editing registry settings as it may cause irreversible results. I hold no responsibility for anything you do to the regist…

864 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

24 Experts available now in Live!

Get 1:1 Help Now