裁剪区域在新位图中有 x 和 y 偏移，但前提是原始位图已缩放

Question

出现了一个奇怪的现象。 使用我的边缘检测程序，我可以将 GraphicsPath 的内部传输到新图像。 它总是很好用——除非我用GIMP 和Word 缩放原始图像（纵横比保持不变，只有尺寸发生了变化）。然后区域转移。向左和向上。见附件。在第 68 行，我查看了 rectCutout 中的内容。一切正常。

这和GIMP 有关系吗？每英寸点数相同 (72)。 JPEG 的压缩质量也是 (100%)。

我刚刚意识到：如果我将图像放大，结果是全黑的。

奇怪的是：我不是说：绘制的图片比保存的图片大。那么路径不在同一个位置是合乎逻辑的。这是因为加载的图像更小。

如果有人能告诉我原因，我会很高兴。 ????

this is the scaled image which is loaded

Here you see the GUI, ready to save

cropped image, area has x and y offset

#Disable Warning CA1707 ' Bezeichner dürfen keine Unterstriche enthalten
Imports System.Drawing.Drawing2D
Imports Microsoft.WindowsAPICodePack.Dialogs

Public NotInheritable Class AllesGrafische
    Public Shared Sub Paint_the_Rectangle(ByVal g As Graphics, ByVal recta As Rectangle)
        If g IsNot Nothing Then
            g.SmoothingMode = SmoothingMode.AntiAlias
            g.CompositingQuality = CompositingQuality.HighQuality
            g.PixelOffsetMode = PixelOffsetMode.HighQuality
            g.InterpolationMode = InterpolationMode.HighQualityBilinear
            Using Pen_Hellblau As Pen = New Pen(Color.FromArgb(0, 200, 255), 1.0F)
                g.DrawRectangle(Pen_Hellblau, recta)
            End Using
        End If
    End Sub

    Public Shared Sub Draw_Curve(ByVal g As Graphics, ByVal theList As List(Of Point))
        If theList IsNot Nothing AndAlso theList.Count > 0 AndAlso g IsNot Nothing Then
            g.SmoothingMode = SmoothingMode.AntiAlias
            g.CompositingQuality = CompositingQuality.HighQuality
            g.PixelOffsetMode = PixelOffsetMode.HighQuality
            g.InterpolationMode = InterpolationMode.HighQualityBilinear

            Dim theList_neu As New List(Of Point)

            Using gp As New GraphicsPath
                For i As Integer = 1 To theList.Count - 1 Step 1
                    Dim a As Integer = theList(i).X
                    Dim b As Integer = theList(i).Y
                    Dim c As Integer = theList(i - 1).X
                    Dim d As Integer = theList(i - 1).Y
                    Dim Entfernungsbetrag As Double = Math.Sqrt(Math.Pow(a, 2) + Math.Pow(b, 2) + Math.Pow(c, 2) + Math.Pow(d, 2) - 2 * a * c - 2 * b * d)
                    If Entfernungsbetrag < Form1.erlaubte_Entfernung Then
                        theList_neu.Add(theList(i))
                    End If
                Next
                If theList_neu.Count = 0 Then Return
                gp.AddLines(theList_neu.ToArray())
                Using Pen_hellrosa As Pen = New Pen(Color.FromArgb(255, 64, 239), 1.0F)
                    g.DrawPath(Pen_hellrosa, gp)
                End Using
                If Form1.ClosePath Then
                    gp.CloseFigure()
                End If

                If Form1.CheckBox1.Checked Then
                    Dim Speicherpfad As String
                    Using SFD1 As New CommonSaveFileDialog
                        SFD1.Title = "Wo soll das Bild gespeichert werden?"
                        SFD1.Filters.Add(New CommonFileDialogFilter("PNG", ".png"))
                        If System.IO.Directory.Exists("C:\Users\...\source\repos\VB.NET\Get mouse position and draw rectangle on screen") Then
                            SFD1.InitialDirectory = "C:\Users\...\source\repos\VB.NET\Get mouse position and draw rectangle on screen"
                        Else
                            SFD1.InitialDirectory = Environment.GetFolderPath(Environment.SpecialFolder.Desktop)
                        End If
                        If SFD1.ShowDialog = CommonFileDialogResult.Ok Then
                            Speicherpfad = SFD1.FileName & ".png"
                        Else
                            Return
                        End If
                    End Using
                    Using bmpSource As Bitmap = New Bitmap(Form1.Pfad_Bild)
                        Dim rectCutout As RectangleF = gp.GetBounds()
                        Using m As Matrix = New Matrix()
                            m.Translate(-rectCutout.Left, -rectCutout.Top)
                            gp.Transform(m)
                        End Using
                        Using bmpCutout As Bitmap = New Bitmap(CInt(Math.Round(rectCutout.Width, 0)), CInt(Math.Round(rectCutout.Height, 0)))
                            Using graphicsCutout As Graphics = Graphics.FromImage(bmpCutout)
                                graphicsCutout.Clip = New Region(gp)
                                graphicsCutout.DrawImage(bmpSource, CInt(-rectCutout.Left), CInt(-rectCutout.Top))
                                bmpCutout.Save(Speicherpfad, Imaging.ImageFormat.Png)
                                Form1.CheckBox1.Checked = False
                            End Using
                        End Using
                    End Using
                End If
            End Using
        End If
    End Sub
End Class

#Enable Warning CA1707 ' Bezeichner dürfen keine Unterstriche enthalten

Answer 1

解决方法是使用.SetResolution()

Using Original As Bitmap = New Bitmap(Form1.Pfad_Bild)
                        Dim rectCutout As RectangleF = gp.GetBounds()
                        Using m As System.Drawing.Drawing2D.Matrix = New System.Drawing.Drawing2D.Matrix()
                            m.Translate(-rectCutout.Left, -rectCutout.Top)
                            gp.Transform(m)
                        End Using
                        Using bmpCutout As Bitmap = New Bitmap(CInt(Math.Round(rectCutout.Width, 0)), CInt(Math.Round(rectCutout.Height, 0)))
                            bmpCutout.SetResolution(Original.HorizontalResolution, Original.VerticalResolution)
.
.
.
.
.