Ver Mensaje Individual
  #4 (permalink)  
Antiguo 20/04/2011, 18:01
truskyvb
 
Fecha de Ingreso: octubre-2008
Mensajes: 188
Antigüedad: 15 años, 7 meses
Puntos: 3
Respuesta: Problemas con Picturebox

Y tercera y última parte del código:

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

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

End Sub
Private Sub Form_MouseUp(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&
Form_Paint
End If

End Sub
Private Sub Form_Paint()

'Clear screen.
Cls

'Draw flag.
PaintPicture picFlag.Picture, Bbox.Left, Bbox.Top, Bbox.width, Bbox.height

'Draw outline with little black boxes.
DrawFrame Bbox

End Sub

Private Function PtInHotSpot%(b As box, ByVal x%, ByVal y%)

'USE: Given box, return hot spot index for point.
'IN: b = bounding box (bbox) 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 (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 (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.
'This border contains all the hot spots except the bbox 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 line up at left/top edge of box).
mx = Bbox.Left + Bbox.width / 2 - HALF_BOXSIZE
my = Bbox.Top + Bbox.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(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

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

'Calc middle x and y (-HALF_BOXSIZE to 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
Line (b.Left - MARGIN, b.Top - MARGIN)-Step(BOXSIZE, BOXSIZE), , BF
Line (mx, b.Top - MARGIN)-Step(BOXSIZE, BOXSIZE), , BF
Line (pRight + MARGIN, b.Top - MARGIN)-Step(-BOXSIZE, BOXSIZE), , BF
Line (pRight + MARGIN, my)-Step(-BOXSIZE, BOXSIZE), , BF
Line (pRight + MARGIN, pBottom + MARGIN)-Step(-BOXSIZE, -BOXSIZE), , BF
Line (mx, pBottom + MARGIN)-Step(BOXSIZE, -BOXSIZE), , BF
Line (b.Left - MARGIN, pBottom + MARGIN)-Step(BOXSIZE, -BOXSIZE), , BF
Line (b.Left - MARGIN, my)-Step(BOXSIZE, BOXSIZE), , BF

End Sub


Private Function Min(ByVal u, ByVal v)

'USE: Return the smaller of two integers.

If (u < v) Then
Min = u
Else
Min = v
End If

End Function

Private Function Max(ByVal u, ByVal v)

'USE: Return the larger of two integers.

If (u < v) Then
Max = v
Else
Max = u
End If

End Function


Private Sub Form_Unload(Cancel As Integer)
End
End Sub

Private Sub mnuAbout_Click()

'Show About Box.
frmAbout.Show vbModal

End Sub


Private Sub mnuExit_Click()
End
End Sub