Solved

vb.net - image quality

Posted on 2010-08-14
7
516 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
  • 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
Networking for the Cloud Era

Join Microsoft and Riverbed for a discussion and demonstration of enhancements to SteelConnect:
-One-click orchestration and cloud connectivity in Azure environments
-Tight integration of SD-WAN and WAN optimization capabilities
-Scalability and resiliency equal to a data center

 
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 85

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

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

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…
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…
Established in 1997, Technology Architects has become one of the most reputable technology solutions companies in the country. TA have been providing businesses with cost effective state-of-the-art solutions and unparalleled service that is designed…
I've attached the XLSM Excel spreadsheet I used in the video and also text files containing the macros used below. https://filedb.experts-exchange.com/incoming/2017/03_w12/1151775/Permutations.txt https://filedb.experts-exchange.com/incoming/201…

820 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