Visual Basic Foro
Programación => Visual Basic 6 => Mensaje iniciado por: LeandroA en Octubre 02, 2013, 02:20:46 pm
-
Hola, intento hacer lo siguiente, por asi decirlo me gustaría lograr hacer rebotar una pelota dentro de un formulario, supongamos que la pelota es un Picturebox, solo deseo que el movimiento sea en dos direcciones, ascendente y descendente (por ahora no me interesa que se mueva en cualquier dirección)
entonces si pincho el picture con el mouse y lo muevo de hacia arriva muevo el picture en esa direccion y lo contrario.
Mi problema no se como representar la inercia, es decir darle un empujón al picture, y que este se detenga según la velocidad y distancia en la que movi el picture.
bien creo que se darán cuenta mis intenciones, ahora pongo el código de lo que tengo echo.
solo se necesita un Picture1 en el formulario
Option Explicit
Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32.dll" (ByVal hwnd As Long, ByRef lpPoint As POINTAPI) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Dim yy As Long
Dim PT As POINTAPI
Dim lContador As Long
Dim Desendente As Boolean
Dim LastTop As Long
Dim Inercia As Long
Dim Aceleracion As Long
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
GetCursorPos PT
ScreenToClient Me.hwnd, PT
yy = (PT.Y * Screen.TwipsPerPixelY) - Picture1.Top
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lY As Long
If Button = 1 Then
GetCursorPos PT
ScreenToClient Me.hwnd, PT
lY = (PT.Y * Screen.TwipsPerPixelY) - yy
If lY + Picture1.Top > 0 Then
If lY < (Me.ScaleHeight - Picture1.Height) Then
If Picture1.Top <> lY Then
Picture1.Top = lY
Desendente = LastTop < Picture1.Top
LastTop = Picture1.Top
End If
Else
Picture1.Top = Me.ScaleHeight - Picture1.Height
End If
Else
Picture1.Top = 0
End If
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Debug.Print IIf(Desendente, "Baja", "Sube")
End Sub
Supongo que para la solución abra que emplear al menos dos Timer
-
Tal ves te sirvan estos amigo.
https://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=74543&lngWId=1 (https://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=74543&lngWId=1)
https://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=74696&lngWId=1 (https://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=74696&lngWId=1)
https://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=70805&lngWId=1 (https://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=70805&lngWId=1)
https://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=66169&lngWId=1 (https://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=66169&lngWId=1)
https://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=62238&lngWId=1 (https://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=62238&lngWId=1)
-
Por ahí te sirvan este viejo hilo en el foro :P
Hacer scroll o arrastre tipo movil (http://leandroascierto.com/foro/index.php?topic=1430.0)
Lastima los links ya no funcionen, pero si alguna vez lo bajaste y lo guardaste, por ahí le debas tener :P
-
Hola, gracias por los links, @Raul, si en realidad intento hacer eso mismo, solo que le di mas vueltas para explicarlo ;D, intente un rato y algo salio, aver que piensan ustedes.
Timer1 y Picture1
Option Explicit
Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32.dll" (ByVal hwnd As Long, ByRef lpPoint As POINTAPI) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Dim yy As Long
Dim PT As POINTAPI
Dim Desendente As Boolean
Dim LastTop As Long
Dim Inercia As Long
Private Sub Form_Load()
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Timer1.Interval = 0
GetCursorPos PT
ScreenToClient Me.hwnd, PT
yy = (PT.Y * Screen.TwipsPerPixelY) - Picture1.Top
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lY As Long
If Button = 1 Then
GetCursorPos PT
ScreenToClient Me.hwnd, PT
lY = (PT.Y * Screen.TwipsPerPixelY) - yy
If lY + Picture1.Top > 0 Then
If lY < (Me.ScaleHeight - Picture1.Height) Then
If Picture1.Top <> lY Then
Picture1.Top = lY
If Abs(LastTop - lY) > 15 Then
Inercia = Abs(LastTop - lY)
Else
Inercia = 0
End If
Desendente = LastTop < Picture1.Top
LastTop = Picture1.Top
End If
Else
Picture1.Top = Me.ScaleHeight - Picture1.Height
End If
Else
Picture1.Top = 0
End If
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Inercia > 0 Then Timer1.Interval = 10
End Sub
Private Sub Timer1_Timer()
If Picture1.Top - Inercia < 0 Then
Picture1.Top = 0
Timer1.Interval = 0
Exit Sub
End If
If Picture1.Top + Inercia + Picture1.Height > Me.ScaleHeight Then
Picture1.Top = Me.ScaleHeight - Picture1.Height
Timer1.Interval = 0
Exit Sub
End If
If Desendente Then
Picture1.Top = Picture1.Top + Inercia
Else
Picture1.Top = Picture1.Top - Inercia
End If
Inercia = Inercia - 1
If Inercia <= 0 Then Timer1.Interval = 0
End Sub
-
Yo lo veo bien, lo estoy probando en Seven por siaca. Me vacila el tema del impulso, mas tarde voy a jugar con ese codigo. Y ¿como seria hacerlo tambien para que asi como se empuja hacia abajo/arriba se empuje a la izquierda/derecha?? o lo que es peor diagonal!!!. :-)
-
Hola Yvan, para izquierda a derecha lo unico que hay que hacer es cambiar Y por X , Top por Left , Height o ScaleHeight por Width o ScaleWidth, lo da las diagonales no se pero ya abra que poner un par de if mas y algún tipo de calculo con la inercia.