Animation Canvas Gadget

Für allgemeine Fragen zur Programmierung mit PureBasic.
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Animation Canvas Gadget

Beitrag von mk-soft »

Ich versuche hier etwas Linie rein zu bekommen. Vielleicht hat jemand noch Vorschläge.

Da man unter MacOS nicht aus einem Thread direkt auf einen CanvasGadget Zeichen kann, nutze ich den nicht verwendeten EventType #PB_EventType_Change um aus dem Thread per PostEvent das Zeichnen anzustossen.
Alle anderen Event Types gehen erst Bit-Orientiert zum Thread und müssen dort auch zurückgesetzt werden.

Hier schon mal mein erster Ansatz.

Code: Alles auswählen

;-TOP
; Comment : Animation Canvas Gadget
; Author  : mk-soft
; Version : v0.04
; OS      : All

CompilerIf Not #PB_Compiler_Thread
  CompilerError "Use Compiler-Option ThreadSafe!"
CompilerEndIf

;- MyGadgetCommon

DeclareModule MyGadgetCommon
  
  Enumeration
    ; Default
    #GadgetRedraw
    ; Size
    #GadgetX
    #GadgetY
    #GadgetWidth
    #GadgetHeight
    #GadgetBorderSize
    ; Text
    #GadgetCaption
    #GadgetText
    ; Colors
    #GadgetTextColor
    #GadgetForegroundColor
    #GadgetBackgroundColor
    #GadgetBorderColor
    #GadgetSelectionColor
    #GadgetSelectedColor
    #GadgetSeparatorColor
    
  EndEnumeration
  
EndDeclareModule

; ----

Module MyGadgetCommon
  ; Nothing
EndModule

; ----

;- MyGadget

DeclareModule MyGadget
  
  Declare Create(Gadget, x, y, Width, Height, Text.s, Flags = 0)
  Declare Free(Gadget)
  
  Declare GetProperty(Gadget, Property, Index = 0)
  Declare SetProperty(Gadget, Property, Value, Index = 0)
  Declare.s GetPropertyString(Gadget, Property, Index = 0)
  Declare SetPropertyString(Gadget, Property, Value.s, Index = 0)
  
EndDeclareModule

; ----

Module MyGadget
  
  EnableExplicit
  
  ;-- PB Internals
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    Import ""
      PB_Object_EnumerateStart( PB_Objects )
      PB_Object_EnumerateNext( PB_Objects, *ID.Integer )
      PB_Object_EnumerateAbort( PB_Objects )
      PB_Object_GetObject( PB_Object , DynamicOrArrayID)
      PB_Window_Objects.i
      PB_Gadget_Objects.i
      PB_Image_Objects.i
    EndImport
  CompilerElse
    ImportC ""
      PB_Object_EnumerateStart( PB_Objects )
      PB_Object_EnumerateNext( PB_Objects, *ID.Integer )
      PB_Object_EnumerateAbort( PB_Objects )
      PB_Object_GetObject( PB_Object , DynamicOrArrayID)
      PB_Window_Objects.i
      PB_Gadget_Objects.i
      PB_Image_Objects.i
    EndImport
  CompilerEndIf
  
  Procedure WindowPB(WindowID) ; Find pb-id over handle
    Protected result, window
    result = -1
    PB_Object_EnumerateStart(PB_Window_Objects)
    While PB_Object_EnumerateNext(PB_Window_Objects, @window)
      If WindowID = WindowID(window)
        result = window
        Break
      EndIf
    Wend
    PB_Object_EnumerateAbort(PB_Window_Objects)
    ProcedureReturn result
  EndProcedure
  
  ; ----
  
  UseModule MyGadgetCommon
  
  ;-- Enumeration
  
  EnumerationBinary
    #EventState_MouseEnter
    #EventState_MouseLeave
    #EventState_MouseMove
    #EventState_MouseWheel
    #EventState_LeftButtonDown
    #EventState_LeftButtonUp
    #EventState_LeftClick
    #EventState_LeftDoubleClick
    #EventState_RightButtonDown
    #EventState_RightButtonUp
    #EventState_RightClick
    #EventState_RightDoubleClick
    #EventState_MiddleButtonDown
    #EventState_MiddleButtonUp
    #EventState_Focus
    #EventState_LostFocus
    #EventState_KeyDown
    #EventState_KeyUp
    #EventState_Input
    #EventState_Resize
  EndEnumeration
  
  ;-- Structure
  
  Structure udtThread
    ThreadID.i
    Signal.i
    Cancel.i
  EndStructure
  
  Structure udtDraw
    ; Draw
    x.i
    y.i
    Width.i
    Height.i
    Text.s
    TextColor.i
    BackgroundColor.i
    BorderColor.i
    Animation.i
    Animation2.i
  EndStructure
  
  Structure udtProperty
    Window.i
    Gadget.i
    State.i
    Redraw.i
    x.i
    y.i
    Width.i
    Height.i
    Caption.s
    Text.s
    Flags.i
    TextColor.i
    SelectionColor.i
    BackgroundColor.i
    BorderColor.i
    Thread.udtThread
    Draw.udtDraw
  EndStructure
  
  ;-- Globals
  
  Global NewMap Property.udtProperty()
  
  ;-- Declare internal functions
  Declare _Redraw(*Property.udtProperty)
  Declare _CreateThread(*Property.udtProperty)
  Declare _ReleaseThread(*Property.udtProperty)
  Declare _DoThread(*Property.udtProperty)
  Declare _DoEvents()
  
  ;-- Public Functions
  
  Procedure Create(Gadget, x, y, Width, Height, Text.s, Flags = 0)
    Protected *Property.udtProperty, GadgetID, PB_ID
    GadgetID = CanvasGadget(Gadget, x, y, Width, Height, Flags)
    If GadgetID
      If Gadget = #PB_Any
        PB_ID = GadgetID
      Else
        PB_ID = Gadget
      EndIf
      *Property = FindMapElement(Property(), Hex(PB_ID))
      If *Property
        _ReleaseThread(*Property)
        DeleteMapElement(Property())
      EndIf
      *Property = AddMapElement(Property(), Hex(PB_ID))
      If Not *Property
        FreeGadget(PB_ID)
        ProcedureReturn 0
      EndIf
      With *Property
        ; Init Properties
        \Window = WindowPB(UseGadgetList(0))
        \Gadget = PB_ID
        \Redraw = #True
        \x = x
        \y = y
        \Width = Width
        \Height = Height
        \Text = Text
        \Flags = Flags
        \TextColor = #Black
        \BackgroundColor = #White
        \BorderColor = #Gray
        ; Init Draw 
        \Draw\Text = \Text
        \Draw\BackgroundColor = \BackgroundColor
        \Draw\BorderColor = \BorderColor
        \Draw\Width = \Width
        \Draw\Height = \Height
        \Draw\Animation = 0
      EndWith
      _Redraw(*Property)
      ; Bind Events
      BindGadgetEvent(PB_ID, @_DoEvents())
      ; Create Thread
      _CreateThread(*Property)
      ; Ready
    EndIf  
    ProcedureReturn GadgetID
  EndProcedure
  
  ; ----
  
  Procedure Free(Gadget)
    Protected *Property.udtProperty
    *Property = FindMapElement(Property(), Hex(Gadget))
    If *Property
      _ReleaseThread(*Property)
      DeleteMapElement(Property())
    EndIf
    If IsGadget(Gadget)
      UnbindGadgetEvent(Gadget, @_DoEvents())
      FreeGadget(Gadget)
    EndIf
  EndProcedure
  
  ; ----
  
  Procedure GetProperty(Gadget, Property, Index = 0)
    Protected *Property.udtProperty
    Protected r1
    
    With *Property
      *Property = FindMapElement(Property(), Hex(Gadget))
      If *Property
        Select Property
            ; Default
          Case #GadgetRedraw          : r1 = \Redraw
            ; Size
          Case #GadgetX               : r1 = \x
          Case #GadgetY               : r1 = \y
          Case #GadgetWidth           : r1 = \Width
          Case #GadgetHeight          : r1 = \Height
            ; Colors
          Case #GadgetTextColor       : r1 = \TextColor
          Case #GadgetSelectionColor  : r1 = \SelectionColor
          Case #GadgetBackgroundColor : r1 = \BackgroundColor
          Case #GadgetBorderColor     : r1 = \BorderColor
        EndSelect
      EndIf
    EndWith
    ProcedureReturn r1
  EndProcedure
  
  ; ----
  
  Procedure SetProperty(Gadget, Property, Value, Index = 0)
    Protected *Property.udtProperty
    Protected r1
    
    With *Property
      *Property = FindMapElement(Property(), Hex(Gadget))
      If *Property
        Select Property
            ; Default
          Case #GadgetRedraw          : \Redraw = Value
            ; Size
          Case #GadgetX               : \x = Value
          Case #GadgetY               : \y  = Value
          Case #GadgetWidth           : \Width = Value
          Case #GadgetHeight          : \Height = Value
            ; Colors  
          Case #GadgetTextColor       : \TextColor = Value
          Case #GadgetSelectionColor  : \SelectionColor = Value
          Case #GadgetBackgroundColor : \BackgroundColor = Value
          Case #GadgetBorderColor     : \BorderColor = Value
        EndSelect
        If *Property\Redraw
          \Draw\Text = \Text
          \Draw\TextColor = \TextColor
          \Draw\BackgroundColor = \BackgroundColor
          \Draw\BorderColor = \BorderColor
          _Redraw(*Property)
        EndIf
      EndIf
    EndWith
  EndProcedure
  
  ; ----
  
  Procedure.s GetPropertyString(Gadget, Property, Index = 0)
    Protected *Property.udtProperty
    Protected r1.s
    
    With *Property
      *Property = FindMapElement(Property(), Hex(Gadget))
      If *Property
        Select Property
          Case #GadgetCaption         : r1 = \Caption
          Case #GadgetText            : r1 = \Text
        EndSelect
      EndIf
    EndWith
    ProcedureReturn r1
  EndProcedure
  
  ; ----
  
  Procedure SetPropertyString(Gadget, Property, Value.s, Index = 0)
    Protected *Property.udtProperty
    Protected r1
    
    With *Property
      *Property = FindMapElement(Property(), Hex(Gadget))
      If *Property
        Select Property
          Case #GadgetCaption         : \Caption = Value
          Case #GadgetText            : \Text = Value
        EndSelect
      EndIf
      If \Redraw
        \Draw\Text = \Text
        _Redraw(*Property)
      EndIf
    EndWith
  EndProcedure
  
  ;-- Private Functions
  
  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 _Position(x, y, angle.d, dx, dy, *display_x.integer, *display_y.integer)
    Protected a0.d, b0.d, a1.d, b1.d
    a0 = dy / 2
    b0 = dx / 2
    angle = Radian(angle)
    a1 = Cos(angle) * a0 - Sin(angle) * b0
    b1 = Sin(angle) * a0 + Cos(angle) * b0
    *display_x\i = x - b1
    *display_y\i = y - a1
  EndProcedure
  
  ; ----
  
  ; ----
  Procedure _Redraw(*Property.udtProperty)
    Protected x, y, dx, dy, x2, y2
    Protected RoundX, RoundY
    Protected Angle.d
    
    With *Property
      If IsGadget(\Gadget) And StartDrawing(CanvasOutput(\Gadget))
        ; Border
        Box(0, 0, \Draw\Width, \Draw\Height, \Draw\BorderColor)
        ; Round box
        x = 1 + (\Draw\Width - 2) * \Draw\Animation / 4 / 100
        y = 1 + (\Draw\Height - 2) * \Draw\Animation / 4 / 100
        dx = (\Draw\Width - 2) * (100 - \Draw\Animation / 2) / 100
        dy = (\Draw\Height - 2) * (100 - \Draw\Animation / 2) / 100
        RoundX = dx * \Draw\Animation / 200
        RoundY = dy * \Draw\Animation / 200
        RoundBox(x, y, dx, dy, RoundX, RoundY, \Draw\BackgroundColor)
        ; Text
        ;DrawingFont(#PB_Default)
        Angle = \Draw\Animation2
        x = \Draw\Width / 2
        y = \Draw\Height / 2
        dx = TextWidth(\Draw\Text)
        dy = TextHeight(\Draw\Text)
        _Position(x, y, angle, dx, dy, @x2, @y2)
        DrawRotatedText(x2, y2, \Draw\Text, Angle, \Draw\TextColor)
        StopDrawing()
      EndIf
    EndWith
  EndProcedure
  
  ; ----
  
  Procedure _CreateThread(*Property.udtProperty)
    With *Property
      \Thread\ThreadID = CreateThread(@_DoThread(), *Property)
      If Not \Thread\ThreadID
        ProcedureReturn 0
      EndIf
      ProcedureReturn *Property
    EndWith
  EndProcedure
  
  ; ----
  
  Procedure _ReleaseThread(*Property.udtProperty)
    Protected time
    With *Property
      \Thread\Cancel = #True
      While IsThread(\Thread\ThreadID)
        Delay(10)
        time + 10
        If time >= 500
          KillThread(\Thread\ThreadID)
          Break
        EndIf
      Wend
    EndWith
  EndProcedure
  
  ; ----
  
  #DelayAmimation = 25 ; Entspricht 40 Frames/Sekunde
  #DelaySleep = 100
  
  Procedure _DoThread(*Property.udtProperty)
    Protected Busy, Busy1, Busy2, Busy3, Busy4, Busy5,
              Redraw, 
              AnimationProcent, AnimationTime, 
              AnimationProcent2, AnimationTime2, 
              ColorProcent, ColorTime
    
    With *Property
      Repeat
        
        If Not IsGadget(\Gadget)
          Debug "Gadget " + \Gadget + " Destroyed"
          If FindMapElement(Property(), Hex(\Gadget))
            DeleteMapElement(Property())
          EndIf
          Break
        EndIf
        
        If \Thread\Cancel
          Break
        EndIf
        
        If \State Or Busy
          
          If \State & #EventState_LeftButtonDown
            \State & ~#EventState_LeftButtonDown
            \Draw\BackgroundColor = _BlendColor(\SelectionColor, $FFFFFF, 80)
            Redraw = #True
          EndIf
          
          If \State & #EventState_LeftButtonUp
            \State & ~#EventState_LeftButtonUp
            \Draw\BackgroundColor = \SelectionColor
            Redraw = #True
          EndIf
          
          If \State & #EventState_LeftClick
            \State & ~#EventState_LeftClick
            If AnimationTime > 0
              Debug "Busy 2 start " + \Gadget
              Busy1 = #False
              Busy2 = #True
            Else
              Debug "Busy 1 start " + \Gadget
              Busy1 = #True
              Busy2 = #False
            EndIf
          EndIf
          
          If Busy1
            If AnimationTime < 300
              AnimationTime + #DelayAmimation
              AnimationProcent = AnimationTime * 100 / 300
              \Draw\Animation = AnimationProcent
              Redraw = #True
            Else
              Debug "Busy 1 done " + \Gadget
              Busy1 = #False
            EndIf
          EndIf
          
          If Busy2
            If AnimationTime > 0
              AnimationTime - #DelayAmimation
              AnimationProcent = AnimationTime * 100 / 300
              \Draw\Animation = AnimationProcent
              Redraw = #True
            Else
              Debug "Busy 2 done " + \Gadget
              Busy2 = #False
            EndIf
          EndIf
          
          If \State & #EventState_MouseEnter
            \State & ~#EventState_MouseEnter
            Debug "Busy 3 start " + \Gadget
            Busy3 = #True
            Busy4 = #False
            Busy5 = #True
          EndIf
          
          If \State & #EventState_MouseLeave
            \State & ~#EventState_MouseLeave
            Debug "Busy 4 start " + \Gadget
            busy3 = #False
            Busy4 = #True
          EndIf
          
          If Busy3
            If ColorTime < 600
              ColorTime + #DelayAmimation
              ColorProcent = ColorTime * 100 / 600
              \Draw\BackgroundColor = _BlendColor(\SelectionColor, \BackgroundColor, ColorProcent)
              Redraw = #True
            Else
              Debug "Busy 3 done " + \Gadget
              Busy3 = #False
            EndIf
          EndIf
          
          If Busy4
            If ColorTime > 0
              ColorTime - #DelayAmimation
              ColorProcent = ColorTime * 100 / 600
              \Draw\BackgroundColor = _BlendColor(\SelectionColor, \BackgroundColor, ColorProcent)
              Redraw = #True
            Else
              Debug "Busy 4 done " + \Gadget
              Busy4 = #False
            EndIf
          EndIf
          
          If Busy5
            If AnimationTime2 >= 4000
              AnimationTime2 = 0
              Busy5 = #False
            Else
              AnimationTime2 + #DelayAmimation
            EndIf
            \Draw\Animation2 = AnimationTime2 * 360 / 4000
            Redraw = #True
          EndIf
          
          If \State = #EventState_Resize
            \State & ~#EventState_Resize
            \Draw\x = \x
            \Draw\y = \x
            \Draw\Width = \Width
            \Draw\Height = \Height
            Redraw = #True
          EndIf
          
          ; Redraw anstossen über PostEvent, da macOS nicht aus Thread gezeichnet werden kann
          If Redraw
            Redraw = #False
            PostEvent(#PB_Event_Gadget, \Window, \Gadget, #PB_EventType_Change)
          EndIf
          
          Busy = Busy1 | Busy2 | Busy3 | Busy4 | Busy5
          
          Delay(#DelayAmimation)
          
        Else
          
          Delay(#DelaySleep)
        
        EndIf
        
      ForEver
    EndWith
  EndProcedure
  
  ; ----
  
  Procedure _DoEvents()
    Protected *Property.udtProperty, Gadget
    
    Gadget = EventGadget()
    *Property = FindMapElement(Property(), Hex(Gadget))
    If *Property
      Select EventType()
        Case #PB_EventType_MouseEnter
          *Property\State | #EventState_MouseEnter
        Case #PB_EventType_MouseLeave
          *Property\State | #EventState_MouseLeave
        Case #PB_EventType_MouseMove
          ;*Property\State | #EventState_MouseMove
        Case #PB_EventType_MouseWheel
          ;*Property\State | #EventState_MouseWheel
        Case #PB_EventType_LeftButtonDown
          *Property\State | #EventState_LeftButtonDown
        Case #PB_EventType_LeftButtonUp
          *Property\State | #EventState_LeftButtonUp
        Case #PB_EventType_LeftClick
          *Property\State | #EventState_LeftClick
        Case #PB_EventType_LeftDoubleClick
          ;*Property\State | #EventState_LeftDoubleClick
        Case #PB_EventType_RightButtonDown
          ;*Property\State | #EventState_RightButtonDown
        Case #PB_EventType_RightButtonUp
          ;*Property\State | #EventState_RightButtonUp
        Case #PB_EventType_RightClick
          ;*Property\State | #EventState_RightClick
        Case #PB_EventType_RightDoubleClick
          ;*Property\State | #EventState_RightDoubleClick
        Case #PB_EventType_MiddleButtonDown
          ;*Property\State | #EventState_MiddleButtonDown
        Case #PB_EventType_MiddleButtonUp
          ;*Property\State | #EventState_MiddleButtonUp
        Case #PB_EventType_Focus
          ;*Property\State | #EventState_Focus
        Case #PB_EventType_LostFocus
          ;*Property\State | #EventState_LostFocus
        Case #PB_EventType_KeyDown
          ;*Property\State | #EventState_KeyDown
        Case #PB_EventType_KeyUp
          ;*Property\State | #EventState_KeyUp
        Case #PB_EventType_Input
          ;*Property\State | #EventState_Input
        Case #PB_EventType_Resize
          *Property\x = GadgetX(Gadget)
          *Property\y = GadgetY(Gadget)
          *Property\Width = GadgetWidth(Gadget)
          *Property\Height = GadgetHeight(Gadget)
          *Property\State | #EventState_Resize
        Case #PB_EventType_Change ; Own Event from Thread
          If *Property\Redraw
            _Redraw(*Property)
          EndIf
      EndSelect
      
    EndIf
    
  EndProcedure
  
  ; ----
  
EndModule

;-Test

CompilerIf #PB_Compiler_IsMainFile
  
  UseModule MyGadgetCommon
  
  If OpenWindow(1, #PB_Ignore, #PB_Ignore, 340, 120, "Animation Canvas Gadgets")
    
    MyGadget::Create(0, 10, 10, 100, 100, "My Gadget")
    MyGadget::SetProperty(0, #GadgetBorderColor, #Gray)
    MyGadget::SetProperty(0, #GadgetBackgroundColor, #Yellow)
    MyGadget::SetProperty(0, #GadgetSelectionColor, #Red)
    
    MyGadget::Create(1, 120, 10, 100, 100, "My Gadget")
    MyGadget::SetProperty(1, #GadgetBorderColor, #Gray)
    MyGadget::SetProperty(1, #GadgetBackgroundColor, #Green)
    MyGadget::SetProperty(1, #GadgetSelectionColor, #Blue)
    
    MyGadget::Create(2, 230, 10, 100, 100, "My Gadget")
    MyGadget::SetProperty(2, #GadgetTextColor, #Red)
    MyGadget::SetProperty(2, #GadgetBorderColor, #Gray)
    MyGadget::SetProperty(2, #GadgetBackgroundColor, #Black)
    MyGadget::SetProperty(2, #GadgetSelectionColor, #White)
    
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_CloseWindow
          Break
        Case #PB_Event_Gadget
          If EventGadget() = 2
            If EventType() = #PB_EventType_LeftClick
              ;MyGadget::Free(1)
              If IsGadget(1)
                FreeGadget(1)
              EndIf
            EndIf
          EndIf
      EndSelect
    ForEver
    
    ;MyGadget::Free(0)
    ;MyGadget::Free(1)
    ;MyGadget::Free(2)
    
  EndIf
  
CompilerEndIf
Zuletzt geändert von mk-soft am 06.04.2019 14:35, insgesamt 2-mal geändert.
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: Animation Canvas Gadget

Beitrag von mk-soft »

Update v0.05

Bei Verwendung von Threads und GUI war schon immer mehr zu beachten...

Den Semahore zum anhalten des Threads habe ich wieder entfernt, da beim beenden des Programm der Thread hängen bleibt und somit auch das Programm hängen bleibt kann. (Besonders bei macOS)
Somit kann jetzt auch der Thread selber überwachten ob es das eigene Gadget noch gibt und gegebenen falls die Daten entfernen und sich selber beenden.
(FreeGadget, CloseWindow räumt der Thread jetzt auch den Speicher auf)

Bei PostEvent zu einem Gadget muss auch die richtige Window Nummer eingetragen werden.
Mit UseGadgetList(0) erhält man aber nur das aktuelle Handle auf welchem gerade die Gadgets erstellt werden.
Mit der PB-Internals Funktion WindowPB(Handle) erhält man die richtige Window Nummer die zum Gadget gehört.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Antworten