TRAITEMENT DES MESSAGES WINDOWS SOUS VB6

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

Télécharger le zip

15 janvier 2007 13:10:29 :

Problème de copier coller sous gedit : 2 caractères de retour à la ligne...

19 janvier 2007 11:10:02 :

Remplacement d'un source exploitant le traitement des messages pour spécifier une taille minimale pour une fenêtre par un source expliquant et facilitant le traitement des messages.

19 janvier 2007 11:17:42 :

Orthographe et correction des commentaires