There is a marquee controller that mantains a list of marquee tools.
You create a marquee controller, usually one for top level window and then add tools to it, it uses a single timer that is only active when any of the tools is scrolling. You handle the window timer event with the built in handler, see example.
You can set colors, font, speed, and horizontal padding. Text is left aligned for now but more options can be added.
Should be crossplatform but just testes on windows.
Code: Select all
DeclareModule guiMarquee
;- MARQUEE_TOOL_EXINFO
Structure MARQUEE_TOOL_EXINFO
LeftPadding.w
RightPadding.w
FontID.i
EndStructure
;- MARQUEE_TOOL
Structure MARQUEE_TOOL
*Marquee.MARQUEE
Canvas.i
Text.s
TextX.w
TextWidth.w
Scrolling.b
ClrText.l
ClrBack.l
ExInfo.MARQUEE_TOOL_EXINFO
EndStructure
;- MARQUEE
Structure MARQUEE
List Tools.MARQUEE_TOOL()
TimerID.i
TimerActive.b
TimerMS.i
ParentWindow.i
EndStructure
;- DECLARES
Declare Create(parentWindow.i, timerID.i)
Declare Free(*marquee.MARQUEE)
Declare CreateTool(*marquee.MARQUEE, x.i, y.i, width.i, height.i, text.s, clrText.l, clrBack.l, *exInfo.MARQUEE_TOOL_EXINFO = #Null)
Declare DestroyTool(*tool.MARQUEE_TOOL)
Declare ResizeTool(*tool.MARQUEE_TOOL, x.i, y.i, width.i, height.i)
Declare HideTool(*tool.MARQUEE_TOOL, hide.b)
Declare SetToolText(*tool.MARQUEE_TOOL, text.s)
Declare OnTimerTick(*marquee.MARQUEE)
Declare SetMiliseconds(*marquee.MARQUEE, ms.i)
EndDeclareModule
Module guiMarquee
EnableExplicit
Declare DrawTool(*tool.MARQUEE_TOOL)
#TIMER_MS = 20
Procedure Create(parentWindow.i, timerID.i)
Define.MARQUEE *this
*this = AllocateStructure(MARQUEE)
*this\ParentWindow = parentWindow
*this\TimerID = timerID
*this\TimerMS = #TIMER_MS
ProcedureReturn *this
EndProcedure
Procedure Free(*this.MARQUEE)
ForEach *this\Tools()
If IsGadget(*this\Tools()\Canvas)
FreeGadget(*this\Tools()\Canvas)
EndIf
Next
FreeList(*this\Tools())
FreeStructure(*this)
EndProcedure
Procedure OnToolResize()
Define.MARQUEE_TOOL *tool
*tool = GetGadgetData(EventGadget())
If *tool
DrawTool(*tool)
EndIf
EndProcedure
Procedure CreateTool(*marquee.MARQUEE, x.i, y.i, width.i, height.i, text.s, clrTxt.l, clrBack.l, *exInfo.MARQUEE_TOOL_EXINFO = #Null)
AddElement(*marquee\Tools())
*marquee\Tools()\Marquee = *marquee
*marquee\Tools()\Text = text
*marquee\Tools()\Canvas = CanvasGadget(#PB_Any, x, y, width, height)
*marquee\Tools()\ClrText = clrTxt
*marquee\Tools()\ClrBack = clrBack
If *exInfo
CopyMemory(*exInfo, *marquee\Tools()\ExInfo, SizeOf(MARQUEE_TOOL_EXINFO))
*marquee\Tools()\TextX = *exInfo\LeftPadding
EndIf
SetGadgetData(*marquee\Tools()\Canvas, @*marquee\Tools())
BindGadgetEvent(*marquee\Tools()\Canvas, @OnToolResize(), #PB_EventType_Resize)
DrawTool(@*marquee\Tools())
ProcedureReturn @*marquee\Tools()
EndProcedure
Procedure DrawTool(*tool.MARQUEE_TOOL)
Define.w txtY
If StartDrawing(CanvasOutput(*tool\Canvas))
If *tool\ExInfo\FontID <> 0
DrawingFont(*tool\ExInfo\FontID)
EndIf
;Text width is saved here to use it in OnTimerTick().
*tool\TextWidth = TextWidth(*tool\Text)
;If text is bigger than canvas activate timer
If *tool\TextWidth > GadgetWidth(*tool\Canvas) - *tool\ExInfo\LeftPadding - *tool\ExInfo\RightPadding
*tool\Scrolling = #True
If *tool\Marquee\TimerActive = #False
AddWindowTimer(*tool\Marquee\ParentWindow, *tool\Marquee\TimerID, *tool\Marquee\TimerMS)
*tool\Marquee\TimerActive = #True
EndIf
Else
*tool\Scrolling = #False
*tool\TextX = 0
EndIf
txtY = (GadgetHeight(*tool\Canvas) - TextHeight(*tool\Text)) / 2
If txtY < 0
txtY = 0
EndIf
Box(0, 0, OutputWidth(), OutputHeight(), *tool\ClrBack)
DrawingMode(#PB_2DDrawing_Transparent)
;Check Horz Padding
If *tool\ExInfo\LeftPadding <> 0 Or *tool\ExInfo\RightPadding <> 0
ClipOutput(*tool\ExInfo\LeftPadding, 0, GadgetWidth(*tool\Canvas) - *tool\ExInfo\LeftPadding - *tool\ExInfo\RightPadding, GadgetHeight(*tool\Canvas))
EndIf
DrawText(*tool\TextX + *tool\ExInfo\LeftPadding, txtY, *tool\Text, *tool\ClrText)
StopDrawing()
EndIf
EndProcedure
Procedure OnTimerTick(*marquee.MARQUEE)
Define.i toolScrolling, canvasWidth
toolScrolling = #False
ForEach *marquee\Tools()
If *marquee\Tools()\Scrolling = #True
toolScrolling = #True
canvasWidth = GadgetWidth(*marquee\Tools()\Canvas)
If *marquee\Tools()\TextX + *marquee\Tools()\TextWidth + *marquee\Tools()\ExInfo\LeftPadding <= *marquee\Tools()\ExInfo\LeftPadding
*marquee\Tools()\TextX = canvasWidth - *marquee\Tools()\ExInfo\RightPadding
Else
*marquee\Tools()\TextX - 1
EndIf
DrawTool(*marquee\Tools())
EndIf
Next
;Remove timer if there are no tools scrolling
If toolScrolling = #False
RemoveWindowTimer(*marquee\ParentWindow, *marquee\TimerID)
*marquee\TimerActive = #False
EndIf
EndProcedure
Procedure SetMiliseconds(*marquee.MARQUEE, ms.i)
*marquee\TimerMS = ms
EndProcedure
Procedure ResizeTool(*tool.MARQUEE_TOOL, x.i, y.i, width.i, height.i)
ResizeGadget(*tool\Canvas, x, y, width, height)
EndProcedure
Procedure SetToolText(*tool.MARQUEE_TOOL, text.s)
*tool\Text = text
DrawTool(*tool)
EndProcedure
Procedure DestroyTool(*tool.MARQUEE_TOOL)
ForEach *tool\Marquee\Tools()
If *tool = @*tool\Marquee\Tools()
FreeGadget(*tool\Marquee\Tools()\Canvas)
DeleteElement(*tool\Marquee\Tools())
Break
EndIf
Next
EndProcedure
Procedure HideTool(*tool.MARQUEE_TOOL, hide.b)
HideGadget(*tool\Canvas, hide)
EndProcedure
EndModule
;- TEST
EnableExplicit
Global.i g_win, g_marquee, g_mt1, g_mt2, g_mt3
#MARQUEE_TIMER_ID = 1
Procedure TimerEvent()
If EventTimer() = #MARQUEE_TIMER_ID
guiMarquee::OnTimerTick(g_marquee)
EndIf
EndProcedure
Procedure SizeEvent()
guiMarquee::ResizeTool(g_mt3, #PB_Ignore, #PB_Ignore, WindowWidth(g_win), #PB_Ignore)
EndProcedure
Define.guiMarquee::MARQUEE_TOOL_EXINFO exInfo
g_win = OpenWindow(#PB_Any, 10, 10, 400, 300, "Marquee", #PB_Window_SystemMenu | #PB_Window_SizeGadget)
g_marquee = guiMarquee::Create(g_win, #MARQUEE_TIMER_ID)
BindEvent(#PB_Event_Timer, @TimerEvent(), g_win)
BindEvent(#PB_Event_SizeWindow, @SizeEvent(), g_win)
g_mt1 = guiMarquee::CreateTool(g_marquee, 10, 10, 100, 30, "very long large big test", RGB(255, 255, 255), RGB(0, 0, 0))
g_mt2 = guiMarquee::CreateTool(g_marquee, 10, 50, 120, 30, "very long large big test", RGB(255, 0, 0), RGB(0, 255, 255))
exInfo\LeftPadding = 8
exInfo\RightPadding = 8
exInfo\FontID = FontID(LoadFont(#PB_Any, "Verdana", 10))
g_mt3 = guiMarquee::CreateTool(g_marquee, 0, 150, WindowWidth(g_win), 30, "very long large big padded test", RGB(255, 0, 0), RGB(0, 255, 255), exInfo)
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow
guiMarquee::Free(g_marquee)
