OVH Cloud OVH Cloud

[KeyPress] Sous-classement

16 réponses
Avatar
Daniel
Bonjour.

Mon application requiert l'utilisation de KeyPress et les fl=E8ches =
gauche et droite d'un clavier standard n'ont pas de code ASCII. =
Quelqu'un m'avait parl=E9 de faire un "sous-classement" mais je n'ai pas =
compris ce qu'il voulait dire.

J'aurais aim=E9 avoir un simple exemple de la fa=E7on de savoir si la =
fl=E8che droite ou gauche a =E9t=E9 enfonc=E9e dans KeyPress.
Et puis pour les deux Shift aussi si possible.

Merci d'avance.

Cordialement
Daniel - Z

10 réponses

1 2
Avatar
Zoury
Dalut Daniel! :O)

pour savoir si les flèches sont enfoncées, regarde du coté des événements
KeyDown et KeyUp. Le paramètre KeyCode te renvoi un code identifiant une
touche. Pour ce qui est de savoir si le shift est enfoncé tu peux regarder
la valeur du paramètre Shift qui représente un Flag. Maintenant si tu veux
connaître lequel des 2 Shifts est enfoncé, tu peux regarder du côté de l'API
GetKeyState().

Ex :
'***
' Form1, KeyPreview à True
Option Explicit

Private Declare Function GetKeyState _
Lib "user32" _
( _
ByVal nVirtKey As Long _
) As Integer

Private Const VK_LSHIFT As Long = &HA0
Private Const VK_RSHIFT As Long = &HA1

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

Dim sShift As String
Dim sTouche As String

' Vérifie l'état du flag vbShiftMask
If ((Shift And vbShiftMask) = vbShiftMask) Then
' il était enfoncé lors de l'appel de lévénement
' on vérifie donc lequel est enfoncé
' si, dans la valeur de retour, le bit le plus
' fort est à 1 alors la touche est enfoncée
If ((GetKeyState(VK_LSHIFT) And &H80000000) = &H80000000) Then
sShift = "Shift gauche enfoncé"
ElseIf ((GetKeyState(VK_RSHIFT) And &H80000000) = &H80000000) Then
sShift = "Shift droit enfoncé"
End If

End If

' Vérifie si les flèches gauche ou droite sont enfoncées
If (KeyCode = vbKeyLeft) Then
sTouche = "Flèche gauche"
ElseIf (KeyCode = vbKeyRight) Then
sTouche = "Flèche droite"
End If

Debug.Print sTouche, sShift

End Sub
'***

Appui sur le différentes combinaisons de shift et de flèche droite et gauche
et regarde le résultat dans la fenêtre d'exécution.


--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 - http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml - http://www.mztools.com/

Merci de poster les réponses au groupe afin d'en faire profiter à tous
Avatar
Daniel
Bonjour.

J'ai bien mentionné dans mon premier message que je dois le faire avec KeyPress. Je le rementionne donc...

