TimeLine gadget (Canvas)
Posted: Thu Jul 30, 2015 7:21 pm
edit:Small bug in TL_ClearFrames() fixed. It didn't reset properly.
Code: Select all
;'TimeLine' gadget module
;Mimics Flash' timeLine 'gadget'
;Created by DK_PETER - Peter bach
;--------------------------
;Use it, change it or throw it away.
;--------------------------
;This is work in progress!
;Some things could be better.
;It should work, though. (Cross platform) - I hope.
;
;TimeLine gadget idea by Ricardo
;http://www.purebasic.fr/english/viewtopic.php?f=13&t=62664
;-----------------------------------
DeclareModule _TG
EnableExplicit
Enumeration #PB_Event_FirstCustomValue
#EventTimeLineChange
EndEnumeration
Declare.i AddTimeLineGadget(GadgetID.i = #PB_Any, x.i = 0, y.i = 0, w.i = 100, TotalFrames.i = 100)
Declare.i TL_SetBackColor(GadgetID.i, RGBA_Color.i)
Declare.i TL_GetBackColor(GadgetID.i)
Declare.i TL_SetSelectionColor(GadgetID.i, RGBA_Color.i = $AA43E640)
Declare.i TL_GetSelectionColor(GadgetID.i)
Declare.i TL_SetSliderColor(GadgetID.i, RGBA_Color.i = $772C4DC6)
Declare.i TL_GetSliderColor(GadgetID.i)
Declare.i TL_Refresh(GadgetID.i)
Declare.i TL_AddFrame(GadgetID.i, Number.i = 1)
Declare.i TL_RemoveFrame(GadgetID.i, Index.i)
Declare.i TL_AttachFrameImage(gadgetID.i, Index.i, image.i)
Declare.i TL_AttachFrameText(gadgetID.i, Index.i, txt.s)
Declare.i TL_ClearFrameText(gadgetID.i, Index.i)
Declare.i TL_ClearFrameImage(GadgetID.i, Index.i)
Declare.i TL_GetCurrentFrameIndex(GadgetID.i)
Declare.i TL_SetCurrentFrameIndex(GadgetID.i, Index.i)
Declare.i TL_GetCurrentFrameImage(GadgetID.i)
Declare.s TL_GetCurrentFrameText(GadgetID.i)
Declare.i TL_ClearFrames(GadgetID.i)
Declare.i TL_CountFrames(GadgetID.i)
EndDeclareModule
Module _TG
Structure _ImageSet
id.i
x.i
y.i
EndStructure
Structure _Item
value.i ;could be anything - a value, handle to image etc....
st.s ;String data
x.i ;index found inside x and x + 10
selected.i
EndStructure
Structure _gad
id.i
x.i
y.i
w.i
h.i
ActiveColor.i
BackColor.i
bg._ImageSet
CurrentIndex.i
max.i
slideColor.i
selectioncolor.i
slideimage._ImageSet
List Index._Item()
EndStructure
Declare.i TL_GadgetEvents()
Global NewList tlg._gad()
Global fnt.i = LoadFont(#PB_Any, "Arial", 6)
Procedure.i AddTimeLineGadget(GadgetID.i = #PB_Any, x.i = 0, y.i = 0, w.i = 100, TotalFrames.i = 100)
AddElement(tlg())
With tlg()
\x = x : \y = y : \w = w : \h = 40
\CurrentIndex = 0
\max = TotalFrames
Select GadgetID
Case #PB_Any
tlg()\id = CanvasGadget(#PB_Any, x, y, w, 40)
Default
tlg()\id = GadgetID
CanvasGadget(tlg()\id, x, y, w, 40)
EndSelect
For x = 0 To TotalFrames-1
AddElement(\Index())
\Index()\value = -1
\Index()\selected = #False
\Index()\x = x * 10
Next x
\CurrentIndex = 0
TL_SetSliderColor(tlg()\id)
BindGadgetEvent(\id, @TL_GadgetEvents())
EndWith
TL_Refresh(tlg()\id)
ProcedureReturn tlg()\id
EndProcedure
Procedure.i TL_SetBackColor(GadgetID.i, RGBA_Color.i)
ForEach tlg()
If tlg()\id = GadgetID
tlg()\BackColor = RGBA_Color
Break
EndIf
Next
EndProcedure
Procedure.i TL_GetBackColor(GadgetID.i)
Protected retval.i = -1
ForEach tlg()
If tlg()\id = GadgetID
retval = tlg()\BackColor
Break
EndIf
Next
ProcedureReturn retval
EndProcedure
Procedure.i TL_SetSliderColor(GadgetID.i, RGBA_Color.i = $772C4DC6)
ForEach tlg()
If tlg()\id = GadgetID
With tlg()
\slideColor = RGBA_Color
If IsImage(\slideimage) : FreeImage(\slideimage) : EndIf
\slideimage\id = CreateImage(#PB_Any, 10, 40, 32, #PB_Image_Transparent)
StartDrawing(ImageOutput(\slideimage\id))
DrawingMode(#PB_2DDrawing_AlphaBlend)
Box(0, 0, 10, 20, \slideColor)
LineXY(5, 20, 5, 40, \slideColor)
StopDrawing()
EndWith
Break
EndIf
Next
EndProcedure
Procedure.i TL_GetSelectionColor(GadgetID.i)
Protected retval.i = -1
ForEach tlg()
If tlg()\id = GadgetID
retval = tlg()\selectioncolor
Break
EndIf
Next
ProcedureReturn retval
EndProcedure
Procedure.i TL_SetSelectionColor(GadgetID.i, RGBA_Color.i = $AA43E640)
ForEach tlg()
If tlg()\id = GadgetID
tlg()\selectioncolor = RGBA_Color
Break
EndIf
Next
EndProcedure
Procedure.i TL_GetSliderColor(GadgetID.i)
Protected retval.i = -1
ForEach tlg()
If tlg()\id = GadgetID
retval = tlg()\slideColor
Break
EndIf
Next
ProcedureReturn retval
EndProcedure
Procedure.i TL_AddFrame(GadgetID.i, Number.i = 1) ;Add one (or more) to max
Protected Count.i
If Number = 0 : ProcedureReturn #False : EndIf
ForEach tlg()
If tlg()\id = GadgetID
If Number = 1
AddElement(tlg()\Index())
Else
For Count = 0 To Number - 1
AddElement(tlg()\Index())
Next Count
EndIf
tlg()\max = ListSize(tlg()\Index())
Break
EndIf
Next
EndProcedure
Procedure.i TL_RemoveFrame(GadgetID.i, Index.i) ;Remove frame
ForEach tlg()
If tlg()\id = GadgetID
SelectElement(tlg()\Index(), Index)
DeleteElement(tlg()\Index())
tlg()\max - 1
Break
EndIf
Next
EndProcedure
Procedure.i TL_GetCurrentFrameImage(GadgetID.i)
Protected im.i = -1
ForEach tlg()
If tlg()\id = GadgetID
With tlg()
SelectElement(\Index(),\CurrentIndex)
If IsImage(\Index()\value)
im = CopyImage(\Index()\value,#PB_Any)
EndIf
EndWith
Break
EndIf
Next
ProcedureReturn im
EndProcedure
Procedure.s TL_GetCurrentFrameText(GadgetID.i)
Protected tx.s = ""
ForEach tlg()
If tlg()\id = GadgetID
SelectElement(tlg()\Index(),tlg()\CurrentIndex)
tx = tlg()\Index()\st
Break
EndIf
Next
ProcedureReturn tx
EndProcedure
Procedure.i TL_Refresh(GadgetID.i)
Protected count.i, interval.i = 1, counter.i = 0
ForEach tlg()
If tlg()\id = GadgetID
With tlg()
If (\CurrentIndex * 10) + 20 > GadgetWidth(\id)
\bg\x = GadgetWidth(\id) - ((\CurrentIndex * 10)+10)
\slideimage\x = GadgetWidth(\id) - 10
Else
\slideimage\x = \CurrentIndex * 10
EndIf
If IsImage(\bg\id) : FreeImage(\bg\id) : EndIf
\bg\id = CreateImage(#PB_Any, ListSize(\Index())*10, 40, 32, #PB_Image_Transparent)
StartDrawing(ImageOutput(\bg\id))
DrawingFont(FontID(fnt))
DrawingMode(#PB_2DDrawing_AllChannels)
Box(0, 20, ImageWidth(\bg\id), 40, $FFFFFFFF)
Box(0, 0, ImageWidth(\bg\id), 20, \BackColor)
For count = 0 To ImageWidth(\bg\id) Step 10
LineXY(count, 10, count, 17, $FF000000)
If interval = 5
DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Transparent)
Box(count, 20, 10, 20, $AA888888)
DrawText(count, 1, Str((count/10)+1), $FF000000)
DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Outlined)
Box(count, 20, 10, 20, $FF000000)
interval = 1
Else
DrawingMode(#PB_2DDrawing_AlphaBlend)
Box(count, 20, 10, 20, $FFFFFFFF)
DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Outlined)
Box(count, 20, 10, 20, $FF000000)
interval + 1
EndIf
Next count
StopDrawing()
StartDrawing(CanvasOutput(\id))
DrawingMode(#PB_2DDrawing_AlphaBlend)
DrawImage(ImageID(\bg\id),\bg\x, 0)
ForEach \Index()
If \Index()\selected = #True
Box((ListIndex(\Index())*10)+1, 21, 8, 18, \selectioncolor)
EndIf
Next
DrawAlphaImage(ImageID(\slideimage\id), \slideimage\x, 1)
StopDrawing()
EndWith
Break
EndIf
Next
ProcedureReturn #True
EndProcedure
Procedure.i TL_AttachFrameImage(gadgetID.i, Index.i, image.i)
ForEach tlg()
If tlg()\id = gadgetID
If Index < ListSize(tlg()\Index())
SelectElement(tlg()\Index(), Index)
tlg()\Index()\value = CopyImage(image, #PB_Any)
tlg()\Index()\selected = #True
EndIf
Break
EndIf
Next
TL_Refresh(gadgetID)
EndProcedure
Procedure.i TL_AttachFrameText(gadgetID.i, Index.i, txt.s)
ForEach tlg()
If tlg()\id = gadgetID
If Index < ListSize(tlg()\Index())
SelectElement(tlg()\Index(), Index)
tlg()\Index()\st = txt
tlg()\Index()\selected = #True
EndIf
Break
EndIf
Next
TL_Refresh(gadgetID)
EndProcedure
Procedure.i TL_ClearFrameText(gadgetID.i, Index.i)
ForEach tlg()
If tlg()\id = gadgetID
If Index < ListSize(tlg()\Index())
SelectElement(tlg()\Index(), Index)
tlg()\Index()\st = ""
If IsImage(tlg()\Index()\value) = 0
tlg()\Index()\selected = #False
EndIf
EndIf
Break
EndIf
Next
EndProcedure
Procedure.i TL_ClearFrameImage(GadgetID.i, Index.i)
ForEach tlg()
If tlg()\id = gadgetID
If Index < ListSize(tlg()\Index())
SelectElement(tlg()\Index(), Index)
If IsImage(tlg()\Index()\value) > 0
FreeImage(tlg()\Index()\value)
EndIf
If tlg()\Index()\st = ""
tlg()\Index()\selected = #False
EndIf
EndIf
Break
EndIf
Next
EndProcedure
Procedure.i TL_GetCurrentFrameIndex(GadgetID.i)
Protected retval.i = -1
ForEach tlg()
If tlg()\id = GadgetID
retval = tlg()\CurrentIndex
Break
EndIf
Next
ProcedureReturn retval
EndProcedure
Procedure.i TL_SetCurrentFrameIndex(GadgetID.i, Index.i)
ForEach tlg()
If tlg()\id = GadgetID
If Index >= 0 And Index < tlg()\max
tlg()\CurrentIndex = Index
SelectElement(tlg()\Index(), Index)
EndIf
Break
EndIf
Next
TL_Refresh(GadgetID)
EndProcedure
Procedure.i TL_ClearFrames(GadgetID.i)
ForEach tlg()
If tlg()\id = GadgetID
ForEach tlg()\Index()
If IsImage(tlg()\Index()\value) > 0
FreeImage(tlg()\Index()\value)
EndIf
If tlg()\Index()\st <> ""
tlg()\Index()\st = ""
EndIf
tlg()\Index()\selected = #False
Next
tlg()\bg\x = 0
tlg()\CurrentIndex = 0
Break
EndIf
Next
TL_Refresh(GadgetID)
EndProcedure
Procedure.i TL_CountFrames(GadgetID.i)
Protected retval.i
ForEach tlg()
If tlg()\id = GadgetID
retval = ListSize(tlg()\Index())
Break
EndIf
Next
ProcedureReturn retval
EndProcedure
Procedure.i TL_GadgetEvents() ;Much more can be done - This is basic only!
Protected x.i, y.i, id.i, remain.i, Down.i = #False
id = EventGadget()
ForEach tlg()
With tlg()
If \id = EventGadget()
If EventType() = #PB_EventType_LeftClick
remain = Mod(GetGadgetAttribute(\id, #PB_Canvas_MouseX), 10)
\slideimage\x = GetGadgetAttribute(\id, #PB_Canvas_MouseX)-remain
SelectElement(\Index(), \slideimage\x / 10)
\CurrentIndex = ListIndex(\Index())
TL_Refresh(id)
PostEvent(#EventTimeLineChange, GetActiveWindow(), \id, #PB_EventType_LeftClick)
EndIf
If EventType() = #PB_EventType_RightClick
remain = Mod(GetGadgetAttribute(\id, #PB_Canvas_MouseX), 10)
\slideimage\x = GetGadgetAttribute(\id, #PB_Canvas_MouseX)-remain
SelectElement(\Index(), \slideimage\x / 10)
\CurrentIndex = ListIndex(\Index())
If \Index()\selected = #True
\Index()\selected = #False
Else
\Index()\selected = #True
EndIf
TL_Refresh(\id)
PostEvent(#EventTimeLineChange, GetActiveWindow(), \id, #PB_EventType_RightClick)
EndIf
Break
EndIf
EndWith
Next
EndProcedure
EndModule
;Example
OpenWindow(0, 0, 0, 550, 350, "TimeLine Test by DK_PETER", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
CanvasGadget(0, 0, 0, 400, 300)
ButtonGadget(1, 420, 10, 100, 20, "Clear Canvas")
ButtonGadget(2, 420, 40, 100, 20, "Clear Frames")
ButtonGadget(3, 420, 70, 100, 20, "Attach Frame")
ButtonGadget(4, 420, 100, 100, 20, "Next index")
ButtonGadget(5, 420, 130, 100, 20, "Prev index")
TextGadget(6, 450, 327, 100, 20, "Index: 1")
gid1 = _TG::AddTimeLineGadget(#PB_Any, 0, 305, 400, 50)
_TG::TL_SetBackColor(gid1, $AADBB36D)
_TG::TL_SetSelectionColor(gid1, $8815C411)
_TG::TL_Refresh(gid1)
Repeat
ev = WaitWindowEvent()
If ev = #PB_Event_Gadget
Select EventGadget()
Case 0 ;Basic Drawing
If EventType() = #PB_EventType_LeftButtonDown Or (EventType() = #PB_EventType_MouseMove And GetGadgetAttribute(0, #PB_Canvas_Buttons) & #PB_Canvas_LeftButton)
If StartDrawing(CanvasOutput(0))
x = GetGadgetAttribute(0, #PB_Canvas_MouseX)
y = GetGadgetAttribute(0, #PB_Canvas_MouseY)
Circle(x, y, 10, RGB(Random(255), Random(255), Random(255)))
StopDrawing()
EndIf
EndIf
Case 1 ;Clear canvas
StartDrawing(CanvasOutput(0))
Box(0, 0, GadgetWidth(0), GadgetHeight(0), $FFFFFF)
StopDrawing()
Case 2 ;
_TG::TL_ClearFrames(gid1)
_TG::TL_SetCurrentFrameIndex(gid1,0)
SetGadgetText(6, "Index: " + Str(_TG::TL_GetCurrentFrameIndex(gid1)+1))
Case 3
img = CreateImage(#PB_Any, GadgetWidth(0), GadgetHeight(0))
StartDrawing(ImageOutput(img))
DrawImage(GetGadgetAttribute(0,#PB_Canvas_Image), 0, 0)
StopDrawing()
_TG::TL_AttachFrameImage(gid1, _TG::TL_GetCurrentFrameIndex(gid1), img)
FreeImage(img)
Case 4
_TG::TL_SetCurrentFrameIndex(gid1, _TG::TL_GetCurrentFrameIndex(gid1)+1)
SetGadgetText(6, "Index: " + Str(_TG::TL_GetCurrentFrameIndex(gid1)+1))
If IsImage(_TG::TL_GetCurrentFrameImage(gid1))
StartDrawing(CanvasOutput(0))
DrawImage(ImageID(_TG::TL_GetCurrentFrameImage(gid1)),0, 0)
StopDrawing()
EndIf
Case 5
_TG::TL_SetCurrentFrameIndex(gid1, _TG::TL_GetCurrentFrameIndex(gid1)-1)
SetGadgetText(6, "Index: " + Str(_TG::TL_GetCurrentFrameIndex(gid1)+1))
If IsImage(_TG::TL_GetCurrentFrameImage(gid1))
StartDrawing(CanvasOutput(0))
DrawImage(ImageID(_TG::TL_GetCurrentFrameImage(gid1)),0, 0)
StopDrawing()
EndIf
Case gid1
If EventType() = #PB_EventType_LeftClick
SetGadgetText(6, "Index: " + Str(_TG::TL_GetCurrentFrameIndex(gid1)+1))
EndIf
If EventType() = #PB_EventType_RightClick
SetGadgetText(6, "Index: " + Str(_TG::TL_GetCurrentFrameIndex(gid1)+1))
EndIf
EndSelect
EndIf
Until ev = #PB_Event_CloseWindow