Solved

vb.net - image quality

Posted on 2010-08-14
7
523 Views
Last Modified: 2012-05-10
hello there,
I am using this code to add a text "hello" in a random location of an image..
the issue that I am having is that the original picture is about 200KB and the saved image is about 100KB
and its pixelated with much lower quality.. how can I remain the same quality as the original picture?
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Static R As New Random
        Dim msg As String = "hello"

        Dim strBitmap As New Bitmap(System.AppDomain.CurrentDomain.BaseDirectory & "image1.jpg")
        Dim strColor As Color = Color.FromArgb(255, Color.SteelBlue)
        Dim strGraphics As Graphics = Graphics.FromImage(strBitmap)
        Dim strFont As New Font("Arial", 14, FontStyle.Bold, GraphicsUnit.Pixel)
        Dim strPoint As New Point(30, 92)
        Dim strBrush As New SolidBrush(strColor)

        Dim szF As SizeF = strGraphics.MeasureString(msg, strFont)
        strGraphics.DrawString(msg, strFont, strBrush, New Point(R.Next(0, strBitmap.Width - szF.Width), R.Next(0, strBitmap.Height - szF.Height)))
        strGraphics.Dispose()

        strBitmap.Save(System.AppDomain.CurrentDomain.BaseDirectory & "image2.jpg")
        strBitmap.Dispose()
    End Sub

Open in new window

0
Comment
Question by:XK8ER
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 2
7 Comments
 
LVL 42

Expert Comment

by:sedgwick
ID: 33439562
use the following function to draw text on image.
so from your code, call the function like this:

        Static R As New Random
        Dim font As Font = New Font("Arial", 14, FontStyle.Bold, GraphicsUnit.Pixel)
        Dim color As Color = color.FromArgb(255, color.SteelBlue)
        Dim msg As String = "hello"
        Dim srcImage As String = System.AppDomain.CurrentDomain.BaseDirectory & "image1.jpg"
        Dim outputImage As String = System.AppDomain.CurrentDomain.BaseDirectory & "image2.jpg"
        Dim strBitmap As New Bitmap(srcImage)
        Dim strGraphics As Graphics = Graphics.FromImage(strBitmap)
        Dim strSize As SizeF = strGraphics.MeasureString(msg, font, 14)

        Dim x As Int32 = R.Next(0, strBitmap.Width - strSize.Width)
        Dim y As Int32 = R.Next(0, strBitmap.Height - strSize.Height)
        Dim point As Point = New Point(x, y)

        TextOnImage(srcImage, outputImage, msg, ImageFormat.Jpeg, font, color, point)
Sub TextOnImage(ByVal OldImage As String, ByVal NewImage As String, ByVal Text As String, ByVal Format As ImageFormat, ByVal Font As Font, ByVal Color As Color, ByVal Position As Point)
        Dim TmpSize As System.Drawing.Size
        Dim Image As Image = System.Drawing.Image.FromFile(OldImage)
        Dim Brush As New SolidBrush(Color)

        'Read Image Dimensions
        TmpSize.Height = Image.Height
        TmpSize.Width = Image.Width

        'Create a new Bitmap Object
        Dim NewBitmap As New System.Drawing.Bitmap(Image, TmpSize)

        'Create a new Graphic Object
        Dim Graphic As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(NewBitmap)

        'Draw String on Image
        Graphic.DrawString(Text, Font, Brush, Position)

        'Save new Image
        NewBitmap.Save(NewImage, Format)

        Graphic.Dispose()
        NewBitmap.Dispose()
    End Sub

Open in new window

0
 
LVL 42

Accepted Solution

by:
sedgwick earned 500 total points
ID: 33439590
i forgot the most important thing which is the keep the quality (and size), here is the updated function.

so from your code, call the function like this:

        Static R As New Random
        Dim font As Font = New Font("Arial", 14, FontStyle.Bold, GraphicsUnit.Pixel)
        Dim color As Color = color.FromArgb(255, color.SteelBlue)
        Dim msg As String = "hello"
        Dim srcImage As String = System.AppDomain.CurrentDomain.BaseDirectory & "image1.jpg"
        Dim outputImage As String = System.AppDomain.CurrentDomain.BaseDirectory & "image2.jpg"
        Dim strBitmap As New Bitmap(srcImage)
        Dim strGraphics As Graphics = Graphics.FromImage(strBitmap)
        Dim strSize As SizeF = strGraphics.MeasureString(msg, font, 14)

        Dim x As Int32 = R.Next(0, strBitmap.Width - strSize.Width)
        Dim y As Int32 = R.Next(0, strBitmap.Height - strSize.Height)
        Dim point As Point = New Point(x, y)

        TextOnImage(srcImage, outputImage, msg, font, color, point)