Je rementionne également que je suis un débutant (je le mentionne habituellement à chaque message, sauf que je l'ai oublié cette fois-ci).

Pour les Shifts, je test tout ça et je te reviens si il y a un problème.

--
Merci d'avance de vos réponces.

Cordialement
Daniel - Z
Avatar
Zoury
: J'ai bien mentionné dans mon premier message que je dois le faire avec
KeyPress. Je le rementionne donc...

J'ai bien vu... mais c'est impossible de le faire par le KeyPress. Quel est
le problème à ajouter l'événement KeyDown? l'un n'empêche pas l'autre...

: Je rementionne également que je suis un débutant (je le mentionne
habituellement à chaque message, sauf que je l'ai oublié cette fois-ci).

Ça aussi je le sais. :O)
Si tu as des problèmes à comprendre le code n'hésite pas nous sommes là pour
ça.


--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 - http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml - http://www.mztools.com/

Merci de poster les réponses au groupe afin d'en faire profiter à tous
Avatar
Daniel
Bonjour.

Le problème dans le KeyCode c'est que ce que je demande se produit uniquement lors du KeyUp. Voici un extrait de mon code :

If KeyCode = 37 Then
If ObjectCurrentX1 > Picture1.Left - 40 Then
ObjectCurrentX1 = ObjectCurrentX1 - A
ObjectCurrentX2 = ObjectCurrentX2 - A
ObjectCurrentX3 = ObjectCurrentX3 - A
ObjectCurrentX4 = ObjectCurrentX4 - A
ObjectCurrentX5 = ObjectCurrentX5 - A
Picture1.Cls
Picture1.PaintPicture BackPicture, 0, 0, , , , , , , vbSrcCopy
Picture1.PaintPicture MaskPicture1, ObjectCurrentX1, ObjectCurrentY1, , , , , , , vbSrcAnd
Picture1.PaintPicture ObjectPicture1, ObjectCurrentX1, ObjectCurrentY1, , , , , , , vbSrcPaint
Picture1.PaintPicture MaskPicture2, ObjectCurrentX2, ObjectCurrentY2, , , , , , , vbSrcAnd
Picture1.PaintPicture ObjectPicture2, ObjectCurrentX2, ObjectCurrentY2, , , , , , , vbSrcPaint
Picture1.PaintPicture MaskPicture3, ObjectCurrentX3, ObjectCurrentY3, , , , , , , vbSrcAnd
Picture1.PaintPicture ObjectPicture3, ObjectCurrentX3, ObjectCurrentY3, , , , , , , vbSrcPaint
End If
End If

Bref, j'utilise PaintPicture, et je déplace mon image. Si j'appuis 11 secondes sur A ou D, mon image se déplacera (11 x son mouvement) uniquement après 11 secondes. Ce que je veux, c'est que l'image se déplace genre 1 fois toute les seconde. On m'a dit qu'il fallait alors utiliser KeyPress.

Solution ?

--
Merci d'avance de vos réponces.

Cordialement
Daniel - Z
Avatar
Zoury
: Solution ?

simple : Ajoute un Timer que tu actives dans le KeyDown lorsque la touche
correspond à celle que tu veux et que tu désactives dans le KeyUp.
désavantage : Le contrôle Timer est impréci.. essai le quand même et
observe le résultat.. si c'est trop lent on changera de technique. (surtout
pour le PaintPicture..)

complexe : Utiliser un hook clavier. Mais commence par tester la première
solution avant.

--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 - http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml - http://www.mztools.com/

Merci de poster les réponses au groupe afin d'en faire profiter à tous
Avatar
Daniel
Bonjour.

Oui j'ai déjà essayé avec un timer mais c'est non-seulement très impréci mais si on a une autre application d'ouverte tel que Office, et bien ça fait monter les ressources systèmes utilisés à 100%, ce qui est intolérable, d'autant plus que ça ralentit l'ordinateur. Avec une autre grosse application d'ouverte en plus de Office, ça saute tout simplement...

Si on déplace l'image coup par coup (on relâche la touche chaque fois, puis on la represse, plutôt que de tenir pressée) c'est correct, mais cela ne m'avance pas plus.

Alors ? Hookclavier ? Je ne connais pas. Si cela n'est pas gourmand en ressource, que c'est rapide, léger... Je suis prêt !
Même si c'est compliqué à coder. Par contre, je suis un newbie alors faut pas me donner pleins de bouts de codes à bricoler lol... Un exemple bien expliqué et tout ira bien.

--
Merci d'avance de vos réponces.

Cordialement
Daniel - Z
Avatar
Daniel
Bonjour.

En bref, qu'est-ce que le "hook clavier", comment l'utiliser et quel sera le résultat vitesse/poids ?

--
Merci d'avance de vos réponces.

Cordialement
Daniel - Z
Avatar
Zoury
T'es en train de faire un jeu toi hein?! :O)

Ton problème de performance provient probablement de l'utilisation de
PaintPicture pour déplacer ton image et de plein d'autre petite chose... Ca
demande beaucoup de ressources et ça finit par ralentir l'appel du Timer et
tout le reste du système.

Voici un exemple qui devrait résoudre tes problèmes de performance, tes
problèmes de transparences, ton problème de timer imprécis et finalement ton
problème de capture de touche du clavier. Le code est simple si tu le prend
morceau par morceau. Je l'ai commenté pour que tu ne t'y perde pas trop. Tu
as besoin de 2 images pour que ça fonctionne. Une principale et une autre
identique MAIS toute les couleurs doivent être noir. Le fond des 2 images
doit être blanc, cette couleur deviendra invisible lors de l'exécution.

désolé pour les longues lignes...
'***
' Form1
' 2 PictureBoxes, BorderStyle = 0 - None
Option Explicit

Private Sub Form_Load()
Call Init
Call StartTimer(Me.hWnd, 10)
Call HookKeyboard
End Sub

Private Sub Init()

Me.AutoRedraw = True
Picture1.AutoRedraw = True
Picture2.AutoRedraw = True

Me.ScaleMode = vbPixels
Picture1.ScaleMode = vbPixels
Picture2.ScaleMode = vbPixels

Picture1.AutoSize = True
Picture2.AutoSize = True

Picture1.Visible = False
Picture2.Visible = False

Set Picture1.Picture = LoadPicture(App.Path & "ball.bmp") ' 50 x 50
Set Picture2.Picture = LoadPicture(App.Path & "blackball.bmp") ' 50 x
50

End Sub

Private Sub Form_Unload(Cancel As Integer)
Call StopTimer(Me.hWnd)
Call UnhookKeyboard
End Sub
'***

'***
' Module1
Option Explicit

Private Const WH_KEYBOARD As Long = 2
Private Const VK_LSHIFT As Long = &HA0
Private Const VK_RSHIFT As Long = &HA1

Private Declare Function CallNextHookEx _
Lib "user32" _
( _
ByVal hHook As Long, _
ByVal nCode As Long, _
ByVal wParam As Long, _
ByRef lParam As Any _
) As Long

Private Declare Function GetKeyState _
Lib "user32" _
( _
ByVal nVirtKey As Long _
) As Integer

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 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 BitBlt _
Lib "gdi32" _
( _
ByVal hDestDC As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hSrcDC As Long, _
ByVal xSrc As Long, _
ByVal ySrc As Long, _
ByVal dwRop As Long _
) As Long

Private m_hHook As Long
Private m_lLeft As Long
Private m_lTop As Long

Public Function KeyboardProc(ByVal idHook As Long, ByVal wParam As Long,
ByVal lParam As Long) As Long

' Si idHook est plus petit que 0
' on ne fait rien..
If idHook >= 0 Then
Call CalculerNouvellePosition(ObtenirTailleDeplacement)
End If

' On appel le prochain hook
KeyboardProc = CallNextHookEx(m_hHook, idHook, wParam, ByVal lParam)

End Function

Private Sub CalculerNouvellePosition(ByRef lDeplacement As Long)

' Ici on vérifie si les flèches gauche, droite, haut ou bas
' sont enfoncées. Le fait de les vérifier une à une et non
' dans un If Then ElseIf Then... permet un déplacement
' en diagonale.

' La flèche gauche
If ((GetKeyState(vbKeyLeft) And &H80000000) = &H80000000) Then
If (m_lLeft - lDeplacement >= 0) Then
m_lLeft = m_lLeft - lDeplacement
Else
m_lLeft = 0
End If
End If

' La flèche droite
If ((GetKeyState(vbKeyRight) And &H80000000) = &H80000000) Then
If (m_lLeft + lDeplacement <= Form1.ScaleWidth -
Form1.Picture1.Width) Then
m_lLeft = m_lLeft + lDeplacement
Else
m_lLeft = Form1.ScaleWidth - Form1.Picture1.Width
End If
End If

' La flèche en haut
If ((GetKeyState(vbKeyUp) And &H80000000) = &H80000000) Then
If (m_lTop - lDeplacement >= 0) Then
m_lTop = m_lTop - lDeplacement
Else
m_lTop = 0
End If
End If

