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
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
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
;=========================================================================
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
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
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