VB.NET GDI Blurred Text problem



I'm new in GDI programming and I am facing the following problem.
I try to dynamically create "thumbnail"-like images (JPEG) in which I
need to draw text.
This works fine, except that the text is always a little bit
Here is the code, could someone give me some help?
Thanks in advance,

Public Shared Function AppropriateFont(ByVal g As Graphics, ByVal
minFontSize As Single, ByVal maxFontSize As Single, ByVal layoutSize
As Size, ByVal s As String, ByVal f As Font, ByRef extent As SizeF) As
If maxFontSize = minFontSize Then
f = New Font(f.FontFamily, minFontSize, f.Style)
End If
extent = g.MeasureString(s, f)
If maxFontSize <= minFontSize Then
Return f
End If
Dim hRatio As Single = layoutSize.Height / extent.Height
Dim wRatio As Single = layoutSize.Width / extent.Width
Dim ratio As Single = Microsoft.VisualBasic.IIf((hRatio <
Dim newSize As Single = f.Size * ratio
If newSize < minFontSize Then
newSize = minFontSize
If newSize > maxFontSize Then
newSize = maxFontSize
End If
End If
f = New Font(f.FontFamily, newSize, f.Style)
extent = g.MeasureString(s, f)
Return f
End Function

Public Sub Generate(ByVal vstrText As String, ByVal vnMaxWidth As
Integer, ByVal vnMaxHeight As Integer)

' Image Container
Dim bmBitmap As Bitmap = New Bitmap(100, 150,
Dim grGraphic As Graphics = Graphics.FromImage(bmBitmap)

' random values for the colors
Dim rndNumber As Random = New
Dim r, g, b As Integer
r = rndNumber.Next(0, 200)
g = rndNumber.Next(0, 200)
b = rndNumber.Next(0, 200)

' Background
Dim myBrush As New SolidBrush(Color.FromArgb(r, g, b))
' Dim myBrush as new SolidBrush(Color.White)
grGraphic.FillRectangle(myBrush, 0, 0, 100, 150)

' Rendering quality
grGraphic.SmoothingMode = SmoothingMode.HighQuality
grGraphic.InterpolationMode = InterpolationMode.HighQualityBilinear
grGraphic.TextRenderingHint =

' Font
Dim myFont As Font = New Font("Times New Roman", 25,
FontStyle.Bold) 'FontStyle.Regular

' text color
' Dim myPen As New SolidBrush(Color.FromArgb(r, g, b))
Dim myPen As New SolidBrush(Color.white)

' location target
Dim initSize As SizeF = new SizeF(vnMaxWidth, vnMaxHeight)
Dim newSize As SizeF

Dim f2 As Font = AppropriateFont(grGraphic, 5, 50,
initSize.ToSize(), vstrText, myFont, newSize)

Dim p As PointF = New PointF((100 - newSize.Width) / 2, 15 +
(vnMaxHeight - newSize.Height) / 2)
grGraphic.DrawString(vstrText, f2, myPen, p)
CType(f2, IDisposable).Dispose()
End Try

'Release Brush

'Release Initial Font
CType(myFont, IDisposable).Dispose()

' Affichage de l'image sur la page
bmBitmap.Save("d:\trash\thumbnail.jpg", ImageFormat.Jpeg)

'Dispose Font

'Dispose bitmap

'Dispose graphical interface
End Sub


Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question