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