Solved

Problem with hot spots in resizing pictures

Posted on 2001-08-09
2
320 Views
Last Modified: 2010-05-02
Hi,

I'm using the following code to display 2 pictures inside two other pictureBoxes. These pictures can be resized, and move around the pictureBox in which they are painted into. I have 2 sets of pictures. On the left side I have picture1(0) and inside it I have picInside(0), and on the right side I have picture1(1) and picInside(1). I have no problem with the left pictures. I have a problem with the right ones. When I want to resize the picture that is inside the outer picture, I have a problem with the left hot spots, that is with : TOP_LEFT, MID_LEFT, BOT_LEFT. These hotspots do not behave the way they suppose to. I can see the "right" cursor, but it doesn't work well. For example, the BOT_LEFT hot spot, when I drag it towards the inside of the picture, instead of resizing the picture while constraining proportions, it acts like as if I dragged the MID_BOT hot spot. Very bizarre, since it works perfectly on the picture on the right side...

Any ideas?

Thanks a lot!




Option Explicit

'Initial bounding box position and size. The width and height are the
'size of the picture control holding the the picture image.

'States to track dragging.
Const WAITING = 0
Const DRAGGING = 1

'Names for hot spots, with a different kind of drag for each. DON'T
'CHANGE -- used as array indices in the Cursor() array, return values
'from PtinHotSpot(), and elsewhere. Stored in global variable hs.
Const TOP_LEFT = 0
Const TOP_MID = 1
Const TOP_RT = 2
Const MID_RT = 3
Const BOT_RT = 4
Const BOT_MID = 5
Const BOT_LEFT = 6
Const MID_LEFT = 7
Const TRANSLATE = 8
Const NO_HIT = 9

'The following three constants determine the size of the little black
'boxes and their distance from the bounding box. The size of the little
'boxes is one more than BOXSIZE; HALF_BOXSIZE is half of that; and
'MARGIN = BOXSIZE + 1 + (number of pixels between the Bbox(index) and the
'little boxes). Here the boxes are 5 pixels square and they are 2 pixels
'from the Bbox(index) -- resetting to (6, 3, 8) respectively gives boxes 7
'pixels square and 1 pixel from the Bbox(index).
Const BOXSIZE = 4
Const HALF_BOXSIZE = 2
Const MARGIN = 7

'Type for bounding box holding image.
Private Type box
 Left As Integer
 Top As Integer
 width As Integer
 height As Integer
End Type

'16-bit Windows (Win31) and 32-bit Windows (Win95 / WIN NT) have
'different type and function declarations. Use conditional compilation
'to compile either way, depending on which VB compiler is being used.
 'WinAPI RECT for ClipCursor().
 Private Type RECT
   x1 As Long
   y1 As Long
   x2 As Long
   y2 As Long
 End Type

 'WinAPI POINT for ClientToScreen().
 Private Type wpoint
   X As Long
   Y As Long
 End Type

 'WinAPI calls for restricting cursor.
 Private Declare Sub ClipCursor Lib "User32" (r As RECT)
 Private Declare Sub ClearCursor Lib "User32" Alias "ClipCursor" (ByVal lpr&)
 Private Declare Sub ClientToScreen Lib "User32" (ByVal hwnd As Long, lpp As wpoint)

'Bounding box holding image.
Dim Bbox(1) As box

'Array of cursors for each hot spot.
Dim Cursor%(NO_HIT)

'State variable to track drag.
Dim State%

'Hot spot index.
Dim hs%

'Mouse deltas relative to Bbox(index) top left (used to translate).
Dim dx%, dy%

Private Sub Form_Load()

 'Set form ScaleMode to pixels.
 Me.ScaleMode = vbPixels

 'Make picture box invisible, use pixels.
 Dim i As Integer
 For i = 0 To 1
    picInside(i).BorderStyle = 0
    picInside(i).Visible = False
    picInside(i).ScaleMode = vbPixels
     
    'Init bounding box to size of the picture, located in middle of screen.
    Bbox(i).Left = Picture1(i).Left / Screen.TwipsPerPixelX
    Bbox(i).Top = Picture1(i).Top / Screen.TwipsPerPixelX
    Bbox(i).width = Picture1(i).width
    Bbox(i).height = Picture1(i).height
  Next i
 
 
 'Init Cursors as appropriate for each hot spot.
 Cursor(TOP_LEFT) = vbSizeNWSE
 Cursor(TOP_MID) = vbSizeNS
 Cursor(TOP_RT) = vbSizeNESW
 Cursor(MID_RT) = vbSizeWE
 Cursor(BOT_RT) = vbSizeNWSE
 Cursor(BOT_MID) = vbSizeNS
 Cursor(BOT_LEFT) = vbSizeNESW
 Cursor(MID_LEFT) = vbSizeWE
 Cursor(TRANSLATE) = vbSizePointer
 Cursor(NO_HIT) = vbArrow



End Sub


Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Me.MousePointer = vbArrow
End Sub

