Draw text on image in vb.net

pamsauto
pamsauto used Ask the Experts™
on
I have the following function to draw text on an image.  Code works great, but the issue I am having is that the code is enlarging the size of the image quite a bit.  Prior to hitting this function I am encoding the image with compression and getting a file size of around 75K.  Once it hits this function, the file grows for 700K.   If I recompress the image the text gets really hard to read.  

How can I just write the text on the image without resampling the image to a better quality?

Public Shared Function TextOnImage(ByVal imgPhoto As Image, ByVal _maxfont As Integer, ByVal _toptext As String, ByVal _BottomText As String, ByVal ShadowText As Boolean) As Image

        'create a image object containing the photograph to watermark
        Dim phWidth As Integer = imgPhoto.Width
        Dim phHeight As Integer = imgPhoto.Height

        'create a Bitmap the Size of the original photograph
        Dim bmPhoto As Bitmap = New Bitmap(phWidth, phHeight, PixelFormat.Format24bppRgb)
        bmPhoto.SetResolution(imgPhoto.HorizontalResolution, imgPhoto.VerticalResolution)

        'load the Bitmap into a Graphics object 
        Dim grPhoto As Graphics = Graphics.FromImage(bmPhoto)

        '------------------------------------------------------------
        'Step #1 - Insert Bottom Message
        '------------------------------------------------------------

        'Set the rendering quality for this Graphics object
        grPhoto.SmoothingMode = SmoothingMode.AntiAlias

        'Draws the photo Image object at original size to the graphics object.
        grPhoto.DrawImage(imgPhoto, New Rectangle(0, 0, phWidth, phHeight), 0, 0, phWidth, phHeight, GraphicsUnit.Pixel)

        '-------------------------------------------------------
        'to maximize the size of the bottom message we will 
        'test multiple Font sizes to determine the largest posible 
        'font we can use for the width of the Photograph
        'define an array of point sizes you would like to consider as possiblities
        '-------------------------------------------------------
        Dim sizes As Integer() = New Integer() {40, 38, 34, 32, 30, 28, 26, 24, 22, 20, 18, 16, 14, 12, 10, 8, 6, 4}
        Dim crFont As Font = Nothing
        Dim crSize As SizeF = New SizeF

        'Loop through the defined sizes checking the length of the Copyright string
        'If its length in pixles is less then the image width choose this Font size.
        Dim i As Integer = 0
        While i < 18
            If sizes(i) <= _maxfont Then
                'set a Font object to Arial (i)pt, Bold
                crFont = New Font("arial", sizes(i), FontStyle.Bold)

                'Measure the text string in this Font
                crSize = grPhoto.MeasureString(_BottomText, crFont)
                If crSize.Width < phWidth Then
                    Exit While
                End If
            End If
            System.Math.Min(System.Threading.Interlocked.Increment(i), i - 1)

        End While


        'Since all photographs will have varying heights, determine a 
        'position 5% from the bottom of the image
        Dim yPixlesFromBottom As Integer = CType((phHeight * 0.02), Integer)

        'Now that we have a point size use the text string height 
        'to determine a y-coordinate to draw the string of the photograph
        Dim yPosFromBottom As Single = ((phHeight - yPixlesFromBottom) - (crSize.Height))

        'Determine its x-coordinate by calculating the center of the width of the image
        Dim xCenterOfImg As Single = (phWidth / 2)

        'Define the text layout by setting the text alignment to centered
        Dim StrFormat As StringFormat = New StringFormat
        StrFormat.Alignment = StringAlignment.Center

        'define a Brush which is semi trasparent black (Alpha set to 153)
        Dim semiTransBrush2 As SolidBrush = New SolidBrush(Color.FromArgb(200, 255, 255, 255))

        'Draw the text string for shadow effect
        If ShadowText Then
            grPhoto.DrawString(_BottomText, crFont, semiTransBrush2, New PointF(xCenterOfImg + 1, yPosFromBottom + 1), StrFormat)
        End If
        
        'define a Brush which is semi trasparent black (Alpha set to 153)
        Dim semiTransBrush As SolidBrush = New SolidBrush(Color.FromArgb(200, 255, 0, 0))

        'Make sure to move this text 1 pixel to the right and down 1 pixel
        grPhoto.DrawString(_BottomText, crFont, semiTransBrush, New PointF(xCenterOfImg, yPosFromBottom), StrFormat)

        '------------------------------------------------------------
        'Step #2 - Insert Top Message
        '------------------------------------------------------------



        'Loop through the defined sizes checking the length of the Copyright string
        'If its length in pixles is less then the image width choose this Font size.
        i = 0
        While i < 18
            If sizes(i) <= _maxfont Then
                'set a Font object to Arial (i)pt, Bold
                crFont = New Font("arial", sizes(i), FontStyle.Bold)

                'Measure the text string in this Font
                crSize = grPhoto.MeasureString(_toptext, crFont)
                If crSize.Width < phWidth Then
                    Exit While
                End If
            End If
            System.Math.Min(System.Threading.Interlocked.Increment(i), i - 1)

        End While


        'Since all photographs will have varying heights, determine a 
        'position 5% from the bottom of the image
        Dim yPixlesFromTop As Integer = CType((phHeight * 0.02), Integer)

        'Now that we have a point size use the text string height 
        'to determine a y-coordinate to draw the string of the photograph
        Dim yPosFromTop As Single = (yPixlesFromTop)



        'Draw the text string for shadow effect
        If ShadowText Then
            grPhoto.DrawString(_toptext, crFont, semiTransBrush2, New PointF(xCenterOfImg + 1, yPosFromTop + 1), StrFormat)
        End If
       
        'Draw the Copyright string a second time to create a shadow effect
        'Make sure to move this text 1 pixel to the right and down 1 pixel
        grPhoto.DrawString(_toptext, crFont, semiTransBrush, New PointF(xCenterOfImg, yPosFromTop), StrFormat)

        Return bmPhoto
    End Function

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Most Valuable Expert 2012
Top Expert 2014

