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

Segunda parte:

Private Sub Form_Load()

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

'Make picture box invisible, use pixels.
picFlag.BorderStyle = 0
picFlag.Visible = False
picFlag.ScaleMode = vbPixels

'Init bounding box to size of Canadian flag, located in middle of screen.
Bbox.Left = INIT_BBOX_LEFT
Bbox.Top = INIT_BBOX_TOP
Bbox.width = INIT_BBOX_WIDTH
Bbox.height = INIT_BBOX_HEIGHT

'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_MouseDown(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(Bbox, 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 frame.
DrawMode = vbNotXorPen
DrawFrame Bbox
'Redraw frame without hot spots.
DrawStyle = vbDot
Line (Bbox.Left, Bbox.Top)-Step(Bbox.width, Bbox.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 bottom right.
q.x = Bbox.Left + Bbox.width
q.y = Bbox.Top + Bbox.height
Case TOP_MID
'Set p to client top left.
p.x = 0
p.y = 0
'Set q to client right, bbox bottom.
q.x = ScaleWidth
q.y = Bbox.Top + Bbox.height
Case TOP_RT
'Set p to client top right.
p.x = Bbox.Left
p.y = 0
'Set q to bbox bottom left.
q.x = ScaleWidth
q.y = Bbox.Top + Bbox.height
Case MID_RT
'Set p bbox left, client top.
p.x = Bbox.Left
p.y = 0
'Set q to client bottom right.
q.x = ScaleWidth
q.y = ScaleHeight
Case BOT_RT
'Set p to bbox left top.
p.x = Bbox.Left
p.y = Bbox.Top
'Set q to client bottom right.
q.x = ScaleWidth
q.y = ScaleHeight
Case BOT_MID
'Set p to client left, bbox top.
p.x = 0
p.y = Bbox.Top
'Set q to client bottom right.
q.x = ScaleWidth
q.y = ScaleHeight
Case BOT_LEFT
'Set p to client left, bbox top.
p.x = 0
p.y = Bbox.Top
'Set q to client bottom, bbox right.
q.x = Bbox.Left + Bbox.width
q.y = ScaleHeight
Case MID_LEFT
'Set p to client top left.
p.x = 0
p.y = 0
'Set q to bbox right, client bottom.
q.x = Bbox.Left + Bbox.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.Left
dy = y - Bbox.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