Notificando al SysTray en Access

Uno ejemplos mas abajo comento sobre como actualizar una BD por otra mas nueva, descargando la BD_Nueva desde una ubicacion en Internet (Por su puesto esta pagina o site debe pertenecernos) ....

el Ejemplo es este

63) Actualizar BD (Front-End) Desde una Ubicacion en Internet

Ahora bien, podemos informacion a nuestros usuarios, mediante una notificacion al estilo Messenger

65) Notifica al Estilo Messenger Splash

O Notificando al SysTray (Barra de Heramientas de Windows) de tal evento

** EL CODIGO **

Option Compare Database

Option Explicit

'***************************************************************

'& &*

'& &*

'& &*

'& &*

'& Jefferson Jimenez (JJJT) &*

'& Cabimas - Venezuela &*

'& Junio - 2010 &*

'& &*

'& &*

'& &*

'& &*

'& &*

'***************************************************************

'Declaramos las APIs a utilizar

'Para Extraer el icono de la Carpeta

Private Declare Function ExtractAssociatedIcon Lib "shell32.dll" Alias "ExtractAssociatedIconA" _

(ByVal hInst As Long, _

ByVal lpIconPath As String, _

lpiIcon As Long) As Long

'Para cargar el Icono al SysTray

Private Declare Function LoadImage Lib "USER32" Alias "LoadImageA" _

(ByVal hInst As Long, _

ByVal lpsz As String, _

ByVal iImageType As Long, _

ByVal cx As Long, _

ByVal cy As Long, _

ByVal fFlags As Long) As Long

'Para destruir el Icono del SysTray

Private Declare Function DestroyIcon Lib "USER32" (ByVal hIcon As Long) As Long

'Para Notificar al SysTray

Private Declare Function ShellNotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" _

(ByVal dwMessage As Long, _

lpData As NOTIFYICONDATA) As Long

'Para encontrar el TwipsPerPixelX

Private Declare Function GetDC Lib "USER32" (ByVal hWnd As Long) As Long

Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Private Declare Function ReleaseDC Lib "USER32" (ByVal hWnd As Long, ByVal hdc As Long) As Long

'Para extraer el nombre de la BD activa

Private Declare Function GetFileTitle Lib "comdlg32.dll" Alias "GetFileTitleA" _

(ByVal lpszFile As String, _

ByVal lpszTitle As String, _

ByVal cbBuf As Integer) As Integer

'La Estructura del SysTray al Notificar

Private Type NOTIFYICONDATA

cbSize As Long

hWnd As Long

uID As Long

uFlags As Long

uCallbackMessage As Long

hIcon As Long

szTip As String * 128

dwState As Long

dwStateMask As Long

szInfo As String * 256

uTimeout As Long

szInfoTitle As String * 64

dwInfoFlags As Long

End Type

'Las Constantes de la API ShellNotifyIcon

Public Const WM_LBUTTONDBLCLK = &H203

Const NIF_INFO = &H10

Const NIIF_INFO = &H1

Const NIM_ADD = &H0

Const NIM_MODIFY = &H1

Const NIM_DELETE = &H2

Const NIF_MESSAGE = &H1

Const NIF_ICON = &H2

Const NIF_TIP = &H4

Const WM_MOUSEMOVE = &H200

Const WM_LBUTTONDOWN = &H201

Const WM_LBUTTONUP = &H202

Const WM_RBUTTONDOWN = &H204

Const WM_RBUTTONUP = &H205

Const WM_RBUTTONDBLCLK = &H206

Const WM_MBUTTONDBLCLK = &H209

Private SysTray As NOTIFYICONDATA

Private IcoNhWnd As Long

Sub NotificaSysTray( _

frm As Form, _

Optional TipText As String, _

Optional BalloonTipTex As String, _

Optional RutaIcon As String)

'Busco el Twips del form

TwipsPerPixelX frm

'Busco el long del Icono

IcoNhWnd = LoadImage(0&, RutaIcon, 1, 16&, 16&, &H10)

'Si el Icono no existe

If IcoNhWnd = 0 Then

'Le cargo el de la carpeta Activa

IcoNhWnd = ExtractAssociatedIcon(Application.hWndAccessApp, "", 0)

End If

With SysTray

'Tamaño de la estructura al Systray

.cbSize = Len(SysTray)

'El hwnd del form activo

.hWnd = frm.hWnd

'El handle de la barra de tareas

.uID = vbNull

'Los flags para la estructura

.uFlags = NIF_ICON Or NIF_INFO Or NIF_MESSAGE Or NIF_TIP

'Estableze el mensaje a windows

.uCallbackMessage = WM_MOUSEMOVE

'Dibuja el Icono seleccionado a la barra de tareas

.hIcon = IcoNhWnd

'Le paso el Texto al tooltips

.szTip = TipText & Chr(0)

'El estado de la barra para los Balloon Tips

.dwState = vbNull

'La mascara de la barra para los Balloon Tips

.dwStateMask = vbNull

'El Texto del Balloon Tips

.szInfo = BalloonTipTex & Chr(0)

'El titulo del Balloon Tips

.szInfoTitle = MiBd & Chr(0)

'Definitivamente la Forma Balloon Tips

.dwInfoFlags = NIIF_INFO

'Tiempo de duracion al pasar el mouse

.uTimeout = 100

End With

'Funcion al llamado API Notificando al Systray

Call ShellNotifyIcon(NIM_ADD, SysTray)

End Sub

Sub QuitaSysTray(frm As Form)

'Elimino la Notificacion al Systray

Call ShellNotifyIcon(NIM_DELETE, SysTray)

'Destruyo el icono

Call DestroyIcon(IcoNhWnd)

End Sub

Function MiBd() As String

'Establezco el tipo y los caracteres; Ejecuto la API

MiBd = String(255, 0): GetFileTitle CurrentDb.Name, MiBd, Len(MiBd)

'Estraigo el nombre y se lo paso a la funcion

MiBd = Left$(MiBd, InStr(1, MiBd, Chr$(0)) - 1)

End Function

Function TwipsPerPixelX(frm As Form) As Single

'--------------------------------------------------

'Returns the width of a pixel, in twips.

'--------------------------------------------------

Dim lngDC As Long

lngDC = GetDC(frm.hWnd)

TwipsPerPixelX = 1440& / GetDeviceCaps(lngDC, 88)

ReleaseDC frm.hWnd, lngDC

End Function