PureBasic

Forums PureBasic - Français
http://forums.purebasic.com/french/

Rester appuyé sur bouton gauche

http://forums.purebasic.com/french/viewtopic.php?t=15122

Page 1 sur 1

Rester appuyé sur bouton gauche

Publié : jeu. 19/mars/2015 12:15
par Mesa
Quelqu'un aurait-il un code tout fait pour détecter que l'utilisateur appuie de façon continue sur le bouton gauche de la souris.

Par exemple dans le code ci-dessous, j'aimerais que lorsque l'utilisateur appuie sur le bouton gauche plus d'1 seconde, le compteur défile tant que le bouton reste appuyé, comme le ferait un spingadget.

Code : Tout sélectionner

;
; This code is automatically generated by the FormDesigner.
; Manual modification is possible to adjust existing commands, but anything else will be dropped when the code is compiled.
; Event procedures needs to be put in another source file.
;

Enumeration FormWindow
  #Window_1
EndEnumeration

Enumeration FormGadget
  #Button_0
  #Button_1
  #Text_0
EndEnumeration


Procedure OpenWindow_1(x = 0, y = 0, width = 600, height = 400)
  OpenWindow(#Window_1, x, y, width, height, "", #PB_Window_SystemMenu)
  ButtonGadget(#Button_0, 230, 30, 70, 40, "+")
  ButtonGadget(#Button_1, 340, 30, 60, 40, "-")
  TextGadget(#Text_0, 260, 90, 110, 30, "0", #PB_Text_Center | #PB_Text_Border)
EndProcedure

OpenWindow_1()
n=0

AddWindowTimer(0, 1, 1000)


Repeat
  event = WaitWindowEvent()
  gadget = EventGadget()
  type = EventType() ;#PB_EventType_LeftClick
  TopTimer = EventTimer()
  
  MDown=GetAsyncKeyState_(#VK_LBUTTON & 1) ;button is down
  If MDown=32768
    Debug "Mouse Down"
  EndIf
  
  Select Event
    Case #WM_LBUTTONDOWN
      If gadget = #Button_0
        Debug "ok"
      EndIf
      
    Case #PB_Event_Timer 
      ;      If  TopTimer=1
      ;       Debug "ok"
      ;       ;keybd_event_(#VK_LBUTTON, 0, 0, 0) 
      ;       ;keybd_event_(#VK_LBUTTON, 0,#KEYEVENTF_KEYUP, 0)
      ;      EndIf
      
      
    Case #PB_Event_Gadget          
      Select gadget
          
        Case #Button_0
          n=n+1
          SetGadgetText(#Text_0, Str(n)) 
        Case #Button_1
          n=n-1
          SetGadgetText(#Text_0, Str(n)) 
      EndSelect
      
  EndSelect
  
Until event = #PB_Event_CloseWindow

End
M.

Re: Rester appuyé sur bouton gauche

Publié : jeu. 19/mars/2015 13:22
par Ar-S
A perfectionner mais c'est une piste. j'ai pas le temps d'aller plus avant.

Code : Tout sélectionner

;
; This code is automatically generated by the FormDesigner.
; Manual modification is possible to adjust existing commands, but anything else will be dropped when the code is compiled.
; Event procedures needs to be put in another source file.
;

Enumeration FormWindow
	#Window_1
EndEnumeration

Enumeration FormGadget
	#Button_0
	#Button_1
	#Text_0
EndEnumeration
Global N

Procedure OpenWindow_1(x = 0, y = 0, width = 600, height = 400)
	OpenWindow(#Window_1, x, y, width, height, "", #PB_Window_SystemMenu)
	ButtonGadget(#Button_0, 230, 30, 70, 40, "+")
	ButtonGadget(#Button_1, 340, 30, 60, 40, "-")
	TextGadget(#Text_0, 260, 90, 110, 30, "0", #PB_Text_Center | #PB_Text_Border)
EndProcedure

OpenWindow_1()
n=0

AddWindowTimer(0, 1, 1000)


Repeat
	event = WaitWindowEvent()
	gadget = EventGadget()
	type = EventType() ;#PB_EventType_LeftClick
	TopTimer = EventTimer()
	
	MDown=GetAsyncKeyState_(#VK_LBUTTON & 1) ;button is down

	If MDown=32768 
	  etatclic = 1
	ElseIf MDown = 0
	  etatclic = 0
	EndIf
		SetGadgetText(#Text_0, Str(N))
	
	Select Event
		Case #WM_LBUTTONDOWN
			If gadget = #Button_0
				Debug "ok"
			EndIf
			
		Case #PB_Event_Timer 
		  If etatclic = 1
		    N+1
		    
		    ElseIf  etatclic = 1 
		      N-1
		    EndIf
		    Debug N
		  
		Case #PB_Event_Gadget          
			Select gadget
; 					
				Case #Button_0
; 					n+1
; 					SetGadgetText(#Text_0, Str(n)) 
 				Case #Button_1
; 					n-1
; 					SetGadgetText(#Text_0, Str(n)) 
			EndSelect
			
	EndSelect
	
Until event = #PB_Event_CloseWindow

End

Re: Rester appuyé sur bouton gauche

Publié : jeu. 19/mars/2015 13:36
par Marc56
À adapter, mais j'ai réalisé un code pour une appli, que tu pourrais adapter comme ceci:

Code : Tout sélectionner

  Select Event
    Case #WM_LBUTTONDOWN
      If gadget = #Button_0
      	While WindowEvent() <> #WM_LBUTTONUP
      		Delay(100)
      		n + 1
      		SetGadgetText(#Text_0, Str(n))
      	Wend
Sachant que WindowEvent() continu à envoyer des events, il suffit d'attendre celui qui relâche le bouton

While WindowEvent() <> #WM_LBUTTONUP
...
Wend
(il faut temporiser un peu, d'où le Delay())

:)

Re: Rester appuyé sur bouton gauche

Publié : sam. 21/mars/2015 12:30
par Mesa
Merci, ça m'a bien aidé mais quand j'utilise les 2 boutons, j'ai un problème de direction.

Quand je passe du + au -, le bouton moins ajoute 1 au lieu de soustraire, il faut insister plusieurs fois pour qu'il se mette à soustraire 1.

Une idée ?

Code : Tout sélectionner

;
; This code is automatically generated by the FormDesigner.
; Manual modification is possible to adjust existing commands, but anything else will be dropped when the code is compiled.
; Event procedures needs to be put in another source file.
;

Enumeration FormWindow
  #Window_1
EndEnumeration

Enumeration FormGadget
  #Button_0
  #Button_1
  #Text_0
EndEnumeration


Procedure OpenWindow_1(x = 0, y = 0, width = 600, height = 400)
  OpenWindow(#Window_1, x, y, width, height, "", #PB_Window_SystemMenu)
  ButtonGadget(#Button_0, 230, 30, 70, 40, "+")
  ButtonGadget(#Button_1, 340, 30, 60, 40, "-")
  TextGadget(#Text_0, 260, 90, 110, 30, "0", #PB_Text_Center | #PB_Text_Border)
EndProcedure

Procedure goDelai(delai, pas)
  Debug pas
  SetGadgetText(#Text_0, Str(Val(GetGadgetText(#Text_0))+pas))
  Delay(delai)
EndProcedure

OpenWindow_1()

pasPlus=1
pasMoins=-1

Repeat
  event = WaitWindowEvent(10)
  gadget = EventGadget()
  ;type = EventType() 
  
  Select Event
      
    Case #WM_LBUTTONDOWN
      Select gadget
        Case #Button_0
          goDelai(600,pasPlus)
          While WindowEvent() <> #WM_LBUTTONUP
            SetGadgetText(#Text_0, Str(Val(GetGadgetText(#Text_0))+pasPlus))
            Delay(100)
          Wend
          
          
        Case #Button_1
          goDelai(600, pasMoins)
          While WindowEvent() <> #WM_LBUTTONUP
            SetGadgetText(#Text_0, Str(Val(GetGadgetText(#Text_0))+pasMoins))
            Delay(100)
          Wend
      EndSelect 
      
  EndSelect
  
Until event = #PB_Event_CloseWindow

End
M.

Re: Rester appuyé sur bouton gauche

Publié : mar. 24/mars/2015 16:58
par Mesa
J’essaie de faire la même chose avec 2 canvas, mais je ne comprends pas pourquoi ça ne marche pas.
Une idée ?

Code : Tout sélectionner



If OpenWindow(0, 0, 0, 220, 220, "CanvasGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  CanvasGadget(0, 10, 10, 60, 60,#PB_Canvas_Border )
  CanvasGadget(1, 100, 10, 60, 60,#PB_Canvas_Border )
  StartDrawing(CanvasOutput(0))
  DrawText(20, 20, "+", $0, $ffffff)
  StopDrawing()
  StartDrawing(CanvasOutput(1))
  DrawText(20, 20, "-", $0, $ffffff)
  StopDrawing()
  
  
  Repeat
    event = WaitWindowEvent(10); 
    gadget = EventGadget() 
    type = EventType() 
    
    Select event 
      Case #PB_Event_Gadget
        Select Gadget
          Case 0 ; canvas +
            While GetGadgetAttribute(0, #PB_Canvas_Buttons) & #PB_Canvas_LeftButton
              n=n+1
              Debug n
            Wend
            Select type
              Case #PB_EventType_LeftButtonDown
                n=0
                
              Case #PB_EventType_LeftButtonUp
                n=0
                
            EndSelect ;type
            
            Case 1 ; canvas -
            While GetGadgetAttribute(1, #PB_Canvas_Buttons) & #PB_Canvas_LeftButton
              n=n-1
              Debug n
            Wend
            Select type
              Case #PB_EventType_LeftButtonDown
                n=0
                
              Case #PB_EventType_LeftButtonUp
                n=0
                
            EndSelect ;type 
        EndSelect     ;gadget  
    EndSelect
    
  Until Event = #PB_Event_CloseWindow
EndIf
M.

Re: Rester appuyé sur bouton gauche

Publié : mar. 24/mars/2015 18:58
par Ar-S
Y'a des comportements bien zarb avec PB des fois ou j'ai zappé qquechose.

J'ai repris ton code en remettant un timer toutes les secondes.
ça marche parfaitement avec le + mais pas avec le -

Code : Tout sélectionner


Global Clic

If OpenWindow(0, 0, 0, 220, 220, "CanvasGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

  CanvasGadget(0, 10, 10, 60, 60,#PB_Canvas_Border )
	CanvasGadget(1, 100, 10, 60, 60,#PB_Canvas_Border )
	StartDrawing(CanvasOutput(0))
	DrawText(20, 20, "+", $0, $ffffff)
	StopDrawing()
	StartDrawing(CanvasOutput(1))
	DrawText(20, 20, "-", $0, $ffffff)
	StopDrawing()
	
	StringGadget(3,22,100,80,20,"0")

	AddWindowTimer(0, 10,1000)
	
	Repeat
		event    = WaitWindowEvent(10); 
		gadget  = EventGadget() 
		type      = EventType() 
		
		Select event 
		  Case #PB_Event_Timer
		    Select EventTimer()
		      Case 10 ; numero du timer
		        N = Val(GetGadgetText(3))
		        If clic = 1 ; Bouton +  
		          N+1
		          SetGadgetText(3, Str(n) )
		          Debug N
		        ElseIf Click = 2 ; Bouton -
		          N-1
		          SetGadgetText(3, Str(n) )
		        Else
		          N = N
		          SetGadgetText(3, Str(n) )
		          EndIf
		        
		    EndSelect
		    
		    
			Case #PB_Event_Gadget
				Select Gadget
					Case 0 ; canvas +
	
						Select type
							Case #PB_EventType_LeftButtonDown
							  Clic = 1
								SetGadgetText(3, Str(n) )
							Case #PB_EventType_LeftButtonUp
								Clic = 0		
						EndSelect ;type
						
					Case 1 ; canvas -
	
						  Select type
  							Case #PB_EventType_LeftButtonDown
  								Clic = 2
  								SetGadgetText(3, Str(n) )
  							Case #PB_EventType_LeftButtonUp
  								Clic = 0		
						  EndSelect ;type 
						  						  

						
				EndSelect     ;gadget  
		EndSelect
		
	Until Event = #PB_Event_CloseWindow
EndIf
pas le courage d'aller plus avant pour le moment je suis claqué.

Re: Rester appuyé sur bouton gauche

Publié : mar. 24/mars/2015 19:47
par falsam
Solution qui manque de finesse dans la précision du résultat.

Code : Tout sélectionner

If OpenWindow(0, 0, 0, 220, 220, "CanvasGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  CanvasGadget(0, 10, 10, 60, 60,#PB_Canvas_Border )
  CanvasGadget(1, 100, 10, 60, 60,#PB_Canvas_Border )
  StartDrawing(CanvasOutput(0))
  DrawText(20, 20, "+", $0, $ffffff)
  StopDrawing()
  StartDrawing(CanvasOutput(1))
  DrawText(20, 20, "-", $0, $ffffff)
  StopDrawing()
  
  TextGadget(2, 20, 80, 50, 22, "0")
  
  Repeat
    event  = WaitWindowEvent(10); 
    gadget = EventGadget() 
    type   = EventType() 
    
    If Press
      Select gadget
        Case 0
          n+1
          
        Case 1
          n-1
          
      EndSelect
      SetGadgetText(2, Str(n))
    EndIf
        
    Select Type 
      Case #PB_EventType_LeftButtonDown ;J'appuie 
        Press = #True
        
      Case #PB_EventType_LeftButtonUp  ;J'appuie plus
        Press = #False
        
    EndSelect  
  Until Event = #PB_Event_CloseWindow
EndIf

Re: Rester appuyé sur bouton gauche

Publié : mar. 24/mars/2015 20:07
par falsam
Une autre solution avec un timer

Code : Tout sélectionner

Global Gadget, Press.b, n

Declare Start()
Declare OnTimer()
Declare OnPress()

Start()

Procedure Start()
  OpenWindow(0, 0, 0, 220, 220, "CanvasGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  CanvasGadget(0, 10, 10, 60, 60,#PB_Canvas_Border )
  CanvasGadget(1, 100, 10, 60, 60,#PB_Canvas_Border )
  StartDrawing(CanvasOutput(0))
  DrawText(20, 20, "+", $0, $ffffff)
  StopDrawing()
  StartDrawing(CanvasOutput(1))
  DrawText(20, 20, "-", $0, $ffffff)
  StopDrawing()
  
  TextGadget(2, 20, 80, 50, 22, "0")
  
  AddWindowTimer(0, 100, 100)
  
  BindGadgetEvent(0, @OnPress())
  BindGadgetEvent(1, @OnPress())
  BindEvent(#PB_Event_Timer, @OnTimer())
  
  Repeat : Until WaitWindowEvent(10) = #PB_Event_CloseWindow
EndProcedure

Procedure OnTimer()
    If Press
      Select Gadget
        Case 0
          n+1
          
        Case 1
          n-1
          
      EndSelect
      
      SetGadgetText(2, Str(n))
    EndIf
EndProcedure

Procedure OnPress()
  Select EventType()  
    Case #PB_EventType_LeftButtonDown
      Press = #True
      Gadget = EventGadget()
        
    Case #PB_EventType_LeftButtonUp
      Press = #False

  EndSelect
EndProcedure

Re: Rester appuyé sur bouton gauche

Publié : mar. 24/mars/2015 21:15
par nico
J'ai l'impression que le canvasgadget ne supporte pas la fonction GetActiveGadget()!

Sinon, je présente un code repris des exemples précédents soit canvas + timer mais avec un stringgadget, on peut modifier la valeur directement à l'intérieur du string, le + et le - fonctionneront toujours.

C'est ce qu'on peut faire de plus simple:

Code : Tout sélectionner

Global Number.l, repetitionPlus.l,repetitionMoins.l

Procedure plus()
  Number = Val(GetGadgetText(2))
  Number = Number + 1
  SetGadgetText(2, Str(Number))
EndProcedure

Procedure moins()
  Number = Val(GetGadgetText(2))
  Number = Number - 1
  SetGadgetText(2, Str(Number))
EndProcedure

If OpenWindow(0, 0, 0, 220, 220, "CanvasGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  CanvasGadget(0, 10, 10, 30, 30,#PB_Canvas_Border )
  CanvasGadget(1, 100, 10, 30, 30,#PB_Canvas_Border )
  StringGadget(2, 20,60,100,20, "")
  
  StartDrawing(CanvasOutput(0))
  DrawText(8, 4, "+", $0, $ffffff)
  StopDrawing()
  
  StartDrawing(CanvasOutput(1))
  DrawText(8, 4, "-", $0, $ffffff)
  StopDrawing()
  
  AddWindowTimer(0, 10,500)
  
  Repeat
    event = WaitWindowEvent()
    gadget = EventGadget()
    type = EventType()
    
    Select event
        
      Case #PB_Event_Timer
        Select EventTimer()
          Case 10 ; numero du timer
            If repetitionPlus
              plus()
            ElseIf repetitionMoins
              moins()
            EndIf
        EndSelect
        
      Case #PB_Event_Gadget
        Select Gadget
            
          Case 0 ; canvas +
            Select type
              Case #PB_EventType_LeftButtonDown
                repetitionPlus = 1
                plus()
                
              Case #PB_EventType_LeftButtonUp
                repetitionPlus = 0
                
            EndSelect 
            
          Case 1 ; canvas -
            Select type       
              Case #PB_EventType_LeftButtonDown
                repetitionMoins = 1
                moins()
                
              Case #PB_EventType_LeftButtonUp
                repetitionMoins = 0
                
            EndSelect 
        EndSelect  
    EndSelect
    
  Until Event = #PB_Event_CloseWindow
EndIf

Re: Rester appuyé sur bouton gauche

Publié : mer. 25/mars/2015 8:15
par Marc56
Je fais une petite amélioration à la proposition de Nico
Une seule procédure pour remplacer plus() et moins()
Juste pour la simplification :wink:
(j'ai aussi mis le timer à 1/10 de sec contre 1/2)

Code : Tout sélectionner

Global Number.l, repetitionPlus.l,repetitionMoins.l

; Procedure plus()
;   Number = Val(GetGadgetText(2))
;   Number = Number + 1
;   SetGadgetText(2, Str(Number))
; EndProcedure
; 
; Procedure moins()
;   Number = Val(GetGadgetText(2))
;   Number = Number - 1
;   SetGadgetText(2, Str(Number))
; EndProcedure

Procedure Variation(Valeur)
	Number = Val(GetGadgetText(2))
	If Valeur > 0
		Number + 1
	Else
		Number - 1
	EndIf
	SetGadgetText(2, Str(Number))
EndProcedure


If OpenWindow(0, 0, 0, 220, 220, "CanvasGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  CanvasGadget(0, 10, 10, 30, 30,#PB_Canvas_Border )
  CanvasGadget(1, 100, 10, 30, 30,#PB_Canvas_Border )
  StringGadget(2, 20,60,100,20, "")
 
  StartDrawing(CanvasOutput(0))
  DrawText(8, 4, "+", $0, $ffffff)
  StopDrawing()
 
  StartDrawing(CanvasOutput(1))
  DrawText(8, 4, "-", $0, $ffffff)
  StopDrawing()
 
  AddWindowTimer(0, 10,100)
 
  Repeat
    event = WaitWindowEvent()
    gadget = EventGadget()
    type = EventType()
   
    Select event
       
      Case #PB_Event_Timer
        Select EventTimer()
          Case 10 ; numero du timer
            If repetitionPlus
            	; plus()
            	Variation(1)
            ElseIf repetitionMoins
            	; moins()
            	Variation(-1)
            EndIf
        EndSelect
       
      Case #PB_Event_Gadget
        Select Gadget
           
          Case 0 ; canvas +
            Select type
              Case #PB_EventType_LeftButtonDown
                repetitionPlus = 1
                ; plus()
                Variation(1)
               
              Case #PB_EventType_LeftButtonUp
                repetitionPlus = 0
               
            EndSelect
           
          Case 1 ; canvas -
            Select type       
              Case #PB_EventType_LeftButtonDown
                repetitionMoins = 1
                ; moins()
                Variation(-1)
               
              Case #PB_EventType_LeftButtonUp
                repetitionMoins = 0
               
            EndSelect
        EndSelect 
    EndSelect
   
  Until Event = #PB_Event_CloseWindow
EndIf
PS. Si on ne laisse pas l'utilisateur entrer une valeur à la main, on peut même supprimer
Number = Val(GetGadgetText(2))

:)
Fuseau horaire sur UTC+01:00
Page 1 sur 1

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

Traduction française officielle © Qiaeru