Discussion :

[Delbeke]

Et encore un de plus, décidément , je suis en forme aujourd'hui

Ce composant à placer sur une form, recupére les evenements déclenchés par la molette de la souris.

Sont fournis : le controle ayant de focus au momment du mouvement de la molette, le sens du mouvement, les coordonées de la souris

Voici un exemple de code sur l'evénement déclenché.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Wheel1_WheelRotate(ctrl As Object, Delta As Long, X As Long, Y As Long)
  Dim CtrlIndex as string
  Dim CtrlName as string
  On Error Resume Next
  CtrlIndex = Cstr(Ctrl.Index)
  On Error goto 0
  If CtrlIndex="" Then
    CtrlName = ctrl.Name
  Else
    CtrlName = ctrl.Name & "(" & Ctrlindex & ")"
  End If
  Debug.Print CtrlName, Delta, X, Y
End Sub

Note : seuls les événements ayant une propriété hWnd peuvent déclencher un événement, donc pour les labels, rien à faire.


OCX DiMouseWheel6.zip

[SfJ5Rpw8]

bon il va falloir que je me réveille une mise à jour de la page sources VB devient de plus en plus nécessaire !

[Phifi]

Formidable !

je l'ai juste adapté à ma Flexgrid (en jouant avec la propriété .TopRow) et hop, ma grille défile à la roulette dans les deux sens ! Du pain béni !

Merci ! Merci ! Merci !

ps : petite coquille à corriger sur le ligne If CtrIndex="" Then (C'est CtrlIndex)

Edit : Voilà, adaptée à un MsFlexGrid nommé Grid1

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Private Sub Wheel1_WheelRotate(ctrl As Object, Delta As Long, X As Long, Y As Long)
    Dim CtrlIndex As String
    Dim CtrlName As String
    '
    On Error Resume Next
    '
    CtrlIndex = CStr(ctrl.Index)
    '
    On Error GoTo 0
    '
    If CtrlIndex = "" Then
        CtrlName = ctrl.Name
    Else
        CtrlName = ctrl.Name & "(" & CtrlIndex & ")"
    End If
    '
    If ctrl.Name = "Grid1" Then
        '
        If Delta > 0 Then
            If ctrl.TopRow < ctrl.Rows Then
                ctrl.TopRow = ctrl.TopRow + 1
            End If
        Else
            If ctrl.TopRow > 0 Then
                ctrl.TopRow = ctrl.TopRow - 1
            End If
        End If
        '
    End If
    '
    Debug.Print CtrlName, Delta, X, Y
    '
End Sub

[Delbeke]

Coquille corrigée

Tu n' as pas besoin de toutes les lignes que j'avais mis en exemple, tu peux simplifier en

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub Wheel1_WheelRotate(ctrl As Object, Delta As Long, X As Long, Y As Long)
    If ctrl.Name = "Grid1" Then
        '
        If Delta > 0 Then
            If ctrl.TopRow < ctrl.Rows Then
                ctrl.TopRow = ctrl.TopRow + 1
            End If
        Else
            If ctrl.TopRow > 0 Then
                ctrl.TopRow = ctrl.TopRow - 1
            End If
        End If
        '
    End If
End Sub

[LeForestier]

Bonsoir,
J'ai télécharger le zip, mais j'ai constaté qu'il ne fonctionne pas sous Vista, comme beaucoup d'autres OCX d'ailleurs, (j'en sais quelques choses).
Heureusement j'ai encore mon portable en XP, j'ai donc pu tester que c'est bien à cause de Vista.
Exemple: dans un OCX qui comportait un PictureBox avec un BMP et bien le BMP n'a pas suivi, ce n'était pas grave mais j'ai du remettre le BMP dans la PictureBox sous Vista et cela a fonctionné.
A titre de renseignement je te met le Log qui a été "pondu" sous vista.
Ligne 46: La classe DiFtpCli6.FtpCli du contrôle FtpCli1 n'est pas une classe de contrôle chargée.
Ligne 49: Le nom de la propriété _extentx dans FtpCli1 est incorrect.
Ligne 50: Le nom de la propriété _extenty dans FtpCli1 est incorrect.
Ligne 51: Le nom de la propriété remotehost dans FtpCli1 est incorrect.
Ligne 52: Le nom de la propriété username dans FtpCli1 est incorrect.
Ligne 53: Le nom de la propriété password dans FtpCli1 est incorrect.

J'ai bien l'impression que Vista nous réserve encore bien des surprises.
Cordialement.

PS: je n'ai pas encore examiné le code, je trouve juste, au premier abord que le déplacement est lent, mais peut-être qu'il y a moyen d'accélerer, j'examinerai cela un peu plus tard.

[Angath]

Merçi pour cet OCX

Juste une petite remarque, dans le cas d'une flexgrid avec des lignes fixes, ça plante, il faut tenir compte de la propriété FixedRows :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub Wheel1_WheelRotate(ctrl As Object, Delta As Long, X As Long, Y As Long)
    If ctrl.Name = "Grid1" Then
        '
        If Delta > 0 Then
            If ctrl.TopRow < ctrl.Rows - ctrl.FixedRows Then
                ctrl.TopRow = ctrl.TopRow + 1
            End If
        Else
            If ctrl.TopRow > ctrl[B].FixedRows Then
                ctrl.TopRow = ctrl.TopRow - 1
            End If
        End If
        '
    End If
End Sub

[Chatbour]

Merci pour la source Delbeke

Je suis curieux de savoir en quoi est codé DiMouseWheel6.ocx (je pense que c'est du C, vous me corrigez sinon ), le principe de son fonctionnement (hook ? :je l'ai dis et je ne connais pas très bien que celà veux dire ...)..

Je vais étudier cette année un "peu" de programmation système ce qui explique ma curiosité

Merci d'avance..

[Delbeke]

Merci pour la source Delbeke

Je suis curieux de savoir en quoi est codé DiMouseWheel6.ocx (je pense que c'est du C, vous me corrigez sinon ), le principe de son fonctionnement (hook ? :je l'ai dis et je ne connais pas très bien que celà veux dire ...)..

Je vais étudier cette année un "peu" de programmation système ce qui explique ma curiosité

Merci d'avance..

Le source du composant est fourni (DiMouseWheel6.vbp). C'est du vb6
Pour le principe, on utilise le sous-classement de la fenetre qui le contient. C'est la fonction hookwindow qui s'en charge. Comme le composant peut être utilisé par plusieurs fenetres simulanément, ma fonction gére un tableau de tous les fenetres sous-classées. En effet, un module , et ses variables , est commun à toutes les occurences du composant.

[Chatbour]

Merci Delbeke

[fmh1982]

bonjour,
on peut le faire fonctionner avec une feuille MDI ?
j'ai essayé mais ça ne marche pas par contre avec les contrôles ça fonctionne très bien.

Merci

[Delbeke]

En l'etat actuel, il ne marche pas avec les feuille MDI.
Les feuilles MDI sont composées de deux fenêtres ayant chacune leur handle.(l'une contenant l'autre, ce qui permet l'affichage des scroll-bars) et manque de chance, celle qui recoit les evénements de fenetre n'est pas celle qui est pointée par la propriété hWnd.

Il faudrait modifier le composant, au quel cas , il ne fonctionnerait plus pour les fenetres ordinaires.

Je ne vois d'ailleurs pas trop l'intéret de la molette de souris sur une feuille MDI.

[fmh1982]

en fait j'ai des form dans une feuille MDI ,ces forms contiennent beaucoup de contrôle, ce qui fait ,au changement de la résolution de l'écran , les scrolls de la MDI apparaissent et ce serait pratique d'utliser la molette de la souris pour scroller , mais bon j'ai pas le choix je laisse comme ça.

sinon merci , ça m'a beaucoup aider pour d'autres contrôles

[fmh1982]

voila enfin j'ai réussi à faire fonctionner ton code avec la feuille MDI , en fait j'ai récupéré un code un peu méchant sur le site de MS et je l'ai mixer avec ton code et ça marche tiptop voila le code de MS à integrer dans un module :
*** le but du code de microsoft est d'utiliser les touches du clavier pour scroller comme PageUp ou PageDown , mais en l'adaptant il fonctionne bien avec la molette de la souris.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
 
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
      (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
       lParam As Any) As Long
 
Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, _
       ByVal wCmd As Long) As Long
 
Public Const SB_BOTTOM = 7
Public Const SB_LEFT = 6
Public Const SB_LINEDOWN = 1
Public Const SB_LINELEFT = 0
Public Const SB_LINERIGHT = 1
Public Const SB_LINEUP = 0
Public Const SB_PAGEDOWN = 3
Public Const SB_PAGELEFT = 2
Public Const SB_PAGERIGHT = 3
Public Const SB_PAGEUP = 2
Public Const SB_RIGHT = 7
Public Const SB_THUMBPOSITION = 4
Public Const SB_THUMBTRACK = 5
Public Const SB_TOP = 6
Public Const SB_ENDSCROLL = 8
 
Public Const WM_HSCROLL = &H114
Public Const WM_VSCROLL = &H115
 
Public Const GW_CHILD = 5

voila le code final à insérer dans le MDI :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
 
Private Sub Wheel1_WheelRotate(ctrl As Object, Delta As Long, X As Long, Y As Long)
    Dim CtrlIndex As String
    Dim CtrlName As String
    '
    On Error Resume Next
    '
    CtrlIndex = CStr(ctrl.Index)
 
    If CtrlIndex = "" Then
        CtrlName = ctrl.Name
    Else
        CtrlName = ctrl.Name & "(" & CtrlIndex & ")"
    End If
    '
    If ctrl.Name = "VotreMDI" Then
        If VotreMDI.Height < 15060 Then
            If Delta > 0 Then
                mdiclientwin = GetWindow(VotreMDI.hwnd, GW_CHILD)
                SendMessage mdiclientwin, WM_VSCROLL, SB_LINEDOWN, ByVal 0&
 
            Else
                mdiclientwin = GetWindow(VotreMDI.hwnd, GW_CHILD)
                SendMessage mdiclientwin, WM_VSCROLL, SB_LINEUP, ByVal 0&
 
            End If
        Else
            Exit Sub
        End If
 
    End If
End Sub

[Delbeke]

Tu me vois ravi que tu t'en sois sorti.
Je te félicite d'avoir pu adapter mon code à yon cas précis.
Cependant, je ne mettrais pas cette amélioriation dans mon composant, car sous cette forme, il faudrait réécrire le composant à chaque fois que l'on developpe une application car le nom de la fenêtre mdi est en dur. Ce qui fatalement posera des problèmes quand on developpera plusieurs applis avec des nom différents pour la fenetre MDI. Hors , il ne peut y avoir qu'une seule version du composant référencée dans la base de registre. La dernière chassant la précédente.