Font is showing up too small or large when using .DrawString - vb.net

Question

I need to add a half inch of white space at the bottom of an image and the draw a string to the bottom left and bottom right (within the newly added white space). Everything seems to work fine but the font sometime appears way too small or too large.
I think I need to somehow scale the drawstring font to the size of the image? I have exhausted myself trying to figure this out... Please help!!
See code below ----
Imports System.IO
Imports System.Drawing.Graphics
Imports System.Drawing
Imports System.Drawing.Bitmap
Imports System.Drawing.Imaging
Public Class Form1
Dim ofilepath As String = "C:\temp\20141022\TEST0000001.tif"
Dim nfilepath As String = "C:\temp\20141022\new.tif"
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Dim newbm As New Bitmap(AddBorderAndStamp(Bitmap.FromFile(ofilepath), Color.White, 50, Path.GetFileNameWithoutExtension(ofilepath), "CONFIDENTIAL"))
newbm.Save(nfilepath, Imaging.ImageFormat.Tiff)
Me.Close()
End Sub
Public Function AddBorderAndStamp(ByVal bm As Bitmap, ByVal borderColor As System.Drawing.Color, ByVal borderWidthInPixels As Integer, ByVal bates As String, ByVal designation As String) As Bitmap
Dim voffset As Integer = 75
Dim hoffset As Integer = 15
Dim newBitmap As New Bitmap(bm.Width, bm.Height + (borderWidthInPixels * 2))
Dim mfont As Font = New Font("Arial", 32, FontStyle.Bold)
For x As Integer = 0 To newBitmap.Width - 1
For y As Integer = newBitmap.Height - 1 To (newBitmap.Height - 1) - borderWidthInPixels Step -1
newBitmap.SetPixel(x, y, borderColor)
Next
Next
Dim gr As System.Drawing.Graphics = Graphics.FromImage(newBitmap)
gr.Clear(Color.White)
gr.DrawImage(bm, 0, 0, bm.Width, bm.Height)
Dim textSize As SizeF = gr.MeasureString(bates, mfont)
gr.DrawString(bates, mfont, Brushes.Black, bm.Width - textSize.Width - hoffset, newBitmap.Height - voffset)
gr.DrawString(designation, mfont, Brushes.Black, hoffset, newBitmap.Height - voffset)
gr.Dispose()
Return newBitmap
End Function
End Class

Answer 1

