lunes, 16 de octubre de 2017

VBA Access. Modulo ModTransparent. Permite hacer un formulario totalmente visible, translúcido o transparente del todo.

Option Compare Database
Option Explicit

'http://grupos.emagister.com/debate/formulario_transparente/6411-674789
'
'Uso por ejemplo en el load del formulario: Transparent Me, 100
'
'Los valores posibles son entre 0 totalmente transparente y 255 totalmente visible.
'Para que funcione debes poner este código en un módulo nuevo

#If Win64 = 1 Then
    Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
#Else
    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
    Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
#End If

Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2

Function Transparent(frm As Form, Nivel As Integer)
    Dim lngHwnd As Long
    If Nivel < 0 Or Nivel > 255 Then Exit Function
    lngHwnd = frm.hWnd
    SetWindowLong lngHwnd, GWL_EXSTYLE, GetWindowLong(lngHwnd, GWL_EXSTYLE) Or WS_EX_LAYERED
    SetLayeredWindowAttributes lngHwnd, 0, Nivel, LWA_ALPHA
End Function

No hay comentarios:

Publicar un comentario

VBA Access. Redondeo de números decimales con el método medio redondeo. Alternativa a la función Round (bankers round)

 Private Function Redondeo(ByVal Numero As Variant, ByVal Decimales As Integer) As Double     'Aplica método medio redondeo (half round ...