Question

我正在尝试编写一个小应用程序，将指定的文本追加到图像的底部。此文本无法添加到原始图像的顶部，除了原始图像的帧大小外，还必须放置。

这在大多数情况下都可以正常工作，但是当我使用不同的相机测试时，脚本会产生相同的结果，但因为图像分辨率要好得多;字体很小，不可靠。

我添加了一些编码来计算所需的字体大小，但这似乎适用于较小分辨率的图像，但产生的字体对于质量更好的图像来说太大了。

我怀疑这可能是由于我的代码计算字体大小，保存命令会改变原始压缩状态或我未考虑过的其他内容。

有些指导会非常赞赏......

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()

Answer 1

我认为它与DPI有关，TextRenderer不知道你的图像使用的是哪个DPI。尝试MeasureString。

在此示例中，TextRenderer为不同的DPI返回相同的高度，而MeasureString返回正确的高度。

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

使用vb.net将文本附加到图像。字体大小计算错误

1 个答案: