Une boite de message (msgbox) qui se prend pour un popup
Description
Une petite source qui montre comment manipuler une bête MsgBox pour en faire un popup.
Cette Source n'utilise que les API Windows et est donc complètement exportable vers VB6. J'ai d'ailleurs mis dans le zip le .bas qui contient tout le code.
Dans cette source vous trouverez:
-une méthode pour récupérer des information sur la barre des taches windows
-une méthode pour modifier une boite de message avant qu'elle ne soit afficher.
-une méthode pour faire défiler du texte dans une boite de message.
-détecter un clic sur la boite et la fermer.
et d'autre petit truc sans prétention.
Cette source a été pour moi un exercice pour essayer de comprendre l'intérêt du "hooking" ainsi que la manipulation d'une fenêtre et des objets quelle contient.
Même si je crois avoir en parti compris l'intérêt du hook il me reste beaucoup à apprendre sur le sujet.
Bonne prog.
A+
Cette Source n'utilise que les API Windows et est donc complètement exportable vers VB6. J'ai d'ailleurs mis dans le zip le .bas qui contient tout le code.
Dans cette source vous trouverez:
-une méthode pour récupérer des information sur la barre des taches windows
-une méthode pour modifier une boite de message avant qu'elle ne soit afficher.
-une méthode pour faire défiler du texte dans une boite de message.
-détecter un clic sur la boite et la fermer.
et d'autre petit truc sans prétention.
Source / Exemple :
Option Explicit
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type APPBARDATA
cbSize As Long
hwnd As Long
uCallbackMessage As Long
uEdge As Long
rc As RECT
lParam As Long
End Type
Private Type CWPSTRUCT
lParam As Long
wParam As Long
Message As Long
hwnd As Long
End Type
Type POINTAPI
x As Long
y As Long
End Type
' type perso lier à la fonction "WinTaskBarSize"
Private Type ABDSIZE
ABDWidth As Long 'largeur de la barre (si barre verticale)
ABDHeight As Long 'hauteur de la barre (si barre horizontale)
End Type
Private Declare Function SetTimer Lib "User32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "User32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function SetWindowText Lib "User32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "User32" Alias "FindWindowExA" (ByVal ParenthWnd As Long, ByVal ChildhWnd As Long, ByVal ClassName As String, ByVal Caption As String) As Long
Private Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function SetWindowsHookEx Lib "User32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "User32" (ByVal hHook As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private 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
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint 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 DrawMenuBar Lib "User32" (ByVal hwnd As Long) As Long
'permet de récupérer l'atat des touches clavier et souris
Private Declare Function GetAsyncKeyState Lib "User32" (ByVal uAction As Long) As Long
'permet de récupérer la position en x,y du pointeur de souris
Declare Function GetCursorPos Lib "User32" (lpPoint As POINTAPI) As Long
'permet de recuperer les infos concernant la barre des taches windows
Private Declare Function SHAppBarMessage Lib "shell32" (ByVal dwMessage As Long, ByRef pData As APPBARDATA) As Long
Private Const ABM_GETTASKBARPOS As Long = &H5
' pour travailler avec une message box non modal
Public Declare Function MessageBox Lib "User32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
' Gestion de la transparence
Private Declare Function SetLayeredWindowAttributes Lib "user32.dll" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'Taille de l'ecran en pixels
Private Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
Const SM_CXSCREEN = 0
Const SM_CYSCREEN = 1
'permet de récupérer les positions de la fenetre
Public Declare Function GetWindowRect Lib "User32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Const MB_SETFOREGROUND As Long = &H10000
Const GWL_STYLE As Long = -16
Const SWP_NOSIZE = &H1
Const SWP_NOZORDER = &H4
Const WS_EX_LAYERED As Long = &H80000
Const LWA_ALPHA As Long = &H2
Const GWL_EXSTYLE As Long = -20
' --------- Contantes de configuration: --------------
Const IntervalTemps As Long = 50 'intervale de temps de l'opacification de la boite de message
Const TransparenceDeFin As Long = 220 '255 -> boite de message completement opaque
Const Titre As String = "Am I a popup ?" 'titre de la boite de message !n'est pas utilisé pour le handle!
Const TheMessage As String = "Boite de Message ou Popup ??? "
' ----------------------------------------------------
Private xPositionMgBox As Long, yPositionMgBox As Long, msgHook As Long, Transparence As Long, wbkHook As Long
Private TransparenceStep As Long, TimerId As Long, nb_3ddI7IHd As Long, NewMessage As String, MgBxWidth As Long, MgBxHeight As Long
Private hwndLabel As Long 'handle du label de la boite de message
Private hwndButton As Long 'handle du bouton de la boite de message
Public hWndMsgBox As Long 'handle de la boite de message
Sub MsgBox_Transparente()
'C'est ici que tout commence
'et tout fini !
Const WH_CALLWNDPROC& = 4
Dim x As Long, y As Long
Dim ABD As APPBARDATA
TransparenceStep = -1
'on donne comme position le coin en bas à droite de l'écran avec prise en compte
'de la hauteur ou de la largeur de la barre des taches en fonction de sa position
SHAppBarMessage ABM_GETTASKBARPOS, ABD
'taille de l’écran en X + prise en compte de la largeur de la barre des taches
xPositionMgBox = GetSystemMetrics(SM_CXSCREEN) - WinTaskBarSize(ABD.uEdge).ABDWidth
'taille de l'écran en Y + prise en compte de la hauteur de la barre des taches
yPositionMgBox = GetSystemMetrics(SM_CYSCREEN) - WinTaskBarSize(ABD.uEdge).ABDHeight
Transparence = 0 ' de 0 a 100, 100 = Opaque
msgHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf HookMsgbox, 0, GetCurrentThreadId)
StartTimer
MessageBox 0&, TheMessage, Titre, vbOKOnly '+ vbInformation
ArretTimer
hWndMsgBox = 0
On Error Resume Next
If Not Application.WindowState = xlMaximized Then Application.WindowState = xlMaximized
End Sub
Function CloseMsgBox()
'ici on ferme la boite de message
'la fermeture est equivalente à un clique sur la croix
Const WM_CLOSE = &H10
Call SendMessage(hWndMsgBox, WM_CLOSE, 0, ByVal 0&)
End Function
Private Function ArretTimer() As Boolean
'ici on arrete le timer
If Not TimerId = 0 Then
TimerId = KillTimer(0&, TimerId)
TimerId = 0
End If
End Function
Sub StartTimer()
'ici on lance le timer
If Not TimerId = 0 Then ArretTimer
TimerId = SetTimer(0&, 0&, ByVal IntervalTemps, AddressOf upDateMsgBox)
End Sub
Private Sub upDateMsgBox(ByVal lHwnd&, ByVal lMsg&, ByVal lIDEvent&, ByVal lTime&)
'cette sub modifie une boite de message à partir de sont handle.
'Elle permet de:
'-cacher le bouton
'-ramène la transparence au niveau souhaité
'-faire défiler le texte
'-detecter le clic sur la boite
Const SW_SHOW As Long = 5
Const SW_HIDE As Long = 0
Const SM_CYCAPTION = 4
Const SM_CYEDGE = 46
Const VK_LBUTTON As Long = &H1
Dim PositionCursor As POINTAPI
'Dim stButtonRect As RECT, x As Long, y As Long, wr As RECT
On Error Resume Next
' si clic il y a:
If GetAsyncKeyState(VK_LBUTTON) And &H8000 Then
'permet de recuperer la position du pointeur
GetCursorPos PositionCursor
'est t'il sur la boite ?
'--------Nouvelle methode------
'on recupere le handle de la fenetre sous le pointeur
HwndFromPoint = WindowFromPoint(PositionCursor.x, PositionCursor.y)
'puis on compare avec le handle de la boite de message
If hWndMsgBox = HwndFromPoint Then Call CloseMsgBox
'------------------------------
'******ancienne methode******
'If PositionCursor.x >= xPositionMgBox And PositionCursor.x <= xPositionMgBox + MgBxWidth Then
'If PositionCursor.y >= yPositionMgBox And PositionCursor.y <= yPositionMgBox + MgBxHeight Then Call CloseMsgBox
'End If
'****************************
End If
If TransparenceStep = -1 And Not hWndMsgBox = 0 Then
' recherche du bouton ("Button" est le "ClassName")
hwndButton = FindWindowEx(hWndMsgBox, ByVal 0&, "Button", vbNullString)
'on cache le boutton
ShowWindow hwndButton, SW_HIDE
'recherche du label("Static" est le "ClassName")
hwndLabel = FindWindowEx(hWndMsgBox, ByVal 0&, "Static", vbNullString)
DoEvents
TransparenceStep = 0
NewMessage = ""
nb_3ddI7IHd = 0
End If
TransparenceStep = TransparenceStep + 5
If TransparenceStep <= TransparenceDeFin Then '255 -> boite de message completement opaque
'opacification de la boite de message
SetWindowLong hWndMsgBox, GWL_EXSTYLE, WS_EX_LAYERED
SetLayeredWindowAttributes hWndMsgBox, 0&, TransparenceStep, LWA_ALPHA
TransparenceStep = TransparenceStep + 5
DoEvents
End If
' deffilement du text dans la boite (gadget mal construit... juste pour essayer ^^)
If TransparenceStep > 50 Then 'pour que le commencement soit visible on attend un peu
Select Case nb_3ddI7IHd
Case 0 'on commence
nb_3ddI7IHd = 1
NewMessage = Space$(Len(TheMessage) - 1) & Left$(TheMessage, nb_3ddI7IHd)
Case 1 To Len(TheMessage) - 1 'du 2ieme caractere au dernier de la variable TheMessage
nb_3ddI7IHd = nb_3ddI7IHd + 1
NewMessage = Right$(NewMessage, Len(NewMessage) - 1)
NewMessage = NewMessage & Mid(TheMessage, nb_3ddI7IHd, 1)
Case Is >= Len(TheMessage) 'apres le dernier caractere de la variable TheMessage
'jusqu'a la disparition total du message
nb_3ddI7IHd = nb_3ddI7IHd + 1
NewMessage = Right$(NewMessage, Len(NewMessage) - 1)
NewMessage = NewMessage & " "
If nb_3ddI7IHd = 2 * Len(TheMessage) Then 'le message à terminé sont deffilement donc on recommence
nb_3ddI7IHd = 0
NewMessage = ""
End If
End Select
End If
' mise à jour du label
SetWindowText hwndLabel, NewMessage
DoEvents
' si erreur on ferme la boite de message ce qui aura aussi pour effet d'arreter le timer
If Not Err = 0 Then Call CloseMsgBox
End Sub
Function HookMsgbox(ByVal ncode As Long, ByVal wParam As Long, msgStruct As CWPSTRUCT) As Long
'cette fonction permet le renvois d'une boite de message :
' - en bas a droite de l'ecran
' - sans sa barre de titre
' - !!! completement transparente !!! (en fonction de la variable "Transparence" biensure)
' - redimensionnee
'
Const SM_CYCAPTION = 4
Const SM_CYEDGE = 46
Const WM_CREATE& = &H1
Dim PosFlag&, wr As RECT, Style_3ddI7IHd As Long
With msgStruct
If .Message = WM_CREATE Then
Dim S As String, i As Integer
S = String(255, 0)
i = InStr(S, vbNullChar)
If i Then S = Left(S, i - 1)
UnhookWindowsHookEx msgHook
hWndMsgBox = .hwnd
'on recupere les positions de la boite de message pour en deduire sa taille
GetWindowRect .hwnd, wr
'calcul des dimensions x,y
MgBxWidth = (wr.Right - wr.Left)
MgBxHeight = (wr.Bottom - wr.Top)
'on ajuste la hauteur pour tenir compte du fait que l'on lui enleve la barre de titre
MgBxHeight = MgBxHeight - (GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYEDGE))
'on redefinit les valeurs de position
xPositionMgBox = xPositionMgBox - MgBxWidth
yPositionMgBox = yPositionMgBox - MgBxHeight
'on enleve la barre de titre
Style_3ddI7IHd = GetWindowLong(.hwnd, GWL_STYLE) And Not &HC00000
SetWindowLong .hwnd, GWL_STYLE, Style_3ddI7IHd
DrawMenuBar .hwnd
'on applique la transparence de depart qui pour la demo est totale
SetWindowLong .hwnd, GWL_EXSTYLE, WS_EX_LAYERED
SetLayeredWindowAttributes .hwnd, 0&, 255 * (Transparence / 100), LWA_ALPHA
'on positionne la boite de message
PosFlag = SWP_NOZORDER 'Or SWP_NOSIZE
SetWindowPos .hwnd, 0&, xPositionMgBox, yPositionMgBox, MgBxWidth, MgBxHeight, PosFlag
End If
End With
End Function
Function WinTaskBarSize(ByVal TaskBarPos As Long) As ABDSIZE
'Cette fonction renvoie la hauteur de la barre de tache windows si celle-ci est en bas de l'ecran
'ou sa largeur si celle-ci est à droite de l'ecran
Dim hWndToolBar As Long
Dim Wr_3ddI7IHd As RECT
'valeur renvoyées par defaut
WinTaskBarSize.ABDHeight = 0
WinTaskBarSize.ABDWidth = 0
'on recupere le handle de la barre des taches
hWndToolBar = FindWindow("Shell_TrayWnd", vbNullString)
If Not hWndToolBar = 0 Then 'si la barre a été trouvée
'on recupere les infos de position
GetWindowRect hWndToolBar, Wr_3ddI7IHd
'on les utilise pour en determiner la hauteur
If TaskBarPos = 3 Then WinTaskBarSize.ABDHeight = (Wr_3ddI7IHd.Bottom - Wr_3ddI7IHd.Top) 'si en bas de l'ecran
If TaskBarPos = 2 Then WinTaskBarSize.ABDWidth = (Wr_3ddI7IHd.Right - Wr_3ddI7IHd.Left) ' si à droite de l'ecran
End If
End Function
Conclusion :
Cette source a été pour moi un exercice pour essayer de comprendre l'intérêt du "hooking" ainsi que la manipulation d'une fenêtre et des objets quelle contient.
Même si je crois avoir en parti compris l'intérêt du hook il me reste beaucoup à apprendre sur le sujet.
Bonne prog.
A+
Codes Sources
A voir également
- Une boite de message (msgbox) qui se prend pour un popup
- Msgbox - Conseils pratiques -Visual Basic / VB.NET
- Fermer boite de dialogue excel - Forum Visual Basic
- Msgbox en premier plan - Forum Visual Basic
- Msgbox vbyesno - Forum Visual Basic
- Message delphi - Conseils pratiques -Delphi
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.