Notifica al Estilo Messenger Splash

Unos Ejemplos mas abajo comente sobre un ejemplo de Actualizacion de Soft, donde podriamos lanzar la notificacion con un
formulario estilo MESSENGER o con Tooltips estilo Balloons, Bien despues de pelear mucho con las APIs de windows .....
 
 
 
 
 
Mas abajo esta un ejemplo de Uso (en formato 2007 y 2003), pero tambien lo podemos hacer con 97, 2000, XP....
 
Aca dejo el codigo que he escrito 
 *** CODIGO  ***
 
Option Compare Database
'Los formularios que vas a diseñar estilo Messenger
'Deben ser tipo EMERGENTE
'***************************************************************
'&                                                            &*
'&                                                            &*
'&                                                            &*
'&                                                            &*
'&               Jefferson Jimenez (JJJT)                     &*
'&                 Cabimas - Venezuela                        &*
'&                    Junio - 2010                            &*
'&                                                            &*
'&                                                            &*
'&                                                            &*
'&                                                            &*
'&                                                            &*
'***************************************************************
'***************************************************************
'& *  Haciendo uso de varias APIs de Windows                 & *
'& *  Logro escribir este modulo que sirve para crear un     & *
'& *  Formulario Notificacion Estilo Messenger y Splash      & *
'& *                                                         & *
'***************************************************************
'
'Lo Unico que debemos cambiar en este modulo es, el nombre del Icono
'que pondremos en el form tipo messenger
'por supuesto el Icono debe estar en la misma carpeta de la aplicacion
Global Const MiIcono As String = "\Icon\Actualiza.ico"
Public Declare Function Ventana_JJJT Lib "user32" Alias "GetWindowLongA" _
                             (ByVal hwnd As Long, _
                              ByVal nIndex As Long) _
                              As Long
                             
Public Declare Function Accion_JJJT Lib "user32" Alias "SetLayeredWindowAttributes" _
                             (ByVal hwnd As Long, _
                              ByVal crKey As Long, _
                              ByVal bAlpha As Byte, _
                              ByVal dwFlags As Long) _
                              As Long
Public Declare Function JJJTAnimar Lib "user32" Alias "AnimateWindow" _
                            (ByVal hwnd As Long, _
                             ByVal dwTime As Long, _
                             ByVal dwFlags As Long) _
                             As Long
Public Declare Function TranVen_JJJT Lib "user32" Alias "SetWindowLongA" _
                            (ByVal hwnd As Long, _
                             ByVal nIndex As Long, _
                             ByVal dwNewLong As Long) _
                             As Long
Public Declare Function LoadImage Lib "user32" _
                            Alias "LoadImageA" (ByVal hInst As Long, _
                            ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, _
                            ByVal n2 As Long, ByVal un2 As Long) As Long
Public Declare Function SendMessage Lib "user32" _
                            Alias "SendMessageA" (ByVal hwnd As Long, _
                            ByVal wMsg As Long, ByVal wParam As Long, _
                            lParam As Any) As Long
Public 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
Public Declare Function GetWindowRect Lib "user32" _
                           (ByVal hwnd As Long, _
                           lpRect As RECT) As Long
Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
                           ByVal lpClassName As String, _
                           ByVal lpWindowName As String) As Long
Public Declare Function apiGetDC Lib "user32" Alias "GetDC" _
                          (ByVal hwnd As Long) As Long
                         
Public Declare Function apiReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal _
                           hwnd As Long, ByVal hDC As Long) As Long
                          
Public Declare Function apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" _
                          (ByVal hDC As Long, ByVal nIndex As Long) As Long
                         
Public Declare Function apiGetActiveWindow Lib "user32" Alias _
                          "GetActiveWindow" () As Long
                         
Public Declare Function apiGetParent Lib "user32" Alias "GetParent" (ByVal _
                           hwnd As Long) As Long
                          