Sub TextOnImage(ByVal OldImage As String, ByVal NewImage As String, ByVal Text As String, ByVal Font As Font, ByVal Color As Color, ByVal Position As Point)
        Dim TmpSize As System.Drawing.Size
        Dim Image As Image = System.Drawing.Image.FromFile(OldImage)
        Dim Brush As New SolidBrush(Color)

        'Read Image Dimensions
        TmpSize.Height = Image.Height
        TmpSize.Width = Image.Width

        'Create a new Bitmap Object
        Dim NewBitmap As New System.Drawing.Bitmap(Image, TmpSize)

        'Create a new Graphic Object
        Dim Graphic As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(NewBitmap)

        'Draw String on Image
        Graphic.DrawString(Text, Font, Brush, Position)

        Dim iciJpegCodec As ImageCodecInfo = Nothing
        'find the correct Codec and specify its quality
        Dim epQuality As New EncoderParameter(System.Drawing.Imaging.Encoder.Quality, 100L)
        ' Get all image codecs that are available
        Dim iciCodecs As ImageCodecInfo() = ImageCodecInfo.GetImageEncoders()
        ' Store the quality parameter in the list of encoder parameters
        Dim epParameters As New EncoderParameters(1)
        epParameters.Param(0) = epQuality
        ' Loop through all the image codecs
        For i As Integer = 0 To iciCodecs.Length - 1
            ' Until the one that we are interested in is found, which is image/jpeg
            If iciCodecs(i).MimeType = "image/jpeg" Then
                iciJpegCodec = iciCodecs(i)
                Exit For
            End If
        Next

        'Save new Image
        NewBitmap.Save(NewImage, iciJpegCodec, epParameters)

        Graphic.Dispose()
        NewBitmap.Dispose()
    End Sub

Open in new window

0
 
LVL 1

Author Comment

by:XK8ER
ID: 33440038
your code and function works fine but still the quality and size doesn't look the same.. what should I do?
0
PeopleSoft Has Never Been Easier

PeopleSoft Adoption Made Smooth & Simple!

On-The-Job Training Is made Intuitive & Easy With WalkMe's On-Screen Guidance Tool.  Claim Your Free WalkMe Account Now

 
LVL 42

Expert Comment

by:sedgwick
ID: 33440082
did u try my latest code?
0
 
LVL 42

Expert Comment

by:sedgwick
ID: 33440086
i've tested it on different images and they all kept the original size and quality. can u post an image that u tested and got poorer quality or the size was diminished?
0
 
LVL 1

Author Comment

by:XK8ER
ID: 33440802
for example this image http://static.travelblog.org/Wallpaper/pix/waterfall_desktop_background-1600x1200.jpg
the size is 373KB and after is 880KB same quality though
0
 
LVL 86

Expert Comment

by:Mike Tomlinson
ID: 33441087
Try experimenting with the different modes of the Graphics you created:

        Dim strGraphics As Graphics = Graphics.FromImage(strBitmap)
        strGraphics.CompositingQuality = Drawing2D.CompositingQuality.HighQuality
        strGraphics.InterpolationMode = Drawing2D.InterpolationMode.High
        strGraphics.SmoothingMode = Drawing2D.SmoothingMode.HighQuality
        strGraphics.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAliasGridFit
0

Featured Post

PeopleSoft Has Never Been Easier

PeopleSoft Adoption Made Smooth & Simple!

On-The-Job Training Is made Intuitive & Easy With WalkMe's On-Screen Guidance Tool.  Claim Your Free WalkMe Account Now

Question has a verified solution.

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

Since .Net 2.0, Visual Basic has made it easy to create a splash screen and set it via the "Splash Screen" drop down in the Project Properties.  A splash screen set in this manner is automatically created, displayed and closed by the framework itsel…
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…
Michael from AdRem Software explains how to view the most utilized and worst performing nodes in your network, by accessing the Top Charts view in NetCrunch network monitor (https://www.adremsoft.com/). Top Charts is a view in which you can set seve…
Sometimes it takes a new vantage point, apart from our everyday security practices, to truly see our Active Directory (AD) vulnerabilities. We get used to implementing the same techniques and checking the same areas for a breach. This pattern can re…
Suggested Courses

635 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