I've written some code to allow the user to crop an image. I can do the crop
of the image itself fine, but I am having trouble writing the code for the
cropping rectangle. I am trying to get a rectangle which is visible over all
the different colors in the picture and which the user can resize and
reposition with the mouse. The effect I want is similar to when you place a
rectangle shape control on your Form in the IDE and you can then move that
shape about on the Form and change its size by clicking and dragging at each
of its sides and the four corners, and you can see any picture which is
beneath it. I have tried all sorts of things but I am just totally stuck.
Any ideas or better still any example code?

Bob

Have a look at these as and example of three different selection rectangles you could use:

'***
Private Declare Function SelectObject Lib "GDI32.dll" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "GDI32.dll" (ByVal hObject As Long) As Long
Private Declare Function Rectangle Lib "GDI32.dll" (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 SetROP2 Lib "GDI32.dll" (ByVal hDC As Long, ByVal nDrawMode As Long) As Long
Private Declare Function SetBkMode Lib "GDI32.dll" (ByVal hDC As Long, ByVal nBkMode As Long) As Long
Private Declare Function SetBkColor Lib "GDI32.dll" (ByVal hDC As Long, ByVal crColor As Long) As Long
Private Declare Function CreatePen Lib "GDI32.dll" ( _
    ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long

Private Const PS_DOT As Long = &H2
Private Const OPAQUE As Long = &H2
Private Const R2_NOT As Long = &H6 ' Dn

Private Sub Form_Paint()
    Dim hPen As Long, hOldPen As Long
    Dim OldBkMode As Long, OldBKCol As Long, OldR2 As Long
    Dim hDC As Long

    hDC = Me.hDC

    hPen = CreatePen(PS_DOT, 0, vbBlack)
    hOldPen = SelectObject(hDC, hPen)

    ' Draw simple black dotted selection
    Call Rectangle(hDC, 10, 10, 50, 50)

    ' Draw black and white dotted selection
    OldBKCol = SetBkColor(hDC, vbWhite)
    OldBkMode = SetBkMode(hDC, OPAQUE)
    Call Rectangle(hDC, 70, 10, 110, 50)
    Call SetBkColor(hDC, OldBKCol)
    Call SetBkMode(hDC, OldBkMode)

    ' Draw XOr dotted selection
    OldR2 = SetROP2(hDC, R2_NOT)
    Call Rectangle(hDC, 130, 10, 170, 50)
    Call SetROP2(hDC, OldR2)

    Call SelectObject(hDC, hOldPen)
    Call DeleteObject(hPen)
End Sub
'***

My personal preference would be the middle one since it can be seen on any colour, however the one VB uses is the third
option which has problems when selecting over mid grey shades (opposite of mid grey is mid grey..)
Here's another example of a selection rectangle similar to VB's:
http://groups.google.co.uk/group/microsoft.public.vb.general.discussion/msg/c14c9f3e78a6ed29
Hope this helps,

    Mike


- Microsoft Visual Basic MVP -
E-Mail: ED***@mvps.org
WWW: Http://EDais.mvps.org/

Try this, on a Form containing a Shape Control and a fairly large Picture
Box:

Mike

Option Explicit
Private dragMode As Long
Private xOffset As Single, yOffset As Single
Private Edge As Long, edgeSense As Single
Private Const OFF As Long = 0
Private Const DRAGGING As Long = 1
Private Const SIZING As Long = 2
Private Const LEFTEDGE As Long = 3
Private Const RIGHTEDGE As Long = 4
Private Const TOPEDGE As Long = 5
Private Const BOTTOMEDGE As Long = 6
Private Const TOPLEFTCORNER As Long = 7
Private Const BOTTOMRIGHTCORNER As Long = 8
Private Const TOPRIGHTCORNER As Long = 9
Private Const BOTTOMLEFTCORNER As Long = 10

Private Sub Form_Load()
Set Shape1.Container = Picture1
With Picture1
  .AutoRedraw = True
  .ScaleMode = vbPixels ' or anything else you wish
  ' alter this to a picture that exists on your machine
  .PaintPicture LoadPicture("c:\tulips.jpg"), _
    0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight
  Shape1.Left = .ScaleWidth * 0.1
  Shape1.Top = .ScaleHeight * 0.1
  Shape1.Width = .ScaleWidth * 0.8
  Shape1.Height = .ScaleHeight * 0.8
  Shape1.Shape = 0 ' rectangle
  ' The following seems to give the most reliable results,
  ' showing up nice and clearly over all shades of grey
  Shape1.BorderColor = RGB(170, 170, 170) ' 255,255,255
  Shape1.DrawMode = vbXorPen
  ' But vbInvert is more pleasing on the eye (decide later)
  Shape1.BorderWidth = 1
  ' set the "edge sensitivity" to 5 pixels
  edgeSense = .ScaleX(5, vbPixels, .ScaleMode)
End With
dragMode = OFF
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift _
    As Integer, x As Single, y As Single)
If Picture1.MousePointer = vbDefault Then Exit Sub
If Picture1.MousePointer <> vbSizeAll Then
  dragMode = SIZING
Else
  xOffset = x - Shape1.Left
  yOffset = y - Shape1.Top
  dragMode = DRAGGING
End If
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift _
    As Integer, x As Single, y As Single)
