Vb.net 计算旋转文字加边界的坐标

我有一个表单，允许用户创建自定义的“戳记”以放置在PDF上。表单显示了pdf第一页的图像，我希望用户基本上可以在屏幕上单击他们想要的图章，并能够预览它的外观。不要担心任何PDF格式的东西，我已经处理好了

为了让事情变得时髦，我有两份图像，一份是普通的，另一份是亮度降低的。我显示低亮度图像，当用户将鼠标移到上面时，会显示或突出显示原始图像的一块。然后，我在该区域显示用户将要放在PDF上的文本

我允许用户使用鼠标滚轮滚动并更改他们放置的文本的角度（从-45度到+45度）

这是我的问题：我无法计算正确的矩形/坐标。有时一切看起来都很棒，但有时（随着字体大小的变化）它们不太合适

如何计算以下各项的x和y坐标： 旋转文本的放置 以及一个边框，在文本的宽度和高度处填充10px

下面的代码是有效的，直到我开始加大字体大小，然后所有的东西都变歪了

前两幅图像以较小字体显示文本+边框。看起来不错：

下一幅图显示，随着文本大小变大，我的像素四处移动并被切掉。在更大的文本中，宽度/高度结束时也相差很远

抱歉，示例图像没有显示太多细节。我有无法共享的实际数据

        Private Sub PanelMouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) '// handles the mouse move (handler added elsehwere)

        With CType(sender, PictureBox)

            .Image.Dispose() '// get rid of old image

            Dim b As Bitmap = _curGray.Clone '// the low brightness image as the base image

            '// stamp font and text values are initiated from another form
            Using g As Graphics = Graphics.FromImage(b),
                f As New Font(DefaultFont.FontFamily, CSng(_stmpTools.StampTextSize), If(_stmpTools.StampBold, FontStyle.Bold, FontStyle.Regular))

                Const borderWidth As Integer = 10
                Const borderPadding As Integer = 5

                '// measure the string
                Dim szx As SizeF = g.MeasureString(_stmpTools.StampText, f, Integer.MaxValue, StringFormat.GenericDefault)
                Dim strLength As Single = szx.Width
                Dim strHeight As Single = szx.Height

                Dim x As Single = e.X - borderWidth - borderPadding,
                    y As Single = e.Y

                Dim w As Double, h As Double

                If Math.Abs(_angle) > Double.Epsilon Then
                    h = CDbl(strLength) * Math.Sin(CDbl(Math.Abs(_angle)) * Math.PI / 180.0F)
                    w = Math.Sqrt(CDbl(strLength) * CDbl(strLength) - h * h)
                Else
                    '// its zero. so use calculated values
                    h = strHeight
                    w = strLength
                End If

                '// add space for the 10px border plus 5px of padding
                Dim r As New Rectangle(0, 0, w, h)
                r.Inflate(borderWidth + borderPadding, borderWidth + borderPadding)

                h = r.Height
                w = r.Width

                '// keep box from moving off the left
                If x < .Location.X Then
                    x = .Location.X
                End If

                '// keep box from moving off the right
                If x > .Location.X + .Width - w Then
                    x = .Location.X + .Width - w
                End If

                '// I don't know, but these values work for most smaller fonts, but
                '// it has got to be a fluke
                If _angle > 0 Then
                    y = y - h + borderWidth + borderWidth
                Else
                    y = y - borderWidth
                End If

                '// can't go off the top
                If y < .Location.Y Then
                    y = .Location.Y
                End If

                '// can't go off the bottom
                If y > .Location.Y + .Height - h Then
                    y = .Location.Y + .Height - h
                End If

                Dim rect As New Rectangle(x, y, w, h)
                g.DrawImage(_curImg, rect, rect, GraphicsUnit.Pixel)

                Using br As New SolidBrush(_stmpTools.StampTextColor)
                    RotateString(_stmpTools.StampText, _angle, e.X, e.Y, f, g, br)
                End Using

                '//draw bounding rectangle
                Using p As New Pen(Color.Black, borderWidth)
                    g.DrawRectangle(p, rect)
                End Using

            End Using
            '// set the picture box to show the new image
            .Image = b
        End With

    End Sub

    Private Sub RotateString(ByVal Text As String, ByVal angle As Integer, _
                      ByVal x As Integer, ByVal y As Integer, myfont As Font, mydrawing As Graphics, myColor As Brush)
        Dim myMatrix As New Matrix
        myMatrix.RotateAt(angle * -1, New Point(x, y)) 'Rotate drawing 
        mydrawing.Transform = myMatrix
        mydrawing.DrawString(Text, myFont, myColor, x, y) 'Draw the text string 
        myMatrix.RotateAt(angle, New Point(x, y)) 'Rotate back 
        mydrawing.Transform = myMatrix
    End Sub

_curImg是亮度调高的原始图像的副本。当我从下面更改代码时，我最终得到：

