Following Moneo's advice, I put the timer delay into a sub to save repeating the same block of code.
That done, I simplified the formula for determining the speed and expanded the range from 3 to 9, also eliminating one of the variables in the Message sub.
The scrolling speed going up or down is a lot faster than that going across, so I added a parameter to the Delay sub to slow down the speed slightly for up/down direction, and just slightly less for diagonal. The argument for calling Delay in each instance was determined accordingly. Because I had used a sub for the delay, this was a lot less error-prone, since I was able to experiment with different values in just one place.
I also DIMed several variables that I had overlooked in the Message sub. Corrected bug in the four diagonal scroll patterns so they now work correctly to replace the random or text background. Since that now resulted in a lot of duplicate code, I created a new sub, PrintRow, with a parameter for the row. Eliminated code that changed row or column numbers in all but the straight across or down patterns to avoid out-of-subscript errors.
===============================================
DECLARE SUB PrintRow (save AS INTEGER)
DECLARE SUB Delay (direct AS INTEGER)
DECLARE SUB TitleScreen (begin AS STRING)
DECLARE SUB Circuit ()
DECLARE SUB TextFile (a AS INTEGER)
DECLARE SUB BottomUp ()
DECLARE SUB TopDown ()
DECLARE SUB Across ()
DECLARE SUB Appear ()
DECLARE SUB Message ()
DECLARE SUB Background ()
DECLARE SUB Edges ()
DECLARE SUB Diagonal ()
DECLARE SUB DiagUp ()
DECLARE SUB Spiral ()
DECLARE SUB FigureAc ()
DECLARE SUB FigureDi ()
DIM choice AS STRING, x AS INTEGER
DIM SHARED N AS INTEGER, row AS INTEGER, col AS INTEGER
DIM SHARED bad AS INTEGER, speed AS SINGLE, keep AS STRING
DIM SHARED msg AS STRING, char AS STRING, charow AS STRING
DIM SHARED charand(3 TO 22) AS STRING
row = 10
col = 10
keep$ = "OFF"
msg$ = "NEWS FLASH! STORM WARNING!"
N = LEN(msg$)
char$ = " "
speed = .1
CALL TitleScreen("start")
DO
CLS : PRINT TAB(8); "Watch message scroll across screen in various formations"
PRINT : PRINT " 1 = Text scrolls back and forth across screen"
PRINT " 2 = Text scrolls to right edge and wraps to left edge of screen"
PRINT " 3 = Text appears at left and disappears at right"
PRINT " 4 = Text scrolls from top to bottom continuously"
PRINT " 5 = Text scrolls from top to bottom and back up"
PRINT " 6 = Text scrolls diagonally top left to bottom right"
PRINT " 7 = Text scrolls diagonally down and back up"
PRINT " 8 = Text scrolls in figure 8 diagonally then across"
PRINT " 9 = Text scrolls in figure 8 across then diagonally"
PRINT " A = Text circles across, down, back, and up"
PRINT " B = Text spirals in large to small circles"
PRINT
PRINT " C = Change options - message, location, speed, preserve"
PRINT " D = Change background - characters, random, text file"
PRINT " E = Quit (or Esc)"
PRINT
IF char$ = "?" OR char$ = "!" THEN
charow$ = charand$(row)
ELSE
charow$ = STRING$(80, char$)
END IF
PRINT charow$
PRINT : PRINT , "Select 1 - 9, A - E, or Esc to quit: "
choice$ = UCASE$(INPUT$(1))
IF choice$ <> "C" THEN
CLS
FOR x = 3 TO 22
LOCATE x
IF char$ = "?" OR char$ = "!" THEN
PRINT charand$(x)
ELSE
PRINT charow$
END IF
NEXT x
END IF
LOCATE 1, 1
SELECT CASE UCASE$(choice$)
CASE "1"
CALL Across
CASE "2"
CALL Edges
CASE "3"
CALL Appear
CASE "4"
CALL TopDown
CASE "5"
CALL BottomUp
CASE "6"
CALL Diagonal
CASE "7"
CALL DiagUp
CASE "8"
CALL FigureDi
CASE "9"
CALL FigureAc
CASE "A"
CALL Circuit
CASE "B"
CALL Spiral
CASE "C"
CALL Message
CASE "D"
CALL Background
CASE "E", CHR$(27)
CLS
EXIT DO
END SELECT
LOOP
CALL TitleScreen("stop")
CLS
END
nofile:
bad = 1
RESUME NEXT
SUB Across
DIM edge AS INTEGER, x AS INTEGER, t AS SINGLE
edge = 81 - N
PRINT , "Text scrolls back and forth across screen"
LOCATE 24
PRINT , , "Press any key to stop";
DO
FOR x = 1 TO edge
COLOR 14
LOCATE row, x 'moves across screen
PRINT msg$
CALL Delay(0)
COLOR 7
LOCATE row, 1
PRINT charow$
IF INKEY$ <> "" THEN EXIT DO
NEXT x
FOR x = edge TO 1 STEP -1
COLOR 14
LOCATE row, x 'moves back across screen
PRINT msg$
CALL Delay(0)
COLOR 7
LOCATE row, 1
PRINT charow$
IF INKEY$ <> "" THEN EXIT DO
NEXT x
LOOP
IF keep$ = "OFF" THEN col = x
COLOR 7
END SUB
SUB Appear
DIM x AS INTEGER, t AS SINGLE
PRINT , "Text appears at left and disappears at right"
LOCATE 24
PRINT , , "Press any key to stop";
DO
FOR x = 1 TO 80 + N - 1
IF x <= N THEN 'appear at left edge
COLOR 14
LOCATE row, 1
PRINT MID$(msg$, N - x + 1)
ELSEIF x >= 80 - N THEN 'disappear at right edge
COLOR 14
LOCATE row, x - N + 1
PRINT LEFT$(msg$, 80 - (x - N))
ELSEIF x > N THEN
COLOR 14
LOCATE row, x - N + 1
PRINT msg$
END IF
CALL Delay(0)
IF x >= N OR x >= 80 - N THEN
COLOR 7
LOCATE row, 1
PRINT charow$
END IF
IF INKEY$ <> "" THEN EXIT DO
NEXT x
LOOP
IF keep$ = "OFF" AND x < 80 - N THEN col = x
COLOR 7
END SUB
SUB Background
DIM choice AS STRING, ch AS STRING, oldchar AS STRING, charsel AS STRING
DIM x AS INTEGER, y AS INTEGER, a AS INTEGER, chloc AS INTEGER
STATIC randnum AS INTEGER
randnum = randnum + 1
DO
a = 0
CLS : PRINT , "Select background character"
COLOR 8: PRINT TAB(8); "Press any key to return to the main menu without changing selection.": COLOR 7
PRINT " 0 = Blank"
PRINT " 1 = *"
PRINT " 2 = -"
PRINT " 3 = ."
PRINT " 4 = :"
PRINT " 5 = ="
PRINT " 6 = "; CHR$(176)
PRINT " 7 = Random"
PRINT " 8 = External text file"
charsel$ = " *-.:=" + CHR$(176) + "?!"
chloc = INSTR(charsel$, char$)
LOCATE chloc + 2, 1: PRINT CHR$(26) 'points to current selection
LOCATE 13, 1
PRINT "Note: Random background stays the same until 7 is selected again."
choice$ = INPUT$(1)
SELECT CASE choice$
CASE "0": char$ = " "
CASE "1": char$ = "*"
CASE "2": char$ = "-"
CASE "3": char$ = "."
CASE "4": char$ = ":"
CASE "5": char$ = "="
CASE "6": char$ = CHR$(176)
CASE "7": char$ = "?"
RANDOMIZE randnum
FOR x = 3 TO 22
charand$(x) = ""
FOR y = 1 TO 80
ch$ = CHR$(INT(RND * 95) + 32)
charand$(x) = charand$(x) + ch$
NEXT y
NEXT x
CASE "8"
oldchar$ = char$
char$ = "!"
LOCATE 2, 1: PRINT SPACE$(80)
LOCATE 2, 15: COLOR 8
PRINT "Press Enter to return to this menu.": COLOR 7
LOCATE 12, 1
CALL TextFile(a)
IF a = 1 THEN char$ = oldchar$
END SELECT
LOOP WHILE a = 1
END SUB
SUB BottomUp
DIM x AS INTEGER, t AS SINGLE
PRINT , "Text scrolls from top to bottom then back up"
LOCATE 24
PRINT , , "Press any key to stop";
DO
FOR x = 3 TO 22
COLOR 14
LOCATE x, col 'moves down screen
PRINT msg$
CALL Delay(1)
COLOR 7
LOCATE x, 1
CALL PrintRow(x)
IF INKEY$ <> "" THEN EXIT DO
NEXT x
FOR x = 22 TO 3 STEP -1
COLOR 14
LOCATE x, col 'moves up screen
PRINT msg$
CALL Delay(1)
COLOR 7
LOCATE x, 1
CALL PrintRow(x)
IF INKEY$ <> "" THEN EXIT DO
NEXT x
LOOP
IF keep$ = "OFF" THEN row = x
COLOR 7
END SUB
SUB Circuit
DIM edge AS INTEGER, x AS INTEGER, y AS INTEGER, t AS SINGLE, cir AS STRING
PRINT TAB(6); "Type 1, 2, 3, 4, or 5 (large to small) to select size of circuit:"
cir$ = INPUT$(1)
IF cir$ < "1" OR cir$ > "5" THEN cir$ = "3"
LOCATE 1, 1:
PRINT , "Text circles across, down, back, and up"; SPACE$(81 - POS(0))
DO
DO
SELECT CASE cir$
CASE "1"
top = 3: bot = 22: marg = 1: edge = 81 - N
CASE "2"
top = 5: bot = 20: marg = 6: edge = 76 - N
CASE "3"
top = 7: bot = 18: marg = 11: edge = 71 - N
CASE "4"
top = 9: bot = 16: marg = 16: edge = 66 - N
CASE "5"
top = 11: bot = 14: marg = 21: edge = 61 - N
END SELECT
LOCATE 24
PRINT TAB(10); "Press 1-5 to change size of circuit, any other key to stop";
IF char$ = "?" OR char$ = "!" THEN charow$ = charand$(top)
FOR x = marg TO edge
COLOR 14
LOCATE top, x 'moves across screen
PRINT msg$
CALL Delay(0)
COLOR 7
LOCATE top, 1
PRINT charow$
cir$ = INKEY$
IF cir$ <> "" THEN EXIT DO
NEXT x
FOR y = top TO bot
IF char$ = "?" OR char$ = "!" THEN charow$ = charand$(y)
COLOR 14
LOCATE y, edge 'moves down screen
PRINT msg$
CALL Delay(1)
COLOR 7
LOCATE y, 1
PRINT charow$
cir$ = INKEY$
IF cir$ <> "" THEN EXIT DO
NEXT y
IF char$ = "?" OR char$ = "!" THEN charow$ = charand$(bot)
FOR x = edge TO marg STEP -1
COLOR 14
LOCATE bot, x 'moves back
PRINT msg$
CALL Delay(0)
COLOR 7
LOCATE bot, 1
PRINT charow$
cir$ = INKEY$
IF cir$ <> "" THEN EXIT DO
NEXT x
FOR y = bot TO top STEP -1
IF char$ = "?" OR char$ = "!" THEN charow$ = charand$(y)
COLOR 14
LOCATE y, marg 'moves up
PRINT msg$
CALL Delay(1)
COLOR 7
LOCATE y, 1
PRINT charow$
cir$ = INKEY$
IF cir$ <> "" THEN EXIT DO
NEXT y
LOOP
LOOP UNTIL cir$ < "1" OR cir$ > "5"
COLOR 7
END SUB
SUB Delay (sp AS INTEGER)
DIM s AS SINGLE
IF sp = 1 THEN s = .05 'up/down
IF sp = 2 THEN s = .03 'diagonal
t = TIMER
DO WHILE t + speed + s >= TIMER 'delay part of a second
IF t > TIMER THEN t = t - 86400
LOOP
END SUB
SUB Diagonal
DIM edge AS INTEGER, x AS INTEGER, y AS INTEGER, gap AS INTEGER, t AS SINGLE
edge = 81 - N
gap = edge \ 17
PRINT , "Text scrolls diagonally from top left to bottom right"
LOCATE 24
PRINT , , "Press any key to stop";
DO
y = 0
FOR x = 4 TO 21
y = y + gap
COLOR 14
LOCATE x, y 'moves across & down screen
PRINT msg$;
CALL Delay(2)
COLOR 7
LOCATE x, 1
CALL PrintRow(x)
IF INKEY$ <> "" THEN EXIT DO
NEXT x
LOOP
COLOR 7
END SUB
SUB DiagUp
DIM edge AS INTEGER, x AS INTEGER, y AS INTEGER, gap AS INTEGER, t AS SINGLE
edge = 81 - N
gap = edge \ 17
PRINT , "Text scrolls diagonally down and then back up"
LOCATE 24
PRINT , , "Press any key to stop";
DO
y = 1
FOR x = 4 TO 21
y = y + gap
COLOR 14
LOCATE x, y 'moves across & down screen
PRINT msg$;
CALL Delay(2)
COLOR 7
LOCATE x, 1
CALL PrintRow(x)
IF INKEY$ <> "" THEN EXIT DO
NEXT x
FOR x = 21 TO 4 STEP -1
y = y - gap
COLOR 14
LOCATE x, y 'moves back & up screen
PRINT msg$;
CALL Delay(2)
COLOR 7
LOCATE x, 1
CALL PrintRow(x)
IF INKEY$ <> "" THEN EXIT DO
NEXT x
LOOP
COLOR 7
END SUB
SUB Edges
DIM edge AS INTEGER, x AS INTEGER, y AS INTEGER, t AS SINGLE
edge = 82 - N
PRINT , "Text scrolls to right edge and wraps to left edge of screen"
LOCATE 24
PRINT , , "Press any key to stop";
x = 0: y = 0
DO
x = x + 1
IF x = 81 THEN x = 1: y = 0
IF x >= edge AND x < 81 THEN
y = y + 1
COLOR 14
LOCATE row, x 'message splits in two when edge is reached
PRINT LEFT$(msg$, N - y)
LOCATE row, 1
PRINT MID$(msg$, 81 - x)
CALL Delay(0)
COLOR 7
LOCATE row, 1
PRINT charow$
ELSE
COLOR 14
LOCATE row, x 'entire message moves across screen
PRINT msg$
CALL Delay(0)
COLOR 7
LOCATE row, 1
PRINT charow$
END IF
LOOP WHILE INKEY$ = ""
IF keep$ = "OFF" AND x < 80 - N THEN col = x
COLOR 7
END SUB
SUB FigureAc
DIM edge AS INTEGER, x AS INTEGER, y AS INTEGER, gap AS INTEGER, t AS SINGLE
edge = 81 - N
gap = edge \ 17
PRINT , "Text scrolls in figure 8 across then diagonally"
LOCATE 24
PRINT , , "Press any key to stop";
DO
FOR y = 3 TO edge - 1
COLOR 14
LOCATE 4, y 'moves across screen
PRINT msg$
CALL Delay(0)
COLOR 7
LOCATE 4, 1
CALL PrintRow(4)
IF INKEY$ <> "" THEN EXIT DO
NEXT y
y = y + 1
FOR x = 4 TO 21
y = y - gap
COLOR 14
LOCATE x, y 'moves back & down screen
PRINT msg$;
CALL Delay(2)
COLOR 7
LOCATE x, 1
CALL PrintRow(x)
IF INKEY$ <> "" THEN EXIT DO
NEXT x
FOR y = 3 TO edge - 1
COLOR 14
LOCATE 21, y 'moves across screen
PRINT msg$
CALL Delay(0)
COLOR 7
LOCATE 21, 1
CALL PrintRow(21)
IF INKEY$ <> "" THEN EXIT DO
NEXT y
y = y + 1
FOR x = 21 TO 4 STEP -1
y = y - gap
COLOR 14
LOCATE x, y 'moves back & up screen
PRINT msg$;
CALL Delay(2)
COLOR 7
LOCATE x, 1
CALL PrintRow(x)
IF INKEY$ <> "" THEN EXIT DO
NEXT x
LOOP
COLOR 7
END SUB
SUB FigureDi
DIM edge AS INTEGER, x AS INTEGER, y AS INTEGER, gap AS INTEGER, t AS SINGLE
edge = 81 - N
gap = edge \ 17
PRINT , "Text scrolls in figure 8 diagonally then across"
LOCATE 24
PRINT , , "Press any key to stop";
DO
y = 0
FOR x = 4 TO 21
y = y + gap
COLOR 14
LOCATE x, y 'moves across & down screen
PRINT msg$;
CALL Delay(2)
COLOR 7
LOCATE x, 1
CALL PrintRow(x)
IF INKEY$ <> "" THEN EXIT DO
NEXT x
FOR y = edge - 1 TO 3 STEP -1
COLOR 14
LOCATE 21, y 'moves back across screen
PRINT msg$
CALL Delay(0)
COLOR 7
LOCATE 21, 1
CALL PrintRow(21)
IF INKEY$ <> "" THEN EXIT DO
NEXT y
y = y - 1
FOR x = 21 TO 4 STEP -1
y = y + gap
COLOR 14
LOCATE x, y 'moves up & across screen
PRINT msg$;
CALL Delay(2)
COLOR 7
LOCATE x, 1
CALL PrintRow(x)
IF INKEY$ <> "" THEN EXIT DO
NEXT x
FOR y = edge - 1 TO 3 STEP -1
COLOR 14
LOCATE 4, y 'moves back across screen
PRINT msg$
CALL Delay(0)
COLOR 7
LOCATE 4, 1
CALL PrintRow(4)
IF INKEY$ <> "" THEN EXIT DO
NEXT y
LOOP
COLOR 7
END SUB
SUB Message
DIM snum AS STRING, note1 AS STRING, note2 AS STRING, newmsg AS STRING
DIM colen AS INTEGER, r AS INTEGER, c AS INTEGER, E AS STRING
DO
CLS : LOCATE 14, 1
PRINT STRING$(80, CHR$(196))
PRINT "Option"; TAB(11); "Current Values"; TAB(53); "Default Values"
PRINT "------"; TAB(11); "--------------"; TAB(53); "--------------"
PRINT "Message:"; TAB(11); msg$; TAB(53); "NEWS FLASH! STORM WARNING!"
PRINT "Row:"; TAB(10); row; TAB(53); "10"
PRINT "Column:"; TAB(10); col; TAB(53); "10"
PRINT "Speed:"; TAB(10); speed * 20; TAB(53); "2"
PRINT "Preserve:"; TAB(11); keep; TAB(53); "OFF"
PRINT
PRINT "Note: With Preserve OFF, row and column values will change to new current"
PRINT "location when scrolling is stopped.";
VIEW PRINT 1 TO 12
CLS : PRINT , "Select Option to Change"
PRINT : PRINT " 1 = Enter new message"
PRINT " 2 = Starting row location"
PRINT " 3 = Starting column location"
PRINT " 4 = Speed"
PRINT " 5 = Preserve selected values"
PRINT " 0 = Return to main menu (Enter or Esc)"
choice$ = INPUT$(1)
CLS
note1$ = " Press Enter alone to keep current value, type 0 to restore the default,"
note2$ = " or enter a new value. Incorrect entry will restore the current value."
SELECT CASE choice$
CASE "1"
PRINT , , "Enter Message"
PRINT : PRINT note1$
PRINT note2$
PRINT : PRINT "Enter message (between 5 - 40 characters):"
PRINT TAB(5); ">"; TAB(46); "< STOP"
COLOR 8: PRINT TAB(6); STRING$(5, CHR$(34)): COLOR 7
LOCATE 7, 6
COLOR 14
LINE INPUT newmsg$
COLOR 7
N = LEN(newmsg$)
IF newmsg$ = "0" THEN
msg$ = "NEWS FLASH! STORM WARNING!"
ELSEIF N > 40 THEN
msg$ = LEFT$(newmsg$, 40)
ELSEIF N > 5 THEN
msg$ = newmsg$
END IF
N = LEN(msg$)
colen = 81 - N
LOCATE 7, 6
COLOR 14: PRINT msg$;
COLOR 7: PRINT TAB(46); "< STOP"; SPACE$(81 - POS(0))
PRINT SPACE$(240)
LOCATE CSRLIN - 1
PRINT "Press any key to continue..."
E$ = INPUT$(1)
CASE "2"
PRINT , , "Enter Row"
PRINT : PRINT note1$
PRINT note2$
PRINT
PRINT "Enter row (3 to 22) to locate message for scolling Across: ";
r = CSRLIN: c = POS(0)
LINE INPUT "", snum$
LOCATE r + 1, 1: PRINT SPACE$(240)
IF VAL(snum$) > 0 AND VAL(snum$) < 23 THEN
row = VAL(snum$)
ELSEIF snum$ = "0" THEN
row = 10
END IF
LOCATE r, c: PRINT row; SPACE$(81 - POS(0))
PRINT
PRINT "Note that if Preserve is OFF, then TopDown scroll changes current row to"
PRINT "located row when stopped."
PRINT : PRINT "Press any key to continue..."
E$ = INPUT$(1)
CASE "3"
colen = 81 - N
PRINT , , "Enter Column"
PRINT : PRINT note1$
PRINT note2$
PRINT : PRINT "Enter column (1 to"; STR$(colen); ") to locate message ";
PRINT "for scrolling TopDown: ";
r = CSRLIN: c = POS(0)
LINE INPUT "", snum$
LOCATE r + 1, 1: PRINT SPACE$(240)
IF VAL(snum$) > 0 AND VAL(snum$) <= colen THEN
col = VAL(snum$)
ELSEIF snum$ = "0" THEN
col = 10
END IF
LOCATE r, c: PRINT col; SPACE$(81 - POS(0))
PRINT
PRINT "Note that if Preserve is OFF, then Across scroll changes current column to"
PRINT "located column when stopped."
PRINT : PRINT "Press any key to continue..."
E$ = INPUT$(1)
CASE "4"
PRINT , , "Enter Speed"
PRINT : PRINT note1$
PRINT note2$
PRINT : PRINT ; "Enter speed between 1 - 9 (fast to slow): ";
snum$ = INPUT$(1)
IF snum$ = "0" THEN
speed = .1
ELSEIF VAL(snum$) > 0 THEN
speed = VAL(snum$) / 20
END IF
LOCATE CSRLIN, POS(0) - 1
PRINT speed * 20; " "
PRINT : PRINT "Press any key to continue..."
E$ = INPUT$(1)
CASE "5"
PRINT , , "Enter Preserve"
PRINT : PRINT note1$
PRINT note2$
PRINT
PRINT "Row and column values will change to current location when scrolling is stopped."
PRINT : PRINT "Enter 1 to preserve selected row and column values, 0 to allow changes: ";
snum$ = INPUT$(1)
IF snum$ = "0" THEN
keep$ = "OFF"
ELSEIF snum$ = "1" THEN
keep$ = "ON"
END IF
LOCATE CSRLIN, POS(0)
PRINT keep$; " "
PRINT : PRINT "Press any key to continue..."
E$ = INPUT$(1)
END SELECT
VIEW PRINT
LOOP UNTIL choice$ = "0" OR choice$ = CHR$(27) OR choice$ = CHR$(13)
END SUB
SUB PrintRow (save AS INTEGER)
IF char$ = "?" OR char$ = "!" THEN
PRINT charand$(save)
ELSE
PRINT charow$
END IF
END SUB
SUB Spiral
DIM x AS INTEGER, y AS INTEGER, z AS INTEGER, w AS INTEGER
DIM start AS INTEGER, t AS SINGLE
PRINT , "Text spirals in large to small circles"
DIM top(1 TO 5) AS INTEGER
DIM bot(1 TO 5) AS INTEGER
DIM marg(1 TO 5) AS INTEGER
DIM edge(1 TO 5) AS INTEGER
top(1) = 3: bot(1) = 22: marg(1) = 1: edge(1) = 81 - N
top(2) = 5: bot(2) = 20: marg(2) = 6: edge(2) = 76 - N
top(3) = 7: bot(3) = 18: marg(3) = 11: edge(3) = 71 - N
top(4) = 9: bot(4) = 16: marg(4) = 16: edge(4) = 66 - N
top(5) = 11: bot(5) = 14: marg(5) = 21: edge(5) = 61 - N
LOCATE 24
PRINT , , "Press any key to stop";
start = 1
DO
FOR z = 1 TO 5
IF char$ = "?" OR char$ = "!" THEN charow$ = charand$(top(z))
FOR x = marg(z) TO edge(z)
COLOR 14
IF z = 1 AND start = 0 THEN
IF x + 21 >= 81 - N THEN EXIT FOR
LOCATE 3, 21 + x
ELSE
LOCATE top(z), x 'moves across screen
END IF
PRINT msg$
CALL Delay(0)
COLOR 7
LOCATE top(z), 1
PRINT charow$
IF INKEY$ <> "" THEN EXIT DO
NEXT x
start = 0
FOR y = top(z) TO bot(z)
IF char$ = "?" OR char$ = "!" THEN charow$ = charand$(y)
COLOR 14
LOCATE y, edge(z) 'moves down screen
PRINT msg$
CALL Delay(1)
COLOR 7
LOCATE y, 1
PRINT charow$
IF INKEY$ <> "" THEN EXIT DO
NEXT y
IF char$ = "?" OR char$ = "!" THEN charow$ = charand$(bot(z))
FOR x = edge(z) TO marg(z) STEP -1
COLOR 14
LOCATE bot(z), x 'moves back
PRINT msg$
CALL Delay(0)
DO WHILE t + speed >= TIMER 'delay part of a second
IF t > TIMER THEN t = t - 86400
LOOP
COLOR 7
LOCATE bot(z), 1
PRINT charow$
IF INKEY$ <> "" THEN EXIT DO
NEXT x
IF z = 5 THEN w = 1 ELSE w = z + 1
FOR y = bot(z) TO top(w) STEP -1
IF char$ = "?" OR char$ = "!" THEN charow$ = charand$(y)
COLOR 14
LOCATE y, marg(z) 'moves up
PRINT msg$
CALL Delay(1)
COLOR 7
LOCATE y, 1
PRINT charow$
IF INKEY$ <> "" THEN EXIT DO
NEXT y
NEXT z
LOOP
COLOR 7
END SUB
SUB TextFile (a AS INTEGER)
DIM x AS INTEGER, y AS INTEGER, beg AS INTEGER, E AS STRING
DIM filenom AS STRING, snum AS STRING, dataitem AS STRING, ch AS STRING
DO
bad = 0: a = 0
LOCATE 12, 1: PRINT SPACE$(240)
LOCATE 14, 1
PRINT TAB(5); "Enter filename with extension. You may also include complete path with"
PRINT TAB(5); "drive letter and subdirectories, or none to abort."
INPUT ; "> ", filenom$
IF filenom$ = "" THEN a = 1: EXIT SUB
ON ERROR GOTO nofile
OPEN filenom$ FOR INPUT AS #1
IF bad = 1 THEN
PRINT : PRINT TAB(5); "Wrong filename. Reenter with correct extension.";
SLEEP 2
LOCATE CSRLIN - 3, 1
PRINT SPACE$(320)
LOCATE CSRLIN - 5, 1
END IF
LOOP UNTIL bad = 0
CLS
INPUT "Enter 0 to fill screen with beginning of file, 1 for end of file: ", snum$
IF snum$ = "1" THEN beg = 1 ELSE beg = 0
VIEW PRINT 3 TO 22
DO WHILE NOT EOF(1)
INPUT #1, dataitem$
L = LEN(dataitem$)
IF beg = 0 AND CSRLIN = 22 THEN
PRINT LEFT$(dataitem$, 80);
EXIT DO
ELSE
PRINT dataitem$; " ";
END IF
LOOP
CLOSE #1
VIEW PRINT
LOCATE 23, 1: PRINT SPACE$(80);
FOR x = 3 TO 22
charand$(x) = ""
FOR y = 1 TO 80
ch$ = CHR$(SCREEN(x, y))
charand$(x) = charand$(x) + ch$
NEXT y
NEXT x
LOCATE 24, 1
PRINT , "Press any key to continue...";
E$ = INPUT$(1)
END SUB
SUB TitleScreen (begin AS STRING)
DIM title AS STRING, author AS STRING
DIM a AS INTEGER, b AS INTEGER, y AS INTEGER
title$ = "TEXT SCROLLER"
author$ = "By Solitaire"
a = 12: b = 34
CLS
LOCATE 24, 20: COLOR 8
PRINT "Press any key to "; begin$; "...", "(c) 6/2006";
COLOR 7
DO
FOR y = 10 TO 58
COLOR 14
LOCATE 8, y 'moves across
PRINT title$
COLOR 7
IF y MOD 6 = 0 THEN 'moves down
LOCATE a, b
PRINT SPACE$(12)
a = a + 1
LOCATE a, b
PRINT author$
END IF
CALL Delay(0)
LOCATE 8, y: PRINT SPACE$(13)
IF INKEY$ <> "" THEN EXIT DO
NEXT y
FOR y = 58 TO 10 STEP -1
COLOR 14
LOCATE 8, y 'moves back
PRINT title$
COLOR 7
IF y MOD 6 = 0 THEN 'moves up
LOCATE a, b
PRINT SPACE$(12)
a = a - 1
LOCATE a, b
PRINT author$
END IF
CALL Delay(0)
LOCATE 8, y: PRINT SPACE$(13)
IF INKEY$ <> "" THEN EXIT DO
NEXT y
LOOP
COLOR 7
END SUB
SUB TopDown
DIM x AS INTEGER, t AS SINGLE
PRINT , "Text scrolls from top to bottom continuously"
LOCATE 24
PRINT , , "Press any key to stop";
DO
FOR x = 3 TO 22
COLOR 14
LOCATE x, col 'moves down screen
PRINT msg$
CALL Delay(1)
COLOR 7
LOCATE x, 1
CALL PrintRow(x)
IF INKEY$ <> "" THEN EXIT DO
NEXT x
LOOP
IF keep$ = "OFF" THEN row = x
COLOR 7
END SUB
This message has been edited by Solitaire1 on Jun 17, 2006 6:00 PM
This message has been edited by Solitaire1 on Jun 17, 2006 3:54 PM
This message has been edited by Solitaire1 on Jun 17, 2006 3:51 PM
|
|