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\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

What's `m.Translate(-rectCutout.Left, -rectCutout.Top)` there for? This move the GraphicsPath towards the Left/Top. Btw, you should use English to name your objects, otherwise it's not that clear what these are for. -- It's aslo not clear whether you generate a List of points using an Image and then you scale the Image before cropping it, invalidating the original Points. — Jimi, Jan 23 '21 at 15:24
Hi Jimi, nice to read you again. Well, I was desperately looking for a way to transfer the inside of the GraphicsPath to a new image. As you know from my last question :) I just copied this function from [here](https://stackoverflow.com/questions/33820712/clip-an-image-in-a-specific-shape-net). (admittedly, I was also wondering what the matrix does) — Daniel, Jan 23 '21 at 15:58
There's nothing special you have to do. If the GraphicsPath already correctly surrounds the selected area, just create a new, empty, Bitmap that is exactly the same as the original (same Size and DpiDescriptor -- you can use `[Bitmap].SetResolution([Original].HorizontalResolution, [Original].VerticalResolution)`), then use the Graphics object derived from this new Image to draw the original Bitmap inside its bounds, setting the Clipping region to the GraphicsPath. That's all. — Jimi, Jan 23 '21 at 16:05
So, if you want to scale this new Image, do that after you have clipped the original. — Jimi, Jan 23 '21 at 16:22
Ok you were right It was really just about the `SetResolution ()` command. Nevertheless, I was sure that I had set everything correctly when scaling with `GIMP`. I checked how many dpi the original photo had and how many the new one should have. Well then something must have gone wrong. Thank you, again! PS: I would give you a `+1`, but I don't think you can do that with comments? — Daniel, Jan 23 '21 at 16:26
Don't worry about it. Next time, when I'll post an actual answer :) -- If you have a concrete solution for issue in this question, you can post an answer yourself and accept it. — Jimi, Jan 23 '21 at 16:28

score 0 · Accepted Answer · answered May 05 '21 at 21:31

The solution is to use .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)
.
.
.
.
.

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

1 Answers1