[TUTO] La souris

Backup · Message par **Backup** » mer. 25/août/2004 16:29

Ces codes ont été fait par nos illustres membres du forum

comment récupérer un double clic !!

Merci chris et le soldat

Code : Tout sélectionner

 If OpenWindow(0, 0, 0, 200, 200, #PB_Window_SystemMenu | #PB_Window_ScreenCentered, "Souris")
    
    SetClassLong_(WindowID(), #GCL_STYLE, GetClassLong_(WindowID(), #GCL_STYLE) | #CS_DBLCLKS) ; Active la gestion du double clic
    
    Repeat
        Event = WaitWindowEvent()
        
        If Event = #WM_LBUTTONDOWN
            Debug "Bouton gauche appuyé"
            
        ElseIf Event = #WM_LBUTTONUP
            Debug "Bouton gauche relaché"
            
        ElseIf Event = #WM_LBUTTONDBLCLK
            Debug "Double clic gauche"
            
        ElseIf Event = #WM_RBUTTONDOWN
            Debug "Bouton droit appuyé"
            
        ElseIf Event = #WM_RBUTTONUP
            Debug "Bouton droit relaché"
            
        ElseIf Event = #WM_RBUTTONDBLCLK
            Debug "Double clic droit"
            
        EndIf
        
    Until Event = #WM_CLOSE
EndIf

double-clic sur un gadget Methode a GUIMAUVE

Code : Tout sélectionner

;voiçi comment je fais pour détecter un double clique sur un gadget à ;mettre dans la boucle de gestion des évenementa après le EventID = WaitWindowEvent()  :

If EventID = #PB_EventGadget
    start = GetTickCount_() ; Note time of first click.
    GetAsyncKeyState_(#VK_LBUTTON) ; Clear left mouse buffer.
    Repeat : Until GetAsyncKeyState_(#VK_LBUTTON) <> 0 Or GetTickCount_() - start > GetDoubleClickTime_()
    If GetTickCount_() - start < GetDoubleClickTime_() ; Timed out!
        ; Mettre ici le code à exécuter
        SetClipboardText(GetGadgetText(#Listview_constante))
    EndIf
EndIf

recuperer les coordonéés de la souris

Code : Tout sélectionner

lpPoint.POINT
Repeat
    GetCursorPos_(lpPoint)
    Debug "X = " + Str(lpPoint\x)
    Debug "Y = " + Str(lpPoint\y)
    Debug ""
    Delay(50)
ForEver

ou bien depuis purebasic 4.00:

Code : Tout sélectionner

If OpenWindow(0, 0, 0, 300, 30, "Position de la souris sur la fenêtre", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    CreateGadgetList(WindowID(0))
      TextGadget(0, 10, 6, 200, 20, "")
    
    Repeat
      Event = WaitWindowEvent(20) ; Boucle au moins chaque 20ms pour une mise à jour
    
      SetGadgetText(0, "Coordonnées: " + Str(WindowMouseX(0)) + "," + Str(WindowMouseY(0)))       
    Until Event = #PB_Event_CloseWindow
  EndIf

un exemple de code

Code : Tout sélectionner

; Auteur : Le Soldat Inconnu
; Version de PB : 3.90
; 
; Explication du programme :
; Pour connaître la position de la souris sur l'écran

If OpenWindow(0, 0, 0, 80, 40, #PB_Window_SystemMenu | #PB_Window_ScreenCentered, "Position")
    
    If CreateGadgetList(WindowID())
        
        TextGadget(1, 5, 5, 50, 15, "")
        TextGadget(2, 5, 25, 50, 15, "")
        
        Repeat
            Event = WindowEvent()
            
            ; position de la souris
            GetCursorPos_(CursorPos.POINT)
            MouseX = CursorPos\x
            MouseY = CursorPos\y
            
            ; on affiche la position de la souris
            SetGadgetText(1, "X = " + Str(MouseX))
            SetGadgetText(2, "Y = " + Str(MouseY))
            UpdateWindow_(WindowID())
            
            Delay(50)
            
        Until Event = #WM_CLOSE
    EndIf
EndIf
; ExecutableFormat=Windows
; CursorPosition=4
; FirstLine=1
; DisableDebugger
; EOF

; rajout dobro
;ceci permet de savoir si l'on click sur le bouton gauche
;Debug GetKeyState_(#VK_LBUTTON)

Cacher ou montrer le pointeur de la souris

Code : Tout sélectionner

 ShowCursor_(1) ; montre le curseur
  ShowCursor_(0) ; cache le curseur !!

gerer la mollette d'une souris

Code : Tout sélectionner

 ;Application du mesage WM_MOUSEWEEL

#WM_MOUSEWHEEL = $20A
Global Hscroll.l

Procedure ProcedureCallback(WindowID, Message, wParam, lParam)
    Resultat = #PB_ProcessPureBasicEvents
    ;Debug Message
    Select Message
        Case #WM_MOUSEWHEEL
            hi.w=(wParam>>16)
            lo.w=wParam & $FFFF
            
            If lo.w & #MK_MBUTTON
                ;indique le click de la molette seulement si celle-ci tourne
                MessageRequester("Info", "Click de la molette")
            EndIf
            
            coef=4
            delta=hi*coef
            Debug delta
            
            While delta>120
                SendMessage_(Hscroll, #WM_VSCROLL, #SB_LINEUP, 0)
                delta=delta-(120+coef)
            Wend
            
            While delta< -120
                SendMessage_(Hscroll, #WM_VSCROLL, #SB_LINEDOWN, 0)
                delta=delta+(120+coef)
            Wend
            
    EndSelect
    
    ProcedureReturn Resultat
EndProcedure
 

If OpenWindow(0,0,0,400,400,#PB_Window_SystemMenu|#PB_Window_ScreenCentered,"ScrollAreaGadget") And CreateGadgetList(WindowID(0))
    Hscroll=ScrollAreaGadget(0, 10, 10,360,300, 340, 800, 30)
    ButtonGadget  (1, 10, 140,230, 30,"Button 1")
    CloseGadgetList()
    
    SetWindowCallback(@ProcedureCallback())
    
    Repeat
        EventID.l=WaitWindowEvent()
        Select EventID
            Case #PB_EventGadget
                Select EventGadgetID()
                    Case 1
                        
                EndSelect
                
            Case #WM_CLOSE
                Quit=1
        EndSelect
    Until Quit=1
EndIf

pilotage automatique de la souris !!

Code : Tout sélectionner

 n=500

Dim Pos.POINT(n)

MessageRequester("CursorPos","Bougez la souris pdt quelques secondes")

For i=0 To n   
    GetCursorPos_(Pos(i))
    Delay(1)
Next

MessageRequester("CursorPos","Replay")

For i=0 To n   
    SetCursorPos_(Pos(i)\x,Pos(i)\y)
    Delay(1)
Next

AUTOCLICK !!

Code : Tout sélectionner

 ;/Constantes Window
Enumeration
    #Window_0
EndEnumeration

;/Constantes Gadget
Enumeration
    #Btn_Quit
EndEnumeration


If OpenWindow(#Window_0, 300, 300, 300, 200, #PB_Window_SystemMenu, "Fenêtre 1",0)
    If CreateGadgetList(WindowID(#Window_0))
        ButtonGadget(#Btn_Quit, 100, 170, 100, 25, "Quitter")
    EndIf
    
    SetTimer_(WindowID(),1,3000,0)
    Repeat
        Select WaitWindowEvent()
            Case #WM_TIMER
                SendMessage_(GadgetID(#Btn_Quit),#WM_LBUTTONDOWN,0,0)
                Delay(300)
                SendMessage_(GadgetID(#Btn_Quit),#WM_LBUTTONUP,0,0) 
            Case #PB_EventGadget
                Select EventGadgetID()
                    ;Case
                    ;Case
                    Case #Btn_Quit : quit = 1
                EndSelect
                ;Case
                ;Case
            Case #PB_EventCloseWindow : quit = 1
        EndSelect
    Until quit = 1
    End
EndIf

deplace et click

Code : Tout sélectionner


#D_Bas = 0 : #D_Haut = 1 : #D_Click = 2 : #D_DoubleClick = 3 ; bouton de droite
#G_Bas = 4 : #G_Haut = 5 : #G_Click = 6 : #G_DoubleClick = 8 ; Bouton de gauche
#M_Bas = 9 : #M_Haut = 10 : #M_Click = 11 : #M_DoubleClick = 12 ; bouton du milieu

Procedure MouseEvent(Ereignis.l)
    Mem.l=GlobalAlloc_(0,8)
    GetCursorPos_(Mem)
    mouse_event_(Ereignis | $8000,PeekL(Mem)*($FFFF/GetSystemMetrics_(0)),PeekL(Mem+4)*($FFFF/GetSystemMetrics_(1)),0,GetMessageExtraInfo_())
    GlobalFree_(Mem)
EndProcedure

Procedure MouseClick(Option.b)
    Select Option
        Case #G_Bas
            MouseEvent($2)
        Case #G_Haut
            MouseEvent($4)
        Case #G_Click
            MouseEvent($2)
            MouseEvent($4)
        Case #G_DoubleClick
            MouseEvent($2)
            MouseEvent($4)
            MouseEvent($2)
            MouseEvent($4)
            
        Case #D_Bas
            MouseEvent($8)
        Case #D_Haut
            MouseEvent($10)
        Case #D_Click
            MouseEvent($8)
            MouseEvent($10)
        Case #D_DoubleClick
            MouseEvent($8)
            MouseEvent($10)
            MouseEvent($8)
            MouseEvent($10)
            
        Case #M_Bas
            MouseEvent($20)
        Case #M_Haut
            MouseEvent($40)
        Case #M_Click
            MouseEvent($20)
            MouseEvent($40)
        Case #M_DoubleClick
            MouseEvent($20)
            MouseEvent($40)
            MouseEvent($20)
            MouseEvent($40)
    EndSelect
EndProcedure

Procedure MouseMove(dx.l,dy.l,AX.l,AY.l,VX.l,VY.l,Delay.l)
    ; Arguments : Depart X -  Depart Y - Arrivée X - Arrivée Y - Vitesse X - Vitesse Y - Temps d'attente entre deux boucles)
    If dx - AX > 0 ; Si on va vers la gauche
        SensX = 1
    EndIf
    If dy- AY > 0 ; Si on va vers le haut
        SensY = 1
    EndIf
    Repeat
        If SensX = 1
            If dx > AX
                dx - VX
            Else
                dx = AX
            EndIf
        Else
            If dx < AX
                dx + VX
            Else
                dx = AX
            EndIf
        EndIf
        If SensY = 1
            If dy > AY
                dy - VY
            Else
                dy = AY
            EndIf
        Else
            If dy < AY
                dy + VY
            Else
                dy = AY
            EndIf
        EndIf
        SetCursorPos_(dx,dy)
        If dx = AX And dy = AY : Break : EndIf
        Delay(Delay)
    ForEver
EndProcedure

Procedure MouseMoveEx(AX.l,AY.l,VX,VY,Delay)
    GetCursorPos_(Pos.POINT)
    MouseMove(Pos\x,Pos\y,AX,AY,VX,VY,Delay)
EndProcedure


Procedure Mousesignal(AX.l,AY.l,taille,temp) 
    GetCursorPos_(Pos.POINT)
    xr=Pos\x:yr=Pos\y
    For compt=1 To temp
        x=taille * Cos( compt) + (AX.l )
        y=taille * Sin( compt) + (AY.l) 
        MouseMove(x,y,x+1,y+1,10,10,10) 
    Next compt
    
     MouseMove(x,y,xr,yr,8,8,2)
EndProcedure





Mousesignal(500,500,20,50)

[/b]

utiliser le joystick a la place de la souris
ce code provient de pure area !

Code : Tout sélectionner

; English forum: http://purebasic.myforums.net/viewtopic.php?t=8572&highlight=
; Author: waffle
; Date: 01. December 2003

;I did this to use a joystick with starfleet command
;works with windows too
;AOE has problems with it

;norms global mouser using joystick
Quit.l=0
If InitJoystick()=0
  MessageRequester("Mouser Error","No controller detected",#MB_ICONSTOP)
  End
EndIf
holdingX.l=0
holdingY.l=0
holddelayX.l=0
holddelayY.l=0
lbhold.l=0
rbhold.l=0
Repeat
  
  If ExamineJoystick()
    dx=JoystickAxisX()
    dy=JoystickAxisY()
    lb=JoystickButton(1) Or JoystickButton(5)
    rb=JoystickButton(4) Or JoystickButton(6)
    If JoystickButton(3)
      Quit=1
    EndIf
    ;now, read the mouse position
    GetCursorPos_(mouse.POINT) : x=mouse\x : y=mouse\y
    ;now to move the mouse
    If dx
      If holddelayX
        If gettickcount_()-holddelayX>300
          holdingX=4*dx
        EndIf
      Else
        holddelayX=gettickcount_()
      EndIf
      x=x+dx+holdingX
      
      
    Else
      holdingX=0
      holddelayX=0
    EndIf
    If dy
      If holddelayY
        If gettickcount_()-holddelayY>300
          holdingY=4*dy
        EndIf
      Else
        holddelayY=gettickcount_()
      EndIf
      y=y+dy+holdingY
      
    Else
      holdingY=0
      holddelayY=0
    EndIf
    
    SetCursorPos_(x,y)
    If lb
      If lbhold=0
        mouse_event_(#MOUSEEVENTF_LEFTDOWN,0,0,0,0)
        lbhold=1
      EndIf
      
      
    Else
      If lbhold
        mouse_event_(#MOUSEEVENTF_LEFTUP,0,0,0,0)
        lbhold=0
      EndIf
    EndIf
    If rb
      If rbhold=0
        mouse_event_(#MOUSEEVENTF_RIGHTDOWN,0,0,0,0)
        rbhold=0
      EndIf
    Else
      If rbhold
        mouse_event_(#MOUSEEVENTF_RIGHTUP,0,0,0,0)
        rbhold=0
      EndIf
    EndIf
  EndIf
  Delay(1)
  
  
Until Quit

; ExecutableFormat=Windows
; EOF

blendman · Message par **blendman** » mar. 21/mai/2013 13:22

A partir de purebasic 5.1, certains events mouse ne sont plus gérés, il faut utiliser une callback.

Voici un petit code tout simple pour y remédier (avec une callback) :

Code : Tout sélectionner

Define EventID

Procedure MyWindowCallback(WindowID, Message, wParam, lParam)
   Result = #PB_ProcessPureBasicEvents
   
   Select Message
       
     Case #WM_LBUTTONDOWN
       Debug "L down"
       
     Case #WM_RBUTTONDOWN 
        Debug "R down"
       
     Case #WM_RBUTTONUP
       Debug "R up"
       
     Case #WM_LBUTTONUP
       Debug "L up"
       
   EndSelect
   ProcedureReturn Result
EndProcedure

   hwnd = OpenWindow(0,0,0,500,400,"Window",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
   SetWindowCallback(@MyWindowCallback())
 
  Repeat
   
    EventID=WaitWindowEvent()
       
   Select EventID
       
     Case #PB_Event_CloseWindow
       End
       
   EndSelect
 
  ForEver

Mesa · Message par **Mesa** » mer. 22/mai/2013 11:15

La même chose avec clavier et doubleclics :

Code : Tout sélectionner

Define EventID

Procedure MyWindowCallback(WindowID, Message, wParam, lParam)
  Result = #PB_ProcessPureBasicEvents
  
  Select Message
      
    Case #WM_RBUTTONUP
      Debug "R up"
      
    Case #WM_LBUTTONUP
      Debug "L up"
      
  EndSelect
  ProcedureReturn Result
EndProcedure

hwnd = OpenWindow(0,0,0,500,400,"Window",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
SetWindowCallback(@MyWindowCallback())

Repeat
  
  EventID=WaitWindowEvent(20)
  
  Select EventID
      
    Case #PB_Event_CloseWindow
      End
      
    Case #WM_LBUTTONDOWN
      Debug "L down" 
    Case #WM_LBUTTONUP ;marche pas, il faut un callback
      Debug "L up" 
      
    Case #WM_RBUTTONDOWN 
      Debug "R down"
    Case #WM_RBUTTONUP ;marche pas, il faut un callback
      Debug "R up"
      
    Case  #WM_MBUTTONDOWN
      Debug "M down"
    Case #WM_MBUTTONUP
      Debug "M up"      
      
    Case #WM_MBUTTONDBLCLK
      Debug "M DBLCLK"
    Case #WM_LBUTTONDBLCLK ;marche pas, il faut utiliser #PB_Event_LeftDoubleClick 
      Debug "L DBLCLK"
    Case #WM_RBUTTONDBLCLK
      Debug "R DBLCLK"
      
    Case #PB_Event_LeftDoubleClick ; ça marche
      Debug "L DBLCLK"
      
    Case #WM_KEYUP
      Debug "KEYUP"
    Case #WM_KEYDOWN
      Debug "KEYDOWN"
      
  EndSelect
  
ForEver

Mesa.

blendman · Message par **blendman** » mar. 13/oct./2015 7:21

Voici un code pour gérer la souris avec un écran (screen) :

MouseButton() et Messagerequester().
Si on utilise un messageRequester() ou d'autres types de codes qui font qu'on perd le focus souris dans l'écran, voici comment y remédier (code de Spock-Dobro) :

Code : Tout sélectionner

; date : 10/2015
; PB : 5.31/5.40

#Window_main = 0

;{ init
If InitSprite()  <> 0: EndIf
If InitKeyboard() <> 0 : EndIf
If InitMouse() <> 0 : EndIf
;}

flag = #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered|#PB_Window_MaximizeGadget|#PB_Window_SizeGadget
If OpenWindow(#Window_main,0,0,600,400, "menu jeu", Flag) <> 0
   If OpenWindowedScreen(WindowID(0), 0,0,600,400) <> 0
   EndIf
   ShowCursor_(1)
EndIf

Repeat
   Repeat
      EventID     = WaitWindowEvent(1)
      Select EventID
         Case #PB_Event_CloseWindow
         End
      EndSelect
   Until event = 0

   if ExamineKeyboard() <> 0
      If KeyboardPushed(#PB_Key_Escape) = 1
         End
      EndIf
   endif

   If ExamineMouse() <> 0 
      If MouseButton(#PB_MouseButton_Left)
         MessageRequester("test","test")
         clic= 1
         ReleaseMouse(1)
      Else
         clic = 0
      EndIf
   Endif
   ClearScreen(RGB(200,200,200))
   FlipBuffers()
   If clic =1
      ReleaseMouse(0) ; <---------- si tu veux que ta souris soit a nouveau prise par le jeux sinon tu commentes cette ligne
   Endif
Until Quit = 1

PureBasic

[TUTO] La souris

[TUTO] La souris

Re: [TUTO] La souris

Re: [TUTO] La souris

Re: [TUTO] La souris