PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Marquee gadget

https://www.purebasic.fr/english/viewtopic.php?t=70644

Page 1 of 1

Marquee gadget

Posted: Tue May 01, 2018 7:21 pm
by Justin
A module to display marquee text like html.
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.
Image

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)
Edit: Bug fix.

Re: Marquee gadget

Posted: Wed May 02, 2018 1:09 pm
by Kwai chang caine
Works perfectly on W7 X86 :D
Thanks for sharing 8)

Re: Marquee gadget

Posted: Wed May 02, 2018 2:48 pm
by RSBasic
Very nice. Image

Re: Marquee gadget

Posted: Wed May 02, 2018 3:57 pm
by davido
Looks good. Works on the Mac, too. :D

Re: Marquee gadget

Posted: Fri May 04, 2018 2:39 pm
by JHPJHP
Hi Justin,

Tested in Ubuntu 17.10 and Windows 10; works great (better accuracy in Windows)...

very long large big padded text
- Ubuntu 17.10: started scrolling when the window was resized to the word padded
- Windows 10: started scrolling when the window was resized to the word text

Re: Marquee gadget

Posted: Fri May 04, 2018 8:54 pm
by Karellen
Nice one! Works very well here, thanks, Justin! :)
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited