Traitement des messages windows sous vb6

Soyez le premier à donner votre avis sur cette source.

Vue 9 845 fois - Téléchargée 589 fois

Description

L'évenementiel prend une place importante en VB6.

On traite en effet généralement de nombreux évènements tels que Click, Load, KeyDown.

En interne, c'est Windows qui récupère toutes les actions souris et clavier, qui est au courant de l'activation des fenêtres...

Il envoie donc tout un tas de messages aux différentes applications pour leur signifier ce qui se passe.

Le compilo de VB6 intègre automatiquement une boucle de traitement dans les executables.

Dans cette boucle, l'application inspecte la pile des messages que lui envoie Windows.

(On peut forcer un exe à traiter les messages de cette pile à tout moment dans le code via l'instruction DoEvents.)

Les messages de cette pile sont envoyés aux différentes fenêtres.

Les différentes fenêtres traitent les messages et déclenchent les évènements implémentés par le programmeur.

Nous nous proposons ici de placer une routine qui sera appelé à chaque message reçut par une fenêtre.

Les messages pourront être inspecté, et on aurat la possibilité de les bloquer pour que leur traitement normal ne soit pas effectuer.

Cette opération n'est pas anodine, et on pourra avoir des soucis avec le débogueur de VB6.

L'implémentation étant en partie effectuée dans un ocx, VB6 est stable, néanmoins, il arrive que notre fonction ne se fasse plus appeler ou encore qu'un point d'arrêt ne fonctionne pas.

Cette possède deux évènement :

1 Le premier permet d'inspecter des messages. Les messages sont traités normalement.
2 Le deuxième permet d'inspecter des messages, mais ceux-ci ne seront pas traités normalement.

(Attention : La valeur retourné pour les messages bloqué est de zéro, valeur commune mais pas universselle.).

Quelques mises en garde :

1 Le traitement des messages n'est pas particulièrement simple.
Il faut bien lire la doc avant de faire quoi que ce soit.
Un exemple: afficher du texte à chaque message WM_PAINT risque de créer beaucoup d'ennuis...

2 Windows envoie une grande quantité de messages : Mettre en place une procédure à chaque arrivée de message est couteux en CPU.

Dans le zip joint, il y a les sources d'un exe et d'un ocx.
L'exe montre quelques exemples de traitement de messages.

Source / Exemple :


Option Explicit

Private Type POINTAPI
        X As Long
        Y As Long
End Type

Private Type MINMAXINFO
        ptReserved As POINTAPI
        ptMaxSize As POINTAPI
        ptMaxPosition As POINTAPI
        ptMinTrackSize As POINTAPI
        ptMaxTrackSize As POINTAPI
End Type

Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Private Const WA_INACTIVE = 0
Private Const WA_ACTIVE = 1
Private Const WA_CLICKACTIVE = 2
Private Const WM_GETMINMAXINFO = &H24
Private Const WM_ACTIVATE = &H6
Private Const WM_MOVE = &H3
Private Const GWL_STYLE = (-16)
Private Const WM_MOUSEWHEEL = 522

Private AnMsgs(0 To 3) As Long              ' Les messages traités
Private AnBlockedMsgs(0 To 1) As Long       ' Les messages blockés
Private uRect As RECT                       ' Pour la taille de la fenêtre

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function AdjustWindowRect Lib "user32" (lpRect As RECT, ByVal dwStyle As Long, ByVal bMenu As Long) As Long

'******************************************************************************
' Calcul de la taille de la fenêtre en fonction de la taille de la zone
' cliente, spécification des messages à récupérer
'******************************************************************************
Private Sub Form_Activate()
  
  ' Calcul de la taille de la fenêtre
  With uRect
    .Left = 0
    .Top = 0
    .Right = 500
    .Bottom = 300
  End With
  fraMain.Width = uRect.Right
  fraMain.Height = uRect.Bottom
  AdjustWindowRect uRect, GetWindowLong(hwnd, GWL_STYLE), 0
  With uRect
    .Right = .Right - .Left
    .Bottom = .Bottom - .Top
  End With
  
  ' On veux savoir quand l'application reçoit ces messages, mais les traiter quand même
  AnMsgs(1) = WM_ACTIVATE
  AnMsgs(2) = WM_MOVE
  AnMsgs(3) = WM_MOUSEWHEEL
  
  ' On veut savoir quand l'application reçoit ce message, et qu'ils ne soient pas traités
  AnBlockedMsgs(1) = WM_GETMINMAXINFO
  
  ' On initialise le contrôle
  MessageListener.Init Me.hwnd, AnMsgs, AnBlockedMsgs
  
End Sub

'******************************************************************************
' Efface le contenu de la text box
'******************************************************************************
Private Sub cmdErase_Click()
  txtMsgs.Text = ""
End Sub

'******************************************************************************
' Cet évenement récupère tous les messages traités spécifiés
'******************************************************************************
Private Sub MessageListener_OnMsg(ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
  Select Case uMsg
    Case WM_ACTIVATE
    
      ' Pour savoir de quelle type d'activation il s'agit, il faut regarder les 2 octets de poid faible de wParam
      Select Case (wParam And &HFFFF)
        Case WA_INACTIVE
          txtMsgs = txtMsgs + "La fenêtre est déactivée" & vbCrLf
        Case WA_ACTIVE
          txtMsgs = txtMsgs + "La fenêtre est activée" & vbCrLf
        Case WA_CLICKACTIVE
          txtMsgs = txtMsgs + "La fenêtre est activée par un clique" & vbCrLf
      End Select
      
    Case WM_MOVE
      txtMsgs = txtMsgs + "La fenêtre est déplacée" & vbCrLf
    Case WM_MOUSEWHEEL
      
      ' Le delta de la roulette est dans les 2 octets de poid fort de wParam
      txtMsgs = txtMsgs + "Roulette de la souris déplacée de " & CStr(wParam / 65536) & vbCrLf
      
  End Select
End Sub

'******************************************************************************
' Cet évenement récupère tous les messages non traités spécifiés
'******************************************************************************
Private Sub MessageListener_OnBlockedMsg(ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
  Dim uMinMaxInfo As MINMAXINFO
  
  ' L'adresse de la structure à modifiée est lParam, on recopie celle-ci
  CopyMemory uMinMaxInfo, ByVal lParam, Len(uMinMaxInfo)
  
  ' On la modifie avec la taille minimum
  uMinMaxInfo.ptMinTrackSize.X = uRect.Right
  uMinMaxInfo.ptMinTrackSize.Y = uRect.Bottom
  
  ' On remplace l'original par la modifiée
  CopyMemory ByVal lParam, uMinMaxInfo, Len(uMinMaxInfo)
  
End Sub

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

cs_rt15
Messages postés
3874
Date d'inscription
mardi 8 mars 2005
Statut
Modérateur
Dernière intervention
7 novembre 2014
10
Hop.
Echange standard.
J'ai pas fait les icônes en bas à droite, y a déjà des sources qui traitent du sujet (Mais différement d'ailleurs).

C'est pas encore parfait lors du débogage, mais au moins c'est stable.
cs_rt15
Messages postés
3874
Date d'inscription
mardi 8 mars 2005
Statut
Modérateur
Dernière intervention
7 novembre 2014
10
Comme le dit Renfield sur sa source, dans une dll, pas de problèmes lors du débogage.

Donc on doit pouvoir aussi faire un contrôle stocké dans un .ocx pour faciliter l'emploi au maximum. Même si certains préfèrent pas multiplier les dépendances.

Si j'ai le temps, je vais essayer de faire un ocx qui propose un event appelé à chaque message. Si ça foire pas, ça devrait faciliter la mise en place de manips sympa du même genre que la spécfication de la taille min de la form. La gestion de petits icônes en bas à droites par exemple.
Renfield
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
60
coté résultat, c'est correct....

pas 36 facons de faire : intercepter WM_GETMINMAX
capoueidiablo
Messages postés
316
Date d'inscription
jeudi 9 janvier 2003
Statut
Membre
Dernière intervention
1 février 2010
1
On a donc deux codes "moches" ...
Y'a pas quelqu'un pour proposer quelque chose de "beau" ?
cs_rt15
Messages postés
3874
Date d'inscription
mardi 8 mars 2005
Statut
Modérateur
Dernière intervention
7 novembre 2014
10
Salut Renfield

Tout à fait la même lol.

Si tu veux supprimer celle-ci, no prob, au contraire.

Je pensais pas qu'un truc aussi moche ai déjà été écrit...

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.