TimeLine gadget (Canvas)

DK_PETER · Post by **DK_PETER** » Thu Jul 30, 2015 7:21 pm

edit:Small bug in TL_ClearFrames() fixed. It didn't reset properly.

;'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

davido · Post by **davido** » Thu Jul 30, 2015 9:01 pm

@DK_PETER ,
Seems to work ok on my MacBook.

PureBasic Forums - English

TimeLine gadget (Canvas)

TimeLine gadget (Canvas)

Re: TimeLine gadget (Canvas)