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