Dim x1 As Single, y1 As Single, Pointer As Long
With Shape1
Select Case dragMode
  Case DRAGGING
    x1 = x - xOffset
    y1 = y - yOffset
    If x1 < 0 Then
      x1 = 0
    End If
    If (x1 + .Width) > Picture1.ScaleWidth Then
      x1 = Picture1.ScaleWidth - .Width
    End If
    If y1 < 0 Then
      y1 = 0
    End If
    If (y1 + .Height) > Picture1.ScaleHeight Then
      y1 = Picture1.ScaleHeight - .Height
    End If
    Shape1.Move x1, y1
  Case OFF
    x1 = x - .Left
    y1 = y - .Top
    If x >= .Left And x <= (.Left + .Width) And _
           y >= .Top And y <= .Top + .Height Then
      Pointer = vbSizeAll
    Else
      Pointer = vbDefault
    End If
    Select Case True
      Case (x1 >= 0) And (x1 <= edgeSense) And (y1 > _
      edgeSense) And (y1 <= (.Height - edgeSense))
        Pointer = vbSizeWE: Edge = LEFTEDGE
      Case (x1 >= (.Width - edgeSense)) And _
      (x1 <= .Width) And (y1 > edgeSense) And _
      (y1 < (.Height - edgeSense))
        Pointer = vbSizeWE: Edge = RIGHTEDGE
      Case (y1 >= 0) And (y1 <= edgeSense) And _
      (x1 > edgeSense) And (x1 <= (.Width - edgeSense))
        Pointer = vbSizeNS: Edge = TOPEDGE
      Case (y1 >= .Height - edgeSense) And _
      (y1 <= .Height) And (x1 > edgeSense) And _
      (x1 < (.Width - edgeSense))
        Pointer = vbSizeNS: Edge = BOTTOMEDGE
      Case (x1 >= 0 And x1 <= edgeSense) And _
      (y1 >= 0 And y1 <= edgeSense)
        Pointer = vbSizeNWSE: Edge = TOPLEFTCORNER
      Case (x1 >= .Width - edgeSense And x1 <= .Width) _
      And (y1 >= .Height - edgeSense And y1 <= .Height)
        Pointer = vbSizeNWSE: Edge = BOTTOMRIGHTCORNER
      Case (x1 >= .Width - edgeSense And x1 <= .Width) _
      And (y1 >= 0 And y1 <= edgeSense)
        Pointer = vbSizeNESW: Edge = TOPRIGHTCORNER
      Case (x1 >= 0 And x1 <= edgeSense) And _
      (y1 >= .Height - edgeSense And y1 <= .Height)
        Pointer = vbSizeNESW: Edge = BOTTOMLEFTCORNER
    End Select ' End Case True
    If Picture1.MousePointer <> Pointer Then
      Picture1.MousePointer = Pointer
    End If
  Case SIZING
    Select Case Edge
      Case LEFTEDGE
        doLeft x, y
      Case RIGHTEDGE
        doRight x, y
      Case TOPEDGE
        doTop x, y
      Case BOTTOMEDGE
        doBottom x, y
      Case TOPLEFTCORNER
        doLeft x, y
        doTop x, y
      Case TOPRIGHTCORNER
        doRight x, y
        doTop x, y
      Case BOTTOMLEFTCORNER
        doLeft x, y
        doBottom x, y
      Case BOTTOMRIGHTCORNER
        doRight x, y
        doBottom x, y
    End Select ' End Case Edge
End Select ' End Case DRAGMODE
End With
End Sub

Private Sub doLeft(x As Single, y As Single)
Dim leftside As Single
With Shape1
leftside = .Left
If x < 0 Then
  x = 0
End If
If x > (.Left + .Width - edgeSense * 4) Then
  x = (.Left + .Width - edgeSense * 4)
End If
..Left = x
..Width = .Width + leftside - x
End With
End Sub

Private Sub doRight(x As Single, y As Single)
With Shape1
If x < .Left + edgeSense * 4 Then
  x = .Left + edgeSense * 4
End If
If x > Picture1.ScaleWidth Then
  x = Picture1.ScaleWidth
End If
..Width = x - .Left
End With
End Sub

Private Sub doTop(x As Single, y As Single)
Dim topside As Single
With Shape1
topside = .Top
If y < 0 Then
  y = 0
End If
If y > (.Top + .Height - edgeSense * 4) Then
  y = (.Top + .Height - edgeSense * 4)
End If
..Top = y
..Height = .Height + topside - y
End With
End Sub

Private Sub doBottom(x As Single, y As Single)
With Shape1
If y < .Top + edgeSense * 4 Then
  y = .Top + edgeSense * 4
End If
If y > Picture1.ScaleHeight Then
  y = Picture1.ScaleHeight
End If
..Height = y - .Top
End With
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift _
    As Integer, x As Single, y As Single)
dragMode = OFF
End Sub

Sad
Inline Assembly In VB6
Problem populating a combobox if cases differ
Determine if: > .dat < is in a string
Interlocked Functions vs VB Reading Current Value
pulling varchar
Excel automation
Treeview
format textbox for ip-address.
Creating a search function in vb.net