When you're about to know the size (width) of your bates string at this line :
Dim textSize As SizeF = gr.MeasureString(bates, mfont)
and before drawing your string on the bitmap, you'll have to compute the scaling to perform on your font size to make sure your text gets shrinked (if too long) or stretched (if too narrow) while not excessively stretched in height-mean to be drawn over the image.
Then, only when you have a valid font size, you draw your text as you do with the following lines
gr.DrawString(bates, mfont, Brushes.Black, bm.Width - textSize.Width - hoffset, newBitmap.Height - voffset)
gr.DrawString(designation, mfont, Brushes.Black, hoffset, newBitmap.Height - voffset)
To know what's the correct font size to use, have a look on this SO Question Page.
I know it's C#, but this is basically what you'll have to do before drawing your bates and designation text. The difference lies in two points :
you have two String to scale in a clip rectangle (bates and designation) instead of one.
you have to take account of a (default) separation between designation on the left, and bates on the right.
But these two points can be easily worked around. This also means that your question could be a duplicate (StackOverflow doesn't recommend multiple variants of the same question as the purpose of SO is to bring you directly to a page asking a question AND its answer - if answered - but not to flood you with dozens copies of the same subject)
But IMHO, the two-string (designation and bates) is enough to consider this as a new question, because the code handling that is not covered by the other topics.
Here is saeed's function converted to vb.Net
Private Function FindFont( _
ByRef rg As Graphics, _
ByVal testString as String, _
ByVal clipRoom As Size, _
ByVal preferedFont As Font) As Font
' You should perform some scale functions...
Dim realSize As SizeF = rg.MeasureString(testString, PreferedFont)
Dim heightScaleRatio As Double = clipRoom.Height / realSize.Height
Dim widthScaleRatio As Double = clipRoom.Width / realSize.Width
Dim scaleRatio As Double
Dim newFontSize As Single ' I'm used to declare everything on top.
If heightScaleRatio < widthScaleRatio Then
scaleRatio = heightScaleRatio
Else
scaleRatio = widthScaleRatio
End If
newFontSize = CSng(preferedFont.Size * ScaleRatio)
Return New Font(preferedFont.FontFamily, newFontSize, preferedFont.Style)
End Function
Credits goes to saeed first for providing the code, but if saeed used code from someone else that I'm not aware of, credits to original author supersede saeed's.
The required parameters for that Function to work are :
rg As Graphics. You already have it, namely rg in your AddBorderAndStamp Function.
testString As String. You also have it, it is simply testString = designation + bates
clipRoom As Size. You don't have that variable yet. You'll have to declare it in your AddBorderAndStamp Function, and use some logic to define its .Width and .Height values.
and preferedFont As Font. You also have that already, which is mfont As Font = New Font("Arial", 32, FontStyle.Bold)
The declarations to add to your AddBorderAndStamp Function are :
Dim clipRoom As Size ' Declare it.
Dim stampSeparation As Integer = 80 ' why 80 ? dunno ! it's an arbitrary value..
stampSeparation is an arbitraty variable that represents the Width IN
PIXELs between designation and bates. Basically, it looks like this :
'< - - - - - - - total Bitmap width - - - - - - - >
'| |designation|_____________|bates| |
'| | | | | ^ Right Image boder
'| | | | ^ Right margin
'| | | ^ Left plot of your bates String
'| | <-------------> Length or Width of stampSeparation
'| ^ Left plot of your designation String
'^ Left image border
Your available room to write text is the sum of
designation.Width
bates.Width
stampSeparation
But because you want designation and bates beeing separated by stampSeparation, stampSeparation must be substracted from the available clip width. So :
clipRoom.Width = newBitmap.Width - (hOffset * 2) - stampSeparation
' newBitmap.Width - 30 - 80
' newBitmap.Width - 110
' CAREFULL !!! clipRoom.Width MUST be positive !!!
' Check your bm is wide enough, say at least 200 pixels Width...
The room you have at the bottom is a sightly different story : Your AddBorderAndStamp Function has one borderWidthInPixels (as Integer) parameter that define the room you add in top/bottom mean. Then you use voffset (as Integer) variable to shift your stamp upward.. That means your available room in terms of heigth at the bottom of your image to plot text in is :
clipRoom.Height = vOffset ' ?
' 75 ?
' (CAREFULL !!! clipRoom.Height MUST be positive !!!)
If I were you, I would dynamically define clipRoom.Height based on a fraction of AddBorderAndStamp and dynamically calculate vOffset after knowing the final heigth of designation and bates heights using MeasureString... But that would be an overkill...
' perhaps one simple logic like the following would suffice
' clipRoom.Height = CInt(vOffset * 4 / 5)
Now you have clipRoom and everything else required to call FindFont(...) Function.
So :
Public Function AddBorderAndStamp(...) As Bitmap
' Dim vOffset ' ...
' Dim hOffset ' ...
' ...
' add the following declarations :
Dim clipRoom As Size
Dim stampSeparation As Integer = 80 ' or 60 as you like but small enough
' ...
' ... your function block code goes here until the following line :
gr.DrawImage(bm, 0, 0, bm.Width, bm.Height)
' Calculate the available clip room...
clipRoom.Width = newBitmap.Width - (hOffset * 2) - stampSeparation
clipRoom.Height = vOffset
' ^^ remember : the logic to handle valid Width and Height is up to you
' I know how to handle that, but you should aswell, or try at least.
' Now, update the size of your font...
mFont = FindFont(rg, designation + bates, clipRoom, mFont)
' then continue with the rest of the code...
Dim textSize As SizeF = gr.MeasureString(bates, mfont)
gr.DrawString(bates, mfont, Brushes.Black, bm.Width - textSize.Width - hoffset, newBitmap.Height - voffset)
gr.DrawString(designation, mfont, Brushes.Black, hoffset, newBitmap.Height - voffset)
gr.Dispose()
Return newBitmap
End Function
by the way :
Hello. You should add [vb.Net] tag to the post and either remove
[image] or [bitmap] since those are synonyms.
It's hard to spot code typos without the formatting. But since you're new on StackOverflow (SO) I don't want to downvote or flag you, but I insist : update the tags of your question.
Remark 1 :
You wrote :
For x As Integer = 0 To newBitmap.Width - 1
For y As Integer = newBitmap.Height - 1 To (newBitmap.Height - 1) - borderWidthInPixels Step -1
newBitmap.SetPixel(x, y, borderColor)
Next
Next
Dim gr As System.Drawing.Graphics = Graphics.FromImage(newBitmap)
gr.Clear(Color.White)
You're changing the color of newBitmap pixel by pixel from the bottom. I'm OK with that but there are better ways to achieve that.
However, you're declaring a Graphics to handle drawings on newBitmap, then you call gr.Clear(Color.White) ???
Isn't that supposed to entirely paint your newBitmap with white, thus, destroing the purpose of your SetPixel loop just above ?
I don't understand. Perhaps you want the function to waste time, so just use
System.Threading.Thread.Sleep(X) ' where X is an Integer variable in miliseconds
Otherwise, I would recommend you to get rid of the SetPixel and its encosing For loops, and just fill a Rectangle using your gr Graphics :
' ...
Dim gr As System.Drawing.Graphics = Graphics.FromImage(newBitmap)
gr.Clear(Color.White)
gr.FillRectangle( _
New SolidBrush(borderColor), _
0, newBitmap.Height - borderWidthInPixels, _
newBitmap.Width, borderWidthInPixels)
gr.DrawImage(bm, 0, 0, bm.Width, bm.Height)
' ...
Remark 2 :
' you've set newBitmap to have
' bm.Heigth expanded by two times the value of borderWidthInPixels
Dim newBitmap As New Bitmap(bm.Width, bm.Height + (borderWidthInPixels * 2))
' ...
' Then you plot bm at the very top of newBitmap
gr.DrawImage(bm, 0, 0, bm.Width, bm.Height)
' that means you have a blank space at the bottom
' that height twice the value of borderWidthInPixels
' ...
' But you plot bates and designation
' at a fixed vOffset from the bottom of newBitmap
gr.DrawString(bates, , , , newBitmap.Height - voffset)
gr.DrawString(designation, , , , newBitmap.Height - voffset)
The relation between borderWidthInPixels and voffset remains unclear to me, that may mislead the formulation of clipRoom.Height above.
However, I think I've given enough material to get you where you want, and even if the clipRoom.Height formulation above is wrong, it would be very easy to fix it.
You also have to understand that I used saeed approach by default, but by reading the post I linked, you'll find other approaches, iteratives ones, which I don't like much because they are iterations CPU heavy without always beeing more precise. You can even find hints about TextToBitmap; have a try if more suitable for you, but it's more complex too.. For what you're doing, I think one or two pixels displaced outputs is not a problem.
For the vertical placement, you said ".. but the font sometime appears way too small or too large.." That's not precise enough to get a full picture of the issue. You should have posted two images samples of the "too small" case and the "too large" case. Since you didn't change Font Size in your code, I assumed the too small problem was a too large space between designation and bates, and the too large is overlapping text. There is not a single reference to a possible vertical laying out issue, so my answer doesn't elaborate on that side. That's why I don't introduce multiline logic here, which would stand for another question (if none available on SO)