Private Sub Picture1_MouseDown(index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

 Dim r As RECT      'clip rect for ClipCursor
 Dim p As wpoint    'for ClientToScreen
 Dim q As wpoint    'for ClientToScreen

 'Grab hot spot index.
 hs = PtInHotSpot(index, Bbox(index), X, Y)

 'Exit immediately if not in hot spot.
 If hs = NO_HIT Then
   Exit Sub
 End If

 If State = WAITING Then
   'If get here, user has buttoned-down in one of the hot spots. Do
   'the common logic for all hot spots.
   State = DRAGGING
   'Set xor mode, erase Bbox(index) frame.
   DrawMode = vbNotXorPen
   DrawFrame index, Bbox(index)
   'Redraw frame without hot spots.
   DrawStyle = vbDot
   Picture1(index).Line (Bbox(index).Left, Bbox(index).Top)-Step(Bbox(index).width, Bbox(index).height), , B
   
   'User is starting to drag one of the hot spots; set points p and q
   'appropriately for each one, to determine how cursor will be restricted.
   'In each case, set p to top left, q to bottom right of clip rect.
   Select Case hs
     Case TOP_LEFT
       'Set p to client top left.
       p.X = 0
       p.Y = 0
       'Set q to Bbox(index) bottom right.
       q.X = Bbox(index).Left + Bbox(index).width
       q.Y = Bbox(index).Top + Bbox(index).height
     Case TOP_MID
       'Set p to client top left.
       p.X = 0
       p.Y = 0
       'Set q to client right, Bbox(index) bottom.
       q.X = ScaleWidth
       q.Y = Bbox(index).Top + Bbox(index).height
     Case TOP_RT
       'Set p to client top right.
       p.X = Bbox(index).Left
       p.Y = 0
       'Set q to Bbox(index) bottom left.
       q.X = ScaleWidth
       q.Y = Bbox(index).Top + Bbox(index).height
     Case MID_RT
       'Set p Bbox(index) left, client top.
       p.X = Bbox(index).Left
       p.Y = 0
       'Set q to client bottom right.
       q.X = ScaleWidth
       q.Y = ScaleHeight
     Case BOT_RT
       'Set p to Bbox(index) left top.
       p.X = Bbox(index).Left
       p.Y = Bbox(index).Top
       'Set q to client bottom right.
       q.X = ScaleWidth
       q.Y = ScaleHeight
     Case BOT_MID
       'Set p to client left, Bbox(index) top.
       p.X = 0
       p.Y = Bbox(index).Top
       'Set q to client bottom right.
       q.X = ScaleWidth
       q.Y = ScaleHeight
     Case BOT_LEFT
       'Set p to client left, Bbox(index) top.
       p.X = 0
       p.Y = Bbox(index).Top
       'Set q to client bottom, Bbox(index) right.
       q.X = Bbox(index).Left + Bbox(index).width
       q.Y = ScaleHeight
     Case MID_LEFT
       'Set p to client top left.
       p.X = 0
       p.Y = 0
       'Set q to Bbox(index) right, client bottom.
       q.X = Bbox(index).Left + Bbox(index).width
       q.Y = ScaleHeight
     Case TRANSLATE
       'Set p to client top left.
       p.X = 0
       p.Y = 0
       'Set q to client bottom right.
       q.X = ScaleWidth
       q.Y = ScaleHeight
       'Also set global deltas of mouse relative to top left.
       dx = X - Bbox(index).Left
       dy = Y - Bbox(index).Top
   End Select
   
   'Force px >= 0, p.y >= 0, q.x <= ScaleWidth, q.y <= ScaleHeight.
   p.X = Max(p.X, 0)
   p.Y = Max(p.Y, 0)
   q.X = Min(q.X, ScaleWidth)
   q.Y = Min(q.Y, ScaleHeight)
   
   'Convert p and q to screen coords expected by ClipCursor().
   ClientToScreen hwnd, p
   ClientToScreen hwnd, q
   'Set clip rect from p and q, restrict cursor to it.
   r.x1 = p.X: r.y1 = p.Y: r.x2 = q.X: r.y2 = q.Y
   ClipCursor r
       
 End If  'If State = WAITING

End Sub


 Private Sub Picture1_MouseMove(index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
 
 If State = DRAGGING Then
   'Erase previous Bbox(index).
   Picture1(index).Line (Bbox(index).Left, Bbox(index).Top)-Step(Bbox(index).width, Bbox(index).height), , B
   'Reset Bbox(index) depending on mouse position and type of drag.
   Select Case hs
     Case TOP_LEFT
       Bbox(index).width = Bbox(index).width + (Bbox(index).Left - X)
       Bbox(index).height = Bbox(index).height + (Bbox(index).Top - Y)
       Bbox(index).Left = X
       Bbox(index).Top = Y
     Case TOP_MID
       Bbox(index).height = Bbox(index).height + (Bbox(index).Top - Y)
       Bbox(index).Top = Y
     Case TOP_RT
       'Add 1 to width to keep it greater than 0.
       Bbox(index).width = X - Bbox(index).Left + 1
       Bbox(index).height = Bbox(index).height + (Bbox(index).Top - Y)
       Bbox(index).Top = Y
     Case MID_RT
       'Add 1 to width to keep it greater than 0.
       Bbox(index).width = X - Bbox(index).Left + 1
     Case BOT_RT
       'Add 1 to width and height to keep them greater than 0.
       Bbox(index).width = X - Bbox(index).Left + 1
       Bbox(index).height = Y - Bbox(index).Top + 1
     Case BOT_MID
       'Add 1 to height to keep it greater than 0.
       Bbox(index).height = Y - Bbox(index).Top + 1
     Case BOT_LEFT
       Bbox(index).width = Bbox(index).width + (Bbox(index).Left - X)
       'Add 1 to height to keep it greater than 0.
       Bbox(index).height = Y - Bbox(index).Top + 1
       Bbox(index).Left = X
     Case MID_LEFT
       Bbox(index).width = Bbox(index).width + (Bbox(index).Left - X)
       Bbox(index).Left = X
     Case TRANSLATE
       'Reset top left using deltas from MouseDown.
       Bbox(index).Left = X - dx
       Bbox(index).Top = Y - dy
   End Select
   'Draw new Bbox(index).
   Picture1(index).Line (Bbox(index).Left, Bbox(index).Top)-Step(Bbox(index).width, Bbox(index).height), , B
 Else
   'Set mouse appropriate to hot spot if moving across.
   MousePointer = Cursor(PtInHotSpot(index, Bbox(index), X, Y))
 End If
 
End Sub

Private Sub Picture1_MouseUp(index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
 'If drag finalized, release cursor and paint.
 If State = DRAGGING Then
   State = WAITING
   DrawMode = vbCopyPen
   'Equivalent to API call ClipCursor(NULL) to free cursor.
   ClearCursor 0&
   Picture1_Paint (index)
 End If

End Sub


Private Sub Picture1_Paint(index As Integer)
 'Clear screen.
 Picture1(index).Cls
 'Draw flag.
 Picture1(index).PaintPicture picInside(index).Picture, Bbox(index).Left, Bbox(index).Top, Bbox(index).width, Bbox(index).height
 'Draw outpicture1(index).Line with little black boxes.
 DrawFrame index, Bbox(index)
End Sub

Private Function PtInHotSpot%(index As Integer, b As box, ByVal X%, ByVal Y%)

'USE:  Given box, return hot spot index for point.
'IN:   b = bounding box (Bbox(index)) around which hot spots are defined
'      (x,y) = point to test
'RET:  index of hot spot (TOP_LEFT...TRANSLATE, NO_HIT if not in any)
'NOTE: The hot spots are the given box and 8 little boxes around it.
'      NO_HIT is returned if the point is in none of these hot spots.

 Dim lbb As box   'to define little black boxes
 Dim mx%          'x-coord of little box at middle
 Dim my%          'y-coord of little box at middle

 'First check for point outside extended Bbox(index) (quick reject).
 If X < b.Left - MARGIN Or X > b.Left + b.width + MARGIN Or _
    Y < b.Top - MARGIN Or Y > b.Top + b.height + MARGIN Then
   PtInHotSpot = NO_HIT
   Exit Function
 End If
 
 'Next check for point within Bbox(index) (quick reject).
 If PtInBox(b, X, Y) Then
   PtInHotSpot = TRANSLATE
   Exit Function
 End If
 
 'Most points will satisfy one of the conditions above. All other
 'points lie along a thin border MARGIN pixels wide around the Bbox(index).
 'This border contains all the hot spots except the Bbox(index) itself; so
 'next check them in order, starting at the upper left and proceeding
 'clockwise.
 
 'Check for point in top left hot spot.
 lbb.Left = b.Left - MARGIN
 lbb.Top = b.Top - MARGIN
 lbb.width = BOXSIZE
 lbb.height = BOXSIZE
 If PtInBox(lbb, X, Y) Then
   PtInHotSpot = TOP_LEFT
   Exit Function
 End If
   
 'Calc middle x and y (-2 to picture1(index).Line up at left/top edge of box).
 mx = Bbox(index).Left + Bbox(index).width / 2 - HALF_BOXSIZE
 my = Bbox(index).Top + Bbox(index).height / 2 - HALF_BOXSIZE
 
 'Check for point in top middle hot spot.
 'Note width and height stay at BOXSIZE, as set above.
 lbb.Left = mx
 lbb.Top = b.Top - MARGIN
 If PtInBox(lbb, X, Y) Then
   PtInHotSpot = TOP_MID
   Exit Function
 End If
 
 'Check for point in top right hot spot.
 lbb.Left = b.Left + b.width + MARGIN - BOXSIZE
 lbb.Top = b.Top - MARGIN
 If PtInBox(lbb, X, Y) Then
   PtInHotSpot = TOP_RT
   Exit Function
 End If
   
 'Check for point in middle right hot spot.
 lbb.Left = b.Left + b.width + MARGIN - BOXSIZE
 lbb.Top = my
 If PtInBox(lbb, X, Y) Then
   PtInHotSpot = MID_RT
   Exit Function
 End If
   
 'Check for point in bottom right hot spot.
 lbb.Left = b.Left + b.width + MARGIN - BOXSIZE
 lbb.Top = b.Top + b.height + MARGIN - BOXSIZE
 If PtInBox(lbb, X, Y) Then
   PtInHotSpot = BOT_RT
   Exit Function
 End If
   
 'Check for point in bottom middle hot spot.
 lbb.Left = mx
 lbb.Top = b.Top + b.height + MARGIN - BOXSIZE
 If PtInBox(lbb, X, Y) Then
   PtInHotSpot = BOT_MID
   Exit Function
 End If
   
 'Check for point in bottom left hot spot.
 lbb.Left = b.Left - MARGIN
 lbb.Top = b.Top + b.height + MARGIN - BOXSIZE
 If PtInBox(lbb, X, Y) Then
   PtInHotSpot = BOT_LEFT
   Exit Function
 End If
   
 'Check for point in middle left hot spot.
 lbb.Left = b.Left - MARGIN
 lbb.Top = my
 If PtInBox(lbb, X, Y) Then
   PtInHotSpot = MID_LEFT
   Exit Function
 End If
   
 'If get thru to here, not in any of the hot spots.
 PtInHotSpot = NO_HIT

End Function

Private Function PtInBox%(b As box, ByVal X%, ByVal Y%)

 'USE:  Returns True if given point is in the box, False otherwise.
 'IN:   b = box to find point in
 '      (x,y) = given point to test
 
 PtInBox = X >= b.Left And X <= b.Left + b.width And _
           Y >= b.Top And Y <= b.Top + b.height

End Function

Private Sub DrawFrame(index As Integer, b As box)

 'USE:  Draw dotted rectangle and little black boxes.
 'IN:   b = rectangle to draw
 'NOTE: Eight little black boxes drawn at corners and middle of
 '      edges. Constants BOXSIZE and MARGIN determine size of the
 '      boxes and how close they are to the rectangle.

 Dim mx%        'x-coord of little box at middle
 Dim my%        'y-coord of little box at middle
 Dim pRight%    'right edge
 Dim pBottom%   'bottom edge

 'Outpicture1(index).Line box with dotted rectangle (VB builds in margin).
 DrawStyle = vbDot
 Picture1(index).Line (b.Left, b.Top)-Step(b.width, b.height), , B

 'Calc middle x and y (-HALF_BOXSIZE to picture1(index).Line up at left/top of box).
 mx = b.Left + b.width / 2 - HALF_BOXSIZE
 my = b.Top + b.height / 2 - HALF_BOXSIZE
 
 'Calc right and bottom edges.
 pRight = b.Left + b.width
 pBottom = b.Top + b.height

 'Draw little black boxes at corners and middle of edges -- start
 'at upper left and proceed clockwise.
 DrawStyle = vbSolid

 Picture1(index).Line (b.Left - MARGIN, b.Top - MARGIN)-Step(BOXSIZE, BOXSIZE), , BF
 Picture1(index).Line (mx, b.Top - MARGIN)-Step(BOXSIZE, BOXSIZE), , BF
 Picture1(index).Line (pRight + MARGIN, b.Top - MARGIN)-Step(-BOXSIZE, BOXSIZE), , BF
 Picture1(index).Line (pRight + MARGIN, my)-Step(-BOXSIZE, BOXSIZE), , BF
 Picture1(index).Line (pRight + MARGIN, pBottom + MARGIN)-Step(-BOXSIZE, -BOXSIZE), , BF
 Picture1(index).Line (mx, pBottom + MARGIN)-Step(BOXSIZE, -BOXSIZE), , BF
 Picture1(index).Line (b.Left - MARGIN, pBottom + MARGIN)-Step(BOXSIZE, -BOXSIZE), , BF
 Picture1(index).Line (b.Left - MARGIN, my)-Step(BOXSIZE, BOXSIZE), , BF
End Sub


Private Function Min(ByVal u, ByVal v)
 If (u < v) Then
   Min = u
 Else
   Min = v
 End If
End Function

Private Function Max(ByVal u, ByVal v)
 If (u < v) Then
   Max = v
 Else
   Max = u
 End If
End Function








0
Comment
Question by:meravkn
2 Comments
 
LVL 6

Accepted Solution

by:
pierrecampe earned 50 total points
Comment Utility
Hi meravkn
change this:
  'Convert p and q to screen coords expected by ClipCursor().
  ClientToScreen hwnd, p
  ClientToScreen hwnd, q
  'Set clip rect from p and q, restrict cursor to it.
 
to this:
  'Convert p and q to screen coords expected by ClipCursor().
  ClientToScreen Picture1(Index).hwnd, p
  ClientToScreen Picture1(Index).hwnd, q
  'Set clip rect from p and q, restrict cursor to it.



0
 
LVL 1

Author Comment

by:meravkn
Comment Utility
You saved my life once again :-) thank you very much!!!

Merav
0

Featured Post

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

Join & Write a Comment

Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now