PureBasic

Forums PureBasic
Nous sommes le Jeu 23/Mai/2013 11:13

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 6 messages ] 
Auteur Message
 Sujet du message: [TUTO] La souris
MessagePosté: Mer 25/Aoû/2004 16:29 
Hors ligne
Avatar de l’utilisateur

Inscription: Lun 26/Avr/2004 0:40
Messages: 12951
Ces codes ont été fait par nos illustres membres du forum

comment récupérer un double clic !!

Merci chris et le soldat

Code:
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:
;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:
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:
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:
; 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:
ShowCursor_(1) ; montre le curseur
  ShowCursor_(0) ; cache le curseur !!


gerer la mollette d'une souris

Code:
;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:
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:
;/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:

#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:
; 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


_________________
Image


Dernière édition par Dobro le Mar 29/Mai/2007 22:59, édité 4 fois.

Haut
 Profil  
 
 Sujet du message:
MessagePosté: Ven 21/Nov/2008 14:42 
Hors ligne
Avatar de l’utilisateur

Inscription: Lun 26/Avr/2004 0:40
Messages: 12951
..........................

_________________
Image


Dernière édition par Dobro le Sam 19/Mar/2011 20:04, édité 1 fois.

Haut
 Profil  
 
 Sujet du message:
MessagePosté: Dim 29/Mar/2009 14:59 
Hors ligne
Avatar de l’utilisateur

Inscription: Lun 26/Avr/2004 0:40
Messages: 12951
............................

_________________
Image


Dernière édition par Dobro le Sam 19/Mar/2011 20:05, édité 1 fois.

Haut
 Profil  
 
 Sujet du message:
MessagePosté: Dim 29/Mar/2009 18:51 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 29/Juin/2007 17:50
Messages: 1901
ça commence à faire un pack! Merci pour toutes ces infos réunies.


Haut
 Profil  
 
 Sujet du message: Re: [TUTO] La souris
MessagePosté: Mar 21/Mai/2013 13:22 
Hors ligne
Avatar de l’utilisateur

Inscription: Sam 19/Fév/2011 12:46
Messages: 907
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:
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

_________________
http://blendman.blogspot.com/


Haut
 Profil  
 
 Sujet du message: Re: [TUTO] La souris
MessagePosté: Mer 22/Mai/2013 11:15 
Hors ligne

Inscription: Mer 14/Sep/2011 16:59
Messages: 335
La même chose avec clavier et doubleclics :
Code:
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.


Haut
 Profil  
 
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 6 messages ] 

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 1 invité


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye