Custom PictureBox for Cropping

[vbdotnut]

Here is a Class that inherits PictureBox that will allow user to crop images and save or get the cropped image. this is an evolution of various sources from MSDN, SO, and about 2 hours of fighting with CHATGPT

How to use:
Create the instance

Dim CropBox As New CropPicBox With {
.SizeMode = PictureBoxSizeMode.Zoom,'must be zoom
.Image = My.Resources.ABD2_0,'this just from resource, can load any image
.Width = 500,'dimensions can be set to your preference
.Height = 500}
PanelPicBox.Controls.Add(CropBox) 'add the control to a container

'example of get the clipped image
SomeOtherPicBox.Image = CropBox.GetClippedImage

'example of save clipped image
CropBox.SaveClippedImage("C:\yourpath\imagename.jpg", 250, 250) 'the last 2 parameters are width x height and will create a canvas this size and center the cropped image on the canvas and resize the cropped image while maintaining aspect ratio

and heres the class:

Public Class CropPicBox
    Inherits PictureBox

    Private MouseDownStage As Integer
    Private MouseDownPt, MouseDownOffsetPt, MouseMovePt As PointF
    Private ClipRectf As RectangleF

    Public Sub New()
        MyBase.New()
        BackgroundImageLayout = ImageLayout.Zoom
    End Sub

    Protected Overrides Sub OnMouseDown(e As MouseEventArgs)
        MouseDownStage = MouseOverRectangle(e.X, e.Y)
        Select Case MouseDownStage
            Case 1
                MouseDownPt = e.Location
                MouseMovePt = e.Location

            Case 2, 3
                MouseDownPt = ClipRectf.Location
                MouseDownOffsetPt = New PointF(e.X - ClipRectf.X, e.Y - ClipRectf.Y)
        End Select
        MyBase.OnMouseDown(e)
    End Sub

    Protected Overrides Sub OnMouseMove(e As MouseEventArgs)
        Dim pt As Point = e.Location
        If pt.X > Width - 1 Then pt.X = Width - 1
        If pt.Y > Height - 1 Then pt.Y = Height - 1
        If pt.X < 0 Then pt.X = 0
        If pt.Y < 0 Then pt.Y = 0

        If MouseDownStage > 0 Then
            Select Case MouseDownStage
                Case 1
                    MouseMovePt = pt
                Case 2
                    'moving fence
                    Dim dx, dy, x, y As Single
                    dx = (pt.X - MouseDownPt.X)
                    dy = (pt.Y - MouseDownPt.Y)
                    x = (MouseDownPt.X + dx - MouseDownOffsetPt.X)
                    If x < 0 Then x = 0
                    y = (MouseDownPt.Y + dy - MouseDownOffsetPt.Y)
                    If y < 0 Then y = 0
                    ClipRectf.X = x
                    ClipRectf.Y = y
                Case 3
                    'moving handle
                    ClipRectf.Width = Math.Abs(ClipRectf.X - pt.X)
                    ClipRectf.Height = Math.Abs(ClipRectf.Y - pt.Y)
            End Select
        Else
            Select Case MouseOverRectangle(pt.X, pt.Y)
                Case 2  'fence
                    Cursor.Current = Cursors.Hand
                Case 3 'handle
                    Cursor.Current = Cursors.SizeNESW
                Case Else
                    Cursor.Current = Cursors.Default
            End Select
        End If

        Invalidate()
        MyBase.OnMouseMove(e)
    End Sub

    Protected Overrides Sub OnMouseUp(e As MouseEventArgs)
        Select Case MouseDownStage
            Case 1
                Dim w1, w2, h1, h2 As Integer
                w1 = CInt(ClientRectangle.Width - MouseDownPt.X)
                w2 = CInt(MouseMovePt.X - MouseDownPt.X)
                If w2 > w1 Then w2 = w1

                h1 = CInt(ClientRectangle.Height - MouseDownPt.Y)
                h2 = CInt(MouseMovePt.Y - MouseDownPt.Y)
                If h2 > h1 Then h2 = h1

                ClipRectf = New RectangleF(MouseDownPt.X, MouseDownPt.Y, w2, h2)

        End Select
        MouseDownStage = 0
        Invalidate()
        MyBase.OnMouseUp(e)
    End Sub

    Protected Overrides Sub OnPaint(e As PaintEventArgs)
        MyBase.OnPaint(e)
        DrawMouseRect(e.Graphics)
    End Sub

    Private Function MouseOverRectangle(x As Integer, y As Integer) As Integer
        Dim h As Integer = 5
        Dim handleRect As New RectangleF(ClipRectf.X + ClipRectf.Width - h, ClipRectf.Y + ClipRectf.Height - h, 2 * h, 2 * h)
        Dim fenceRect As New RectangleF
        fenceRect = ClipRectf

        If handleRect.Contains(x, y) Then
            Return 3
        ElseIf fenceRect.Contains(x, y) Then
            Return 2
        Else
            Return 1
        End If
    End Function

    Private Sub DrawMouseRect(g As Graphics)
        Using p As New Pen(Color.Red, 2)
            If ClipRectf.Width > 0 Then
                p.DashStyle = Drawing2D.DashStyle.Dash
                g.DrawRectangle(p, Rectangle.Round(ClipRectf))

                p.Width = 3
                p.Color = Color.LimeGreen
                p.DashStyle = Drawing2D.DashStyle.Solid

                Dim h As Integer = 5
                g.DrawRectangle(p, Rectangle.Round(New RectangleF(ClipRectf.X + ClipRectf.Width - h,
                                           ClipRectf.Y + ClipRectf.Height - h, 2 * h, 2 * h)))
            End If

            If MouseDownStage = 1 Then
                p.Width = 2
                p.Color = Color.OrangeRed
                p.DashStyle = Drawing2D.DashStyle.Dash
                g.DrawRectangle(p, Rectangle.Round(New RectangleF(MouseDownPt.X, MouseDownPt.Y,
                                             MouseMovePt.X - MouseDownPt.X, MouseMovePt.Y - MouseDownPt.Y)))
            End If
        End Using
    End Sub

    Public Function GetClippedImage() As Bitmap
        Dim image As Image = Me.Image
        If image Is Nothing Then Return Nothing

        Dim ratio As Double = Math.Max(image.Width / Me.ClientSize.Width, image.Height / Me.ClientSize.Height)
        Dim x As Integer = CInt(ClipRectf.X * ratio)
        Dim y As Integer = CInt(ClipRectf.Y * ratio)
        Dim width As Integer = CInt(ClipRectf.Width * ratio)
        Dim height As Integer = CInt(ClipRectf.Height * ratio)

        If x < 0 Then x = 0
        If y < 0 Then y = 0
        If x + width > image.Width Then width = image.Width - x
        If y + height > image.Height Then height = image.Height - y

        Dim clippedImage As New Bitmap(width, height)
        Using g As Graphics = Graphics.FromImage(clippedImage)
            g.DrawImage(image, New Rectangle(0, 0, width, height), New Rectangle(x, y, width, height), GraphicsUnit.Pixel)
        End Using

        Return clippedImage
    End Function
    Public Sub SaveClippedImage(imagePath As String, targetWidth As Integer, targetHeight As Integer)
        Dim image As Image = Me.Image
        If image Is Nothing Then Return

        Dim ratio As Double = Math.Max(image.Width / Me.ClientSize.Width, image.Height / Me.ClientSize.Height)
        Dim x As Integer = CInt(ClipRectf.X * ratio)
        Dim y As Integer = CInt(ClipRectf.Y * ratio)
        Dim width As Integer = CInt(ClipRectf.Width * ratio)
        Dim height As Integer = CInt(ClipRectf.Height * ratio)

        If x < 0 Then x = 0
        If y < 0 Then y = 0
        If x + width > image.Width Then width = image.Width - x
        If y + height > image.Height Then height = image.Height - y

        Dim croppedImage As New Bitmap(width, height)
        Using g As Graphics = Graphics.FromImage(croppedImage)
            g.DrawImage(image, New Rectangle(0, 0, width, height), New Rectangle(x, y, width, height), GraphicsUnit.Pixel)
        End Using

        Dim resizedWidth As Integer = targetWidth
        Dim resizedHeight As Integer = targetHeight
        Dim aspectRatio As Double = width / CDbl(height)
        If aspectRatio > 1 Then
            resizedHeight = CInt(targetWidth / aspectRatio)
        Else
            resizedWidth = CInt(targetHeight * aspectRatio)
        End If

        Dim canvas As New Bitmap(targetWidth, targetHeight)
        Using g As Graphics = Graphics.FromImage(canvas)
            g.Clear(Color.White)

            Dim canvasX As Integer = (targetWidth - resizedWidth) \ 2
            Dim canvasY As Integer = (targetHeight - resizedHeight) \ 2

            g.DrawImage(croppedImage, New Rectangle(canvasX, canvasY, resizedWidth, resizedHeight))
        End Using

        ClipRectf = RectangleF.Empty

        canvas.Save(imagePath, ImageFormat.Jpeg)

    End Sub

End Class