Crear un formulario fantasma (solucionado)

Hola amigos,

Llevaba no se ya ni cuanto tiempo, buscando una forma de colocar un formulario en el fondo del escritor y que permaneciera ahí como si formara parte del mismo, como un gadget.

Ayer me puse a experimentar con la declaración API, SetLayeredWindowAttributes y modificando el valor dwNewLong de SetWindowLong y ¡Sorpresa! El formulario permanece siempre en el escritorio y no se puede tocar, ni mover, ni cerrar, ni nada, pero si que se puede ver. Tampoco aparece al pulsar Alt+Tab. Y cuando haces clic en él con el ratón, es como si no existiera. En definitiva, un formulario fantasma. No se cual será el término correcto.

Funciona con el Handle (HWND), de modo que se puede aplicar a cualquier ventana.

He hecho un ejemplo. Es un gigantesco reloj del sistema que se muestra en el escritorio.

Se necesita:
- Un formulario
- Un control PictureBox (para mostra el reloj)
- Un control Timer (para actualizar reloj)

Modifica las propiedades del form a:
BorderStyle = 0
ShowInTaskbar =False

Esto es para un MÓDULO:

Código

'//////////////////////////////////////////////////////////////////
'//////////////////////////////////////////////////////////////////
'/////Establece el estilo de un formulario a modo fantastasma./////
'/////Características:                                        /////
'/////-Permenece siempre en el fondo del escritorio.          /////
'/////-Es visible.                                            /////
'/////-No se activa mediante el puntero del ratón.            /////
'/////-No se puede mover.                                     /////
'/////-No se puede colocar encima de otro formulario.         /////
'/////-No se puede activar mediante  ALT + TAB.               /////
'/////-Cuando haces clic con el ratón sobre él, se comporta   /////
'///// como si el formulario no existiera. De modo que en el  /////
'///// escritorio aparecerán los menús flotantes o el cuadro  /////
'///// de selección tal y como si no estuviera.               /////
'//////////////////////////////////////////////////////////////////
'//////////////////////////////////////////////////////////////////
'/////////////////////Creado por OKIK//////////////////////////////
'//////////////////////////////////////////////////////////////////
 
Option Explicit
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 HWND_TOP = 0
Const HWND_BOTTOM = 1
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
 
'Declaración del Api SetLayeredWindowAttributes _
que establece la transparencia al form
Private Declare Function SetLayeredWindowAttributes Lib "user32" _
(ByVal Hwnd As Long, _
ByVal crKey As Long, _
ByVal bAlpha As Byte, _
ByVal dwFlags As Long) As Long
 
'Recupera el estilo de la ventana
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal Hwnd As Long, _
ByVal nIndex As Long) As Long
 
'Establece un valor del 32bits para una compensación especificada en la memoria de la ventana extra
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal Hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
 
Public Const LWA_ALPHA = &H2               'Crea una capa alfa (transparencia)
Public Const LWA_NULLCOLOR = &H1           'Anula un color especificado
Public Const LWA_ALPHA_NULLCOLOR = &H3     'Crea una capa alfa y anula un color especificado
Public Const LWA_NORMAL = &H0              'Normal, sin trasnparencia y sin anulación color
Public Const RMV_COLOR_BLACK = &H0         'Color para anular (negro)
Public Const RMV_COLOR_MAGENTA = &HFF00FF  'Color para anular (magenta)
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000       'Estilo de capa
Private Const WS_EX_GHOSTFORM = &H64        'Estilo fantasma
 
Private Function SendFormBottom(ByVal Hwnd As Long)
'Envia el formulario al fondo la primera vez que se ejecuta
SetWindowPos Hwnd, HWND_BOTTOM, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE
End Function
Public Function SetGhostForm(ByVal Hwnd As Long, _
ByVal NivelTransparencia As Integer, _
ByVal NullColor As Long, _
ByVal TypeLayer As Long) As Long
Dim X As Long
Dim lpPrevWndProc As Long
 On Error Resume Next
       X = GetWindowLong(Hwnd, GWL_EXSTYLE)
       X = X Or WS_EX_LAYERED Or WS_EX_GHOSTFORM
       SetWindowLong Hwnd, GWL_EXSTYLE, X
       NivelTransparencia = Int(((NivelTransparencia * 255) / 100) + 0.5)
       SetLayeredWindowAttributes Hwnd, NullColor, NivelTransparencia, TypeLayer
       SetGhostForm = 0
       SendFormBottom Hwnd
If Err Then
SetGhostForm = 2
End If
End Function

Y esto para el FORMULARIO

Código

Private Sub Form_Activate()
'SetGhostForm (Handle, Trasnparencia, Color para anular, Tipo de capa)
'Mantiene el formulario siempre abajo
Call SetGhostForm(Me.Hwnd, 45, RMV_COLOR_BLACK, LWA_ALPHA_NULLCOLOR)
End Sub
 
Private Sub Form_Load()
    With Picture1
        .Font = "Arial"
        .ForeColor = vbGreen
        .BackColor = vbBlack
        .FontSize = 100
        .AutoRedraw = True
        .Move 0, 0, 8000, 2000
        .BorderStyle = 0
    End With
    Timer1.Enabled = True
    Timer1.Interval = 1
End Sub
Private Sub Form_Resize()
    Me.Move Screen.Width - Me.Width - 100, 0, _
    Picture1.Width, Picture1.Height
End Sub
 
Private Sub Timer1_Timer()
    With Picture1
        Picture1.Cls
        Picture1.CurrentX = 150
        Picture1.CurrentY = 15
        Picture1.Print Time
    End With
End Sub

Lo malo es que los accesos directos no se superponen sobre el formulario, sino que se quedan debajo. Pero lo curioso es que aunque estén debajo, si haces doble clic sobre ellos (con el form encima), se pueden mover o ejecutar igualmente.

He hecho lo del reloj sólo como un ejemplo de utilidad, pero para crear un formulario fantasma basta con hacer la llamada a SetGhostForm que se encuentra en el módulo. No funciona desde Form_Load, solo en Form_Resize y Form_Activate

Si no quieres transparencia, ni remover ningún color, usa LWA_NORMAL:

Call SetGhostForm(Me.Hwnd, 0, 0, LWA_NORMAL)

Si solo quieres transparencia usa LWA_ALPHA y estableces un valor entre 0 y 100, cuanto menor sea el valor más transparente se volverá el formulario:

Call SetGhostForm(Me.Hwnd, 100, 0, LWA_ALPHA)

LWA_ALPHA_NULLCOLOR, permite hacer las dos cosas:

Call SetGhostForm(Me.Hwnd, 50, RMV_COLOR_BLACK, LWA_ALPHA_NULLCOLOR)