Mega Code Archive
Draw Font Metrics
<![CDATA[
Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.Windows.Forms
Imports System.Math
public class DrawStringMetrics
public Shared Sub Main
Application.Run(New Form1)
End Sub
End class
public class Form1
Inherits System.Windows.Forms.Form
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
Dim txt As String = "www.rntsoft.com"
Dim layout_rect As New RectangleF(0, 0, Me.ClientSize.Width , Me.ClientSize.Height)
Dim string_format As New StringFormat
string_format.LineAlignment = StringAlignment.Center
string_format.Alignment = StringAlignment.Center
Dim the_font As Font
e.Graphics.TextRenderingHint = System.Drawing.Text.TextRenderingHint.AntiAliasGridFit
the_font = New Font("Times New Roman", 80, FontStyle.Bold, GraphicsUnit.Pixel)
MeasureCharacters(e.Graphics, the_font, txt, layout_rect, string_format)
End Sub
Public Sub MeasureCharacters(ByVal gr As Graphics, ByVal the_font As Font, ByVal txt As String, ByVal layout_rect As RectangleF, ByVal string_format As StringFormat)
Dim character_ranges(txt.Length - 1) As CharacterRange
For i As Integer = 0 To txt.Length - 1
character_ranges(i) = New CharacterRange(i, 1)
Next i
string_format.SetMeasurableCharacterRanges(character_ranges)
Dim character_regions() As Region = gr.MeasureCharacterRanges(txt, the_font, layout_rect, string_format)
Dim em_height As Integer = the_font.FontFamily.GetEmHeight(FontStyle.Bold)
Dim em_height_pix As Single = the_font.Size
Dim design_to_pixels As Single = the_font.Size / em_height
Dim ascent As Integer = the_font.FontFamily.GetCellAscent(FontStyle.Bold)
Dim ascent_pix As Single = ascent * design_to_pixels
Dim descent As Integer = the_font.FontFamily.GetCellDescent(FontStyle.Bold)
Dim descent_pix As Single = descent * design_to_pixels
Dim cell_height_pix As Single = ascent_pix + descent_pix
Dim internal_leading_pix As Single = cell_height_pix - em_height_pix
Dim line_spacing As Integer = the_font.FontFamily.GetLineSpacing(FontStyle.Bold)
Dim line_spacing_pix As Single = line_spacing * design_to_pixels
Dim external_leading_pix As Single = line_spacing_pix - cell_height_pix
For Each rgn As Region In character_regions
Dim character_bounds As RectangleF = rgn.GetBounds(gr)
Dim character_rect As Rectangle = Rectangle.Round(character_bounds)
gr.DrawRectangle(Pens.Black, character_rect)
gr.DrawLine(Pens.White, character_rect.X, character_rect.Y + internal_leading_pix, character_rect.Right, character_rect.Y + internal_leading_pix)
gr.DrawLine(Pens.Yellow, character_rect.X, character_rect.Y + ascent_pix, character_rect.Right, character_rect.Y + ascent_pix)
gr.DrawLine(Pens.Orange, character_rect.X, character_rect.Y + ascent_pix + descent_pix, character_rect.Right, character_rect.Y + ascent_pix + descent_pix)
gr.FillRectangle(Brushes.Red, character_rect.X, character_rect.Y + ascent_pix + descent_pix, character_rect.Width, external_leading_pix)
Next rgn
gr.DrawString(txt, the_font, Brushes.Black, layout_rect, string_format)
End Sub
Public Sub New()
MyBase.New()
Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
Me.ClientSize = New System.Drawing.Size(292, 273)
Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterScreen
End Sub
End Class
]]>