我想使用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

您的意思是什么。如果您的意思是打开一个字体对话框，然后从中选择一种字体，则代码如下。

' 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