PureBasic Forums - English

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

Scroll text horizontally

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

Page 3 of 4

Re: Scroll text horizontally

Posted: Sat Apr 10, 2021 9:06 pm
by chi
mk-soft wrote:I still can't get a jerk-free output ...
Pretty smooth (on Windows) if you put WaitForVerticalBlank() after Delay(\Delay)...

Code: Select all

Procedure WaitForVerticalBlank()
  Static *ddraw.IDirectDraw
  If *ddraw = 0
    DirectDrawCreate_(0, @*ddraw, 0)
  EndIf
  *ddraw\WaitForVerticalBlank(1, 0)
EndProcedure
[/size]... or get rid of the Delay(\Delay) and call DwmFlush_() instead. If DWM is running it will sync to your monitor refresh rate without hogging the CPU. On Mac and Linux, I assume there is something similar.

Re: Scroll text horizontally

Posted: Sat Apr 10, 2021 9:48 pm
by DK_PETER
Here's another approach. It needs some spacing ('i') work.

Code: Select all



DeclareModule MessageScroll
  ;Create canvasgadget before using the module
  ;This was done in a jiffy but works..It continues to scroll when moving window.
  Declare.i SetDisplayObject(Canvas.i)
  Declare.i SetFont(Font.i)
  Declare.i SetBackColor(bColor.i = $0)
  Declare.i SetFontColor(fColor.i = -1) ;-1 = random color
  Declare.i AssignMessage(txt.s)
  Declare.i Begin()
  Declare.i Stop()
  Declare.i Pause()
  Declare.i Resume()
  Declare.i ScrollSpeed(milliseconds.i = 50)
EndDeclareModule

