It is currently Mon Nov 18, 2019 2:12 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 8 posts ] 
Author Message
 Post subject: Module GadgetTimer (Update Trigger for Gadgets)
PostPosted: Sun Jun 16, 2019 1:44 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2038
Location: Germany
Maybe someone could use it.

The timer events arrive at the gadget as EventType.
With the function EventData you get the current counter

Update v1.02
- Renamed all functions names
- Now more than one timer event pro gadget

Update v1.04
- Bugfix StopGadgetTimer
- Thread Runtime compensation calculated to delay

Code:
;-TOP
; Comment : Modul Timer for Gadget
; Author  : mk-soft
; Version : v1.04
; Create  : 16.06.2019
; Update  : 23.06.2019
; Link    : https://www.purebasic.fr/english/viewtopic.php?f=12&t=73031

; OS      : All

; *****************************************************************************

;- Begin Module GadgetTimer

DeclareModule GadgetTimer
 
  Declare AddGadgetTimer(Window, Gadget, EventType, Time, Count = 0)
  Declare RemoveGadgetTimer(Gadget, EventType = #PB_All)
  Declare StartGadgetTimer()
  Declare StopGadgetTimer()
 
EndDeclareModule

Module GadgetTimer
 
  EnableExplicit
 
  Structure udtGadgetTimer
    EventType.i
    Time.i
    Count.i
    StartTime.i
    Counter.i
  EndStructure
 
  Structure udtGadget
    Window.i
    Gadget.i
    Map Timer.udtGadgetTimer()
  EndStructure
 
  Structure udtData
    ThreadID.i
    Exit.i
  EndStructure
 
 
  Global NewMap Gadgets.udtGadget()
  Global Mutex = CreateMutex()
  Global thData.udtData
 
  Declare thGadgetTimer(*data.udtData)
 
  ; ----
 
  Procedure AddGadgetTimer(Window, Gadget, EventType, Time, Count = 0)
    With Gadgets()
      LockMutex(Mutex)
      If Not FindMapElement(Gadgets(), Hex(Gadget))
        AddMapElement(Gadgets(), Hex(Gadget))
      EndIf
      \Window = Window
      \Gadget = Gadget
      If AddMapElement(\Timer(), Hex(EventType))
        \Timer()\EventType = EventType
        \Timer()\Time = Time
        \Timer()\Count = Count
        \Timer()\StartTime = ElapsedMilliseconds()
        \Timer()\Counter = 1
      EndIf
      UnlockMutex(Mutex)
    EndWith
  EndProcedure
 
  ; ----
 
  Procedure RemoveGadgetTimer(Gadget, EventType = #PB_All)
    LockMutex(Mutex)
    If FindMapElement(Gadgets(), Hex(Gadget))
      If EventType = #PB_All
        DeleteMapElement(Gadgets())
      Else
        If FindMapElement(Gadgets()\Timer(), Hex(EventType))
          DeleteMapElement(Gadgets()\Timer())
          If MapSize(Gadgets()\Timer()) = 0
            DeleteMapElement(Gadgets())
          EndIf
        EndIf
      EndIf
    EndIf
    UnlockMutex(Mutex)
  EndProcedure
 
  ; ----
 
  Procedure StartGadgetTimer()
    With thData
      If Not IsThread(\ThreadID)
        \ThreadID = CreateThread(@thGadgetTimer(), @thData)
      EndIf
    EndWith
  EndProcedure
 
  ; ----
 
  Procedure StopGadgetTimer()
    Protected time
    With thData
      If IsThread(\ThreadID)
        time = ElapsedMilliseconds()
        \Exit = #True
        Delay(20)
        While IsThread(\ThreadID)
          If ElapsedMilliseconds() - time > 200
            KillThread(\ThreadID)
            Break
          EndIf
          Delay(50)
        Wend
      EndIf
      \ThreadID = 0
      \Exit = #False
    EndWith
  EndProcedure
 
  ; ----
 
  Procedure thGadgetTimer(*data.udtData)
    Protected time, difftime, eventtime
    Protected th_time, th_difftime, th_delay
   
    With Gadgets()
      While Not *data\Exit
        th_time = ElapsedMilliseconds()
        LockMutex(Mutex)
        time = ElapsedMilliseconds()
        ForEach Gadgets()
          If IsGadget(\Gadget)
            ForEach \Timer()
              difftime = time - \Timer()\StartTime
              eventtime = \Timer()\Time * \Timer()\Counter
              If difftime >= eventtime
                PostEvent(#PB_Event_Gadget, \Window, \Gadget, \Timer()\EventType, \Timer()\Counter)
                \Timer()\Counter + 1
              EndIf
              If \Timer()\Count > 0 And \Timer()\Counter > \Timer()\Count
                DeleteMapElement(Gadgets()\Timer())
                If MapSize(Gadgets()\Timer()) = 0
                  DeleteMapElement(Gadgets())
                  Break
                EndIf
              EndIf
            Next
          Else
            DeleteMapElement(Gadgets())
          EndIf
        Next
        UnlockMutex(Mutex)
        th_difftime = ElapsedMilliseconds() - th_time
        th_delay = 25 - th_difftime
        If th_delay < 0
          th_delay = 0
        EndIf
        Delay(th_delay)
      Wend
    EndWith   
  EndProcedure
 
EndModule

;- End Module GadgetTimer

; *****************************************************************************

;- Example

CompilerIf #PB_Compiler_IsMainFile
 
  UseModule GadgetTimer
 
  Enumeration #PB_EventType_FirstCustomValue
    #EventType_Timer1
    #EventType_Timer2
    #EventType_Timer3
    #EventType_Timer4
  EndEnumeration
 
  Enumeration FormWindow
    #Main
  EndEnumeration
 
  Enumeration FormGadget
    #ProgressBar
    #Canvas1
    #Canvas2
    #Text
    #Button0
    #Button1
    #Button2
    #Button3
  EndEnumeration
 
  Procedure OpenMain(x = 0, y = 0, width = 530, height = 170)
    OpenWindow(#Main, x, y, width, height, "Trigger for Gadgets", #PB_Window_SystemMenu)
    ProgressBarGadget(#ProgressBar, 10, 10, 510, 30, 0, 40)
    CanvasGadget(#Canvas1, 10, 50, 40, 40)
    CanvasGadget(#Canvas2, 60, 50, 40, 40)
    TextGadget(#Text, 110, 50, 410, 40, "Trigger Off", #PB_Text_Center)
    ButtonGadget(#Button0, 10, 110, 120, 40, "Progress")
    ButtonGadget(#Button1, 140, 110, 120, 40, "Canvas On")
    ButtonGadget(#Button2, 270, 110, 120, 40, "Canvas Off")
    ButtonGadget(#Button3, 400, 110, 120, 40, "Text", #PB_Button_Toggle)
  EndProcedure
 
  Procedure.i BlendColor(Color1.i, Color2.i, Scale.i = 50) ; Thanks to Thorsten
    Protected.i R1, G1, B1, R2, G2, B2
    Protected.f Blend = Scale / 100
    R1 = Red(Color1): G1 = Green(Color1): B1 = Blue(Color1)
    R2 = Red(Color2): G2 = Green(Color2): B2 = Blue(Color2)
    ProcedureReturn RGB((R1*Blend) + (R2 * (1 - Blend)), (G1*Blend) + (G2 * (1 - Blend)), (B1*Blend) + (B2 * (1 - Blend)))
  EndProcedure
 
  Procedure DrawOn(Counter)
    Protected dx, dy, scale , color
    If StartDrawing(CanvasOutput(#Canvas1))
      scale = Counter * 4
      color = BlendColor(#Green, #Gray, scale)
      dx = GadgetWidth(#Canvas1)
      dy = GadgetHeight(#Canvas1)
      Box(0, 0, dx, dy, #Black)
      Box(1, 1, dx-2, dy-2, color)
      StopDrawing()
    EndIf
  EndProcedure
 
  Procedure DrawOff(Counter)
    Protected dx, dy, scale , color
    If StartDrawing(CanvasOutput(#Canvas1))
      scale = Counter * 4
      color = BlendColor(#Gray, #Green, scale)
      dx = GadgetWidth(#Canvas1)
      dy = GadgetHeight(#Canvas1)
      Box(0, 0, dx, dy, #Black)
      Box(1, 1, dx-2, dy-2, color)
      StopDrawing()
    EndIf
  EndProcedure
 
  Procedure Draw2(Counter)
    Protected dx, dy
    If StartDrawing(CanvasOutput(#Canvas2))
      scale = Counter * 4
      dx = GadgetWidth(#Canvas1)
      dy = GadgetHeight(#Canvas1)
      Box(0, 0, dx, dy, #Black)
      Box(1, 1, dx-2, dy-2, #Gray)
      Circle(dx/2, dy/2, dx/3, #Black)
      If Counter % 2
        Circle(dx/2, dy/2, dx/3-2, #Red)
      Else
        Circle(dx/2, dy/2, dx/3-2, #Gray)
      EndIf 
      StopDrawing()
    EndIf
  EndProcedure
 
  LoadFont(0, "Arial", 28, #PB_Font_Italic)
  Global Dim Text.s(10)
  For i = 0 To 8
    Text(i) = "Count " + Str(i+1)
  Next
  Text(9) = "I like Purebasic!"
 
  Procedure Main()
   
    OpenMain()
    If IsWindow(#Main)
     
      DrawOn(0)
      Draw2(0)
     
      SetGadgetFont(#Text, FontID(0))
     
      StartGadgetTimer()
     
      Repeat
        Select WaitWindowEvent()
          Case #PB_Event_CloseWindow
            Break
          Case #PB_Event_Gadget
            Select EventGadget()
              Case #Button0
                AddGadgetTimer(#Main, #ProgressBar, #EventType_Timer1, 50, 40)
                RemoveGadgetTimer(#ProgressBar, #EventType_Timer3)
              Case #Button1
                RemoveGadgetTimer(#Canvas1)
                AddGadgetTimer(#Main, #Canvas1, #EventType_Timer1, 25, 25)
              Case #Button2
                RemoveGadgetTimer(#Canvas1)
                AddGadgetTimer(#Main, #Canvas1, #EventType_Timer2, 25, 25)
              Case #Button3
                If GetGadgetState(#Button3) = 1
                  AddGadgetTimer(#Main, #Text, #EventType_Timer1, 1000, 0)
                  AddGadgetTimer(#Main, #Canvas2, #EventType_Timer1, 500, 0)
                  SetGadgetText(#Text, "Trigger On")
                Else
                  RemoveGadgetTimer(#Text)
                  RemoveGadgetTimer(#Canvas2)
                  SetGadgetText(#Text, "Trigger Off")
                  draw2(0)
                EndIf
               
              Case #ProgressBar
                Select EventType()
                  Case #EventType_Timer1
                    SetGadgetState(#ProgressBar, EventData())
                EndSelect
              Case #Canvas1
                Select EventType()
                  Case #EventType_Timer1 : DrawOn(EventData())
                  Case #EventType_Timer2 : DrawOff(EventData())
                EndSelect
              Case #Canvas2
                If EventType() = #EventType_Timer1
                  Draw2(EventData()+1)
                EndIf
               
              Case #Text
                If EventType() = #EventType_Timer1
                  SetGadgetText(#Text, Text((EventData() - 1) % 10))
                EndIf
               
            EndSelect
           
        EndSelect
       
      ForEver
     
      StopGadgetTimer()
     
    EndIf
   
  EndProcedure : Main()
 
CompilerEndIf

_________________
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Last edited by mk-soft on Sun Jun 23, 2019 10:02 am, edited 6 times in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Trigger Events for Gadgets
PostPosted: Sun Jun 16, 2019 1:56 pm 
Offline
Enthusiast
Enthusiast

Joined: Thu Apr 18, 2019 8:17 am
Posts: 392
What does it do?


Top
 Profile  
Reply with quote  
 Post subject: Re: Trigger Events for Gadgets
PostPosted: Sun Jun 16, 2019 2:37 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2038
Location: Germany
Is for animation of gadgets without using WindowTimer...

_________________
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
 Post subject: Re: Trigger Events for Gadgets
PostPosted: Sun Jun 16, 2019 10:18 pm 
Offline
PureBasic Team
PureBasic Team
User avatar

Joined: Fri Apr 25, 2003 6:14 pm
Posts: 1704
Location: Germany (Saxony, Deutscheinsiedel)
Could become useful, thank you :D

_________________
Bye,
...André
(PureBasicTeam::Docs & Support - PureArea.net | Order:: PureBasic | PureVisionXP)


Top
 Profile  
Reply with quote  
 Post subject: Re: Module GadgetTimer (Update Trigger for Gadgets)
PostPosted: Sat Jun 22, 2019 7:26 pm 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2038
Location: Germany
Update v1.02
- Renamed all functions names
- Now more than one timer event pro gadget

:wink:

_________________
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
 Post subject: Re: Module GadgetTimer (Update Trigger for Gadgets)
PostPosted: Sun Jun 23, 2019 8:24 am 
Offline
Enthusiast
Enthusiast

Joined: Fri Oct 16, 2009 10:12 am
Posts: 602
Location: BE
Where do you set the timerinterval ?
I would think Time will do that :
"AddGadgetTimer(Window, Gadget, EventType, Time, Count = 0)"
But, I tried different things, don't get it.

_________________
Yeah I know, but keep in mind ... Leonardo da Vinci was also an autodidact.


Top
 Profile  
Reply with quote  
 Post subject: Re: Module GadgetTimer (Update Trigger for Gadgets)
PostPosted: Sun Jun 23, 2019 9:01 am 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2038
Location: Germany
The time interval is set in milliseconds with the parameter "Time". the number of events is set with the parameter "Count". Count = 0 sets infinity.
The minimum time grid is 25 milliseconds, because the thread only checks the gadgets every 25 milliseconds to save the process load.

P.S. Perhaps forget "StartGadgetTimer()"

Short Example
Code:
;-TOP

IncludeFile "Modul_GadgetTimer.pb"

UseModule GadgetTimer

Enumeration #PB_EventType_FirstCustomValue
  #EventType_Timer1
  ;#EventType_Timer2
  ;#EventType_Timer3
  ;#EventType_Timer4
EndEnumeration

If OpenWindow(0, 0, 0, 270, 160, "GadgetTimer", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
 
  StartGadgetTimer()
 
  TextGadget(0, 10,  10, 250, 20, "Timer 1")
  TextGadget(1, 10,  70, 250, 20, "Timer 2")
 
  AddGadgetTimer(0, 0, #EventType_Timer1, 1000, 0)
  AddGadgetTimer(0, 1, #EventType_Timer1, 1000, 20)
 
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        Break
      Case #PB_Event_Gadget
        Select EventGadget()
          Case 0
            If EventType() = #EventType_Timer1
              SetGadgetText(0, "Timer 1: Count = " + EventData())
            EndIf
          Case 1
            If EventType() = #EventType_Timer1
              SetGadgetText(1, "Timer 2: Count = " + EventData() + "/20")
            EndIf
        EndSelect
    EndSelect
  ForEver
 
  StopGadgetTimer()
 
EndIf

_________________
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
 Post subject: Re: Module GadgetTimer (Update Trigger for Gadgets)
PostPosted: Sun Jun 23, 2019 9:36 am 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2038
Location: Germany
Update v1.04
- Bugfix StopGadgetTimer
- Thread Runtime compensation calculated to delay

_________________
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 8 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 13 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye