PureBasic

Forums PureBasic - Français
https://www.purebasic.fr/french/

API - Etat général de toutes les touches du clavier

https://www.purebasic.fr/french/viewtopic.php?t=7236

Page 1 sur 1

API - Etat général de toutes les touches du clavier

Publié : mer. 26/sept./2007 0:30
par Ollivier
Suite au léger bug clavier que rencontre Pollux, kaeru (forum UK) m'a fait découvrir une fonction de l'API : GetKeyboardState_()

Voici un des deux exemples d'affichage simultané de l'état de chaque touche.

Code : Tout sélectionner

Structure FFmap 
  key.b[256] 
EndStructure 

Global Dim Keys.FFmap(1) 


Procedure FunStd() 

  Protected WinX.L 

  WinX = OpenWindow(-1, 0, 0, 600, 300, "GetKeyboardState - Map of the keyboard", $00CF0001) 
  If WinX 
    MenuX.L = CreateMenu(-1, WindowID(WinX) ) 

    If MenuX 
      OpenSubMenu("File") 
        MenuItem($1F0, "Quit") 
      CloseSubMenu() 
      Static Exit.L = 0 
      Repeat 
;____________________________________________________________________________ 
;¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯            
          Swaping = 1 - Swaping 
          If GetKeyboardState_(@Keys(Swaping) ) 
              StartDrawing(WindowOutput(WinX) ) 
                  For y = 0 To 15                  
                      For x = 0 To 15                          
                          N = (y << 4) + x 
                          If Keys(Swaping)\Key[N] <> Keys(1 - Swaping)\Key[N] 
                              xx = (x + 1) << 5 
                              yy = (y + 1) << 4 
                              Box(xx, yy, 32, 16, #Black) 
                              Box(xx, yy, 31, 15, #White) 
                              DrawingMode(#PB_2DDrawing_Transparent) 
                              DrawText(xx, yy, Str(Keys(Swaping)\Key[N]) ) 
                          EndIf 
                      Next 
                  Next 
                  Line(31, 15, 0, 256, #Black) 
                  Line(31, 15, 512, 0, #Black) 
              StopDrawing() 
          EndIf 
;____________________________________________________________________________ 
;¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯          
          Delay(5) 
          eWindow = WindowEvent() ; << Is this the problem? 
          aWindow = EventWindow() 
          Select eWindow 
              Case #PB_Event_Repaint 
                    For i = 0 To 255 
                          Keys(0)\Key[i] = 254 
                    Next 
                    StartDrawing(WindowOutput(WinX) ) 
                          For x = 0 To 15 
                                DrawingMode(#PB_2DDrawing_Transparent) 
                                DrawText((1 + x) << 5 + 8, 0, RSet(Str(x), 2, "0") ) 
                                DrawText(4, (1 + x) << 4, RSet(Str(x << 4), 3, "0") )              
                          Next 
          ;Line(0, ) 
                    StopDrawing()                  
              Case #PB_Event_CloseWindow:                          Exit = $1 
              Case #PB_Event_Menu       : eMenu   =   EventMenu(): If eMenu = $1F0: Exit = $1: EndIf 
              Case #PB_Event_Gadget     : eGadget = EventGadget(): 
          EndSelect 
      Until Exit = 1 
    EndIf 
  EndIf 
  EndProcedure 
    
  FunStd()

Publié : mer. 26/sept./2007 7:30
par Kwai chang caine
Super cool, j'adoooorrreeee !!!

Il est fou OLLIVOU, il est fou :lol:

Merci de ce super code

Publié : ven. 28/sept./2007 10:56
par Ollivier
Bonjour tt la monde,

Avec ce code, je viens de m'apercevoir que j'ai aussi l'état des touches de ma souris. Pouvez-vous me confirmer si c'est pareil pour un peu tout le monde (ce serait cool de préciser si c'est un portable ou une centrale)

Publié : ven. 28/sept./2007 23:54
par Huitbit
Bonjour,

Sur poste fixe:
Etat des touches + boutons gauche et droit de la souris(souris en (01,000) et (02,000))

Hasta la vista!

Publié : sam. 29/sept./2007 3:03
par Ollivier
De la balle cte fonction... Il ne me reste plus qu'à savoir comment elle réagit en multi-thread parce qu'a priori elle ne répond qu'à la dernière fenêtre ouverte avant son appel ET si cette dernière est active. Résultat : un capharnaüm pour la faire tourner en arrière-plan.

Merci beaucoup 8bits!

Publié : sam. 29/sept./2007 6:43
par Kwai chang caine
Excuse moi pour arriver apres la guerre, mais j'avais pas vu ta question, pourtant c'est pas faute de hanter le forum :?
Et pourtant, j'ai déjà montré les effets de ton code à mon chef au boulot.
J'aime bien les faire baver eux qui ne connaissent que VBA. :D
Tu as raison mon OLLIVIER
En plus la souris est aussi intercepté. 8O
Le clic droit, gauche , le bouton central.
Par contre et tu doit t'en douter pas le scrolling.

Je suis aussi sur un desktop.

Voila, voila, voila

Publié : sam. 29/sept./2007 10:21
par Backup
Kwai chang caine a écrit : Par contre et tu doit t'en douter pas le scrolling.
Je suis aussi sur un desktop.

Voila, voila, voila
pour info la souris on peut comme ça :)

Code : Tout sélectionner

 ; Auteur : Le Soldat Inconnu, Fred
; Version de PB : 3.90
;
; Explication du programme :
; Détection des différents état de la souris - Appuyer sur le bouton gauche, relacher le bouton gauche, double clic, etc ...

#WM_MOUSEWHEEL = $20A
#WHEEL_DELTA = 120
#text=1
If OpenWindow(0, 0, 0, 200, 200, "Souris",#PB_Window_SystemMenu | #PB_Window_ScreenCentered) And CreateGadgetList(WindowID(0))
    
    SetClassLong_(WindowID(0), #GCL_STYLE, GetClassLong_(WindowID(0), #GCL_STYLE) | #CS_DBLCLKS) ; Active la gestion du double clic
    
    CreateImage(0, 200, 100)
    StartDrawing(ImageOutput(0))
    DrawingMode(1)
    FrontColor(RGB(255, 255, 255))
    DrawText(5,5,"Marche pas sur l'image :")
     DrawText(5,20,"Bouton gauche appuyé")
     DrawText(5,35,"Double clic gauche")
    StopDrawing()
    
    
    ImageGadget(0, 0, 0, 200, 100, ImageID(0))
    SetWindowLong_(GadgetID(0), #GWL_STYLE, GetWindowLong_(GadgetID(0), #GWL_STYLE) & ~#SS_NOTIFY)
    
    TextGadget(#text, 1, 150, 200, 50, "appuis touche souris") 
    Repeat
        Event = WaitWindowEvent() 
        If Event = #WM_LBUTTONDOWN
            SetGadgetText(#text, "Bouton gauche appuyé") 
          ElseIf Event = #WM_LBUTTONUP
           SetGadgetText(#text,"Bouton gauche relaché") 
        ElseIf Event = #WM_LBUTTONDBLCLK
            SetGadgetText(#text,"Double clic gauche") 
        ElseIf Event = #WM_RBUTTONDOWN
           SetGadgetText(#text,"Bouton droit appuyé")
            
        ElseIf Event = #WM_RBUTTONUP
            SetGadgetText(#text,"Bouton droit relaché") 
        ElseIf Event = #WM_RBUTTONDBLCLK
           SetGadgetText(#text,"Double clic droit") 
        ElseIf Event = #WM_MBUTTONDOWN
            SetGadgetText(#text,"Bouton du milieu appuyé") 
        ElseIf Event = #WM_MBUTTONUP
            SetGadgetText(#text,"Bouton du milieu relaché") 
        ElseIf Event = #WM_MBUTTONDBLCLK
           SetGadgetText(#text,"Double clic du milieu") 
        ElseIf Event = #WM_MOUSEWHEEL
            Molette.l = -(EventwParam() >> 16) / #WHEEL_DELTA
            If Molette > 0
              SetGadgetText(#text,"Molette en avant de " + Str(Molette))
            ElseIf Molette < 0
                SetGadgetText(#text,"Molette en arrière de " + Str(Molette))
            EndIf
            
        ElseIf Event = #PB_Event_Gadget
            Select EventGadget()
                Case 0
                    Select EventType()
                        Case #PB_EventType_LeftClick
                           SetGadgetText(#text,"Gadget : Bouton gauche appuyé")
                        Case #PB_EventType_LeftDoubleClick
                           SetGadgetText(#text,"Gadget : Double clic gauche")
                    EndSelect
            EndSelect
        EndIf
        
    Until Event = #WM_CLOSE
EndIf

Publié : sam. 29/sept./2007 15:04
par Ollivier
Ah ça c'est mon défaut : j'ai pas de molette, alors je passe ce détail. J'en avais eu une souris à molette : Mais elle a fait un saut fatal sur le sol un jour.

@dobro

Intéressant ce code : la ligne qui modifie les options de la fenêtre m'a intrigué. Je ne pensais pas qu'il y ait les options de saisie des infos de la souris modifiable ainsi.

Publié : dim. 30/sept./2007 17:50
par djes
Voici un code pour tester le clavier quand les fonctions standard de PB KeyboardReleased et KeyboardPressed ne fonctionnent pas bien avec openscreen (sur certaines configs)

Code : Tout sélectionner

;*****************************************************************************************
;*
;* myKeyboardKeys
;*
;* Windows callback routine to get keyboard state with openscreen when
;* standard pb KeyboardReleased and KeyboardPressed don't work
;*
;* djes (djes@free.fr)
;* http://www.bgames.org
;*
;* 09/30/2007 : first version
;*
;*****************************************************************************************

Global Dim myKeyboardKeys.l(255)
Global *myKeyboard_pb_callback

;*****************************************************************************************

Procedure myKeyboardCB(WindowID.l, Message.l, wParam.l, lParam.l)
   
  Select Message
   
;    Case #WM_CHAR
;      MessageRequester("#WM_CHAR","Character typed : Code "+ Str(wParam)+"="+Chr(wParam)+" ; Code 2 :"+Hex(lParam)) 


    Case #WM_KEYDOWN
    ;    wParam
    ;        Specifies the virtual-key code of the nonsystem key. 
    ;    lParam
    ;        Specifies the Repeat count, scan code, extended-key flag, context code, previous key-state flag, And transition-state flag, As shown in the following table.
    
    ;        0-15
    ;            Specifies the Repeat count For the current message. The value is the number of times the keystroke is autorepeated As a result of the user holding down the key. If the keystroke is held long enough, multiple messages are sent. However, the Repeat count is Not cumulative.
    ;        16-23
    ;            Specifies the scan code. The value depends on the OEM.
    ;        24
    ;            Specifies whether the key is an extended key, such As the right-hand ALT And CTRL keys that appear on an enhanced 101- Or 102-key keyboard. The value is 1 If it is an extended key; otherwise, it is 0.
    ;        25-28
    ;            Reserved; do not use.
    ;        29
    ;            Specifies the context code. The value is always 0 For a WM_KEYDOWN message.
    ;        30
    ;            Specifies the previous key state. The value is 1 If the key is down before the message is sent, Or it is zero If the key is up.
    ;        31
    ;            Specifies the transition state. The value is always zero For a WM_KEYDOWN message.

;      MessageRequester("#WM_KEYDOWN","Character typed : Code "+ Str(wParam)+"="+Chr(wParam)+" ; Code 2 :"+Hex(lParam)) 
      myKeyboardKeys(wParam)=1

    Case #WM_KEYUP
    ;    wParam
    ;        Specifies the virtual-key code of the nonsystem key. 
    ;    lParam
    ;        Specifies the Repeat count, scan code, extended-key flag, context code, previous key-state flag, And transition-state flag, As shown in the following table.
    
    ;        0-15
    ;            Specifies the Repeat count For the current message. The value is the number of times the keystroke is autorepeated As a result of the user holding down the key. The Repeat count is always one For a WM_KEYUP message.
    ;        16-23
    ;            Specifies the scan code. The value depends on the OEM.
    ;        24
    ;            Specifies whether the key is an extended key, such As the right-hand ALT And CTRL keys that appear on an enhanced 101- Or 102-key keyboard. The value is 1 If it is an extended key; otherwise, it is 0.
    ;        25-28
    ;            Reserved; do not use.
    ;        29
    ;            Specifies the context code. The value is always 0 For a WM_KEYUP message.
    ;        30
    ;            Specifies the previous key state. The value is always 1 For a WM_KEYUP message.
    ;        31
    ;            Specifies the transition state. The value is always 1 For a WM_KEYUP message.

;      MessageRequester("#WM_KEYUP","Character typed : Code "+ Str(wParam)+"="+Chr(wParam)+" ; Code 2 :"+Hex(lParam)) 
      myKeyboardKeys(wParam)=2

    Default
  
  EndSelect

  CallWindowProc_(*myKeyboard_pb_callback, WindowID.l, Message.l, wParam.l, lParam.l)

EndProcedure

;*****************************************************************************************

Procedure myKeyboardReleased(code.l)

  If mykeyboardkeys(code)=2
    mykeyboardkeys(code)=0
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf 

EndProcedure

;*****************************************************************************************

Procedure myKeyboardPressed(code.l)

  If mykeyboardkeys(code)=1
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf 

EndProcedure

;*****************************************************************************************
;* Need to be called after openscreen
Procedure myKeyboardInit()

  If ScreenID()=0
    MessageRequester("myKeyboardInit","Screen not opened") 
    End
  EndIf

  ;Our callback working with openscreen
  *myKeyboard_pb_callback=GetWindowLong_(ScreenID(), #GWL_WNDPROC)
  If SetWindowLong_(ScreenID(), #GWL_WNDPROC, @myKeyboardCB())=0
    MessageRequester("myKeyboardInit","Can't intercept keys") 
    End
  EndIf

EndProcedure

;*****************************************************************************************

InitSprite()

;OpenWindow(0, 0, 0, 220, 160, "A screen in a window...", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
;OpenWindowedScreen(WindowID(0), 0, 0, 160, 160, 0, 0, 0)

;Usual PB callback for the Windows OS allowing you to process window events
;SetWindowCallback_( @WindowCB())

ExamineDesktops()
OpenScreen(DesktopWidth(0),DesktopHeight(0),DesktopDepth(0),"")
myKeyboardInit()

CreateSprite(1,100,100)
StartDrawing(SpriteOutput(1))
Box( 0, 0,100,100,RGB(250,20,20))
Box(10,10, 80, 80,RGB(50,20,220))
Circle(50,50,30,RGB(200,200,50))
StopDrawing()

x=DesktopWidth(0)/2-SpriteWidth(1)/2
y=DesktopHeight(0)/2-SpriteHeight(1)/2

;*****************************************************************************************

Repeat

  ;Repeat
  ;  Event = WindowEvent()
    
  ;  If Event = #PB_Event_CloseWindow
  ;    End 
  ;  EndIf
  ;Until Event = 0

  If myKeyboardPressed(#PB_Shortcut_Up)
    y-1
  EndIf
  If myKeyboardReleased(#PB_Shortcut_Down)
    y+1
  EndIf

  ClearScreen(0)

  DisplaySprite(1,x,y)

  StartDrawing(ScreenOutput())
  text.s="myKeyboardKeys test"
  DrawText(DesktopWidth(0)/2-TextWidth(text)/2,50,text,RGB($FF,$FF,$FF),0)
  text.s="Up Arrow to move up, press and release Down Arrow to move down"
  DrawText(DesktopWidth(0)/2-TextWidth(text)/2,DesktopHeight(0)/2-TextHeight(text)/2,text,RGB($FF,$FF,$FF),0)
  StopDrawing()

  FlipBuffers()

Until myKeyboardReleased(#PB_Shortcut_Escape)

End

Publié : dim. 30/sept./2007 19:59
par Ollivier
Franchement, bravo! ça semble si simple à l'exécution, mais au final, c'est un casse-tête cette histoire de touche capricieuse.

J'espère que LJ4 pourra bénéficier de cette méthode et que cette dernière mette fin au problème.

Le code est nickel au niveau procédures, ça m'a permis d'insérer facilement le clic gauche de la souris
(Modifs.:
Insertion de la procedure CallBack MouseKey()
Insertion de l'appel depuis ta Callback
Copie d'un second Sprite
Insertion d'un bloc souris dans la boucle principale)

Sinon, c'est sympa d'avoir posté la doc avec.

Code : Tout sélectionner

Procedure MouseKey(Msg, wParam, lParam)
  Shared MouseLButton.L
  If Msg = $20
    PData.L = lParam >> 16
    If (PData & $FFF) = $201
      MouseLButton = 1
    EndIf
    If (PData & $FFF) = $202
      MouseLButton = 0
    EndIf
;    Debug "Msg = " + Hex(Msg) + ": wParam = " + Hex(wParam) + ": lParam = " + Hex(lParam)
  EndIf
EndProcedure

Publié : lun. 01/oct./2007 10:44
par djes
J'espère que LJ4 pourra bénéficier de cette méthode et que cette dernière mette fin au problème.
J'espère aussi ;)
Sinon, c'est sympa d'avoir posté la doc avec.
De rien, je trouve ça normal :)
C'est sympa d'avoir posté le code pour la souris ;)

Publié : mar. 24/juin/2008 21:05
par Ollivier
Petite mise à jour pour l'affichage optionnel en hexa..

Code : Tout sélectionner

Structure FFmap 
  key.b[256] 
EndStructure 

Global Dim Keys.FFmap(1) 


Procedure.S StrI(n.L, Base.L)
  ; Base = 0 : Décimal
  ; Base = 1 : Hexadécimal
  Protected Result.S
    Select Base
      Case 0
        Result = Str(n)
      Case 1
        Result = Hex(n)
    EndSelect 
  ProcedureReturn Result
EndProcedure

Procedure DrawHead(WinX.L, ViewHexaState.L)
  Protected x.L
  Protected Bc.L
  StartDrawing(WindowOutput(WinX) )
    Bc = Point(0, 0)
    For x = 0 To 15 
      DrawText((1 + x) << 5 + 8, 0, RSet(StrI(x, ViewHexaState), 2, "0") + " ", 0, Bc) 
      DrawText(4, (1 + x) << 4, RSet(StrI(x << 4, ViewHexaState), 3, "0"), 0, Bc)              
    Next 
  StopDrawing()                  
EndProcedure

Procedure FunStd() 

  Protected WinX.L
  Protected ViewHexaState.L

  WinX = OpenWindow(-1, 0, 0, 600, 300, "GetKeyboardState - Map of the keyboard", $00CF0001) 
  If WinX 
    MenuX.L = CreateMenu(-1, WindowID(WinX) ) 

    If MenuX 
      OpenSubMenu("File") 
        MenuItem($1F0, "Quit")
      CloseSubMenu() 
      OpenSubMenu("View")
        MenuItem($200, "Hexadecimal")
      CloseSubMenu() 
      Static Exit.L = 0 
      Repeat 
;____________________________________________________________________________ 
;¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯            
          Swaping = 1 - Swaping 
          If GetKeyboardState_(@Keys(Swaping) ) 
              StartDrawing(WindowOutput(WinX) ) 
                  For y = 0 To 15                  
                      For x = 0 To 15                          
                          N = (y << 4) + x 
                          If Keys(Swaping)\Key[N] <> Keys(1 - Swaping)\Key[N] 
                              xx = (x + 1) << 5 
                              yy = (y + 1) << 4 
                              Box(xx, yy, 32, 16, #Black) 
                              Box(xx, yy, 31, 15, #White) 
                              DrawingMode(#PB_2DDrawing_Transparent) 
                              DrawText(xx, yy, Str(Keys(Swaping)\Key[N]) ) 
                          EndIf 
                      Next 
                  Next 
                  Line(31, 15, 0, 256, #Black) 
                  Line(31, 15, 512, 0, #Black) 
              StopDrawing() 
          EndIf 
;____________________________________________________________________________ 
;¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯          
          Delay(5) 
          eWindow = WindowEvent()
          aWindow = EventWindow() 
          Select eWindow 
              Case #PB_Event_Repaint
                    For i = 0 To 255 
                          Keys(0)\Key[i] = 254 
                    Next 
                    DrawHead(WinX, ViewHexaState)
              Case #PB_Event_CloseWindow:                          Exit = $1 
              Case #PB_Event_Menu
                eMenu   =   EventMenu()
                If eMenu = $1F0
                  Exit = $1
                EndIf
                If eMenu = $200
                  ViewHexaState = 1 - GetMenuItemState(MenuX, $200)
                  SetMenuItemState(MenuX, $200, ViewHexaState)
                  DrawHead(WinX, ViewHexaState)
                EndIf
              Case #PB_Event_Gadget     : eGadget = EventGadget(): 
          EndSelect 
      Until Exit = 1 
    EndIf 
  EndIf 
  EndProcedure 
    
  FunStd()

Re: API - Etat général de toutes les touches du clavier

Publié : ven. 02/févr./2018 18:23
par celtic88
j apprend toujours avec vous :)

merci @Ollivier
Fuseau horaire sur UTC+01:00
Page 1 sur 1

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru