This is the same program I posted last year on the main forum, but this version is perpetual - will always display the current coming new year starting from September.
=========================================================================
DECLARE SUB ball (x AS INTEGER, y AS INTEGER, w AS INTEGER, tint() AS INTEGER)
DIM x AS INTEGER, y AS INTEGER, w AS INTEGER, t AS SINGLE, E AS STRING
DIM year AS STRING, month AS STRING, yr AS INTEGER, mo AS INTEGER
year$ = RIGHT$(DATE$, 4)
month$ = LEFT$(DATE$, 2)
yr = VAL(year$)
mo = VAL(month$)
IF mo >= 9 THEN yr = yr + 1
year$ = LTRIM$(RTRIM$(STR$(yr)))
CLS
DIM tint(0 TO 20) AS INTEGER
FOR x = 0 TO 20 'changing colors of ball as it drops
READ tint(x) 'assigned to array
NEXT x
COLOR , 6 'color of pole
FOR x = 1 TO 20
LOCATE x + 2, 38
PRINT " " 'space prints background color
NEXT x
x = 2
y = 10
w = 1
CALL ball(x, y, w, tint())
w = 0
COLOR 7, 0
LOCATE 23, 1: PRINT "Press any key to begin countdown ";
E$ = INPUT$(1)
LOCATE 23, 1: PRINT SPACE$(40)
s = 260
FOR x = 1 TO 20
SOUND s, 10 'sound heard while ball is dropping
s = s + 9
IF x MOD 2 = 0 THEN 'countdown from 10 to 1
y = y - 1
END IF
CALL ball(x, y, w, tint())
t = TIMER
DO WHILE t + .5 >= TIMER: LOOP
NEXT x
COLOR 30, 0
LOCATE 10, 10
PRINT "HAPPY NEW YEAR!"
LOCATE 10, 55
PRINT year$
LOCATE x, 38
COLOR , 3
PRINT CHR$(1) 'happy face replaces countdown number
LOCATE x + 1, 38
PRINT "*"
PLAY "mbmlO2T220" 'song - Auld Lang Syne
PLAY "ccfffeffaagggfgg"
PLAY "agffffaa>ccddddd"
PLAY "ddccc<aaaffgggfgg"
PLAY "agfffdddccfffff"
c = 16
FOR blink = 1 TO 120
c = c + 1
IF c = 32 THEN c = 17
COLOR c, 0
IF blink > 110 THEN COLOR 30 'messages blink and switch places
IF blink = 120 THEN COLOR 14
SELECT CASE blink
CASE 1 TO 16, 33 TO 48, 65 TO 80, IS > 97
LOCATE 10, 10
PRINT "HAPPY NEW YEAR!"
LOCATE 10, 55
PRINT year$; " "
CASE ELSE
LOCATE 10, 10
PRINT year$; " "
LOCATE 10, 55
PRINT "HAPPY NEW YEAR!"
END SELECT
LOCATE x, 38
COLOR , 3
PRINT CHR$(1)
row = INT(21 * RND) + 2 'confetti fills the sky
col = INT(75 * RND) + 3 '(always in same random locations)
tint = INT(15 * RND) + 1
confetti$ = CHR$(INT(6 * RND) + 1)
LOCATE row, col
COLOR tint, 0
IF blink > 105 THEN
confetti$ = "*" 'last confetti stars remain blinking
COLOR tint + 16, 0
END IF
PRINT confetti$
t = TIMER
DO WHILE t + .15 >= TIMER: LOOP
NEXT blink
COLOR 7, 0
LOCATE 24, 55
PRINT "by Solitaire";
DATA 3,3,2,2,3,3,5,5,3,3,2,2,3,3,5,5,3,3,2,2,3,3,3
SYSTEM
SUB ball (x AS INTEGER, y AS INTEGER, w AS INTEGER, tint() AS INTEGER)
STATIC t AS INTEGER
COLOR , 0
IF x > 1 THEN 'clear top of ball
LOCATE x - 1, 36
PRINT SPACE$(5) 'space prints background color
END IF
LOCATE x, 35
PRINT SPACE$(7)
COLOR , 6
IF x > 2 THEN 'redraw pole on top
LOCATE x - 1, 38
PRINT " "
END IF
COLOR , tint(t) 'redraw descending ball with changing colors
IF x > 1 THEN
LOCATE x, 36
PRINT SPACE$(5)
END IF
FOR z = 1 TO 2
IF x = 1 THEN
LOCATE x + z, 36
PRINT SPACE$(5)
ELSE
LOCATE x + z, 35
PRINT SPACE$(7)
END IF
NEXT z
LOCATE x + 3, 36
PRINT SPACE$(5)
COLOR 1, 3
IF y = 10 THEN
IF w = 1 THEN
LOCATE 3, 36
ELSE
LOCATE x + 2, 36
END IF
ELSE
LOCATE x + 1, 37
END IF
COLOR , tint(t) 'background color of countdown number
PRINT y; 'countdown number
COLOR 7, 0
LOCATE 1, 30
PRINT "TIMES SQUARE BALL"
t = t + 1 'static counter
END SUB