请注意双行。它们随戳记旋转，即使它们用作背景图像，并且应该不旋转

根据建议，我将DrawStamp从@LarsTech更改为以下内容：

        Private Sub DrawStamp(g As Graphics, text As String,
                  f As Font, center As Point, angle As Integer, backImg As Image)

        Dim s As Size = g.MeasureString(text, f).ToSize
        Dim r As New Rectangle(center.X - (s.Width / 2) - 16,
                                 center.Y - (s.Height / 2) - 16,
                                 s.Width + 32,
                                 s.Height + 32)

        g.DrawImage(backImg, r, r, GraphicsUnit.Pixel)

        Using m As New Matrix
            m.RotateAt(angle, center)
            g.Transform = m

            Using p As New Pen(Color.Black, 6)
                g.DrawRectangle(p, r)
            End Using
            Using sf As New StringFormat
                sf.LineAlignment = StringAlignment.Center
                sf.Alignment = StringAlignment.Center
                g.DrawString(text, f, Brushes.Black, r, sf)
            End Using
            g.ResetTransform()
        End Using
    End Sub

然而，我现在只剩下

请注意，它绘制了背景，然后进行了旋转并绘制了图章。它几乎起作用了。在本例中，直线显示预期行为。。。然而，我希望用背景填充整个邮票。两侧额外的白色将被旋转成邮票的背景。我很困惑，因为我会怀疑“灰色”部分会剪掉图像的一部分，但它们不会（如果我把它移到其他区域，我很遗憾不能在这里发布）注意到，除了矩形的边这样绘制之外，它们没有倾斜

另一次编辑，希望提供更多信息

希望这里能更好地解释我想做的事情。我使用第三方PDF查看器，我需要允许用户向PDF添加图像。查看器不允许我在其上引发单击事件，因此为了抓住用户的鼠标单击，我执行以下操作：

        Private Sub DrawStamp(g As Graphics, text As String,
                  f As Font, center As Point, angle As Integer, backImg As Image)

        Dim s As Size = g.MeasureString(text, f).ToSize
        Dim r As New Rectangle(center.X - (s.Width / 2) - 16,
                                 center.Y - (s.Height / 2) - 16,
                                 s.Width + 32,
                                 s.Height + 32)

        g.DrawImage(backImg, r, r, GraphicsUnit.Pixel)

        Using m As New Matrix
            m.RotateAt(angle, center)
            g.Transform = m

            Using p As New Pen(Color.Black, 6)
                g.DrawRectangle(p, r)
            End Using
            Using sf As New StringFormat
                sf.LineAlignment = StringAlignment.Center
                sf.Alignment = StringAlignment.Center
                g.DrawString(text, f, Brushes.Black, r, sf)
            End Using
            g.ResetTransform()
        End Using
    End Sub

截屏

隐藏PDF查看器

将PictureBox控件添加到我的表单，替换PDF查看器所在的区域

使用屏幕抓取，我复制了一份亮度降低的图像

显示图像的灰度副本，并使用picturebox上的鼠标悬停事件直接在图像上绘制

我在picturebox上画了一个图章，但希望它的背景是原始的（未调整的亮度图像）。但是，由于该区域可能会使用旋转进行变换，因此我无法获取背景图像。如果未提供角度，则源矩形匹配。但是，如果它旋转了，我就无法从源图像中获取相同的旋转矩形

按钮单击事件：

  Dim bds As Rectangle = AxDPVActiveX1.Bounds
  Dim pt As Point = AxDPVActiveX1.PointToScreen(bds.Location)

    Using bit As Bitmap = New Bitmap(bds.Width, bds.Height)
        Using g As Graphics = Graphics.FromImage(bit)
            g.CopyFromScreen(New Point(pt.X - AxDPVActiveX1.Location.X, pt.Y - AxDPVActiveX1.Location.Y), Point.Empty, bds.Size)
        End Using

        _angle = 0

        _curImg = bit.Clone
        _curGray = Utils.CopyImageAndAdjustBrightness(bit, -100)

 End Using

   Dim p As New PictureBox

        Utils.SetControlDoubleBuffered(p)

        p.Dock = DockStyle.Fill
        p.BackColor = Color.Transparent
        AxDPVActiveX1.Visible = False
        p.Image = _curImg.Clone

        AddHandler p.MouseClick, AddressOf PanelDownMouse
        AddHandler p.MouseMove, AddressOf PanelMouseMove
        AddHandler p.MouseWheel, Sub(s As Object, ee As MouseEventArgs)
                                     _angle = Math.Max(Math.Min(_angle + (ee.Delta / 30), 45), -45)
                                     PanelMouseMove(s, ee)
                                 End Sub
        AddHandler p.MouseEnter, Sub(s As Object, ee As EventArgs)
                                     CType(s, Control).Focus()
                                 End Sub


        AxDPVActiveX1.Parent.Controls.Add(p)

