SpeedButtonGadget

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Mesa
Messages : 1092
Inscription : mer. 14/sept./2011 16:59

SpeedButtonGadget

Message par Mesa »

J'appelle SpeedButtonGadget un gadget qui débite un évènement tant qu'on reste appuyé dessus.

Toute plateforme Canvas + Timer

Code : Tout sélectionner

; falsam
;http://www.purebasic.fr/french/viewtopic.php?f=1&t=15122

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
Toute plateforme Canvas ressemblant à dun bouton + Timer

Code : Tout sélectionner

Global Gadget, Pressed.b, n
Global Min=-50, Max=50

; Change the speed here !
Global Delay=50 ; 50 ms

Procedure paint(canvas, state, text$)
  ; Paint canvas as fake button "+" and fake button "-"
  Protected w, h
  ;State: 0     = Pushed
  ;State: Not 0 = Released
  If StartDrawing(CanvasOutput(canvas))
    Box(0,0,31,31,$CECECE) ; Gray background
    If state=0 ; UP
      LineXY(0,31,31,31,$000000)
      LineXY(31,0,31,31,$000000)
      LineXY(0,0,31,0,$FFFFFF)
      LineXY(0,0,0,31,$FFFFFF)
    Else       ;DOWN
      LineXY(0,31,31,31,$FFFFFF)
      LineXY(31,0,31,31,$FFFFFF)
      LineXY(0,0,31,0,$000000)
      LineXY(0,0,0,31,$000000)
    EndIf
    w=TextWidth(text$)
    h=TextHeight(text$)
    DrawText(16-w/2, 16-h/2, Text$, $000000, $CECECE)
    
    StopDrawing()
  EndIf
  
EndProcedure

Procedure OnSpeedButtonEvent()
  ; Bind all button "-" events and all button "+" events
  Gadget = EventGadget()
  
  Select EventType() ; Which event ?
    Case #PB_EventType_MouseEnter
      If Gadget=0
        Debug "Enter button -"
      ElseIf Gadget=1
        Debug "Enter button +" 
      EndIf      
      
    Case #PB_EventType_MouseLeave
      If Gadget=0
        Debug "Leave button -"
      ElseIf Gadget=1
        Debug "Leave button +" 
      EndIf  
      
    ; Each time a button is left clicked  
    Case #PB_EventType_LeftButtonDown
      Pressed = #True
      
      Select Gadget
        Case 0 ; Button "-"
          paint(0,1,"-") ; Paint the button "-" pushed
        Case 1 ; Button "+"
          paint(1,1,"+") ; Paint the button "+" pushed
      EndSelect
      
    Case #PB_EventType_LeftButtonUp
      Pressed = #False
      paint(0,0,"-")     ; Paint the button "-" released
      paint(1,0,"+")     ; Paint the button "+" released
      
  EndSelect
EndProcedure

Procedure OnTimer()
  If Pressed ; Each time a button is left clicked and as long as it's clicked
    Select Gadget
      Case 0 ; Button "-"  
        If n>Min
         n-1 
         SetGadgetState(2, GetGadgetState(2)-1) ; ProgressBar down        
        EndIf
        
      Case 1 ; Button "+"      
        If n<Max
         n+1 
         SetGadgetState(2, GetGadgetState(2)+1) ; ProgressBar up	
        EndIf
    EndSelect    
    
    Debug n
  EndIf
EndProcedure