Public Declare Function apiGetClassName Lib "user32" Alias "GetClassNameA" _
                          (ByVal hwnd As Long, ByVal lpClassName As String, ByVal _
                           nMaxCount As Long) As Long
                          
Public Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" _
                          (ByVal hInstance As Long, ByVal pCursorName As Long) As Long
                         
Public Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" ( _
                          ByVal lpszName As String, _
                          ByVal hModule As Long, _
                          ByVal dwFlags As Long) As Long
                         
Private Declare Function MessageBeep Lib "user32" ( _
                          ByVal wType As Long) As Long
                         
'Las Constantes a utilizar
'Estas para el sonido
Global Const SND_ASYNC = &H1
Global Const SND_FILENAME = &H20000
Global Const SND_NODEFAULT = &H2
Global Const MB_ICONHAND = &H10&
Global Const MB_ICONQUESTION = &H20&
Global Const MB_ICONEXCLAMATION = &H30&
Global Const MB_ICONASTERISK = &H40&
Global Const TWIPSPERINCH = 1440
Global Const HWND_TOP = 0
Global Const SWP_NOZORDER = &H4
Public buffRECT As RECT
Public FormDims As RECT
Public i, w, h, x, y, p As Integer
Global Const Transp = &H2
Global Const Efecto = &H80000
Global Const OpenEfectoMsn = &H8 Or &H20000
Global Const CloseEfectoMsn = &H4 Or &H10000
'Por aqui le paso la velocidad del Efecto
Global Const VelOpen As Long = 200
Global Const VelClose As Long = 200
'Establezco el color del Formulario
Public Color As Long
'Establezco la Transparencia del Formulario
Global Const EfecTrans As Long = 200
'Con esta funcion Abro el Form para hacerlo parecer
'Notificacion Tipo Messenger Splash
Function NotificaMsnSplash_JJJT(frm As Form, TimeSegundos As Long, cx As Long, cy As Long, _
                                  cHeight As Long, cWidth As Long)
'TimeSegundos: es el tiempo que quiero, que dure visible el form estilo messenger
Dim h As Long 'Declaro la variable a la que le paso el hwnd del Form
    h = frm.hwnd
 
 'Con esta API posiciono el Form, para que abra justamente
 'del lado derecho de la pantalla e inferior
                    SetWindowPos h, _
                    HWND_TOP, cx, cy, _
                    cWidth, _
                    cHeight, SWP_NOZORDER
 
 'Con esta funcion le coloco icono al form
                    CambioIcon frm, CurrentProject.Path & MiIcono
                   
 'Con esta funcion le doy efecto al abrir
                    JJJT_EfectoOpenSplash frm
                   
 'Con efecto de Sonido
                    Sonido "Type"
 'Con esta funcion le doy transparencia
                    JJJT_Transparencia frm
                   
  'Con esta funcion Cargo las variables para el Splash e inicio el timer
                    CargarFrm frm, TimeSegundos
                   
End Function   'JJJT
'Con esta funcion Abro el Form para hacerlo parecer
'Notificacion Tipo Efecto Messenger
Function NotificaMsnEfecto_JJJT(frm As Form, TimeSegundos As Long, cx As Long, cy As Long, _
                                  cHeight As Long, cWidth As Long)
Dim h As Long
    h = frm.hwnd
                    frm.TimerInterval = TimeSegundos * 1000
                    SetWindowPos h, _
                    HWND_TOP, cx, cy, _
                    cWidth, _
                    cHeight, SWP_NOZORDER
                    CambioIcon frm, CurrentProject.Path & MiIcono
                    JJJT_EfectoOpenMsn frm
                    Sonido "New"
                    JJJT_Transparencia frm
 End Function   'JJJT
Function AnchoMonitor() As Long 'Busco el Height de la pantalla activa
Dim rec As RECT
    Call GetWindowRect(GetDesktopWindow, rec)
    AnchoMonitor = CStr(rec.Right - rec.Left)
