CODEWITHSUNDEEP
vb.netimagegraphicsfonts
Matthew Kelly
Matthew Kelly

Reputation: 33

Appending text to an image using vb.net. Errors with font size calculation

I am trying to write a small application to append specified text to the bottom of an image. This text cannot be added on top of the original image, and must be placed in addition to the original image frame-size.

This works fine in most cases, but when I tested using a different camera the script produced the same result, but because the image resolution was far better; the font was so small to be unredable.

I added some coding to calculate the required font size, but this seems to work fine for the smaller resolution images, but produces a font far too large for the better quality images.

I suspect this may be due to my code to calculate the font size, the fact that the save command changes the compression status of the original or something else I've not considered.

Some guidance would be much apprecite...

Dim objImage As Bitmap
Dim objNewImage As Bitmap
Dim objGraphics As Graphics
Dim objFont As Font
Dim szTextSize As Size
Dim intPictureHeightToAdd As Integer
Dim emFontSize As Single

' load image passed as full path string, return 1 if failure
objImage = Bitmap.FromFile(v_strFullFileName, True)

' height to add will be 5%
intPictureHeightToAdd = (objImage.Height * 5) / 100
' create a new image with the same dimensions plus space for text and same pixel format
objNewImage = New Bitmap(objImage.Width, objImage.Height + intPictureHeightToAdd, objImage.PixelFormat)
' set the resolution to the same as existing
objNewImage.SetResolution(objImage.HorizontalResolution, objImage.VerticalResolution)

 ' create a graphic object for image manipultion
 objGraphics = objGraphics.FromImage(objNewImage)
 ' place existing image into graphic top left. This will leave space at bottom for text
 objGraphics.DrawImage(objImage, 0, 0)

 ' add meta data to intended new image from existing
 For Each propItem In objImage.PropertyItems
     objNewImage.SetPropertyItem(propItem)
 Next propItem

 ' create the font and measure this, comparing to height of image. (if image is to large, and font too small; it will be unredable)
 emFontSize = 10.0F
 Do
     emFontSize += 1
     objFont = New Font("Courier", emFontSize)
     szTextSize = TextRenderer.MeasureText(m_strTextToAppend, objFont)
 Loop Until szTextSize.Height >= intPictureHeightToAdd
 emFontSize -= 10
 objFont = New Font("Courier", emFontSize)

 ' draw a rectangle with text in space remaining (set text to red as most likely to stand out in background
 objGraphics.DrawString(m_strTextToAppend, objFont, Brushes.Red, New RectangleF(0, objImage.Height, objImage.Width, intPictureHeightToAdd))

objImage.Dispose()
' save font added

objNewImage.Save(v_strFullFileName, Imaging.ImageFormat.Jpeg)

'dispose of new image as now saved and graphics object
objNewImage.Dispose()
objGraphics.Dispose()

Upvotes: 0

Views: 340

Answers (1)

the_lotus
the_lotus

Reputation: 12748

I think it has to do with DPI, TextRenderer does not know which DPI your image is using. Try MeasureString.

In this sample, TextRenderer returns the same height for different DPI while MeasureString returns the proper height.

Sub Main()

    Dim toDraw As String = "A"
    Dim image As Bitmap
    Dim g As Graphics
    Dim f As Font

    image = New Bitmap(100, 100)
    g = Graphics.FromImage(image)
    f = New Font("Arial", 16)

    Console.WriteLine(TextRenderer.MeasureText(toDraw, f)) ' height = 25
    Console.WriteLine(g.MeasureString(toDraw, f)) ' height = 26.5

    g.DrawString(toDraw, f, Brushes.Black, New PointF(0, 0))
    image.Save("C:\a.jpg") ' Image with small A

    image = New Bitmap(100, 100)
    image.SetResolution(300, 300)
    g = Graphics.FromImage(image)
    f = New Font("Arial", 16)

    Console.WriteLine(TextRenderer.MeasureText(toDraw, f)) ' height = 25
    Console.WriteLine(g.MeasureString(toDraw, f)) ' height = 82.8

    g.DrawString(toDraw, f, Brushes.Black, New PointF(0, 0))
    image.Save("C:\b.jpg") ' Image with big A

    Console.ReadLine()

End Sub

Upvotes: 1

Related Questions