vb.net - The cropping area has an x and y offset in the new bitmap, but only if the original has been scaled

Question

a strange phenomenon occurs. With my edge detection program, I can transfer the inside of the GraphicsPath to a new image. It always works great – except when I scale the original image with GIMP and Word (aspect ratio remains, only the dimensions are changed). Then the area is shifted. To the left and up. See attachement. In line 68, I looked what is in rectCutout. Everything OK.

Does this have anything to do with GIMP? The dots per inch are the same (72). The compression quality of the JPEG also (100%).

I just realized: if I scale an image larger, the result is completely black.

The strange thing is: I'm not saying: the picture that is drawn on is larger than the picture that is saved. Then it would be logical that the path is not in the same position. It's about the fact that the loaded image is just smaller.

I would be happy if someone could tell me why. ??

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
eposVB.NETGet mouse position and draw rectangle on screen") Then
                            SFD1.InitialDirectory = "C:Users...source
eposVB.NETGet 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

question from:https://stackoverflow.com/questions/65859120/the-cropping-area-has-an-x-and-y-offset-in-the-new-bitmap-but-only-if-the-origi

Answer 1

Waitting for answers