Module MessageScroll
  
  Structure Message
    i.i
    x.i
    y.i
    dir.i
  EndStructure
  Global NewList m.Message()
  
  Structure vars
    obj.i
    bc.i
    fc.i
    fo.i
    h.i
    max.i
    min.i
    bend.i
    tx.s
    w.i
    speed.i
    owidth.i
    oheight.i
  EndStructure
  Global v.vars 
  
  Global thr.i, canv.i, Pause.i = #False, KillIt.i = #False
  
  Declare.i Looper(var.i)
  Declare.i IsAllReady()
  
  Procedure.i SetDisplayObject(Canvas.i)
    v\obj = Canvas
    If IsGadget(v\obj) > 0 
      canv = #True 
      v\owidth = GadgetWidth(v\obj)
      v\oheight = GadgetHeight(v\obj)
    EndIf
  EndProcedure
  
  Procedure.i SetFont(Font.i)
    v\fo = Font
  EndProcedure
  
  Procedure.i SetBackColor(bColor.i = $0)
    v\bc = bColor
  EndProcedure
  
  Procedure.i SetFontColor(fColor.i = -1) ;-1 = random color
    v\fc = fColor
  EndProcedure
  
  Procedure.i AssignMessage(txt.s)
    Protected co.i
    Protected x.i, tim.i = CreateImage(#PB_Any, 10, 10) 
    If IsThread(thr) > 0 : killit = #True : EndIf
    Pause = #False
    v\tx = txt
    ClearList(m())
    StartDrawing(ImageOutput(tim))
    DrawingFont(FontID(v\fo))
    v\w = TextWidth("W") :  v\h = TextHeight("W")
    StopDrawing()
    v\bend = (v\w * Len(txt)) + v\w
    For x = 1 To Len(txt)
      AddElement(m())
      m()\i = CreateImage(#PB_Any, v\w, v\h)
      StartDrawing(ImageOutput(m()\i))
      DrawingMode(#PB_2DDrawing_Transparent)
      DrawingFont(FontID(v\fo))
      If v\fc = -1
        co = RGB(Random(255, 50), Random(255, 100), Random(255, 50))
        DrawText(m()\x, m()\y, Mid(txt, x, 1), co)
      Else
        DrawText(m()\x, m()\y, Mid(txt, x, 1), v\fc)
      EndIf
      StopDrawing()
      
      m()\x = v\owidth + (v\w * x)
      m()\y = v\oheight / 2 - v\h / 2
    Next x
  EndProcedure
  
  Procedure.i Begin() ;Begin the thread
    thr = CreateThread(@Looper(), #True)
  EndProcedure
  
  Procedure.i Stop() ;Kill the Thread
    KillIt = #True
  EndProcedure
  
  Procedure.i Looper(var.i)
    Protected ms.i = ElapsedMilliseconds()
    
    Repeat
      If Pause = #False
        If ElapsedMilliseconds() - ms >= v\speed
          If canv = #True
            StartDrawing(CanvasOutput(v\obj))
            Box(0, 0, OutputWidth(), OutputHeight(), $0)
            ForEach m()
              If m()\x - 1 < -v\w 
                If v\bend < OutputWidth()
                  m()\x = OutputWidth()
                Else
                  m()\x = v\bend
                EndIf
              Else
                m()\x - 1  
              EndIf
              DrawImage(ImageID(m()\i), m()\x, m()\y)
            Next 
            StopDrawing()
          EndIf
          ms = ElapsedMilliseconds()
        EndIf
      EndIf
    Until KillIt = #True
  EndProcedure
  
  Procedure.i Pause()
    Pause = #True
  EndProcedure
  
  Procedure.i Resume()
    Pause = #False
  EndProcedure
  
  Procedure.i ScrollSpeed(milliseconds.i = 50)
    v\speed = milliseconds
  EndProcedure 
  
  Procedure.i IsAllReady()
    If IsGadget(v\obj) = 0 And IsScreenActive() = 0
      ProcedureReturn #False  
    EndIf
    If v\speed <= 0
      ProcedureReturn #False
    EndIf
    If v\tx = ""
      ProcedureReturn #False
    EndIf
    If w <= 0 Or h <= 0
      ProcedureReturn #False
    EndIf
    If ListSize(m()) = 0
      ProcedureReturn #False
    EndIf
    If IsFont(v\fo) = 0
      ProcedureReturn #False
    EndIf
  EndProcedure
EndModule

Global breakit.i = #False

tex.s = "This is a small test. Each character is an image and can be moved as you wish on the x and y axis"

;Canvas
OpenWindow(0, 0, 0, 1024, 100, "Scroller", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
CanvasGadget(0, 0, 0, 1024, 95)

MessageScroll::SetFont(LoadFont(#PB_Any, "Arial", 20, #PB_Font_Bold|#PB_Font_Italic))
;MessageScroll::SetFontColor($28F7C8)
MessageScroll::SetFontColor()
MessageScroll::SetDisplayObject(0)
MessageScroll::SetBackColor($0)
MessageScroll::ScrollSpeed(2)
MessageScroll::AssignMessage(tex)
MessageScroll::Begin()


Repeat
  
  ev = WindowEvent()
  
Until ev = #PB_Event_CloseWindow
MessageScroll::Stop()
Delay(100)

Re: Scroll text horizontally

Posted: Sat Apr 10, 2021 10:40 pm
by RASHAD
Hi DK_PETER
Good but I will give it a second place after JHPJHP :)
Thanks for sharing

Re: Scroll text horizontally

Posted: Sat Apr 10, 2021 10:53 pm
by Saki
Code moved to T&T

viewtopic.php?f=12&t=77077&p=568673#p568673

Re: Scroll text horizontally

Posted: Sat Apr 10, 2021 11:29 pm
by mk-soft
@DK_PETER

On macOS not work. Drawing on CanvasGadget inside threads fails ...
Besides, your programme needs 100% processor power.

Re: Scroll text horizontally

Posted: Sun Apr 11, 2021 12:10 am
by JHPJHP
Hi netmaestro,

Thanks for the kudos. As is evident by this thread, there are numerous approaches to accomplishing the same task.
I agree, this is definitely not an OS thing; sometimes it's just about finding a tool that works.

Hi RASHAD,

I was just about to disagree with you. I thought the solution provided by DK_PETER was the most effective, but in light of the previous post by mk-soft I am still on the fence.

For additional examples see Windows Services & Other Stuff\Other_Stuff\GadgetStuff\WebGadget\MarqueeText...

Re: Scroll text horizontally

Posted: Sun Apr 11, 2021 12:17 am
by Saki
chi wrote:
mk-soft wrote:I still can't get a jerk-free output ...
Pretty smooth (on Windows) if you put WaitForVerticalBlank() after Delay(\Delay)...

Code: Select all

Procedure WaitForVerticalBlank()
  Static *ddraw.IDirectDraw
  If *ddraw = 0
    DirectDrawCreate_(0, @*ddraw, 0)
  EndIf
  *ddraw\WaitForVerticalBlank(1, 0)
EndProcedure
[/size]... or get rid of the Delay(\Delay) and call DwmFlush_() instead. If DWM is running it will sync to your monitor refresh rate without hogging the CPU. On Mac and Linux, I assume there is something similar.
Great, that completely solves the problem in my code even under DPI aware.
But the output must be on canvas.
On ButtonImageGadget there are massiv problems when you move the mouse over the gadget.
I have now added it to the top of my new code.

Re: Scroll text horizontally

Posted: Sun Apr 11, 2021 7:49 am
by RASHAD
My last 2 cents :)
Tested with PB 5.73 x86 - Windows 10 x64

# 1: Using Windows CallBack

Code: Select all

Global x
x = 0

Procedure WndProc(hwnd, uMsg, wParam, lParam)
  result = #PB_ProcessPureBasicEvents
  Select uMsg 
    Case #WM_TIMER
      x - 1
      If x = -380
        x = 380
      EndIf
      ResizeGadget(1,x,0,380,75)
      StartDrawing(CanvasOutput(1))
        DrawImage(ImageID(0),0,0)
      StopDrawing()            
   EndSelect
   
  ProcedureReturn result 
EndProcedure

OpenWindow(0, 0, 0, 400, 130, "Scroller", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
SmartWindowRefresh(0,1)
LoadFont(0, "Georgia"  ,  32)
ContainerGadget(0,10,10,380,75,#PB_Container_Flat)
SetGadgetColor(0,#PB_Gadget_BackColor,0)
  CanvasGadget(1,0,0,380,80)
CloseGadgetList()
DisableGadget(0,1)
text.s = " .... Scroll Text .... "

CreateImage(0,380,80,24,0)
StartDrawing(ImageOutput(0))
DrawingFont(FontID(0))
DrawingMode(#PB_2DDrawing_AlphaBlend | #PB_2DDrawing_Transparent )
pos = DrawText(0,6,".... ",$4DFE3A |$FF000000)
pos = DrawText(pos,6,"Scrolling ",$FE785D |$FF000000)
pos = DrawText(pos,6,"Text ",$5D80FE |$FF000000)
DrawText(pos,6,"....",$16E200 |$FF000000)
StopDrawing()

StartDrawing(CanvasOutput(1))
  DrawImage(ImageID(0),0,0)
StopDrawing()
ButtonGadget(2,10,98,40,24,"ON",#PB_Button_Toggle)

SetWindowCallback(@WndProc())
Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Quit = 1
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 2
          If GetGadgetState(2) = 1
            SetGadgetText(2,"OFF")
            SetTimer_(WindowID(0),125,10,0)
          Else
            SetGadgetText(2,"ON")
            KillTimer_(WindowID(0),125)
            x = 0
            ResizeGadget(1,x,0,380,75)
          EndIf          
      EndSelect
  EndSelect
Until Quit = 1
# 2: Using BindEvent

Code: Select all

Global x
x = 0

Procedure scrollTEXT()
  x - 1
  If x = -380
    x = 380
  EndIf
  ResizeGadget(1,x,0,380,75)
  StartDrawing(CanvasOutput(1))
  DrawImage(ImageID(0),0,0)
  StopDrawing()
EndProcedure

OpenWindow(0, 0, 0, 400, 130, "Scroller", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
SmartWindowRefresh(0,1)
LoadFont(0, "Georgia"  ,  32)
ContainerGadget(0,10,10,380,75,#PB_Container_Flat)
SetGadgetColor(0,#PB_Gadget_BackColor,0)
CanvasGadget(1,0,0,380,80)
CloseGadgetList()
DisableGadget(0,1)
text.s = " .... Scroll Text .... "

CreateImage(0,380,80,24,0)
StartDrawing(ImageOutput(0))
DrawingFont(FontID(0))
DrawingMode(#PB_2DDrawing_AlphaBlend | #PB_2DDrawing_Transparent )
pos = DrawText(0,6,".... ",$4DFE3A |$FF000000)
pos = DrawText(pos,6,"Scrolling ",$FE785D |$FF000000)
pos = DrawText(pos,6,"Text ",$5D80FE |$FF000000)
DrawText(pos,6,"....",$16E200 |$FF000000)
StopDrawing()

StartDrawing(CanvasOutput(1))
DrawImage(ImageID(0),0,0)
StopDrawing()
ButtonGadget(2,10,96,45,25,"ON",#PB_Button_Toggle)
Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Quit = 1
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 2
          If GetGadgetState(2) = 1
            SetGadgetText(2,"OFF")
            ;SetTimer_(WindowID(0),125,10,0)
            AddWindowTimer(0,125,10)
            BindEvent(#PB_Event_Timer,@scrollTEXT())
          Else
            SetGadgetText(2,"ON")
            ;KillTimer_(WindowID(0),125)
            RemoveWindowTimer(0,125)
            x = 0
            ResizeGadget(1,x,0,380,75)
            UnbindEvent(#PB_Event_Timer,@scrollTEXT())
          EndIf          
      EndSelect
  EndSelect
Until Quit = 1
# 3: Using Thread

Code: Select all

Global x,onflag

Procedure scrolltext(par)
  Repeat
    For t = 0 To 500
      x - 1
      If IsGadget(1)
        MoveWindow_(GadgetID(1),x,10,380,70,1)
      EndIf
    Next
    Delay(1000)
    For t = 0 To 550
      x - 1
      If IsGadget(1)
        MoveWindow_(GadgetID(1),x,10,380,70,1)
      EndIf
    Next
    Delay(1000)
    x = 700
  Until onflag = 0
EndProcedure

chk = 16
CreateImage(10, chk*2,chk*2)
StartDrawing(ImageOutput(10))
Box(0,0,chk,chk,$4BE0FE)
Box(chk,0,chk,chk,$CFFEE7)
Box(0,chk,chk,chk,$CFFEE7)
Box(chk,chk,chk,chk,$4BE0FE)
StopDrawing()
hBrush = CreatePatternBrush_(ImageID(10))

OpenWindow(0, 0, 0, 800, 130, "Scroller", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
SmartWindowRefresh(0,1)
LoadFont(0, "Georgia"  ,  32)
ContainerGadget(0,10,10,780,75,#PB_Container_Flat)
SetClassLongPtr_(GadgetID(0), #GCL_HBRBACKGROUND, hBrush)
ImageGadget(1,700,12,780,70,0)
CloseGadgetList()
DisableGadget(0,1)
text.s = " .... Scroll Text .... "
CreateImage(0,390,70,32,#PB_Image_Transparent)
StartDrawing(ImageOutput(0))
DrawingMode(#PB_2DDrawing_AlphaBlend | #PB_2DDrawing_Transparent)
DrawingFont(FontID(0))
color = ($E2E2E2|$FF000000)
DrawText(6,2,text,color)
color = ($000000|$FF000000)
DrawText(8,4,text,color)
color = ($959595|$FF000000)
DrawText(7,3,text,color) 
StopDrawing()
SetGadgetState(1,ImageID(0))

ButtonGadget(2,10,96,45,25,"ON",#PB_Button_Toggle)

x = 700
Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Quit = 1      
       
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 2
          If GetGadgetState(2) = 1
            onflag = 1
            SetGadgetText(2,"OFF")
            thread = CreateThread(@scrolltext(),30)
          Else
            SetGadgetText(2,"ON")
            onflag = 0          
          EndIf          
      EndSelect
  EndSelect
Until Quit = 1

Re: Scroll text horizontally

Posted: Sun Apr 11, 2021 10:47 am
by Saki
Hi @RASHAD
Try your code so - dear

Code: Select all

Global x, xx=8, xxx=10, onflag

Procedure scrolltext(par)
  Repeat
    t=0
    xx=8
    xxx=10
    Repeat
      Delay(10)
      xx-1
      x-xxx
      If xx<0
        xx=8
        xxx-1
      EndIf
      t+1
      If IsGadget(1)
        MoveWindow_(GadgetID(1),x,10,380,70,1)
      EndIf
    Until t>90
    Delay(1000)
    t=0
    xx=5
    xxx=0
    Repeat
      Delay(10)
      xx-1
      x+xxx
      If xx<0
        xx=8
        xxx-1
      EndIf
      t+1
      If IsGadget(1)
        MoveWindow_(GadgetID(1),x,10,380,70,1)
      EndIf
    Until t>75*2.5
    x=700
  Until onflag = 0
EndProcedure

chk = 16
CreateImage(10, chk*2,chk*2)
StartDrawing(ImageOutput(10))
Box(0,0,chk,chk,$4BE0FE)
Box(chk,0,chk,chk,$CFFEE7)
Box(0,chk,chk,chk,$CFFEE7)
Box(chk,chk,chk,chk,$4BE0FE)
StopDrawing()
hBrush = CreatePatternBrush_(ImageID(10))

OpenWindow(0, 0, 0, 800, 130, "Scroller", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
SmartWindowRefresh(0,1)
LoadFont(0, "Georgia"  ,  32)
ContainerGadget(0,10,10,780,75,#PB_Container_Flat)
SetClassLongPtr_(GadgetID(0), #GCL_HBRBACKGROUND, hBrush)
ImageGadget(1,700,12,780,70,0)
CloseGadgetList()
DisableGadget(0,1)
text.s = " .... Scroll Text .... "
CreateImage(0,390,70,32,#PB_Image_Transparent)
StartDrawing(ImageOutput(0))
DrawingMode(#PB_2DDrawing_AlphaBlend | #PB_2DDrawing_Transparent)
DrawingFont(FontID(0))
color = ($E2E2E2|$FF000000)
DrawText(6,2,text,color)
color = ($000000|$FF000000)
DrawText(8,4,text,color)
color = ($959595|$FF000000)
DrawText(7,3,text,color)
StopDrawing()
SetGadgetState(1,ImageID(0))

ButtonGadget(2,10,96,45,25,"ON",#PB_Button_Toggle)

x = 700
Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Quit = 1     
      
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 2
          If GetGadgetState(2) = 1
            onflag = 1
            SetGadgetText(2,"OFF")
            thread = CreateThread(@scrolltext(),30)
          Else
            SetGadgetText(2,"ON")
            onflag = 0         
          EndIf         
      EndSelect
  EndSelect
Until Quit = 1

Re: Scroll text horizontally

Posted: Sun Apr 11, 2021 11:05 am
by BarryG
Searching for "marquee" in these forums has these other scrolling text examples:

viewtopic.php?f=12&t=70658

viewtopic.php?f=12&t=70644

viewtopic.php?f=12&t=37943

viewtopic.php?t=22826

viewtopic.php?t=17693

Re: Scroll text horizontally

Posted: Sun Apr 11, 2021 4:39 pm
by JHPJHP
Hi RASHAD,

Just tested your last two cents; definitely worth more.
I think you deserve the top position, not only for functionality, but also keeping it concise.

In addition, a thank you should be given to chi for breaking through the nonsense with his contribution.

Code: Select all

Procedure WaitForVerticalBlank()
  Static *ddraw.IDirectDraw
  If *ddraw = 0
    DirectDrawCreate_(0, @*ddraw, 0)
  EndIf
  *ddraw\WaitForVerticalBlank(1, 0)
EndProcedure
Slightly modified RASHAD's code, added WaitForVerticalBlank() and increased the x-position from 1 to 10.
- tested above changes with his other contributions and the results were just as good

Code: Select all

Global x,onflag

Procedure WaitForVerticalBlank()
  Static *ddraw.IDirectDraw
  If *ddraw = 0
    DirectDrawCreate_(0, @*ddraw, 0)
  EndIf
  *ddraw\WaitForVerticalBlank(1, 0)
EndProcedure

Procedure scrolltext(par)
  Repeat
    For t = 0 To 50
      x - 10
      If IsGadget(1)
        MoveWindow_(GadgetID(1),x,10,380,70,1)
        WaitForVerticalBlank()
      EndIf
    Next
    Delay(1000)
    For t = 0 To 55
      x - 10
      If IsGadget(1)
        MoveWindow_(GadgetID(1),x,10,380,70,1)
        WaitForVerticalBlank()
      EndIf
    Next
    Delay(1000)
    x = 700
  Until onflag = 0
EndProcedure

chk = 16
CreateImage(10, chk*2,chk*2)
StartDrawing(ImageOutput(10))
Box(0,0,chk,chk,$4BE0FE)
Box(chk,0,chk,chk,$CFFEE7)
Box(0,chk,chk,chk,$CFFEE7)
Box(chk,chk,chk,chk,$4BE0FE)
StopDrawing()
hBrush = CreatePatternBrush_(ImageID(10))

OpenWindow(0, 0, 0, 800, 130, "Scroller", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
SmartWindowRefresh(0,1)
LoadFont(0, "Georgia"  ,  32)
ContainerGadget(0,10,10,780,75,#PB_Container_Flat)
SetClassLongPtr_(GadgetID(0), #GCL_HBRBACKGROUND, hBrush)
ImageGadget(1,700,12,780,70,0)
CloseGadgetList()
DisableGadget(0,1)
text.s = " .... Scroll Text .... "
CreateImage(0,390,70,32,#PB_Image_Transparent)
StartDrawing(ImageOutput(0))
DrawingMode(#PB_2DDrawing_AlphaBlend | #PB_2DDrawing_Transparent)
DrawingFont(FontID(0))
color = ($E2E2E2|$FF000000)
DrawText(6,2,text,color)
color = ($000000|$FF000000)
DrawText(8,4,text,color)
color = ($959595|$FF000000)
DrawText(7,3,text,color)
StopDrawing()
SetGadgetState(1,ImageID(0))

ButtonGadget(2,10,96,45,25,"ON",#PB_Button_Toggle)

x = 700
Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Quit = 1     
       
     
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 2
          If GetGadgetState(2) = 1
            onflag = 1
            SetGadgetText(2,"OFF")
            thread = CreateThread(@scrolltext(),30)
          Else
            SetGadgetText(2,"ON")
            onflag = 0         
          EndIf         
      EndSelect
  EndSelect
Until Quit = 1

Re: Scroll text horizontally

Posted: Sun Apr 11, 2021 5:37 pm
by RASHAD
Fantastic :)
Thanks JHPJHP and chi
I was trying to keep it away from Windows API but any how I am Windows user only :P
Thanks again JHPJHP
Be save

Re: Scroll text horizontally

Posted: Wed Apr 14, 2021 6:08 am
by collectordave
Hi All

Thanks for the replies.

If my thinking is correct:

1. Moving the text by 1 pixel at a time is the smoothest you are going to get.

2. You have to wait for the screen to be refreshed before moving another pixel.

i.e. if your code runs twice or more times between screen refreshes a jerk will be seen as the text moves more than one pixel.

3. The idea is then to run the code just once then wait for the screen to be refreshed before running again.

My macbook has a refresh rate of 60Hz so the screen is refreshed every 16 to 17 milliseconds. I increased my delay to 20 from 5 and it runs smoothly. Trying to get a balance between readability and scroll speed.

I imagine that the WaitForVerticalBlank() procedure detects when the screen is refreshed?

Is there an equivalent procedure for the MAC?

CD

Re: Scroll text horizontally

Posted: Wed Apr 14, 2021 1:54 pm
by kernadec
Hi,
Here for fun a little ripple on the code of DK_PETER
bestregard

Code: Select all

DeclareModule MessageScroll  ;Create canvasgadget before using the module
  ;This was done in a jiffy but works..It continues to scroll when moving window.
  Global number.l, Latitude.l, yy.l
  Declare.i SetDisplayObject(Canvas.i)
  Declare.i SetFont(Font.i)
  Declare.i SetBackColor(bColor.i = $0)
  Declare.i SetFontColor(fColor.i = -1) ;-1 = random color
  Declare.i AssignMessage(txt.s)
  Declare.i Begin()
  Declare.i Stop()
  Declare.i Pause()
  Declare.i Resume()
  Declare.i ScrollSpeed(milliseconds.i = 50)
EndDeclareModule

Module MessageScroll
 
  Structure Message
    i.i
    x.i
    y.i
    dir.i
  EndStructure
  Global NewList m.Message()
 
  Structure vars
    obj.i
    bc.i
    fc.i
    fo.i
    h.i
    max.i
    min.i
    bend.i
    tx.s
    w.i
    speed.i
    owidth.i
    oheight.i
  EndStructure
  Global v.vars
 
  Global thr.i, canv.i, Pause.i = #False, KillIt.i = #False
 
  Declare.i Looper(var.i)
  Declare.i IsAllReady()
 
  Procedure.i SetDisplayObject(Canvas.i)
    v\obj = Canvas
    If IsGadget(v\obj) > 0
      canv = #True
      v\owidth = GadgetWidth(v\obj)
      v\oheight = GadgetHeight(v\obj)
    EndIf
  EndProcedure
 
  Procedure.i SetFont(Font.i)
    v\fo = Font
  EndProcedure
 
  Procedure.i SetBackColor(bColor.i = $0)
    v\bc = bColor
  EndProcedure
 
  Procedure.i SetFontColor(fColor.i = -1) ;-1 = random color
    v\fc = fColor
  EndProcedure
 
  Procedure.i AssignMessage(txt.s)
    Protected co.i
    Protected x.i, tim.i = CreateImage(#PB_Any, 10, 10)
    If IsThread(thr) > 0 : killit = #True : EndIf
    Pause = #False
    v\tx = txt
    ClearList(m())
    StartDrawing(ImageOutput(tim))
    DrawingFont(FontID(v\fo))
    v\w = TextWidth("W") :  v\h = TextHeight("W")
    StopDrawing()
    v\bend = (v\w * Len(txt)) + v\w
    For x = 1 To Len(txt)
      AddElement(m())
      m()\i = CreateImage(#PB_Any, v\w, v\h)
      StartDrawing(ImageOutput(m()\i))
      DrawingMode(#PB_2DDrawing_Transparent)
      DrawingFont(FontID(v\fo))
      
      ; ############## sinusoide ######################
      Latitude = WindowHeight(0) / 5
      number = 100
      yy = Latitude * Sin(number * x / (WindowWidth(0) / (2 * #PI)))
      ; ###############################################

      If v\fc = -1
        co = RGB(Random(255, 50), Random(255, 100), Random(255, 50))
        DrawText(m()\x, m()\y, Mid(txt, x, 1), co)
      Else
        DrawText(m()\x, m()\y, Mid(txt, x, 1), v\fc)
      EndIf
      StopDrawing()
     
      m()\x = v\owidth + (v\w * x)
  
      m()\y = (v\oheight / 2 - v\h / 2) + yy ; sinusoide

      m()\y+zz
      
    Next x
  EndProcedure
 
  Procedure.i Begin() ;Begin the thread
    thr = CreateThread(@Looper(), #True)
  EndProcedure
 
  Procedure.i Stop() ;Kill the Thread
    KillIt = #True
  EndProcedure
 
  Procedure.i Looper(var.i)
    Protected ms.i = ElapsedMilliseconds()
   
    Repeat
      If Pause = #False
        If ElapsedMilliseconds() - ms >= v\speed
          If canv = #True
            StartDrawing(CanvasOutput(v\obj))
            Box(0, 0, OutputWidth(), OutputHeight(), $0)
            ForEach m()
              If m()\x - 1 < -v\w
                If v\bend < OutputWidth()
                  m()\x = OutputWidth()
                Else
                  m()\x = v\bend
                EndIf
              Else
                m()\x - 1 
              EndIf
              DrawImage(ImageID(m()\i), m()\x, m()\y)
            Next
            StopDrawing()
          EndIf
          ms = ElapsedMilliseconds()
        EndIf
      EndIf
    Until KillIt = #True
  EndProcedure
 
  Procedure.i Pause()
    Pause = #True
  EndProcedure
 
  Procedure.i Resume()
    Pause = #False
  EndProcedure
 
  Procedure.i ScrollSpeed(milliseconds.i = 50)
    v\speed = milliseconds
  EndProcedure
 
  Procedure.i IsAllReady()
    If IsGadget(v\obj) = 0 And IsScreenActive() = 0
      ProcedureReturn #False 
    EndIf
    If v\speed <= 0
      ProcedureReturn #False
    EndIf
    If v\tx = ""
      ProcedureReturn #False
    EndIf
    If w <= 0 Or h <= 0
      ProcedureReturn #False
    EndIf
    If ListSize(m()) = 0
      ProcedureReturn #False
    EndIf
    If IsFont(v\fo) = 0
      ProcedureReturn #False
    EndIf
  EndProcedure
EndModule

Global breakit.i = #False

tex.s = "This is a small test. Each character is an image and can be moved as you wish on the x and y axis"

;Canvas
OpenWindow(0, 0, 0, 1024, 100, "Scroller Sinusoide", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
CanvasGadget(0, 0, 0, 1024, 95)

MessageScroll::SetFont(LoadFont(#PB_Any, "Arial", 20, #PB_Font_Bold|#PB_Font_Italic))
;MessageScroll::SetFontColor($28F7C8)
MessageScroll::SetFontColor()
MessageScroll::SetDisplayObject(0)
MessageScroll::SetBackColor($0)
MessageScroll::ScrollSpeed(2)
MessageScroll::AssignMessage(tex)
MessageScroll::Begin()


Repeat
 
  ev = WindowEvent()
 
Until ev = #PB_Event_CloseWindow
MessageScroll::Stop()
Delay(100)

Re: Scroll text horizontally

Posted: Thu Apr 15, 2021 11:00 am
by fluent
This simple code produces a perfectly smooth scroll for me. (windows 10 x64)

Code: Select all

InitSprite()

W=940 : H=90

OpenWindow(0, 1, 1, W, H, "Ex07", #PB_Window_BorderLess | #PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0),0,0,W,H,1,0,0) 

x=W:t$="Buttery smooth & CPU friendly horizontal ticker. Long live PureBasic!"
LoadFont(1,"Consolas",44)

Repeat
  FlipBuffers()
  
  StartDrawing(ScreenOutput())
  Box(1,1,W-2,H-2,#Green)
  
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawingFont(FontID(1))
  DrawText(x,5,t$,0)
  a = 0-TextWidth(t$)
  StopDrawing()
  
  If x > a : x = x - 1 : Else : x = W : EndIf
  
  If WindowEvent() = #PB_Event_CloseWindow  : End : EndIf
Forever
All times are UTC+01:00
Page 3 of 4

Powered by phpBB® Forum Software © phpBB Limited