Since there are always requests for ScrollText, I have made a small module,
which solves this problem very simple.
Have fun with it
Code: Select all
DeclareModule ScrollingTextSimple_BF
EnableExplicit
Declare CreateTextImageSimple_BF(text$, font_ID, text_color=#Black, background_color=#White)
Declare ScrollTextImageSimple_BF(image_ID, step_width=1)
EndDeclareModule
Module ScrollingTextSimple_BF
; Text scrolling - By Saki - DPI aware - This is a part from GFX_Wizzard_BF
Procedure CreateTextImageSimple_BF(text$, font_ID, text_color=#Black, background_color=#White)
Protected image_ID=CreateImage(#PB_Any, 16, 16, 24, background_color)
If Not image_ID : ProcedureReturn 0 : EndIf
If Not StartDrawing(ImageOutput(image_ID)) : FreeImage(image_ID) : ProcedureReturn 0 : EndIf
DrawingFont(FontID(font_ID))
Protected text_width=TextWidth(text$)
Protected text_height=TextHeight(text$)
StopDrawing()
ResizeImage(image_ID, text_width, text_height*1.2)
StartDrawing(ImageOutput(image_ID))
BackColor(background_color)
DrawingFont(FontID(font_ID))
DrawText(0, 0, text$, text_color)
StopDrawing()
ProcedureReturn image_ID
EndProcedure
Procedure ScrollTextImageSimple_BF(image_ID, step_width=1)
step_width*DesktopResolutionX()
If step_width<1 : step_width=1 : EndIf
Protected text_width=ImageWidth(image_ID)
Protected text_height=ImageHeight(image_ID)
If Not StartDrawing(ImageOutput(image_ID)) : ProcedureReturn 0 : EndIf
Protected temp_image_1_ID=GrabDrawingImage(#PB_Any, 0, 0, step_width, text_height)
If Not temp_image_1_ID : ProcedureReturn 0 : EndIf
Protected temp_image_2_ID=GrabDrawingImage(#PB_Any, step_width, 0, text_width-step_width, text_height)
If Not temp_image_2_ID : FreeImage(temp_image_1_ID) : ProcedureReturn 0 : EndIf
DrawImage(ImageID(temp_image_1_ID), text_width-step_width, 0)
DrawImage(ImageID(temp_image_2_ID), 0, 0)
StopDrawing()
FreeImage(temp_image_1_ID) : FreeImage(temp_image_2_ID)
ProcedureReturn image_ID
EndProcedure
EndModule
UseModule ScrollingTextSimple_BF
; ###### Get the result ######
CompilerIf #PB_Compiler_IsMainFile
EnableExplicit
Define font_ID=LoadFont(#PB_Any,"Tahoma", 24)
Define text$="Hello World, this is scrolling text BF - "
Define text_color=#Black
Define background_color=#Green
Define window_ID=OpenWindow(#PB_Any, 5 ,5 ,800 ,300 ,"Scrolling text" ,#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
SetWindowColor(window_ID, #Blue)
Global image_ID=CreateTextImageSimple_BF(text$, font_ID, text_color, background_color) ; Init
#CanvasOutput=#True ; Choose CanvasGadget for output or ButtonImagegadget
If #CanvasOutput
; Output on a CanvasGadget
Global gadget_ID=CanvasGadget(#PB_Any,
WindowWidth(window_ID)/2-ImageWidth(image_ID)/2/DesktopResolutionX()/1.5,
WindowHeight(window_ID)/3,
ImageWidth(image_ID)/DesktopResolutionX()/1.5,
ImageHeight(image_ID)/DesktopResolutionY(), #PB_Canvas_Border)
Else
; Output on a ButtonImageGadget
gadget_ID=ButtonImageGadget(#PB_Any,
WindowWidth(window_ID)/2-ImageWidth(image_ID)/2/DesktopResolutionX()/1.5,
WindowHeight(window_ID)/3,
ImageWidth(image_ID)/DesktopResolutionX()/1.5,
ImageHeight(image_ID)/DesktopResolutionY(), 0)
EndIf
Procedure DrawScrollingTextSimple()
SetGadgetAttribute(gadget_ID, #PB_Button_Image, ImageID(image_ID))
ScrollTextImageSimple_BF(image_ID, 1) ; 1 = Step width
ProcedureReturn 1
EndProcedure
#BindEventMethod=#False ; Try what you want - WinOS is here bitchy
If #BindEventMethod
; BindEvent method
AddWindowTimer(window_ID, 1, 10) ; Speed
BindEvent(#PB_Event_Timer, @DrawScrollingTextSimple())
Repeat
Define win_event=WaitWindowEvent()
Until win_event=#PB_Event_CloseWindow
Else
; Timer method
Define time
Repeat
Delay(1)
If ElapsedMilliseconds()>time
time=ElapsedMilliseconds()+10 ; Speed
DrawScrollingTextSimple()
EndIf
Repeat
Define win_event=WindowEvent()
If win_event=#PB_Event_CloseWindow
End
EndIf
Until Not win_event
ForEver
EndIf
CompilerEndIf