End Function
Function AltoMonitor() As Long 'Busco el Widht de la pantalla activa
Dim rec As RECT
    Call GetWindowRect(GetDesktopWindow, rec)
    AltoMonitor = CStr(rec.Bottom - rec.Top)
End Function
Function TamañoBarra() As Long 'Verifico el hwnd de la barra windows
Dim hwndTrayWnd As Long        'y calculo el tamaño de la misma
Dim res As Long
hwndTrayWnd& = FindWindow("Shell_TrayWnd", "")
If hwndTrayWnd > 0 Then
  res = GetWindowRect(hwndTrayWnd, buffRECT)
      If res > 0 Then
        TamañoBarra = CStr(buffRECT.Bottom - buffRECT.Top) ' * 15
    End If
 End If
End Function
Sub GetFormDimensions(F As Form, FLeft As Long, FTop As Long, _
                       FWidth As Long, FHeight As Long)
   Dim FormRect As RECT
   Dim MDIClient As RECT
   Dim MDIClientLeft As Long
   Dim MDIClientTop  As Long
                    GetWindowRect F.hwnd, FormRect
                    FLeft = FormRect.Left
                    FTop = FormRect.Top
                    FWidth = FormRect.Right - FormRect.Left
                    FHeight = FormRect.Bottom - FormRect.Top
   ConvertPIXELSToTWIPS FLeft, FTop
   ConvertPIXELSToTWIPS FWidth, FHeight
            If GetWindowClass(F.hwnd) <> "OFormPopup" Then
               GetWindowRect apiGetParent(F.hwnd), MDIClient
               MDIClientLeft = MDIClient.Left
               MDIClientTop = MDIClient.Top
               ConvertPIXELSToTWIPS MDIClientLeft, MDIClientTop
              
               FLeft = FLeft - MDIClientLeft
               FTop = FTop - MDIClientTop
            End If
End Sub
Sub ConvertPIXELSToTWIPS(x As Long, y As Long)
                       Dim hDC As Long, hwnd As Long, RetVal As Long
   Dim XPIXELSPERINCH, YPIXELSPERINCH
   Const LOGPIXELSX = 88
   Const LOGPIXELSY = 90
            hDC = apiGetDC(0)
            XPIXELSPERINCH = apiGetDeviceCaps(hDC, LOGPIXELSX)
            YPIXELSPERINCH = apiGetDeviceCaps(hDC, LOGPIXELSY)
            RetVal = apiReleaseDC(0, hDC)
   x = (x / XPIXELSPERINCH) * TWIPSPERINCH
   y = (y / YPIXELSPERINCH) * TWIPSPERINCH
End Sub
Function GetWindowClass(hwnd As Long) As String
   Dim Buff As String
   Dim BuffSize As Integer
   Buff = String$(255, " ")
   BuffSize = apiGetClassName(hwnd, Buff, 255)
   GetWindowClass = Left$(Buff, BuffSize)
End Function
Sub CargarFrm(frm As Form, TimeSegundos As Long)
    If GetWindowRect(frm.hwnd, FormDims) Then
        x = FormDims.Right
        y = FormDims.Top
    End If
    frm.TimerInterval = TimeSegundos * 1000
    i = 1
    w = frm.Width
    h = frm.Detalle.Height
    p = 25
End Sub
Sub Sonido(File As String)
Call PlaySound(CurrentProject.Path & "\Sound\" & File & ".wav", _
                            ByVal 0&, SND_FILENAME Or _
                            SND_ASYNC Or SND_NODEFAULT)
End Sub
Sub MeCierroSPLASH(frm As Form)
    frm.TimerInterval = 1
    MoveForm frm
    i = i + 1
    If i = p + 1 Then
        DoCmd.Close acForm, frm.Name
            Call Sonido("Reciclaje")
    End If
