Scroll text horizontally

Just starting out? Need help? Post your questions and find answers here.
User avatar
chi
Addict
Addict
Posts: 1028
Joined: Sat May 05, 2007 5:31 pm
Location: Linz, Austria

Re: Scroll text horizontally

Post 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.
Et cetera is my worst enemy
User avatar
DK_PETER
Addict
Addict
Posts: 898
Joined: Sat Feb 19, 2011 10:06 am
Location: Denmark
Contact:

Re: Scroll text horizontally

Post 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)

Current configurations:
Ubuntu 20.04/64 bit - Window 10 64 bit
Intel 6800K, GeForce Gtx 1060, 32 gb ram.
Amd Ryzen 9 5950X, GeForce 3070, 128 gb ram.
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Re: Scroll text horizontally

Post by RASHAD »

Hi DK_PETER
Good but I will give it a second place after JHPJHP :)
Thanks for sharing
Egypt my love
User avatar
Saki
Addict
Addict
Posts: 830
Joined: Sun Apr 05, 2020 11:28 am
Location: Pandora

Re: Scroll text horizontally

Post by Saki »

Last edited by Saki on Tue Apr 13, 2021 11:30 pm, edited 15 times in total.
地球上の平和
User avatar
mk-soft
Always Here
Always Here
Posts: 5335
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Scroll text horizontally

Post by mk-soft »

@DK_PETER

On macOS not work. Drawing on CanvasGadget inside threads fails ...
Besides, your programme needs 100% processor power.
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
JHPJHP
Addict
Addict
Posts: 2129
Joined: Sat Oct 09, 2010 3:47 am
Contact:

Re: Scroll text horizontally

Post 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...
Last edited by JHPJHP on Sun Apr 18, 2021 5:45 am, edited 4 times in total.
User avatar
Saki
Addict
Addict
Posts: 830
Joined: Sun Apr 05, 2020 11:28 am
Location: Pandora

Re: Scroll text horizontally

Post 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.
地球上の平和
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Re: Scroll text horizontally

Post 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
Egypt my love
User avatar
Saki
Addict
Addict
Posts: 830
Joined: Sun Apr 05, 2020 11:28 am
Location: Pandora

Re: Scroll text horizontally

Post 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
地球上の平和
BarryG
Addict
Addict
Posts: 3292
Joined: Thu Apr 18, 2019 8:17 am

Re: Scroll text horizontally

Post 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
JHPJHP
Addict
Addict
Posts: 2129
Joined: Sat Oct 09, 2010 3:47 am
Contact:

Re: Scroll text horizontally

Post 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
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Re: Scroll text horizontally

Post 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
Egypt my love
collectordave
Addict
Addict
Posts: 1309
Joined: Fri Aug 28, 2015 6:10 pm
Location: Portugal

Re: Scroll text horizontally

Post 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
Any intelligent fool can make things bigger and more complex. It takes a touch of genius — and a lot of courage to move in the opposite direction.
User avatar
kernadec
Enthusiast
Enthusiast
Posts: 146
Joined: Tue Jan 05, 2010 10:35 am

Re: Scroll text horizontally

Post 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)
fluent
User
User
Posts: 68
Joined: Sun Jan 24, 2021 10:57 am

Re: Scroll text horizontally

Post 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
Post Reply