Results 1 to 1 of 1

Thread: Custom PictureBox for Cropping

  1. #1

    Thread Starter
    Addicted Member
    Join Date
    Jan 2022
    Posts
    211

    Custom PictureBox for Cropping

    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
    Code:
    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:
    Code:
    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
    Last edited by vbdotnut; Jun 2nd, 2023 at 06:41 AM.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width