; Open a window with some gadgets
OpenWindow(0, 0, 0, 400, 100, "Clic a looooong time please on +/- ;)", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CanvasGadget(0, 10, 30, 32, 32)        ; Fake button -
CanvasGadget(1, 400-32-10, 30, 32, 32) ; Fake button +
paint(0,0,"-")
paint(1,0,"+")
ProgressBarGadget(2,52,30,296,32,Min,Max,#PB_ProgressBar_Smooth)

AddWindowTimer(0, 100, Delay) ; Timer 100 ms

BindGadgetEvent(0, @OnSpeedButtonEvent()) ; Bind all button "-" events
BindGadgetEvent(1, @OnSpeedButtonEvent()) ; Bind all button "+" events
BindEvent(#PB_Event_Timer, @OnTimer())    ; Bind the timer event

Repeat : Until WaitWindowEvent(10) = #PB_Event_CloseWindow

Windows Module: Canvas + Timer + Threads

Code : Tout sélectionner

;netmaestro
;http://www.purebasic.fr/english/viewtopic.php?f=13&t=61960
;=============================================================================================================================
; Includefile:        CUSTOM SPINNER INCLUDE
;
; Author:             Lloyd Gallant (netmaestro)
; Date:               March 25, 2015
; Why:                It's raining outside
; Target OS:          Microsoft Windows
; Target Compiler:    PureBasic 5.31
; License:            Do as you like with it
; Warranty:           5 years give or take, no coverage whatsoever
;
; Usage:              <var>.CSPIN::iCSPIN = CSPIN::CreateInstance(x, y, initialvalue, CSPIN::#Portrait)  // Create vertical spinner
;                     <var>.CSPIN::iCSPIN = CSPIN::CreateInstance(x, y, initialvalue, CSPIN::#Landscape) // Create horizontal spinner
;
;                     <var> is now a custom spinner object and supports these methods:
;
;                     Increment()        // increase gadget's value by 1
;                     Decrement()        // decrease gadget's value by 1
;                     SetValue(newvalue) // set a new value
;                     Value()            // returns gadget's current value
;                     Disable(state)     // Disables/Enables gadget depending on state (mimics PB's DisableGadget() )
;                     Dispose()          // free gadget and its resources
;
;                     Have fun and don't poke your eye out with it
;
;==============================================================================================================================

CompilerIf #PB_Compiler_Thread = 0
	CompilerError "Please compile custom spinner include with threadsafe switch"
CompilerEndIf
; fonctionne sans thread safe !


DeclareModule CSPIN
	
	#Portrait  = 0
	#Landscape = 1
	
	Interface iCSPIN
		Increment()
		Decrement()
		Value()
		SetValue(newvalue)
		Disable(state)
		Dispose()
	EndInterface
	
	Structure sCSPIN
		*vtable
		container.i
		incCanvas.i
		decCanvas.i
		value.i
		display.i
		imgIncNormal.i
		imgIncDisabled.i
		imgIncHot.i
		imgIncPressed.i
		imgDecNormal.i
		imgDecDisabled.i
		imgDecHot.i
		imgDecPressed.i  
		keyboardDelay.i
	EndStructure
	
	Declare CreateInstance(x=0, y=0, initialvalue=0, display=#Landscape)
	
EndDeclareModule

Module CSPIN
	
	Global keyDelayThreadID
	
	Procedure Increment(*this.sCSPIN)
		*this\value + 1
	EndProcedure
	
	Procedure Decrement(*this.sCSPIN)
		*this\value - 1
	EndProcedure
	
	Procedure Value(*this.sCSPIN)
		ProcedureReturn *this\value
	EndProcedure
	
	Procedure SetValue(*this.sCSPIN, newvalue)
		*this\value = newvalue
	EndProcedure
	
	Procedure Disable(*this.sCSPIN, state)
		DisableGadget(*this\incCanvas, state)
		DisableGadget(*this\decCanvas, state)
		If state
			SetGadgetAttribute(*this\incCanvas, #PB_Canvas_Image, ImageID(*this\imgIncDisabled))
			SetGadgetAttribute(*this\decCanvas, #PB_Canvas_Image, ImageID(*this\imgDecDisabled))
		Else
			SetGadgetAttribute(*this\incCanvas, #PB_Canvas_Image, ImageID(*this\imgIncNormal))
			SetGadgetAttribute(*this\decCanvas, #PB_Canvas_Image, ImageID(*this\imgDecNormal))
		EndIf
	EndProcedure
			
	Procedure KeyDelay(gadget)
		Delay(250)
		*this.sCSPIN = GetGadgetData(gadget)
		While GetAsyncKeyState_(#VK_LBUTTON) & 32768
			Delay(*this\keyboardDelay)
			Select gadget
				Case *this\incCanvas
					*this\value + 1
				Case *this\decCanvas
					*this\value - 1
			EndSelect
		Wend
	EndProcedure
	
	Procedure ProcessIncEvents()
		Protected thisgadget = EventGadget()
		*this.sCSPIN = GetGadgetData(thisgadget)
		Select EventType()
			Case #PB_EventType_MouseEnter
				SetGadgetAttribute(thisgadget, #PB_Canvas_Image, ImageID(*this\imgIncHot))
			Case #PB_EventType_MouseLeave 
				SetGadgetAttribute(thisgadget, #PB_Canvas_Image, ImageID(*this\imgIncNormal))
				If IsThread(keyDelayThreadID):KillThread(keyDelayThreadID):EndIf
			Case #PB_EventType_LeftButtonDown
				*this\value + 1
				SetGadgetAttribute(thisgadget, #PB_Canvas_Image, ImageID(*this\imgIncPressed))
				If IsThread(keyDelayThreadID):KillThread(keyDelayThreadID):EndIf
				keyDelayThreadID = CreateThread(@KeyDelay(), thisgadget)
			Case #PB_EventType_LeftButtonUp
				If IsThread(keyDelayThreadID):KillThread(keyDelayThreadID):EndIf
				SetGadgetAttribute(thisgadget, #PB_Canvas_Image, ImageID(*this\imgIncHot))
		EndSelect
	EndProcedure
	
	Procedure ProcessDecEvents()
		Protected thisgadget = EventGadget()
		*this.sCSPIN = GetGadgetData(thisgadget)
		Select EventType()
			Case #PB_EventType_MouseEnter
				SetGadgetAttribute(thisgadget, #PB_Canvas_Image, ImageID(*this\imgDecHot))
			Case #PB_EventType_MouseLeave 
				SetGadgetAttribute(thisgadget, #PB_Canvas_Image, ImageID(*this\imgDecNormal))
				If IsThread(keyDelayThreadID):KillThread(keyDelayThreadID):EndIf
			Case #PB_EventType_LeftButtonDown
				*this\value - 1
				SetGadgetAttribute(thisgadget, #PB_Canvas_Image, ImageID(*this\imgDecPressed))
				If IsThread(keyDelayThreadID):KillThread(keyDelayThreadID):EndIf
				keyDelayThreadID = CreateThread(@KeyDelay(), thisgadget)
			Case #PB_EventType_LeftButtonUp
				If IsThread(keyDelayThreadID):KillThread(keyDelayThreadID):EndIf
				SetGadgetAttribute(thisgadget, #PB_Canvas_Image, ImageID(*this\imgDecHot))
		EndSelect
	EndProcedure
	
	Procedure Dispose(*this.sCSPIN)
		FreeImage(*this\imgIncNormal)
		FreeImage(*this\imgIncDisabled)
		FreeImage(*this\imgIncHot)
		FreeImage(*this\imgIncPressed)
		FreeImage(*this\imgDecNormal)
		FreeImage(*this\imgDecDisabled)
		FreeImage(*this\imgDecHot)
		FreeImage(*this\imgDecPressed)    
		FreeGadget(*this\container)
		FreeMemory(*this)
	EndProcedure
	
	Procedure DrawButtons(*this.sCSPIN)
		UsePNGImageDecoder():UseLZMAPacker()
		*unpacked = AllocateMemory(1082)
		UncompressMemory(?Horz, 1079, *unpacked, 1082)
		Protected img0 = CatchImage(#PB_Any, *unpacked, 1082)
		Protected img1 = CatchImage(#PB_Any, ?Vert, 1119)
		With *this
			If \display=#Portrait
				\imgIncNormal   = GrabImage(Img1,#PB_Any,0,0,16,16)  
				\imgDecNOrmal   = GrabImage(Img1,#PB_Any,0,16,16,16) 
				\imgIncDisabled = GrabImage(Img1,#PB_Any,0,32,16,16) 
				\imgDecDisabled = GrabImage(Img1,#PB_Any,0,48,16,16) 
				\imgIncHot      = GrabImage(Img1,#PB_Any,0,64,16,16) 
				\imgDecHot      = GrabImage(Img1,#PB_Any,0,80,16,16) 
				\imgIncPressed  = GrabImage(Img1,#PB_Any,0,96,16,16) 
				\imgDecPressed  = GrabImage(Img1,#PB_Any,0,112,16,16)  
			Else
				\imgIncNormal   = GrabImage(Img0, #PB_Any,16,0,16,16)
				\imgDecNOrmal   = GrabImage(Img0, #PB_Any,0,0,16,16)
				\imgIncDisabled = GrabImage(Img0, #PB_Any,48,0,16,16)
				\imgDecDisabled = GrabImage(Img0, #PB_Any,32,0,16,16)
				\imgIncHot      = GrabImage(Img0, #PB_Any,80,0,16,16)
				\imgDecHot      = GrabImage(Img0, #PB_Any,64,0,16,16)
				\imgIncPressed  = GrabImage(Img0, #PB_Any,112,0,16,16)
				\imgDecPressed  = GrabImage(Img0, #PB_Any,96,0,16,16)
			EndIf
		EndWith
		FreeImage(img0):FreeImage(img1)
		
		DataSection
			Horz:
			Data.q $944400010000005D,$89EEF7F6277AC405,$50D5AAB38890508E,$88650D1E11A8383E,$79956B58AC7CF7C7,$CC693132D317F961,
							$09BC7C8A7DCB0846,$D44CBDAC1D09779B,$A499688BC268307E,$66C0BC2A62CE4683,$2D9A17CD0BF1F4F6,$D89F1EE7CC5E6A1B,
							$C0CDA9723132A0E2,$C60EC01FB9303C89,$D6814AAE6E692791,$485E536797EA86C2,$CCC0BDE6BC5B9A07,$F8DACA1AC7D3EDDA,
							$A11E888A2BC073CB,$D1F18C4DF0571E2B,$0164F396B0B88BF0,$D39DE27430EB9959,$FDB58261B29A9CA6,$375EFCC5D0D2F243,
							$745AEC230DD2B5F4,$4701D8B5B8C8FD57,$3EBAEAC86CB4AE06,$C0A25B6B75F14F12,$5467700721CE51B2,$E33086E275553A65,
							$A48188F455431F02,$415F55A123B28133,$DE7CD374C09F7AA4,$E03934FEE05D34D6,$051DDD09328338EA,$C36806C8FB6F4539,
							$87AF0FE77E760162,$407DD3390AC6A5C6,$FCE103327149B0B6,$E9C02E8605E29213,$2504251DE0CDD987,$01AA58A1A78392DA,
							$FCC91B29D94AD4E7,$D3F6EB6FD07C5579,$DC775FF8DFBA29E9,$C271EE4F083C98FB,$62C92B209A996FFE,$2D65AF4AEF0C7309,
							$B094A4AA2CD90DDF,$27B7D00C6233F206,$7FD93273A283F38B,$F71A6C8E181B97B1,$23BA1BC89BDC0A83,$FCC935054C2AA633,
							$46E1826A20424329,$E671FA30E8CC3863,$30050CFD416F3274,$AEF06FFD312A9028,$74FDB0FD1D24FF5F,$71650D8C343C9589,
							$86023C643956A45F,$46664EF76120884E,$D0DC7B407A638459,$F41E47B5A18F01C7,$A39C3B245CCD361A,$1C225A975EAE5DCA,
							$B5B46062494C0591,$A5C9BDDD1E71A37D,$0EE3E044F8F8DDE7,$A13A0EB5E6DB362D,$9E2B5A291B803425,$704EEB58E21D2690,
							$BF79E2B2A6124BE0,$1D3D2D1BE730F099,$25F3D6D857D0AB35,$8FEF533B267D1418,$F2CBC8025270B939,$4691C181DD553517,
							$358EA4D8D6C156D5,$CBC6F3A30F33FC01,$CC66B3C503DCC246,$653A712D8C9C7AD8,$4AC640F02E533149,$58B4DFAA8E207AB0,
							$D5248818111C0E8B,$FAE8C19E9DBD9850,$A473E5AEC0F09173,$F6F239965C36CA37,$2A4755F30D0BE425,$898A7BB537AFA4D0,
							$0DE8764459EEA316,$37C1E8C6D9016749,$1DC611B7AD94D4CA,$B346E020152AB204,$59AD6815E843A22B,$16D1862778F5E559,
							$00184D0FFA7291CE,$7F342718BD4FA3C8,$035384BC8BE6A79D,$0EE2D11C8D4B7089,$9B367211B4B1EBC4,$E38B7B8AE5B1DE69,
							$62D7A06518155456,$17DD50FBCD83D739,$D16C125F02CB56F8,$ABF1C75D8C869347,$2014159856BE395F,$2064266DED71E655,
							$5D05E8676D886838,$B90834F4EA14DB67,$ABBEEC550C23EB10,$124F4D6FF6995E44,$D680DC356D95B9FB,$3FC065AFCE94A7D0,
							$C72475A160AD9AAA,$514F873E45B11C30,$24117B7068C3457A,$1B759B8D1C27EE0C,$CE517A3A7E07890B,$B7183BBB6F82DAAA,
							$4C36B71681AF996C,$3E010C534929DE3A,$FEB0C7A86C102411,$EA1FF0595CF5AA16,$FA2F0B0585BB66FC,$CFEEFC37584C6C93,
							$9AE391CAF1BCB3A8,$7C826FA1ED556F04,$1161E83378C71790,$AF752B1A5B492F85,$857A77DA364C8DD8,$D1CF18B049B89071,
							$62C21A4FAF94D36C,$4DAB960C20CDAA9B : Data.b $02,$1B,$B5,$E2,$BF,$1C,$FE
			Vert:
			Data.q $0A1A0A0D474E5089,$524448490D000000,$8000000010000000,$7EF78D0000000208,$5948700900000075,$2E0000232E000073,
							$0000763FA5780123,$0958544144491104,$4F18415B483F57ED,$889515B4561E4C62,$22283828A41D1488,$D2E6E0EA1C1C5D4A,
							$20A938A8382294A9,$2A50941D0C870542,$2943B4A560EC1C9D,$1C52820CC445162E,$8885222894450A94,$DDF772F725FDA8D1,
							$8F2414A1AF33DEE5,$777DFEE7F7EFBE40,$FE86E3E1CB9712F7,$995959574338F8F8,$939F0DE997294327,$2C58A43340D1170F,
							$9ADADAD10ADADAD6,$666690FD6AA7EFDF,$62CD54041F257E66,$66E6E6C3C3C387B5,$546C6C6FCD1A0274,$F1F187A69B705454,
							$66AE52010886A671,$C5C5F5F5F5E93481,$188922900A40AA45,$5F5F54747473C075,$034C5040172E72AF,$BDBDB7373730F456,
							$DEE1C24A08006E9D,$92509129292BDBDB,$63865E6032008280,$F30D468896969641,$5555550C2418F2F2,$0D58E8398B974AAA,
							$D1A3452AE60C1F76,$7950531CCD53D3D3,$AE670A8EEAD8B979,$AA48C8C8D1515152,$1B650204141BF539,$A6A6A7F143E6F1CB,
							$C017DF2008A93344,$F4F4F4B4B4B5C2A4,$922900A46F8994A4,$621A1A1E09C511F5,$0F6A819A07A0224D,$947470B319AFED40,
							$29511004C4C4D028,$AE6A1AAC207A6B42,$18181EEE7D925519,$A3A3A3D2624AD470,$674AA52727267A19,$FAD1E10B701BD362,
							$20F935FBD7AF0635,$672B2B2B0C68F748,$CBCBCB86DDC107C9,$F1548043A665E5E5,$899C78F12C603DA8,$AD91224433B52010,
							$A222900A40AA2DAD,$62C7293BBC356C07,$C61C38430A177480,$6171C50400374EB1,$9634AE6529EEB9B0,$781E93378FAFAFBC,
							$01A6E01B9B9B9E3C,$4C238EBA4618620B,$7DC1F673890C548D,$3F3F3B5584AB9830,$63DB2161616E99B7,$3CAC850A16AB01A6,
							$39AC838383050505,$503D569D9D9D4AB1,$4081029A9A9A184A,$AE030B8E282007BA,$2000F04E6EEEEED4,$CDE09018500505FF,
							$029008A5C0D0D0D7,$C5D5D5D1006488A4,$35588D54A4023ECF,$42260E8E8EBE7CF8,$F6F6F6E8030EF480,$D66A46A28107C987,
							$14AB091B10281281,$8A353535A006F4A5,$381561381CEAA78E,$EF13C4B21AADEEBE,$B84CBC962FDBDBB8,$58586F41CF1CCFDD,
							$4334CCDD6E47C558,$DF815EEAEAAEC58A,$7E9B53E7F7EB79D9,$3E08FDFDC7E0C148,$07070F6AC59AA808,$40AE2E2F2FB5B527,
							$CACABBEEEEFE461B,$9EFC3C30F4D36E52,$2059AB94804221A9,$77FCFCC7F5757A4D,$7D70C222900A40AA,$018B1CA21FDFDD7D,
							$DB7ECECC30B8E282,$C504001E09C9FCDC,$287D9D9F4A8044D3,$0A05DE251BBF252D,$BE1860F3CC21B602,$57AF32932C8DF870,
							$761D2D5D5F90FFFD,$85DA020731124E49,$717A346B2E60C1F7,$23C081B266DBF272,$E2A55CCE151DD5B1,$01EAB73F5FAF07E2,
							$E3C4F80F45820414,$0115340B1F1B1A9F,$27F01D44C034C504,$E5A001EBF35A7A61,$4FBDBD27B6B687FF,$48A40291BE274D53,
							$97AC6C78271447D6,$3DAA06681E808935,$51D1C2CC66BFB500,$52A2200BE0C140A2,$5CD4355840F4D684,$0E7EFFE43FE4AA33,
							$F721BD3D38652F62,$D594BDC850BDC942,$218D9F37EB31B25E,$F8F6DD7BAEE7DD77,$6C75D3E6F1DEEB9B,$D38663F9F001FD8B,
							$49000000002D1BB5 : Data.b $45,$4E,$44,$AE,$42,$60,$82
		EndDataSection
		
	EndProcedure
	
	Procedure CreateInstance(x=0, y=0, initialvalue=0, display=#Landscape)
		Protected.i width, height, dx, dy
		Select display
			Case #Landscape : width=32 : height=16 : ix=16 : iy=0 : dx=0 : dy=0
			Case #portrait  : width=16 : height=32 : ix=0  : iy=0 : dx=0 : dy=16
		EndSelect
		*this.sCSPIN = AllocateMemory(SizeOf(sCSPIN))
		With *this
			\vtable = ?CSPIN_Methods
			\value  = initialvalue
			\display = display
			SystemParametersInfo_(#SPI_GETKEYBOARDSPEED, 0, @thisdelay, 0)
			\keyboardDelay = 1000/thisdelay
			DrawButtons(*this)
			\container = ContainerGadget(#PB_Any, x, y, width, height)
			\incCanvas = CanvasGadget(#PB_Any, ix, iy, 16, 16)
			\decCanvas = CanvasGadget(#PB_Any, dx, dy, 16, 16)
			CloseGadgetList()
			SetGadgetAttribute(\incCanvas, #PB_Canvas_Image, ImageID(\imgIncNormal))
			SetGadgetAttribute(\decCanvas,  #PB_Canvas_Image, ImageID(\imgDecNormal))
			BindGadgetEvent(\incCanvas, @ProcessIncEvents())
			BindGadgetEvent(\decCanvas, @ProcessDecEvents())
			SetGadgetData(\incCanvas, *this)
			SetGadgetData(\decCanvas, *this)
		EndWith
		ProcedureReturn *this
	EndProcedure
	
	DataSection
		CSPIN_Methods: 
		Data.i @Increment(),@Decrement(),@Value(),@SetValue(),@Disable(),@Dispose(),@CreateInstance()
	EndDataSection
	
EndModule

; Demo code: No need to remove

CompilerIf #PB_Compiler_IsMainFile
	
	Global spin1.CSPIN::iCSPIN
	Global spin2.CSPIN::iCSPIN
	
	Procedure Monitor(void)
		Repeat
			Delay(1)
			If oldvalue1 <> spin1\Value()
				SetGadgetText(0, Str(spin1\Value()))
				oldvalue1 = spin1\Value()
			EndIf
			If oldvalue2 <> spin2\Value()
				SetGadgetText(1, Str(spin2\Value()))
				oldvalue2 = spin2\Value()
			EndIf    
		ForEver
	EndProcedure
	
	Procedure buttonproc()
		Static status=1
		status = 1-status
		spin2\Disable(status)
	EndProcedure
	
	OpenWindow(0,0,0,640,480,"")
	spin1 = CSPIN::CreateInstance(40,100,0,CSPIN::#Portrait)
	spin2 = CSPIN::CreateInstance(80,105,0,CSPIN::#Landscape)
	spin2\Disable(1)
	TextGadget(#PB_Any, 10, 5,60,20, "spin1:")
	TextGadget(#PB_Any, 10,35,60,20, "spin2:")
	StringGadget(0, 70, 5,100,20,"0")
	StringGadget(1, 70,35,100,20,"0")
	ButtonGadget(2, 40,150,120,20, "Enable/disable spin2")
	BindGadgetEvent(2, @buttonproc())
	
	tid = CreateThread(@Monitor(),0)
	
	Repeat:Until WaitWindowEvent() = #PB_Event_CloseWindow
	
	KillThread(tid)
	WaitThread(tid)
	spin1\Dispose()
	spin2\Dispose()
	
CompilerEndIf

;=========================================================================
;                     END CUSTOM SPINNER INCLUDE
;=========================================================================

Windows Bouton + Timer

Code : Tout sélectionner


Global Pressed, BoutonG 

If GetSystemMetrics_(#SM_SWAPBUTTON)=0 
  BoutonG=#VK_LBUTTON 
Else 
  BoutonG=#VK_RBUTTON 
EndIf 


Procedure SpeeButtonEvent() 
  Protected UnderMouse.POINT, hBouton 
  
  If GetActiveWindow_() = WindowID(0) 
    
    GetCursorPos_(UnderMouse) 
    ;MapWindowPoints_(0, WindowID(0), @UnderMouse, 1)
    ;hBouton=RealChildWindowFromPoint_(WindowID(0),UnderMouse\y << 32 + UnderMouse\x); 
    hBouton=WindowFromPoint_(UnderMouse\y << 32 + UnderMouse\x)
    
    If Pressed=0 And GetAsyncKeyState_(BoutonG)<>0       
      Pressed=1 
      
    ElseIf Pressed=1 And GetAsyncKeyState_(BoutonG)=0 
      Pressed=0 
      
    ElseIf Pressed=1 And GetAsyncKeyState_(BoutonG)<>0
      Pressed=1 
      
    EndIf
    
  EndIf 
  
  ProcedureReturn hBouton 
EndProcedure 



OpenWindow(0, 100, 100, 400, 100,"SpeedButton",#PB_Window_SystemMenu) 

hBoutonSpeedDOWN=ButtonGadget(1, 50, 30,  30, 30, "-") 
hBoutonSpeedUP=ButtonGadget(2, 310, 30,  30, 30, "+") 
TextGadget(3, 200, 30, 30,30,"0")

AddWindowTimer(0,100,50)

Repeat 
  EventID = WaitWindowEvent(10) 
  hBouton=SpeeButtonEvent()
  
  Select EventID
    Case #PB_Event_Timer 
      
      If Pressed=1
        Select hBouton
          Case hBoutonSpeedUP
            n+1
            
          Case hBoutonSpeedDOWN
            n-1
            
        EndSelect
        
        SetGadgetText(3, Str(n))
      EndIf
      
  EndSelect 
  
  
Until EventID = #PB_Event_CloseWindow 


Windows Bouton + Timer créé puis timer détruit quand inutile

Code : Tout sélectionner


Global Pressed, BoutonG 

If GetSystemMetrics_(#SM_SWAPBUTTON)=0 
  BoutonG=#VK_LBUTTON 
Else 
  BoutonG=#VK_RBUTTON 
EndIf 


Procedure SpeeButtonEvent(Window, Compteur, Sens) 
  Protected UnderMouse.POINT, hBouton 
  
  If GetActiveWindow_() = WindowID(Window) 
    n=compteur
    GetCursorPos_(UnderMouse) 
    ;MapWindowPoints_(0, WindowID(Window), @UnderMouse, 1)
    ;hBouton=RealChildWindowFromPoint_(WindowID(Window),UnderMouse\y << 32 + UnderMouse\x); 
    hBouton=WindowFromPoint_(UnderMouse\y << 32 + UnderMouse\x)
    
    If Pressed=0 And GetAsyncKeyState_(BoutonG)<>0       
     Pressed=1
     n=n+sens
     SetGadgetText(3, Str(n))
     AddWindowTimer(Window,100,50)
      
    ElseIf Pressed=1 And GetAsyncKeyState_(BoutonG)=0 
      Pressed=0 
      RemoveWindowTimer(Window,100)
      
    ElseIf Pressed=1 And GetAsyncKeyState_(BoutonG)<>0
      Pressed=1 
      
    EndIf
    
  EndIf 
  
  ProcedureReturn hBouton 
EndProcedure 



OpenWindow(1, 100, 100, 400, 100,"SpeedButton",#PB_Window_SystemMenu) 

hBoutonSpeedDOWN=ButtonGadget(1, 50, 30,  30, 30, "-") 
hBoutonSpeedUP=ButtonGadget(2, 310, 30,  30, 30, "+") 
TextGadget(3, 200, 30, 30,30,"0")

n=0

Repeat 
  EventID = WaitWindowEvent(10) 
  hBouton=SpeeButtonEvent(1,n,sens)
  
  Select EventID
    Case #PB_Event_Timer 
      
      If Pressed=1
        Select hBouton
          Case hBoutonSpeedUP
            Sens=1
            n+1
            
          Case hBoutonSpeedDOWN
            Sens=-1
            n-1
            
        EndSelect
        
        SetGadgetText(3, Str(n))
      EndIf
      
  EndSelect 
  
  
Until EventID = #PB_Event_CloseWindow 


Windows Bouton Gauche et bouton Droit de la souris (sans Timer)

Code : Tout sélectionner

; Code provenant de purearea.net, debuggé et augmenté

Structure event 
  id.l 
  oldid.l 
  pressed.l 
  left.l 
  right.l 
  changed.l 
  key.l 
EndStructure 

Global EventData.event
Global CursorPosition.POINT 

Global n

If GetSystemMetrics_(#SM_SWAPBUTTON)=0 
  EventData\right=#VK_RBUTTON 
  EventData\left=#VK_LBUTTON 
Else 
  EventData\right=#VK_LBUTTON 
  EventData\left=#VK_RBUTTON 
EndIf 


Procedure info(text.s) 
  ;Debug text;  
  StatusBarText(1, 0, text, 4) 
EndProcedure 

Procedure RightKlickEvent() 
  If GetActiveWindow_()=WindowID(0) 
    GetCursorPos_(CursorPosition) 
    id=WindowFromPoint_(CursorPosition\y<< 32 + CursorPosition\x) 
    If EventData\pressed=0 And GetAsyncKeyState_(EventData\right)<>0 
      EventData\oldid=id 
      EventData\pressed=2:mouse_event_(#MOUSEEVENTF_LEFTDOWN,0,0,0,0) 
      result=1 
    ElseIf EventData\pressed=2 And GetAsyncKeyState_(EventData\right)=0 
      If id=EventData\oldid    
        result=1 
      EndIf 
      mouse_event_(#MOUSEEVENTF_LEFTUP,0,0,0,0) 
      EventData\key=2 
      EventData\pressed=0 
    ElseIf EventData\pressed=2 And GetAsyncKeyState_(EventData\right)<>0
      n=n+1
      Debug n
    EndIf
  EndIf 
  
  If result <>0:Debug "clic droit "+Str(result):EndIf
  ProcedureReturn result 
EndProcedure 

Procedure LeftKlickEvent() 
  
  If GetActiveWindow_()=WindowID(0) 
    
    GetCursorPos_(CursorPosition)
    
    ;MapWindowPoints_(0, WindowID(0), @CursorPosition, 1)
    ;    id=RealChildWindowFromPoint_(WindowID(0),CursorPosition); 
    id=WindowFromPoint_(CursorPosition\y<< 32 + CursorPosition\x)
    
    If id<>EventData\id 
      EventData\id=id 
      EventData\changed=1 
    EndIf 
    If EventData\pressed=0 And GetAsyncKeyState_(EventData\left)<>0       
      EventData\oldid=id 
      EventData\pressed=1 
      result=1 
    ElseIf EventData\pressed=1 And GetAsyncKeyState_(EventData\left)=0 
      
      If id=EventData\oldid 
        
        result=1 
      EndIf 
      EventData\pressed=0 
      
    ElseIf EventData\pressed=1 And GetAsyncKeyState_(EventData\left)<>0
      n=n+1
      Debug n
    EndIf
    
  EndIf 
  If EventData\key>0
    result=0
    EventData\key-1
  EndIf 
  If result <>0:Debug "clic gauche "+Str(result):EndIf
  ProcedureReturn result 
EndProcedure 

Procedure ButtonState()
  Debug "button state "+ Str(EventData\pressed)
  ProcedureReturn EventData\pressed 
EndProcedure 

Procedure KlickID() 
  Debug "clicID " + Str(EventData\oldid) 
  ProcedureReturn EventData\oldid 
EndProcedure 

Procedure MouseOverGadget() 
  result=EventData\changed 
  EventData\changed=0 
  If result<>0:Debug "over " + Str(result):EndIf
  ProcedureReturn result 
EndProcedure 

Procedure MouseOverID() 
  ProcedureReturn EventData\id 
EndProcedure 

OpenWindow(0, 100, 100, 400, 300,"Events",#PB_Window_SystemMenu) 
CreateStatusBar(1,WindowID(0)) 
AddStatusBarField(#PB_Ignore)

ButtonGadget(1, 160, 90,  80, 20, "Button-1") 
ButtonGadget(2, 160, 190,  80, 20, "Button-2") 

Repeat 
  EventID = WaitWindowEvent(10) 
  If RightKlickEvent() 
    If ButtonState() 
      Select KlickID() 
        Case GadgetID(1):info("Button-1 Right-Down") 
        Case GadgetID(2):info("Button-2 Right-Down") 
        Default:info("---") 
      EndSelect 
    Else 
      Select KlickID() 
        Case GadgetID(1):info("Button-1 Right-Up") 
        Case GadgetID(2):info("Button-2 Right-Up") 
        Default:info("---") 
      EndSelect 
    EndIf 
    
  ElseIf LeftKlickEvent() ; renvoie 1 si Lup et LDown
    If ButtonState()      ; 0 L/R up, 1 Ldown, 2 RDown
      Select KlickID()    ; Gadgets
        Case GadgetID(1):info("Button-1 Left-Down") 
        Case GadgetID(2):info("Button-2 Left-Down") 
        Default:info("---") 
      EndSelect 
    Else 
      Select KlickID() 
        Case GadgetID(1):info("Button-1 Left-Up") 
        Case GadgetID(2):info("Button-2 Left-Up") 
        Default:info("---") 
      EndSelect 
    EndIf 
    
  ElseIf MouseOverGadget() 
    Select MouseOverID() 
      Case GadgetID(1):info("Button-1 Mouseover") 
      Case GadgetID(2):info("Button-2 Mouseover") 
      Default:info("---") 
    EndSelect 
  EndIf 
Until EventID = #PB_Event_CloseWindow 


M.