title: I want to change text font using font dialog in vb.net
body: <p>Here is my code and I am able to add the text by defining some font properties but I want to add this using Font dialog.Can anyone help me regarding this issue.</p>
  
  <pre><code>Public Class Form1
  Dim pic_font As New Font("Arial Black", 40, FontStyle.Regular, GraphicsUnit.Pixel)
  Dim bm As Bitmap = New Bitmap(100, 100)
  Dim strText As String = "Diver Dude"
  Dim szText As New SizeF
  Dim ptText As New Point(125, 125)
  Dim ptsText() As PointF
  Dim MovingOffset As PointF
  Dim ptsTextPen As Pen = New Pen(Color.LightSteelBlue, 1)
  Dim MouseMoving As Boolean
  Dim MouseOver As Boolean
  
  Public Sub New()
      MyBase.New()
  
      'This call is required by the Windows Form Designer.
      InitializeComponent()
      'Add any initialization after the InitializeComponent() call
      Me.SetStyle(ControlStyles.AllPaintingInWmPaint, True)
      Me.SetStyle(ControlStyles.DoubleBuffer, True)
  End Sub
  
  Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
      PictureBox1.Hide()
      bm = Image.FromFile(Application.StartupPath &amp; "\DivePic.bmp")
      szText = Me.CreateGraphics.MeasureString(strText, pic_font)
      SetptsText()
      ptsTextPen.DashStyle = DashStyle.Dot
  End Sub
  
  Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
  
      'Check if the pointer is over the Text
      If IsMouseOverText(e.X - 10, e.Y - 10) Then
          MouseMoving = True
          'Determine the upper left corner point from where the mouse was clicked
          MovingOffset.X = e.X - ptText.X
          MovingOffset.Y = e.Y - ptText.Y
      Else
          MouseMoving = False
      End If
  
  End Sub
  
  Private Sub Form1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove
  
      'Check if the pointer is over the Text
      If IsMouseOverText(e.X - 10, e.Y - 10) Then
          If Not MouseOver Then
              MouseOver = True
              Me.Refresh()
          End If
      Else
          If MouseOver Then
              MouseOver = False
              Me.Refresh()
          End If
      End If
  
      If e.Button = Windows.Forms.MouseButtons.Left And MouseMoving Then
          ptText.X = CInt(e.X - MovingOffset.X)
          ptText.Y = CInt(e.Y - MovingOffset.Y)
          Me.Refresh()
      End If
  End Sub
  
  Private Sub Form1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseUp
      MouseMoving = False
      Me.Refresh()
  End Sub
  
  Public Function IsMouseOverText(ByVal X As Integer, ByVal Y As Integer) As Boolean
      'Make a Graphics Path from the rotated ptsText.
      Using gp As New GraphicsPath()
          gp.AddPolygon(ptsText)
  
          'Convert to Region.
          Using TextRegion As New Region(gp)
              'Is the point inside the region.
              Return TextRegion.IsVisible(X, Y)
          End Using
  
      End Using
  End Function
  Dim tbm As Bitmap
  Private Sub Form1_Paint(ByVal sender As Object, _
      ByVal e As System.Windows.Forms.PaintEventArgs) _
      Handles MyBase.Paint
  
      tbm = CType(bm.Clone, Bitmap)
      Dim g As Graphics = Graphics.FromImage(tbm)
      Dim mx As Matrix = New Matrix
      Dim gpathText As New GraphicsPath
      Dim br As SolidBrush = New SolidBrush(Color.FromArgb(tbarTrans.Value, _
                                           KryptonColorButton1.SelectedColor))
  
      SetptsText()
      'Smooth the Text
      g.SmoothingMode = SmoothingMode.AntiAlias
  
      'Make the GraphicsPath for the Text
      Dim emsize As Single = Me.CreateGraphics.DpiY * pic_font.SizeInPoints / 72
      gpathText.AddString(strText, pic_font.FontFamily, CInt(pic_font.Style), _
          emsize, New RectangleF(ptText.X, ptText.Y, szText.Width, szText.Height), _
          StringFormat.GenericDefault)
      'Draw a copy of the image to the Graphics Object canvas
      g.DrawImage(CType(bm.Clone, Bitmap), 0, 0)
  
      'Rotate the Matrix at the center point
      mx.RotateAt(tbarRotate.Value, _
          New Point(ptText.X + (szText.Width / 2), ptText.Y + (szText.Height / 2)))
  
      'Get the points for the rotated text bounds
      mx.TransformPoints(ptsText)
  
      'Transform the Graphics Object with the Matrix
      g.Transform = mx
  
      'Draw the Rotated Text
  
      If chkAddOutline.Checked Then
          Using pn As Pen = New Pen(Color.FromArgb(tbarTrans.Value, KryptonColorButton2.SelectedColor), 1)
              g.DrawPath(pn, gpathText)
          End Using
      Else
          g.FillPath(br, gpathText)
      End If
  
      If CheckBox2.Checked = True Then
          Dim p As New Pen(Color.FromArgb(tbarTrans.Value, KryptonColorButton2.SelectedColor), 1)
          'draw te hollow outlined text
          g.DrawPath(p, gpathText)
          'clear the path
          gpathText.Reset()
      Else
          g.FillPath(br, gpathText)
      End If
      'Draw the box if the mouse is over the Text
  
      If MouseOver Then
          g.ResetTransform()
          g.DrawPolygon(ptsTextPen, ptsText)
      End If
  
      'Draw the whole thing to the form
      e.Graphics.DrawImage(tbm, 10, 10)
  
      'tbm.Dispose()
      g.Dispose()
      mx.Dispose()
      br.Dispose()
      gpathText.Dispose()
  
  End Sub
  
  Private Sub TrackBar_Scroll(ByVal sender As System.Object, ByVal e As System.EventArgs) _
    Handles tbarRotate.Scroll, tbarTrans.Scroll
      lblRotate.Text = tbarRotate.Value
      lblOpacity.Text = tbarTrans.Value
      Me.Refresh()
  End Sub
  
  Sub SetptsText()
      'Create a point array of the Text Rectangle
      ptsText = New PointF() { _
          ptText, _
          New Point(CInt(ptText.X + szText.Width), ptText.Y), _
          New Point(CInt(ptText.X + szText.Width), CInt(ptText.Y + szText.Height)), _
          New Point(ptText.X, CInt(ptText.Y + szText.Height)) _
          }
  End Sub
  
  Private Sub chkAddOutline_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chkAddOutline.CheckedChanged
      Me.Refresh()
  End Sub
  
  Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
      If FontDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
  
      End If
  End Sub
  
  Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
      If OpenFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
          PictureBox1.Image = Image.FromFile(OpenFileDialog1.FileName)
          bm = Image.FromFile(OpenFileDialog1.FileName)
          szText = Me.CreateGraphics.MeasureString(strText, pic_font)
          SetptsText()
          ptsTextPen.DashStyle = DashStyle.Dot
      End If
  End Sub
  
  Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
      If SaveFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
          tbm.Save(SaveFileDialog1.FileName)
      End If
  End Sub
  </code></pre>
  
  <p>End Class</p>