Commented:
What happens if you comment out

grPhoto.SmoothingMode = SmoothingMode.AntiAlias

Author

Commented:
It made a couple of Kb difference, but not more then 2-3%.

Commented:
This may cost you a signup but it could be well worth it
http://www.techrepublic.com/article/watermark-your-images-with-this-vbnet-code/6131225

Author

Commented:
Good code, but it has the same issue.  It works with Bitmaps.   I think I need something that is working native with Jpegs.

Commented:
Did it give you the same result?
Mohamed AbowardaSenior Software Engineer

Commented:

Author

Commented:
All of the above code works with Bitmaps, which when converted to a jpeg get blurred.  Any other ideas?

Commented:
Thank you. Do you mind posting the update.

Author

Commented:
Lots of changes, but it works directly with the image in its native form.  You still loose some sharpness but it is as good as it gets.

 ''' <summary>
    ''' Draw Text on the Top and/or Bottom of an image at the maximum size possible or the set limit.
    ''' </summary>
    ''' <param name="imgPhoto">Image to modify</param>
    ''' <param name="_maxfont">The max size the font can be</param>
    ''' <param name="_toptextLine1">Text to draw on the top line 1</param>
    ''' <param name="_toptextLine2">Text to draw on the top line 1</param>
    ''' <param name="_BottomText">Text to draw on the bottom </param>
    ''' <param name="_BottomText2">Text to draw on 2nd line from the bottom </param>
    ''' <param name="ShadowText">If True, text will be shadowed</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function TextOnImage(ByVal imgPhoto As Image, ByVal _maxfont As Integer, ByVal _toptextLine1 As String, ByVal _toptextLine2 As String, ByVal _BottomText As String, ByVal _BottomText2 As String, ByVal ShadowText As Boolean) As Image

        'create a image object containing the photograph to watermark
        Dim phWidth As Integer = imgPhoto.Width
        Dim phHeight As Integer = imgPhoto.Height

       
        'load the Bitmap into a Graphics object 
        Dim grPhoto As Graphics = Graphics.FromImage(imgPhoto)


        '------------------------------------------------------------
        'Step #1 - Insert Bottom Message
        '------------------------------------------------------------

        'Set the rendering quality for this Graphics object
        grPhoto.SmoothingMode = SmoothingMode.None

        'Draws the photo Image object at original size to the graphics object.
        grPhoto.DrawImage(imgPhoto, New Rectangle(0, 0, phWidth, phHeight), 0, 0, phWidth, phHeight, GraphicsUnit.Pixel)

        '-------------------------------------------------------
        'to maximize the size of the bottom message we will 
        'test multiple Font sizes to determine the largest posible 
        'font we can use for the width of the Photograph
        'define an array of point sizes you would like to consider as possiblities
        '-------------------------------------------------------
        Dim sizes As Integer() = New Integer() {40, 38, 34, 32, 30, 28, 26, 24, 22, 20, 18, 16, 14, 12, 10, 8, 6, 4}
        Dim crFont As Font = Nothing
        Dim crSize As SizeF = New SizeF
        Dim crSizeLine2 As SizeF = New SizeF

        'Loop through the defined sizes checking the length of the Copyright string
        'If its length in pixles is less then the image width choose this Font size.
        Dim i As Integer = 0
        While i < 18
            If sizes(i) <= _maxfont Then
                'set a Font object to Arial (i)pt, Bold
                crFont = New Font("arial", sizes(i), FontStyle.Bold)

                'Measure the text string in this Font
                crSize = grPhoto.MeasureString(_BottomText, crFont)
                crSizeLine2 = grPhoto.MeasureString(_BottomText2, crFont)
                If crSize.Width < phWidth And crSizeLine2.Width < phWidth Then
                    Exit While
                End If
            End If
            System.Math.Min(System.Threading.Interlocked.Increment(i), i - 1)

        End While


        'Since all photographs will have varying heights, determine a 
        'position 5% from the bottom of the image
        Dim yPixlesFromBottom As Integer = CType((phHeight * 0.02), Integer)

        'Now that we have a point size use the text string height 
        'to determine a y-coordinate to draw the string of the photograph
        Dim yPosFromBottom As Single = ((phHeight - yPixlesFromBottom) - (crSize.Height))

        'Determine its x-coordinate by calculating the center of the width of the image
        Dim xCenterOfImg As Single = (phWidth / 2)

        'Define the text layout by setting the text alignment to centered
        Dim StrFormat As StringFormat = New StringFormat
        StrFormat.Alignment = StringAlignment.Center

        'define a Brush which is semi trasparent black (Alpha set to 153)
        Dim semiTransBrush2 As SolidBrush = New SolidBrush(Color.FromArgb(200, 255, 255, 255))

        'Draw the text string for shadow effect
        If ShadowText Then
            grPhoto.DrawString(_BottomText, crFont, semiTransBrush2, New PointF(xCenterOfImg + 1, yPosFromBottom + 1), StrFormat)
        End If


        ' Dim semiTransBrush As SolidBrush = New SolidBrush(Color.FromArgb(200, 255, 0, 0))
        Dim semiTransBrush As SolidBrush = New SolidBrush(Color.DarkRed)

        'Make sure to move this text 1 pixel to the right and down 1 pixel
        grPhoto.DrawString(_BottomText, crFont, semiTransBrush, New PointF(xCenterOfImg, yPosFromBottom), StrFormat)

        'Draw the text string for shadow effect
        If ShadowText Then
            grPhoto.DrawString(_BottomText2, crFont, semiTransBrush2, New PointF(xCenterOfImg + 1, yPosFromBottom - (crFont.GetHeight + 6)), StrFormat)
        End If

        'Make sure to move this text 1 pixel to the right and down 1 pixel
        grPhoto.DrawString(_BottomText2, crFont, semiTransBrush, New PointF(xCenterOfImg, yPosFromBottom - (crFont.GetHeight + 5)), StrFormat)

        '------------------------------------------------------------
        'Step #2 - Insert Top Message
        '------------------------------------------------------------



        'Loop through the defined sizes checking the length of the Copyright string
        'If its length in pixles is less then the image width choose this Font size.
        i = 0

        While i < 18
            If sizes(i) <= _maxfont Then
                'set a Font object to Arial (i)pt, Bold
                crFont = New Font("arial", sizes(i), FontStyle.Bold)

                'Measure the text string in this Font
                crSize = grPhoto.MeasureString(_toptextLine1, crFont)
                crSizeLine2 = grPhoto.MeasureString(_toptextLine2, crFont)
                If crSize.Width < phWidth And crSizeLine2.Width < phWidth Then
                    Exit While
                End If
            End If
            System.Math.Min(System.Threading.Interlocked.Increment(i), i - 1)

        End While


        'Since all photographs will have varying heights, determine a 
        'position 5% from the bottom of the image
        Dim yPixlesFromTop As Integer = CType((phHeight * 0.02), Integer)

        'Now that we have a point size use the text string height 
        'to determine a y-coordinate to draw the string of the photograph
        Dim yPosFromTop As Single = (yPixlesFromTop)



        'Draw the text string for shadow effect
        If ShadowText Then
            grPhoto.DrawString(_toptextLine1, crFont, semiTransBrush2, New PointF(xCenterOfImg + 1, yPosFromTop + 1), StrFormat)
        End If

        'Draw the Copyright string a second time to create a shadow effect
        'Make sure to move this text 1 pixel to the right and down 1 pixel
        grPhoto.DrawString(_toptextLine1, crFont, semiTransBrush, New PointF(xCenterOfImg, yPosFromTop), StrFormat)

        'Draw the text string for shadow effect
        If ShadowText Then
            grPhoto.DrawString(_toptextLine2, crFont, semiTransBrush2, New PointF(xCenterOfImg + 1, yPosFromTop + 1 + crFont.GetHeight + 5), StrFormat)
        End If

        'Draw the Copyright string a second time to create a shadow effect
        'Make sure to move this text 1 pixel to the right and down 1 pixel
        grPhoto.DrawString(_toptextLine2, crFont, semiTransBrush, New PointF(xCenterOfImg, yPosFromTop + crFont.GetHeight + 5), StrFormat)


        Return imgPhoto
    End Function

Open in new window

Commented:
I did a method to resize image and these are the settings I used

                    Imports System.Drawing.Drawing2D

                    Using newGraphic As Graphics = Graphics.FromImage(IMG)
                        With newGraphic
                            .CompositingQuality = CompositingQuality.HighQuality
                            .InterpolationMode = InterpolationMode.HighQualityBicubic
                            .SmoothingMode = SmoothingMode.HighQuality
                            .PixelOffsetMode = PixelOffsetMode.HighQuality
                            .DrawImage(outImage, 0, 0, size.Width, size.Height)
                        End With

                        IMG.Save(ms, Imaging.ImageFormat.Jpeg)
                    End Using

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial