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.
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.
Merci de poster les réponses au groupe afin d'en faire profiter à tous
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.
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.
Merci de poster les réponses au groupe afin d'en faire profiter à tous
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
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.
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
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.
Merci de poster les réponses au groupe afin d'en faire profiter à tous
: 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.
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.
Merci de poster les réponses au groupe afin d'en faire profiter à tous
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
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.
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
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
Bonjour.
En bref, qu'est-ce que le "hook clavier", comment l'utiliser et quel sera le résultat vitesse/poids ?
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
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
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 '***
Merci de poster les réponses au groupe afin d'en faire profiter à tous
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
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
'***
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
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 '***
Merci de poster les réponses au groupe afin d'en faire profiter à tous
"Daniel" <NOSPAM_daniel.z@laposte.net> wrote in message
news:etTn4bZpDHA.3844@tk2msftngp13.phx.gbl...
Bonjour.
Ok j'attend le projet d'exemple... tu peux le faire avec plusieurs images à
déplacer SVP ?