Module GadgetTimer (Trigger für Gadgets)

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Module GadgetTimer (Trigger für Gadgets)

Beitrag von mk-soft »

Vielleicht kann es jemand brauchen :wink:

Update v1.02
- Funktionsnamen geändert
- Jetzt mehr als ein Event pro Gadget

Update v1.04
- Bugfix StopGadgetTimer()
- Thread Laufzeit Kompensation zum Delay berechnet

Code: Alles auswählen

;-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
[/size]
Zuletzt geändert von mk-soft am 23.06.2019 11:44, insgesamt 3-mal geändert.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
RSBasic
Admin
Beiträge: 8022
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: Trigger für Gadgets

Beitrag von RSBasic »

Was ist der Vorteil deines Moduls? Ich habe den Sinn oder Vorteil noch nicht verstanden.
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Trigger für Gadgets

Beitrag von mk-soft »

Zum Beispiel ohne WindowTimer Gadgets zu animieren, oder
Daten von Gadgets in zyklischen Zeitraum zu aktualisieren.

P.S.
Sendet ein Anzahl (Count) von GadgetEvent mit den eigenen EventType mit dem Timeout (Time) an das Gadget.
Danach wird das Gadget wieder entfernt, ausser wenn die Anzahl Null ist. Dann wird immer das Event gesendet bis dieser wieder mit RemoveGadget entfernt wird.
Mit EventData() kann der Counter abgefragt werden.
Das hinzufügen und entfernen von Gadgets kann auch im Threads erfolgen. Somit funktioniert auch das animieren von Gadgets unter Linux and macOS.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Module GadgetTimer (Trigger für Gadgets)

Beitrag von mk-soft »

Update v1.02
- Funktionsnamen geändert
- Jetzt mehr als ein Event pro Gadget

:wink:
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Module GadgetTimer (Trigger für Gadgets)

Beitrag von mk-soft »

Update v1.04
- Bugfix StopGadgetTimer()
- Thread Laufzeit Kompensation zum Delay berechnet
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Antworten