Efecto Combinado para los Forms visual basic 6.0

Hola a todos.
Empecemos
Abrimos VB6, y creamos un nuevo proyecto.
Voy a agregar 4 forms en total y 1 modulo.
A los forms los voy a llamar: Arriba, Derecha, Izquierda y BotonCerrar.
A los tres primeros le hice una Ventana Personalizada.
Yo la hice así: miren la imagen de abajo y cualquier duda que tengan no olviden comentar para tratar de darles solución a su inquietud o fallo ok



Le agrego un label a cada uno y le cambio el atributo Visible a false

Al modulo le vamos a agregar la API para usar la función Sleep
---------
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
----------
Y un code para hacer transparencia de forms. Yo utilizo este.
----------------
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
----------------------------
En el evento Load del form arriba ponemos este código:
--------------------------------
Private Sub Form_Load()
Move (Screen.Width - Width) \ 2, ((Screen.Height - Height) \ 2) -
5000
Derecha.Show
Izquierda.Show
BotonCerrar.Show
Label1.Caption = "Arriba"
Derecha.Label1.Caption = "Arriba"
Izquierda.Label1.Caption = "Arriba"
Call Aplicar_Transparencia(Me.hWnd, CByte(100))
Call Aplicar_Transparencia(Derecha.hWnd, CByte(100))
Call Aplicar_Transparencia(Izquierda.hWnd, CByte(100))
End Sub
-------------------------------
Posicionamos el form, muestro los demás, y en el atributo Caption de los 3 labels ponemos
"Arriba"
Este lo utilizamos para saber la posición en la que se encuentra el form.
Y lo último que hacemos es ponerle una transparencia con el valor 100 a los tres forms.
Ahora, vamos a usar la imagen que utilizaron como la barra de títulos del form.
Vamos a usar el evento Click.
-------------------------------
Private Sub Superior_Click()
If Label1.Caption = "Centro" Then Exit Sub
If (Derecha.Label1.Caption = "Arriba") And (Izquierda.Label1.Caption
= "Arriba") Then
Do While Me.Top < (Screen.Height - Height) \ 2
Me.Top = Me.Top + 1
Sleep 0.6
DoEvents
Loop
Call Aplicar_Transparencia(Me.hWnd, CByte(250))
Label1.Caption = "Centro"
------------------------------------
End If
If Derecha.Label1.Caption = "Centro" Then
Do While Me.Top < (Screen.Height - Height) \ 2
Me.Top = Me.Top + 1
Derecha.Top = Derecha.Top - 1
Derecha.Left = Derecha.Left + 1
Sleep 0.6
DoEvents
Loop
Call Aplicar_Transparencia(Me.hWnd, CByte(250))
Call Aplicar_Transparencia(Derecha.hWnd, CByte(100))
Label1.Caption = "Centro"
Derecha.Label1.Caption = "Arriba"
End If
If Izquierda.Label1.Caption = "Centro" Then
Do While Me.Top < (Screen.Height - Height) \ 2
Me.Top = Me.Top + 1
Izquierda.Top = Izquierda.Top - 1
Izquierda.Left = Izquierda.Left - 1
Sleep 0.6
DoEvents
Loop
Call Aplicar_Transparencia(Me.hWnd, CByte(250))
Call Aplicar_Transparencia(Izquierda.hWnd, CByte(100))
Label1.Caption = "Centro"
Izquierda.Label1.Caption = "Arriba"
End If
End Sub
---------------------------------------
Esta parte lo que hace es ver como están los form posicionados y dependiendo de eso hace
diferentes cosas.
Si el mismo form tiene Label1.Caption = "Centro", no hace nada.
Si nadie tiene Label1.Caption = "Centro", se mueve a si mismo hacia el centro de la pantalla.
Si el form derecha tiene Label1.Caption = "Centro", lo mueve a su posición original, y mueve a si
mismo al centro de la pantalla.
Y si el form izquierda tiene Label1.Caption = "Centro", lo mueve a su posición original, y mueve a
si mismo al centro de la pantalla.
Cambiando transparencias y los caption de los labels según correspondan.
Los códigos de los demás form son similares.
Form Derecha
---------------
Private Sub Form_Load()
Move ((Screen.Width - Width) \ 2) + 5000, ((Screen.Height - Height) \
2) - 5000
End Sub
Private Sub Superior_Click()
If Label1.Caption = "Centro" Then Exit Sub
If (Arriba.Label1.Caption = "Arriba") And (Izquierda.Label1.Caption =
"Arriba") Then
----------------------------
Do While Me.Top < (Screen.Height - Height) \ 2
Me.Top = Me.Top + 1
Me.Left = Me.Left - 1
Sleep 0.6
DoEvents
Loop
Call Aplicar_Transparencia(Me.hWnd, CByte(250))
Label1.Caption = "Centro"
End If
If Arriba.Label1.Caption = "Centro" Then
Do While Me.Top < (Screen.Height - Height) \ 2
Me.Top = Me.Top + 1
Me.Left = Me.Left - 1
Arriba.Top = Arriba.Top - 1
Sleep 0.6
DoEvents
Loop
Call Aplicar_Transparencia(Me.hWnd, CByte(250))
Call Aplicar_Transparencia(Arriba.hWnd, CByte(100))
Label1.Caption = "Centro"
Arriba.Label1.Caption = "Arriba"
End If
If Izquierda.Label1.Caption = "Centro" Then
Do While Me.Top < (Screen.Height - Height) \ 2
Me.Top = Me.Top + 1
Me.Left = Me.Left - 1
Izquierda.Top = Izquierda.Top - 1
Izquierda.Left = Izquierda.Left - 1
Sleep 0.6
DoEvents
Loop
Call Aplicar_Transparencia(Me.hWnd, CByte(250))
Call Aplicar_Transparencia(Izquierda.hWnd, CByte(100))
Label1.Caption = "Centro"
Izquierda.Label1.Caption = "Arriba"
End If
End Sub
------------------------
Form Izquierda



