Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 534
  • Last Modified:

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

0
XK8ER
Asked:
XK8ER
  • 4
  • 2
1 Solution
 
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
 
Meir RivkinFull 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
 
XK8ERAuthor Commented:
your code and function works fine but still the quality and size doesn't look the same.. what should I do?
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
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

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

  • 4
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now