UTILISATION DE LA MOLETTE DE LA SOURIS AVEC UN CÔNTROLE MSHFLEXGRID -
cs_scenic29
Messages postés
5
Date d'inscription
lundi 6 octobre 2003
Statut
Membre
Dernière intervention
9 août 2012
-
9 août 2012 à 15:38
Cjvg Messages postés 330 Date d'inscription mercredi 6 décembre 2000 Statut Membre Dernière intervention 26 octobre 2017 - 11 août 2012 à 09:40
Cjvg Messages postés 330 Date d'inscription mercredi 6 décembre 2000 Statut Membre Dernière intervention 26 octobre 2017 - 11 août 2012 à 09:40
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/54496-utilisation-de-la-molette-de-la-souris-avec-un-controle-mshflexgrid
https://codes-sources.commentcamarche.net/source/54496-utilisation-de-la-molette-de-la-souris-avec-un-controle-mshflexgrid
11 août 2012 à 09:40
Il y a cependant un léger petit problème. Au premier tour de la molette,
la ligne 10 est remplacée par la ligne 0.
Encore Merci
11 août 2012 à 02:03
J'ai la mémoire courte
11 août 2012 à 01:59
Public Function GetMsgProc(ByVal nCode As Long, ByVal wParam As Long, lParam As MSG) As Long
Dim PosX As Long
Dim PosY As Long
Dim Lig As Long 'ligne du TopRow
If lParam.Message = WM_MOUSEWHEEL Then
Lig = Objet.TopRow 'on sauvegarde cette ligne
DoEvents 'on reste le temp d'accomplir la fonction
Feuille.ScaleMode = 3
PosX = lParam.Pt.X - Feuille.ScaleX(Feuille.Left, vbTwips, vbPixels)
PosY = lParam.Pt.Y - Feuille.ScaleY(Feuille.Top, vbTwips, vbPixels)
'On se trouve à l'intérieur de l'Objet
On Error Resume Next 'on évite les erreurs (première et dernière ligne du MSHFlexGrid)
If PosX > Objet.Left And PosX < (Objet.Left + Objet.Width) And _
PosY > Objet.Top And PosY < (Objet.Top + Objet.Height) Then
If lParam.wParam > 0 Then
Objet.TopRow = Lig - LignesRoulette
Else
Objet.TopRow = Lig + LignesRoulette
End If
End If
Objet.TextMatrix(10, 0) = Objet.TopRow
End If
Feuille.ScaleMode = 1
GetMsgProc = CallNextHookEx(Ihook, nCode, wParam, lParam)
End Function
11 août 2012 à 01:27
Public Function GetMsgProc(ByVal nCode As Long, ByVal wParam As Long, lParam As MSG) As Long
Dim PosX As Long
Dim PosY As Long
Dim Lig As Long 'ligne du TopRow
If lParam.Message = WM_MOUSEWHEEL Then
Lig = Objet.TopRow 'on sauvegarde cette ligne
DoEvents 'on reste le temp d'accomplir la fonction
Feuille.ScaleMode = 3
PosX = lParam.Pt.X - Feuille.ScaleX(Feuille.Left, vbTwips, vbPixels)
PosY = lParam.Pt.Y - Feuille.ScaleY(Feuille.Top, vbTwips, vbPixels)
'On se trouve à l'intérieur de l'Objet
On Error Resume Next 'on évite les erreurs (première et dernière ligne du MSHFlexGrid)
If PosX > Objet.Left And PosX < (Objet.Left + Objet.Width) And _
PosY > Objet.Top And PosY < (Objet.Top + Objet.Height) Then
If lParam.wParam > 0 Then
Objet.TopRow = Lig - LignesRoulette
Else
Objet.TopRow = Lig + LignesRoulette
End If
End If
Objet.TextMatrix(10, 0) = Objet.TopRow
End If
Feuille.ScaleMode = 1
GetMsgProc = CallNextHookEx(Ihook, nCode, wParam, lParam)
End Function
9 août 2012 à 19:28
Avec la procédure modifiée par SCENIC29, la progression se fait normalement.
j'avais placé la variable UnDeux dans la procédure sans la mettre Static.
Merci encore.
Cependant, si quelqu'un peut expliquer l'erreur qui se produit avec la source d'origine ........
9 août 2012 à 19:13
Je viens de refaire un nouvel essai avec la procédure modifiée comme indiqué par SCENIC29.
Avec LIGNESROULETTE = 1, le déplacement est normal
Avec LIGNESROULETTE = 2, il est de 4 puis de 8 puis de 12, 16 ...............
Ce serait bien qu'un essai soit fait par une troisième personne.
Avis aux amateurs
Par avance merci.
9 août 2012 à 17:36
Ce n'est pas çà le but de cette variable ?
Dans ce cas, pas de pb selon mes tests.
9 août 2012 à 17:24
Em mettant un point d'arrêt sur la dernière ligne (Feuille.ScaleMode = 1) le traitement semble normal.
J'ai essayé un Doevents mais là ça tombe en erreur
9 août 2012 à 15:51
Il y a cependant un petit problème: Cela fonctionne lorsque la variable LIGNESROULETTE est à la valeur 1
Initialisée à une autre valeur, le problème reste entier.
Merci encore
9 août 2012 à 15:38
Ajouter une variable
Dim UnDeux As Boolean
Modifier la fonction Function GetMsgProc
Public Function GetMsgProc(ByVal nCode As Long, ByVal wParam As Long, lParam As MSG) As Long
Dim PosX As Long
Dim PosY As Long
If lParam.message = WM_MOUSEWHEEL Then
If Objet.Rows = Objet.FixedRows Then Exit Function
Feuille.ScaleMode = 3
PosX = lParam.pt.x - Feuille.ScaleX(Feuille.Left, vbTwips, vbPixels)
PosY = lParam.pt.y - Feuille.ScaleY(Feuille.Top, vbTwips, vbPixels)
'On se trouve à l'intérieur de l'Objet
If PosX > Objet.Left And PosX < (Objet.Left + Objet.Width) And _
PosY > Objet.Top And PosY < (Objet.Top + Objet.Height) Then
If UnDeux = False Then
If lParam.wParam > 0 Then
' On est en haut de la feuille
If Objet.TopRow - LIGNESROULETTE <= Objet.FixedRows Then
Objet.TopRow = Objet.FixedRows
Feuille.ScaleMode = 1
Exit Function
End If
If Objet.TopRow > Objet.FixedRows Then Objet.TopRow = Objet.TopRow - LIGNESROULETTE
Else
If Objet.TopRow + LIGNESROULETTE < Objet.Rows - 1 Then If Objet.TopRow < Objet.Rows - 1 Then Objet.TopRow = Objet.TopRow + LIGNESROULETTE
End If
UnDeux = True
Else
UnDeux = False
End If
End If
Feuille.ScaleMode = 1
End If
GetMsgProc = CallNextHookEx(Ihook, nCode, wParam, lParam)
End Function