----------------------
Private Sub Form_Load()
Move ((Screen.Width - Width) \ 2) - 5000, ((Screen.Height - Height) \
2) - 5000
End Sub
Private Sub Superior_Click()
If Label1.Caption = "Centro" Then Exit Sub
If (Arriba.Label1.Caption = "Arriba") And (Derecha.Label1.Caption =
"Arriba") Then
Do While Me.Top < (Screen.Height - Height) \ 2
Me.Top = Me.Top + 1
Me.Left = Me.Left + 1
Sleep 0.6
DoEvents
Loop
Call Aplicar_Transparencia(Me.hWnd, CByte(250))
------------------
Label1.Caption = "Centro"
End If
If Arriba.Label1.Caption = "Centro" Then
Do While Me.Top < (Screen.Height - Height) \ 2
Me.Top = Me.Top + 1
Me.Left = Me.Left + 1
Arriba.Top = Arriba.Top - 1
Sleep 0.6
DoEvents
Loop
Call Aplicar_Transparencia(Me.hWnd, CByte(250))
Call Aplicar_Transparencia(Arriba.hWnd, CByte(100))
Label1.Caption = "Centro"
Arriba.Label1.Caption = "Arriba"
End If
If Derecha.Label1.Caption = "Centro" Then
Do While Me.Top < (Screen.Height - Height) \ 2
Me.Top = Me.Top + 1
Me.Left = Me.Left + 1
Derecha.Top = Derecha.Top - 1
Derecha.Left = Derecha.Left + 1
Sleep 0.6
DoEvents
Loop
Call Aplicar_Transparencia(Me.hWnd, CByte(250))
Call Aplicar_Transparencia(Derecha.hWnd, CByte(100))
Label1.Caption = "Centro"
Derecha.Label1.Caption = "Arriba"
End If
End Sub
---------------
Y por ultimo al form BotonCerrar, como su nombre lo indica solo lo utilizo para cerrar el programa,
ustedes lo hacen a gusto.
El mío le coloque una imagen. Y el siguiente código.
-------------------------------------------------------------------

Private Sub Form_Load()
Move Derecha.Left + Derecha.Width + 1000, Arriba.Top
With BotonCerrar
.Height = 375
.Width = 375
End With
----------------------------------
Image1.Visible = False
Image2.Visible = True
End Sub
Private Sub Image2_Click()
Image1.Visible = True
Dim i As Integer
For i = 100 To 0 Step -1
Call Aplicar_Transparencia(Derecha.hWnd, CByte(i))
Call Aplicar_Transparencia(Arriba.hWnd, CByte(i))
Call Aplicar_Transparencia(Izquierda.hWnd, CByte(i))
Sleep 50
DoEvents
Next i
DoEvents
Sleep 1000
End
End Sub
-----------------------------------
Terminamos.
Saludos a todos.