Les vengo a dejar este efecto de rotación.
Como en el tuto anterior, también hice uso del VB Shaped Form Creator.
Hice dos imágenes de Dos círculos de diámetros diferentes.
Una vez hecho eso abro VB6 y generamos un nuevo proyecto.
Agregamos los 5 forms antes creados y un sexto form que llame Principal.
A los anteriores 5 los llame: CirculoAb, CirculoAr, CirculoDe y CirculoIz (los chiquitos) y
Presentación (al Grande).
Al cual le agregue este código para hacer transparente un form:
---------------------
Option Explicit
Private Declare Function SetLayeredWindowAttributes Lib "user32" _
(ByVal hWnd As Long, _
ByVal crKey As Long, _
ByVal bAlpha As Byte, _
ByVal dwFlags As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias
"GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias
"SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const WS_EX_LAYERED = &H80000
Public Function Is_Transparent(ByVal hWnd As Long) As Boolean
On Error Resume Next
Dim Msg As Long
Msg = GetWindowLong(hWnd, GWL_EXSTYLE)
If (Msg And WS_EX_LAYERED) = WS_EX_LAYERED Then
Is_Transparent = True
Else
Is_Transparent = False
End If
If Err Then
Is_Transparent = False
End If
End Function
Public Function Aplicar_Transparencia(ByVal hWnd As Long, Valor As
Integer) As Long
Dim Msg As Long
On Error Resume Next
If Valor < 0 Or Valor > 255 Then
Aplicar_Transparencia = 1
Else
Msg = GetWindowLong(hWnd, GWL_EXSTYLE)
Msg = Msg Or WS_EX_LAYERED
SetWindowLong hWnd, GWL_EXSTYLE, Msg
SetLayeredWindowAttributes hWnd, 0, Valor, LWA_ALPHA
Aplicar_Transparencia = 0
End If
If Err Then
Aplicar_Transparencia = 2
End If
End Function
---------------------
Yo le cambie el color de Fondo de todos los Forms por un negro. (Atributo BackColor igual a
&H80000007&), ustedes pueden poner algunas imágenes o lo que deseen.
En los códigos que crea el VB Shaped le borre el del evento MouseDown para que no se puedan
mover con el Mouse.
A los 4 forms chiquitos les agregue un Label, a los cuales llame Posición en todos los casos.
Al Form Principal solamente usando el evento Load, lo posicionamos en el medio de la pantalla.
----------------
Private Sub Form_Load()
Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
End Sub
----------------
En el caso de los cuatro form Chiquitos. Usando el evento Load, posicionamos el form en el medio
de la pantalla. Ocultamos los Label (Atributo Visible = False) y en el atributo Caption le ponemos la
posición en que se encuentra.
CirculoAr --> Caption = "Arriba"
CirculoAb --> Caption = "Abajo"
CirculoDe --> Caption = "Derecha"
CirculoIz --> Caption = "Izquierda"
Veamos como seria:
Form CirculoAr:
-----------------
Private Sub Form_Load()
Dim nRet As Long
nRet = SetWindowRgn(Me.hWnd, CreateFormRegion(1, 1, 0, 0), True)
-----------------
Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
Posicion.Visible = False
Posicion.Caption = "Arriba"
End Sub
Form CirculoAb:
Private Sub Form_Load()
Dim nRet As Long
nRet = SetWindowRgn(Me.hWnd, CreateFormRegion(1, 1, 0, 0), True)
Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
Posicion.Visible = False
Posicion.Caption = "Abajo"
End Sub
Form CirculoDe:
Private Sub Form_Load()
Dim nRet As Long
nRet = SetWindowRgn(Me.hWnd, CreateFormRegion(1, 1, 0, 0), True)
Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
Posicion.Visible = False
Posicion.Caption = "Derecha"
End Sub
Form CirculoIz:
Private Sub Form_Load()
Dim nRet As Long
nRet = SetWindowRgn(Me.hWnd, CreateFormRegion(1, 1, 0, 0), True)
Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
Posicion.Visible = False
Posicion.Caption = "Izquierda"
End Sub
NOTA: Las dos primeras líneas las crea el VB Shaped.
Ahora el form Presentación.
Primero le agregamos un Timer.
Y le ponemos un 1000 en el atributo Interval.
Bien.
Agregamos la Api para la función Sleep
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Y definimos estas variables globales, que utilizaremos más adelante:
Dim SeguirGirando As Boolean
Dim arribaX As Integer, arribaY As Integer, abajoX As Integer, abajoY As
Integer, derechaX As Integer, derechaY As Integer, izquierdaX As Integer,
izquierdaY As Integer
En el evento Load ponemos esto:
Private Sub Form_Load()
Dim nRet As Long
nRet = SetWindowRgn(Me.hWnd, CreateFormRegion(1, 1, 0, 0), True)
Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
Call Aplicar_Transparencia(Me.hWnd, CByte(0))
CirculoAb.Show
CirculoAr.Show
CirculoDe.Show
CirculoIz.Show
SeguirGirando = True
End Sub
Las primeras dos líneas las agrega el VB Shaped.
Posicionamos el form en el medio de la pantalla.
Le ponemos una transparencia = 0, es decir lo hago totalmente invisible.
Muestro todos los forms chiquitos.
Y le asigno a la variable booleana antes definida un valor igual a True.
Vamos a agregar un Sub llamado Girar, que va a ser el encargado de producir el efecto.
Private Sub Girar()
Dim j As Integer
j = 0
Do While SeguirGirando
If CirculoAr.Posicion.Caption = "Arriba" Then
CirculoAr.Top = CirculoAr.Top + 1
CirculoAr.Left = CirculoAr.Left + 1
If (CirculoAr.Left = derechaX) And (CirculoAr.Top = derechaY)
Then CirculoAr.Posicion.Caption = "Derecha"
DoEvents
End If
If CirculoAr.Posicion.Caption = "Derecha" Then
CirculoAr.Top = CirculoAr.Top + 1
CirculoAr.Left = CirculoAr.Left - 1
If (CirculoAr.Left = abajoX) And (CirculoAr.Top = abajoY)
Then CirculoAr.Posicion.Caption = "Abajo"
DoEvents
End If
If CirculoAr.Posicion.Caption = "Abajo" Then
CirculoAr.Top = CirculoAr.Top - 1
CirculoAr.Left = CirculoAr.Left - 1
If (CirculoAr.Left = izquierdaX) And (CirculoAr.Top =
izquierdaY) Then CirculoAr.Posicion.Caption = "Izquierda"
DoEvents
End If
If CirculoAr.Posicion.Caption = "Izquierda" Then
CirculoAr.Top = CirculoAr.Top - 1
CirculoAr.Left = CirculoAr.Left + 1
If (CirculoAr.Left = arribaX) And (CirculoAr.Top = arribaY)
Then
CirculoAr.Posicion.Caption = "Arriba"
j = j + 1
End If
DoEvents
End If
If CirculoAb.Posicion.Caption = "Abajo" Then
CirculoAb.Top = CirculoAb.Top - 1
CirculoAb.Left = CirculoAb.Left - 1
If (CirculoAb.Left = izquierdaX) And (CirculoAb.Top =
izquierdaY) Then CirculoAb.Posicion.Caption = "Izquierda"
DoEvents
End If
If CirculoAb.Posicion.Caption = "Izquierda" Then
CirculoAb.Top = CirculoAb.Top - 1
CirculoAb.Left = CirculoAb.Left + 1
If (CirculoAb.Left = arribaX) And (CirculoAb.Top = arribaY)
Then CirculoAb.Posicion.Caption = "Arriba"
DoEvents
End If
If CirculoAb.Posicion.Caption = "Arriba" Then
CirculoAb.Top = CirculoAb.Top + 1
CirculoAb.Left = CirculoAb.Left + 1
If (CirculoAb.Left = derechaX) And (CirculoAb.Top = derechaY)
Then CirculoAb.Posicion.Caption = "Derecha"
DoEvents
End If
If CirculoAb.Posicion.Caption = "Derecha" Then
CirculoAb.Top = CirculoAb.Top + 1
CirculoAb.Left = CirculoAb.Left - 1
If (CirculoAb.Left = abajoX) And (CirculoAb.Top = abajoY)
Then CirculoAb.Posicion.Caption = "Abajo"
DoEvents
End If
If CirculoDe.Posicion.Caption = "Derecha" Then
CirculoDe.Top = CirculoDe.Top + 1
CirculoDe.Left = CirculoDe.Left - 1
If (CirculoDe.Left = abajoX) And (CirculoDe.Top = abajoY)
Then CirculoDe.Posicion.Caption = "Abajo"
DoEvents
End If
If CirculoDe.Posicion.Caption = "Abajo" Then
CirculoDe.Top = CirculoDe.Top - 1
CirculoDe.Left = CirculoDe.Left - 1
If (CirculoDe.Left = izquierdaX) And (CirculoDe.Top =
izquierdaY) Then CirculoDe.Posicion.Caption = "Izquierda"
DoEvents
End If
If CirculoDe.Posicion.Caption = "Izquierda" Then
CirculoDe.Top = CirculoDe.Top - 1
CirculoDe.Left = CirculoDe.Left + 1
If (CirculoDe.Left = arribaX) And (CirculoDe.Top = arribaY)
Then CirculoDe.Posicion.Caption = "Arriba"
DoEvents
End If
If CirculoDe.Posicion.Caption = "Arriba" Then
CirculoDe.Top = CirculoDe.Top + 1
CirculoDe.Left = CirculoDe.Left + 1
If (CirculoDe.Left = derechaX) And (CirculoDe.Top = derechaY)
Then CirculoDe.Posicion.Caption = "Derecha"
DoEvents
End If
If CirculoIz.Posicion.Caption = "Izquierda" Then
CirculoIz.Top = CirculoIz.Top - 1
CirculoIz.Left = CirculoIz.Left + 1
If (CirculoIz.Left = arribaX) And (CirculoIz.Top = arribaY)
Then CirculoIz.Posicion.Caption = "Arriba"
DoEvents
End If
If CirculoIz.Posicion.Caption = "Arriba" Then
CirculoIz.Top = CirculoIz.Top + 1
CirculoIz.Left = CirculoIz.Left + 1
If (CirculoIz.Left = derechaX) And (CirculoIz.Top = derechaY)
Then CirculoIz.Posicion.Caption = "Derecha"
DoEvents
End If
If CirculoIz.Posicion.Caption = "Derecha" Then
CirculoIz.Top = CirculoIz.Top + 1
CirculoIz.Left = CirculoIz.Left - 1
If (CirculoIz.Left = abajoX) And (CirculoIz.Top = abajoY)
Then CirculoIz.Posicion.Caption = "Abajo"
DoEvents
End If
If CirculoIz.Posicion.Caption = "Abajo" Then
CirculoIz.Top = CirculoIz.Top - 1
CirculoIz.Left = CirculoIz.Left - 1
If (CirculoIz.Left = izquierdaX) And (CirculoIz.Top =
izquierdaY) Then CirculoIz.Posicion.Caption = "Izquierda"
DoEvents
End If
Sleep 0.5
If j = 2 Then SeguirGirando = False
Loop
End Sub
Hago una breve explicación de cómo trabaja.
Dependiendo de la palabra que contenga cada label de los form, les cambia los atributos Left y
Top. Haciendo mover el circulo que se encuentra arriba hacia donde está el circulo de la derecha,
el circulo de la derecha hacia el circulo de abajo, el circulo de abajo hacia el circulo de la izquierda
y el circulo de la izquierda hacia el circulo de arriba.
Una vez que llegan a su nueva posición, les cambio el atributo Caption por la posición nueva,
recién llegada.
Usando una variable local j de tipo Integer. Controlo que se hagan dos vueltas y luego hago que
salga del bucle.
Entendido esto sigamos con el código.
Ahora vamos a hacer uso del evento Timer del Timer agregado.
Private Sub Timer1_Timer()
Dim i As Integer
For i = 0 To 3000
CirculoAr.Top = CirculoAr.Top - 1
DoEvents
Sleep 0.6
Next i
arribaX = CirculoAr.Left
arribaY = CirculoAr.Top
For i = 0 To 3000
CirculoAb.Top = CirculoAb.Top + 1
DoEvents
Sleep 0.6
Next i
abajoX = CirculoAb.Left
abajoY = CirculoAb.Top
For i = 0 To 3000
CirculoDe.Left = CirculoDe.Left + 1
DoEvents
Sleep 0.6
Next i
derechaX = CirculoDe.Left
derechaY = CirculoDe.Top
For i = 0 To 3000
CirculoIz.Left = CirculoIz.Left - 1
DoEvents
Sleep 0.6
Next i
izquierdaX = CirculoIz.Left
izquierdaY = CirculoIz.Top
For i = 0 To 255
Call Aplicar_Transparencia(Me.hWnd, CByte(i))
DoEvents
Sleep 0.6
Next i
Girar
Sleep 500
Unload Me
Unload CirculoAr
Unload CirculoAb
Unload CirculoDe
Unload CirculoIz
Principal.Show
End Sub
Al principio aparecen los 4 forms chiquitos en el centro de la pantalla, usando la sentencia For
llevo cada Circulo a su posición, uno por uno, y cuando los tengo posicionados guardo sus atributo
Top y Left en las variables globales que definimos al principio, y que van a servir para tener la
referencia de las ubicaciones principales. Luego hago que el form Presentación aparezca de a poco
cambiando su transparencia. Llamamos al Sub Girar para que produzca el efecto y por últimos
cerramos todos los forms y mostramos el Form Principal.
Ustedes miren con más paciencia el código, y se darán cuenta de lo que hablo.
Y ya hemos terminado.
Verificamos que el proyecto se inicialice con el Form Presentación.
Espero que les guste.
Saludos.
--------------
No olviden visitar mi Web Oficial |no-mames.com| solo por apoyo ya que hay no hablo nada sobre programación hay es algo mas ligero y solo de pasatiempo así que espero tener su apoyo en mi humilde web y pues a un que sea me den un me gusta o algo a si bueno ya mucho bla bla bla
Empezando con tutoriales super básicos apoyame con un me gusta si el post su de tu agrado
0 comentarios:
Publicar un comentario