vb.netのフォントダイアログを使用してテキストフォントを変更したい

Question

ここに私のコードがありますが、いくつかのフォントプロパティを定義してテキストを追加できますが、フォントダイアログを使用して追加したいと思います。 。

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 & "\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 

エンドクラス

Answer 1

あなたは、フォントダイアログを開き、そこからフォントを選択する意味は何をmean.Ifんが、ここでのコードがあります。

' You need Import System.Drawing before your class 
' In your class vars section 
Dim fd As New FontDialog 

'later in your code 
' This should be in the code where you call the font dialog 
If(fd.ShowDialog() == DialogResults.Ok) 
    pic_font = fd.Font 
End If