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