在这段代码之后，我得到了两张图片_curgray是一个亮度可调的图像，而_curImg是我最初的屏幕抓图

_柯格雷： _库里姆：

mouseMove

move事件应用于我的新图片框。这就是问题前面的所有代码发挥作用的地方

使用上面的代码，my mouseMove事件不断创建一个新图像以显示在my picture框中。如果没有轮换的话，我会得到我想要的东西。请注意下图中邮票的背景比任何东西都亮。蓝色正方形上方的部分稍轻一些。我用这个方法来吸引观众的眼球到这个区域。。。这对我的工作很重要

然而，当对其应用旋转时，我似乎无法从原始图像复制。请看下图，背景并没有随之旋转。我需要从原始图像中获取一个旋转的矩形

Graphics.DrawImage（）

接受

Public Sub DrawImage ( _
    image As Image, _
    destRect As Rectangle, _
    srcRect As Rectangle, _
    srcUnit As GraphicsUnit _
)

在这里，我可以指定从源图像复制此源矩形（在本例中为_curImg）并放置到新图形上。它不允许我对源矩形应用转换。基本上，我想从我的源图像复制一个相当于旋转矩形的区域（基于@larstech的转换）

---

我不知道如何更清楚地表达这个概念。如果仍然没有意义，我将接受拉尔斯泰克的答案作为最佳答案，放弃我的想法。

这只是三角函数：

你知道

c

是因为你知道原文有多宽，你知道

h

是因为你知道文本的高度。你还需要知道alpha，它是你旋转文本的角度

现在你需要运用数学的力量：首先，取最后的小矩形。在左下角你可以看到，x的右角实际上是180°-90°-alpha，或者90°-alpha。所以阿尔法也在相反的位置被发现。因此，您可以找到x：

x=h*sin（alpha）

y也是一样，但它要么是sin（90°-alpha），要么是cos（alpha）

y=h*cos（α）

接下来你需要找到a和b来合作

Private Sub DrawStamp(g As Graphics, text As String,
                      f As Font, center As Point, angle As Integer)
  Using m As New Matrix
    g.SmoothingMode = SmoothingMode.AntiAlias
    g.TextRenderingHint = TextRenderingHint.AntiAlias
    m.RotateAt(angle, center)
    g.Transform = m
    Dim s As Size = g.MeasureString(text, f).ToSize
    Dim r As New Rectangle(center.X - (s.Width / 2) - 16,
                           center.Y - (s.Height / 2) - 16,
                           s.Width + 32,
                           s.Height + 32)
    g.FillRectangle(Brushes.White, r)
    Using p As New Pen(Color.Black, 6)
      g.DrawRectangle(p, r)
    End Using
    Using sf As New StringFormat
      sf.LineAlignment = StringAlignment.Center
      sf.Alignment = StringAlignment.Center
      g.DrawString(text, f, Brushes.Black, r, sf)
    End Using
    g.ResetTransform()
  End Using
End Sub

Protected Overrides Sub OnPaint(e As PaintEventArgs)
  MyBase.OnPaint(e)
  e.Graphics.Clear(Color.LightGray)
  Using f As New Font("Calibri", 16, FontStyle.Bold)
    DrawStamp(e.Graphics,
              "Reviewed By Doctor Papa",
              f,
              New Point(Me.ClientSize.Width / 2, Me.ClientSize.Height / 2),
              -25)
  End Using
End Sub

Private Sub DrawStamp(g As Graphics, text As String,
                      f As Font, center As Point, angle As Integer)

  Dim s As Size = g.MeasureString(text, f).ToSize
  Dim r As New Rectangle(center.X - (s.Width / 2) - 16,
                         center.Y - (s.Height / 2) - 16,
                         s.Width + 32,
                         s.Height + 32)

  Using bmp As New Bitmap(_curImg.Width, _curImg.Height)
    Using gx As Graphics = Graphics.FromImage(bmp)
      Using m As New Matrix
        m.RotateAt(angle, center)
        gx.Transform = m
        gx.SetClip(r)
        gx.ResetTransform()
      End Using
      gx.DrawImage(_curImg, Point.Empty)
    End Using
    g.DrawImage(bmp, Point.Empty)
  End Using

  Using m As New Matrix
    g.SmoothingMode = SmoothingMode.AntiAlias
    g.TextRenderingHint = TextRenderingHint.AntiAlias
    m.RotateAt(angle, center)
    g.Transform = m      
    Using p As New Pen(Color.Black, 6)
      g.DrawRectangle(p, r)
    End Using
    Using sf As New StringFormat
      sf.LineAlignment = StringAlignment.Center
      sf.Alignment = StringAlignment.Center
      g.DrawString(text, f, Brushes.Black, r, sf)
    End Using
    g.ResetTransform()
  End Using
End Sub