Este codigo es un ejemplo de como hacer para cerrar un formualrio con efecto de transparencia,a medida que se va cerrando se va haciendo mas trasparente hasta que se hace transparente por completo y es ahi donde se cierra.solo se necesita un control Timer en el formulario.el codigo se puede modificar a gusto para lograr hacer el efecto cuando sea necesario.
En el Formulario pone:
Option Explicit
Dim Trans As Integer
Private Const LWA_COLORKEY = 1
Private Const LWA_ALPHA = 2
Private Const LWA_BOTH = 3
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = -20
Private Declare Function SetLayeredWindowAttributes Lib "user32" _
(ByVal hwnd As Long, ByVal color As Long, ByVal x As Byte, _
ByVal alpha As Long) As Boolean
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Sub SetTrans(hwnd As Long, Trans As Integer)
Dim Tcall As Long
Tcall = GetWindowLong(hwnd, GWL_EXSTYLE)
SetWindowLong hwnd, GWL_EXSTYLE, Tcall Or WS_EX_LAYERED
SetLayeredWindowAttributes hwnd, RGB(255, 255, 0), Trans, LWA_ALPHA
Exit Sub
End Sub
Private Sub Form_Load()
Form1.Show
Form1.Enabled = False
Timer1.Interval = 1
Trans = 255
SetTrans Me.hwnd, Trans
End Sub
Private Sub Timer1_Timer()
If Trans <> 0 Then
Trans = Trans - 1
End If
SetTrans Me.hwnd, Trans
If Trans = 0 Then
Form1.Enabled = True
Unload Me
End If
End Sub
Este codigo permite activar el salvapantallas que tengamos como predeterminado.Solo se necesita un Boton en el Formulario para probar el ejemplo.
En el Formulario Pone:
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Const WM_SYSCOMMAND = &H112&
Private Const SC_SCREENSAVE = &HF140&
Private Sub Command1_Click()
Dim Ret As Long
Ret = SendMessage(Form1.hWnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0&)
End Sub
Este codigo permite redimensionar controles cuando la aplicacion este ejecutandose.Solo los controles que tengan la funcion Hwnd podran usar esta funcion.Para probar el ejemplo solo necesitas un PictureBox.
En el Formulario pone:
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 Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cX As Long, ByVal cY As Long, ByVal wFlags As Long) As Long
Const GWL_STYLE = (-16)
Const WS_THICKFRAME = &H40000
Const WS_CHILD = &H40000000
Const SWP_DRAWFRAME = &H20
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Const SWP_NOZORDER = &H4
Private Sub dimensionar(ByVal elControl As Control)
Dim Style As Long
On Local Error Resume Next
Style = GetWindowLong(elControl.hWnd, GWL_STYLE)
Style = Style Or WS_THICKFRAME
Style = SetWindowLong(elControl.hWnd, GWL_STYLE, Style)
Style = SetWindowPos(elControl.hWnd, Me.hWnd, 0, 0, 0, 0, SWP_NOZORDER Or SWP_NOSIZE Or SWP_NOMOVE Or SWP_DRAWFRAME)
Err = 0
On Local Error GoTo 0
End Sub
Private Sub Form_Load()
dimensionar Picture1
End Sub