如何通过标签在图像上粘贴一些文本？

Question

大家好

简而言之：我正在尝试通过放置在图片框中的图像上的标签添加文本。 我下面的代码在某些情况下有效，但并非总是如此。我正在使用一个奇怪的数字 （3.16），它在大多数情况下都有帮助，但我真的不明白为什么。

我正在寻找的是： 1- 将标签的文本粘贴在我的图像 上 2- 显示在我的图像上的标签（来自 TGlass 类）必须与屏幕上显示的完全相同（在我的图片框“pbCheckImage01”400x266px 中） 3- 我的图像可以以像素为单位更改（例如：6016x4000 或 2256x1504 或 317x212 ...始终相同的比例 1.5） 4- 标签的大小可以通过个性化和有限的 FontDialog （大小 48 到 108） 进行更改

欢迎任何想法、更正、改进。希望我的解释足够清楚。

我尝试了 DrawToBitmap 方法，但它不起作用，因为我丢失了像素。 我也尝试了 MeasureString 方法，但没有成功，但这可能是要走的路。

以下是我用来在图像上粘贴标签的代码。

            Dim myBitmap As Bitmap = Nothing
            Using fs As New System.IO.FileStream(myPath, System.IO.FileMode.Open, System.IO.FileAccess.Read)
                'Dim img2 As Image = Image.FromStream(fs)
                Dim img2 As Bitmap = CType(Bitmap.FromStream(fs), Bitmap)
                pbCheckImage01.BackgroundImage = img2
                Dim g As Graphics = Graphics.FromImage(img2)
                ' Text position of Label TGlass
                Dim topleft As Point
                topleft = New Point(TGlass.Left, TGlass.Top)
                ' Text content of Label TGlass
                Dim strCalendar As String = TGlass.Text
                ' Rectangle layout for the selected font
                Dim layout As New Rectangle(topleft, TGlass.Size)
                ' Rectangle position with respect of the image
                layout.X = CInt(layout.X * (img2.Height / pbCheckImage01.Height))
                layout.Y = CInt(layout.Y * (img2.Width / pbCheckImage01.Width))
                ' Text First Page
                Dim myFontSize As Integer
                myFontSize = CInt(TGlass.Font.Size * (img2.Width / pbCheckImage01.Width) / 3.16)
                Dim myFont As New Font(TGlass.Font.FontFamily, myFontSize, TGlass.Font.Style)
                Dim myBrush As New SolidBrush(TGlass.ForeColor)
                ' Drawing on Image
                g.DrawString(strCalendar, myFont, myBrush, layout.X, layout.Y)
                ' Remove the TextWindow class
                ckbYear.Checked = False
                myBitmap = img2
            End Using
            ' Update the new image on FirstPage
            pb00.BackgroundImage = myBitmap
            pb00.BackgroundImageLayout = ImageLayout.Stretch
            pb00.Size = fSizeTransfer(myBitmap.Width, myBitmap.Height, 120)
            ' Save (Replace) the Image in the right folder
            myBitmap.Save(myPath, System.Drawing.Imaging.ImageFormat.Jpeg)

这里是 TextWindow 类 TGlass 的代码。

Public Class cTextWindow

    Inherits Label ' Control Text
    ' Variable initialisation
    Dim a As Integer
    Dim b As Integer
    Dim newPoint As Point
    Public bClick As Boolean

    Public Sub New()
        ' Initialisation
        Me.Cursor = Cursors.SizeAll
        bClick = True
    End Sub

    Protected Overrides Sub OnPaint(ByVal e As System.Windows.Forms.PaintEventArgs)
        ' Draw the border of the label
        Try
            If bClick = True Then
                e.Graphics.DrawRectangle(New Pen(Brushes.Blue, 4), Me.ClientRectangle)
            Else
                e.Graphics.DrawRectangle(New Pen(Brushes.Transparent, 4), Me.ClientRectangle)
            End If
            MyBase.OnPaint(e)
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub

    Protected Overrides Sub OnMouseDown(ByVal e As System.Windows.Forms.MouseEventArgs)
        ' Find the position of the label
        Try
            a = MousePosition.X - Me.Location.X
            b = MousePosition.Y - Me.Location.Y
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub

    Protected Overrides Sub OnMouseMove(ByVal e As System.Windows.Forms.MouseEventArgs)
        ' Update the position of the label
        Try
            ' New location
            If e.Button = MouseButtons.Left Then
                newPoint = MousePosition
                newPoint.X -= a
                newPoint.Y -= b
                Me.Location = newPoint
            End If
            ' Raise the MouseMove event
            MyBase.OnMouseMove(e)
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub

    Protected Overrides Sub OnMove(ByVal e As System.EventArgs)
        ' Control the position of the label
        Try
            ' Keep it inside the main PictureBox
            If Me.Location.X < 0 Then Me.Location = New Point(0, Me.Location.Y)
            If Me.Location.Y < 0 Then Me.Location = New Point(Me.Location.X, 0)
            If Me.Location.X + Me.Width > frmECalendar.pbCheckImage01.Width Then Me.Location = New Point(frmECalendar.pbCheckImage01.Width - Me.Width, Me.Location.Y)
            If Me.Location.Y + Me.Height > frmECalendar.pbCheckImage01.Height Then Me.Location = New Point(Me.Location.X, frmECalendar.pbCheckImage01.Height - Me.Height)
            ' Control to be redrawn
            'Me.Invalidate()
            Me.Update()
            ' Raise the Move event
            MyBase.OnMove(e)
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub

    Protected Overrides Sub OnMousedoubleClick(e As MouseEventArgs)
        ' Display the label frame with a mouse click 
        Try
            bClick = Not bClick
            ' Raise the MouseClick event
            MyBase.OnMouseDoubleClick(e)
            Refresh()
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub

End Class

Note：此问题总结整理于:How to stick some text on an Image via a Label?

Answer 1

嗨 ，

尤其是关于这些数字 3 或 4，具体取决于我的做法。

（intRenderer.Width / PictureBox1.Width） *** img.宽度不能用作字体大小。 在“Button4_Click”中，您将 TGlass.Font = New Font（“Arial”， 80， FontStyle.Bold） 因此考虑：

            Dim WidthRate = img.Width / PictureBox1.Width  
            Dim myFontSize = CInt(WidthRate * 80)  

---

如果答案是正确的，请点击“接受答案”并点赞。 如果您对此答案还有其他疑问，请点击“评论”。

注意：如果您想接收相关电子邮件，请按照我们的文档中的步骤启用电子邮件通知 此线程的通知。