Click and drag image cropping using VB6

Hello,

I need to be able to click and drag a rectangle or circle to crop areas of an image file, similar to the way you crop in Photoshop with the select tool.  I needto be able to add that functionality to my VB6 app.
PaulRosebushAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Mike TomlinsonHigh School Computer Science, Computer Applications, Digital Design, and Mathematics TeacherCommented:
Create a New Project and add two PictureBoxes.  Set the Picture() property of Picture1 to an Image.

Run the app and drag an area in the PictureBox.

Option Explicit

Private Type Point
    X As Long
    Y As Long
End Type

Private Type Rect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Declare Function GetCursorPos Lib "user32" (lpPoint As Point) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function SetROP2 Lib "gdi32" (ByVal hDC As Long, ByVal nDrawMode As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As Rect) As Long
Private Declare Function ClipCursor Lib "user32" (ByRef lpRect As Rect) As Long
Private Declare Function GetClipCursor Lib "user32" (ByRef lpRect As Rect) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, ByRef lpPoint As Point) As Long

Private Const SW_NORMAL = 1
Private Const NULLBRUSH = 5

Private cxBorder As Long
Private startBox As Point
Private endBox As Point
Private Box As Rect
Private prevClip As Rect

Private Sub Form_Load()
    cxBorder = GetSystemMetrics(5)
   
    Picture1.Appearance = 0 ' flat
    Picture1.BorderStyle = 1 ' single
    Picture1.ScaleMode = vbPixels
    Picture1.AutoRedraw = True
   
    Picture2.ScaleMode = vbPixels
    Picture2.Visible = False
    Picture2.AutoRedraw = True
    Picture2.Width = Picture1.Width
    Picture2.Height = Picture1.Height
    Picture2.Appearance = Picture1.Appearance
    Picture2.BorderStyle = Picture1.BorderStyle
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
        Dim r As Rect
        Call GetWindowRect(Picture1.hWnd, r)
        Call GetClipCursor(prevClip)
        Call ClipCursor(r)
       
        GetCursorPos startBox
        endBox = startBox
        rubberBand
    End If
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
        rubberBand
        GetCursorPos endBox
        rubberBand
    End If
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
        Call ClipCursor(prevClip)
        rubberBand
        startBox.X = Box.Left
        startBox.Y = Box.Top
        endBox.X = Box.Right
        endBox.Y = Box.Bottom
        Call ScreenToClient(Picture1.hWnd, startBox)
        Call ScreenToClient(Picture1.hWnd, endBox)
       
        Dim picWidth As Integer
        Dim picHeight As Integer
        picWidth = endBox.X - startBox.X + 1
        picHeight = endBox.Y - startBox.Y + 1
       
        Set Picture2.Picture = Nothing
        Picture2.PaintPicture Picture1.Picture, 0, 0, picWidth, picHeight, startBox.X, startBox.Y, picWidth, picHeight
        Picture2.Picture = Picture2.Image
       
        Set Picture1.Picture = Picture2.Picture
    End If
End Sub

Private Sub rubberBand()
    Const NULL_BRUSH = 5
    Const R2_NOT = 6
    Const PS_INSIDEFRAME = 6
   
    Dim hPen As Long
    Dim hOldPen As Long
    Dim hOldBrush As Long
    Dim hNullBrush As Long
    Dim deskWnd As Long
    Dim deskDC As Long
    Dim cr As Long
       
    ' normalize the box
    If startBox.X < endBox.X Then
        Box.Left = startBox.X
        Box.Right = endBox.X
    Else
        Box.Left = endBox.X
        Box.Right = startBox.X
    End If
   
    If startBox.Y < endBox.Y Then
        Box.Top = startBox.Y
        Box.Bottom = endBox.Y
    Else
        Box.Top = endBox.Y
        Box.Bottom = startBox.Y
    End If
    ' get a device context to the picturebox
    deskWnd = GetDesktopWindow()
    deskDC = GetWindowDC(deskWnd)
    ' Create an inverse pen that is the size of a window border.
    SetROP2 deskDC, R2_NOT
    cr = RGB(0, 0, 0)
    hPen = CreatePen(PS_INSIDEFRAME, 3 * cxBorder, cr)
    ' store the previous pen and select our pen created above
    hOldPen = SelectObject(deskDC, hPen)
    hNullBrush = GetStockObject(NULL_BRUSH)
    ' store the previous brush and select our null brush
    hOldBrush = SelectObject(deskDC, hNullBrush)
    ' draw the rectangle
    Rectangle deskDC, Box.Left, Box.Top, Box.Right, Box.Bottom
    ' put the stored brush and pen back
    SelectObject deskDC, hOldBrush
    SelectObject deskDC, hOldPen
    ' delete our created pen and brush
    DeleteObject hPen
    DeleteObject hNullBrush
    ' release our device context
    ReleaseDC deskWnd, deskDC
End Sub

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
PaulRosebushAuthor Commented:
Hello Idle_Mind and thank you.  Your code works great.  There are a few other items I require.  Not sure if I am able to contact you outside of this forum however, if you are able to converse with me, please respond.  

Again, thank you.
Regards,
Paul Rosebush
Mike TomlinsonHigh School Computer Science, Computer Applications, Digital Design, and Mathematics TeacherCommented:
If it's a minor modification to this code, then feel free to post your "other items" here.

If not minor, then post a new question in the Visual Basic TA:
http://www.experts-exchange.com/Programming/Programming_Languages/Visual_Basic/

You can include a link back to this question if you want people to build off of what I have already provided.
PaulRosebushAuthor Commented:
Thanks again Idle_Mind.  I have just posted a new question.  As I am new to this site, I am not sure how to add a link to this question.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Programming Theory

From novice to tech pro — start learning today.