vb.net - image quality

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

LVL 1
XK8ERAsked:
Who is Participating?
 
Meir RivkinConnect With a Mentor Full stack Software EngineerCommented:
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
 
Meir RivkinFull stack Software EngineerCommented:
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
 
XK8ERAuthor Commented:
your code and function works fine but still the quality and size doesn't look the same.. what should I do?
0
Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

 
Meir RivkinFull stack Software EngineerCommented:
did u try my latest code?
0
 
Meir RivkinFull stack Software EngineerCommented:
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
 
XK8ERAuthor Commented:
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
 
Mike TomlinsonMiddle School Assistant TeacherCommented:
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
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.