TIP: Click on subject to list as thread! ANSI
echo: power_bas
to: SANDER SMEENK
from: ROBERT FORTUNE
date: 1996-10-01 15:07:00
subject: Scroller

SS>Could someone help me creating a 'scroller'?
SS>Not a SmoothScroller, but a letter by letter scroller, from
SS>the right of my screen to the left.
   Sander,
   Is this what you mean?
' -------- CUT HERE -------------------------- CUT HERE --------------------
REM Tickertape message scrolling QB demo
DEFINT A-Z  ' All untyped variables default to type integer (%)
DECLARE SUB Pause (Ticks%)          ' pauses Ticks% milliseconds subprogram
DECLARE SUB Scroll (Row%, Column%, Message$)  ' scrolls Message$
COLOR 14, 0     ' use yellow text on black background
CLS             ' clear the screen
PRINT
PRINT "Press any key to stop this scrolling message."
Message$ = " SEND ME MONEY! CASH! "
Row% = 23                            ' put Message$ on line 23
Column% = 40 - LEN(Message$) \ 2     ' calc centered position for Message$
CALL Scroll(Row%, Column%, Message$) ' call Scroll Subprogram
LOCATE , , 1    ' turn the screen cursor back on
COLOR 7, 0      ' reset text color to drab white on black
PRINT
END             ' The End.
SUB Pause (Ticks%) STATIC
DEF SEG = &H40  ' BIOS data area
Start& = PEEK(&H6C) + PEEK(&H6D) * 256& + PEEK(&H6E) * 65536
DO
  Current& = PEEK(&H6C) + PEEK(&H6D) * 256& + PEEK(&H6E) * 65536
LOOP UNTIL (Current& - Start&) >= Ticks%
DEF SEG          ' reset to default QB DGroup Data segment
END SUB
SUB Scroll (Row%, Column%, Message$)
COLOR 14, 4  ' make message yellow (text) on red (background)
Ticks% = 2   ' numer of system timer ticks to pause (18.2 per sec)
LOCATE , , 0 ' turn off the cursor
DO
  J% = 1
  FOR I% = LEN(Message$) TO 1 STEP -1
      Text$ = RIGHT$(Message$, LEN(Message$) - J%) + LEFT$(Message$, J%)
      LOCATE Row%, Column%
      PRINT Text$;
      J% = J% + 1
      Pause (Ticks%)
  NEXT I%
  Userkey$ = INKEY$
LOOP UNTIL LEN(Userkey$) ' loop till user presses a key
END SUB
' -------- CUT HERE -------------------------- CUT HERE --------------------
___
 X OLX 2.1 TD X I'll tell ya about heartache and the loss of God.
--- Maximus/2 3.01
---------------
* Origin: * BlueDog BBS * (212) 594-4425 * NYC FileBone Hub (1:278/304)

SOURCE: echomail via exec-pc

Email questions or comments to sysop@ipingthereforeiam.com
All parts of this website painstakingly hand-crafted in the U.S.A.!
IPTIA BBS/MUD/Terminal/Game Server List, © 2025 IPTIA Consulting™.