' La flèche en bas
If ((GetKeyState(vbKeyDown) And &H80000000) = &H80000000) Then
If (m_lTop + lDeplacement <= Form1.ScaleHeight -
Form1.Picture1.Height) Then
m_lTop = m_lTop + lDeplacement
Else
m_lTop = Form1.ScaleHeight - Form1.Picture1.Height
End If
End If

' Si la touche est escape, on quitte le programme
If ((GetKeyState(vbKeyEscape) And &H80000000) = &H80000000) Then
Call Unload(Form1)
End If

End Sub

' Dicte la longueur d'un déplacement
' Left Shift + ou - 25
' Right Shift + ou - 10
' Aucun Shift + ou - 1
Private Function ObtenirTailleDeplacement()

' Vérifie si shift gauche est enfoncé
If ((GetKeyState(VK_LSHIFT) And &H80000000) = &H80000000) Then

ObtenirTailleDeplacement = 100

' Vérifie si shift droit est enfoncé
ElseIf ((GetKeyState(VK_RSHIFT) And &H80000000) = &H80000000) Then

ObtenirTailleDeplacement = 10

' Shift n'est pas enfoncé
Else
ObtenirTailleDeplacement = 1
End If
End Function

Private Sub DessinerBalle()

' Vide l'écran
Call Form1.Cls

' Le rôle de la balle noir
'
' vbMergePaint inverse la couleur
' de l'image source, donc amène
' le noir en blanc et le blanc
' en noir. Ensuite il combine
' l'image source et l'image
' destination avec un Or.
' Le blanc reste blanc et
' le noir devient de la couleur
' qu'était la destination.
' on se retrouve donc avec
' une balle blanche
'
Call BitBlt(Form1.hDC, _
m_lLeft, _
m_lTop, _
Form1.Picture2.Width, _
Form1.Picture2.Height, _
Form1.Picture2.hDC, _
0, _
0, _
vbMergePaint)

' Le rôle de la balle bleu
'
' vbSrcAnd copie l'image
' tel quelle est. Sauf que
' le blanc qui se trouvait
' sur l'image source n'apparait
' pas dans l'image destination.
' on se retrouve donc avec une
' balle bleu avec fond transparent.
'
Call BitBlt(Form1.hDC, _
m_lLeft, _
m_lTop, _
Form1.Picture1.Width, _
Form1.Picture1.Height, _
Form1.Picture1.hDC, _
0, _
0, _
vbSrcAnd)

' Rafraichit le Form
Call Form1.Refresh

End Sub

Public Sub HookKeyboard()
m_hHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf KeyboardProc,
App.hInstance, App.ThreadID)
End Sub

Public Sub UnhookKeyboard()
Call UnhookWindowsHookEx(m_hHook)
End Sub

Public Sub TimerProc(ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal
uElapse As Long, ByVal lpTimerFunc As Long)
Call DessinerBalle
End Sub

Public Sub StartTimer(ByRef hWnd As Long, ByRef lInterval As Long)
Call SetTimer(hWnd, 0, lInterval, AddressOf TimerProc)
End Sub

Public Sub StopTimer(ByRef hWnd As Long)
Call KillTimer(hWnd, 0)
End Sub
'***

je poste le projet dans le message qui suit.

--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 - http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml - http://www.mztools.com/

Merci de poster les réponses au groupe afin d'en faire profiter à tous
Avatar
Daniel
Bonjour.

Ok j'attend le projet d'exemple... tu peux le faire avec plusieurs images à déplacer SVP ?

Prend ton temps.

--
Merci d'avance de vos réponces.

Cordialement
Daniel - Z
Avatar
Zoury
Je vais te laisser le faire et corriger ton code par la suite.. :O)

tips : même principe mais avec 2 tableaux de PictureBoxes et des tableaux
aussi pour les positions (m_lLeft() et m_lTop())

--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 - http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml - http://www.mztools.com/

Merci de poster les réponses au groupe afin d'en faire profiter à tous
"Daniel" wrote in message
news:
Bonjour.

Ok j'attend le projet d'exemple... tu peux le faire avec plusieurs images à
déplacer SVP ?

Prend ton temps.

--
Merci d'avance de vos réponces.

Cordialement
Daniel - Z
1 2