End Sub
Function MoveForm(ByVal frm As Form)
Dim x As Long, X2 As Long, y As Long, y2 As Long
    GetFormDimensions frm, x, X2, y, y2
    DoCmd.MoveSize x * ((p - i) / p), X2 * ((p - i) / p), w * ((p - i) / p), h * ((p - i) / p)
End Function
Sub CambioIcon(frm As Form, RutaIcon As String)
    SendMessage frm.hwnd, &H80, 0, _
           ByVal LoadImage(0&, RutaIcon, _
                1, 16, 16, &H10)
End Sub
'Creo la Funcion del efecto al abrir
'El Formulario debe tener la Opcion Emergente = Si
Function JJJT_EfectoOpenSplash(frm As Form)
Color = RGB(214, 232, 255)
JJJTAnimar frm.hwnd, VelOpen, Efecto
frm.Section(0).BackColor = Color
frm.ShortcutMenu = True
End Function
Function JJJT_EfectoOpenMsn(frm As Form)
Color = RGB(214, 232, 255)
JJJTAnimar frm.hwnd, VelOpen, OpenEfectoMsn
frm.Section(0).BackColor = Color
frm.ShortcutMenu = True
End Function
'Creo la Funcion al cerrar
Function JJJT_EfectoClose(frm As Form)
JJJTAnimar frm.hwnd, VelClose, CloseEfectoMsn
    Call MessageBeep(MB_ICONEXCLAMATION)
End Function
'Creo la Funcion Transparencia
Function JJJT_Transparencia(frm As Form)
   TranVen_JJJT frm.hwnd, (-20), _
   Ventana_JJJT(frm.hwnd, (-20)) _
   Or &H80000
   Accion_JJJT frm.hwnd, 0, _
   EfecTrans, Transp
End Function
'**********************   Fin del Modulo *********************************************
'& *                                                                     & *
'& *  Para Usarlo :  METODO SPLASH                                       & *
'& *  Crea un form pequeño parecido a un Messenger                       & *
'& *  En el evento al cargar Form_Load() llama la funcion                & *
'& *                                                                     & *
'  Private Sub Form_Load()
'   NotificaMsnSplash_JJJT Me, 4, AnchoMonitor - _
          (Me.Width / 15), _
          AltoMonitor - _
         ((Me.Detalle.Height / 12) _
         + (TamañoBarra + 6)), _
          Me.Detalle.Height / 12, _
         ((Me.Width / 15) - 10)
'  End Sub
'& *                                                                     & *
'& *                                                                     & *
'& * En el evento al cronometro                                          & *
' Private Sub Form_Timer()
' Call MeCierroSPLASH(Me)
' End Sub
'***************************************************************************
'& *                                                                     & *
'& *  Para Usarlo :  METODO EFECTO MESSENGER                             & *
'& *  Crea un form pequeño parecido a un Messenger                       & *
'& *  En el evento al cargar Form_Load() llama la funcion                & *
'& *                                                                     & *
'  Private Sub Form_Load()
'  NotificaMsnEfecto_JJJT Me, 4, AnchoMonitor - _
          (Me.Width / 15), _
          AltoMonitor - _
         ((Me.Detalle.Height / 12) _
         + (TamañoBarra + 6)), _
          Me.Detalle.Height / 12, _
         ((Me.Width / 15) - 10)
'  End Sub
'& *                                                                     & *
'& *                                                                     & *
'& * En el evento al cronometro                                          & *
' Private Sub Form_Timer()
' Me.TimerInterval = 1
' DoCmd.Close acForm, Me.Name
' End Sub
' Private Sub Form_Close()
' JJJT_EfectoClose Me
' End Sub
SelectionFile type iconFile nameDescriptionSizeRevisionTimeUser
ċ

Descargar
Descarga el Ejemplo   280 kb v. 3 29 jun. 2010 17:55 Jefferson Jimenez
ċ

Descargar
Descargue el Ejemplo  235 kb v. 3 29 jun. 2010 17:54 Jefferson Jimenez
Comments