The Android-Basic menu includes Run.c to compile and run faster, Load a BAS file, Run, i which is slower and Settings:
Settings allows you to choose which font and LOCATE syntax you wish to use:
Font 16 works for phones, but 24 looks better on my tablet. Larger makes the screen scroll with text all over the place.
The default LOCATE syntax can be changed from x, y 0,0 to y, x 1,1 which Qbasic uses.
Font 16 is pretty small. The box around the calendar month uses LINE a bit differently: LINE (80, 40)-(460, 264), hsv(160, 25, 80), b
Font 24 is larger for tablets, but I need to redo the LINE coordinates for the box:
Most of the code is pure Qbasic, but the SUB programs were converted to GOSUB calls:
Code: Select all
CLS 3
SCREEN 1, 1, 1, 0
'
'CALENDOS.BAS
'
' COMPUTER GENERATED CALENDER
'
' FILE records all holidays and weekends
' for accurate business days in year
'
' Enter a year or press Enter for current year.
'
DIM Daxy(7, 6)
DIM Hol(4)
DIM Rel(4)
CLS
BEEP
COLOR COL(9)
LOCATE 5, 5
PRINT "CALENDOS PROGRAM"
LOCATE 15, 3
PRINT "Enter Year ent=current"
in$ = ""
WHILE -1
a$ = INKEY$
PAUSE 50
IF a$ <> "" THEN
IF ASC(a$) > 47 AND ASC(a$) < 58 THEN
'filter for numbers only
in$ = in$ + a$
ELSE
IF a$ = CHR$(13) THEN
in$ = MID$(DATE$, 1, 4)
BREAK
ENDIF
ENDIF
ENDIF
LOCATE 10, 8
PRINT "Year = "; in$
IF LEN(in$) = 4 THEN
BREAK
ENDIF
WEND
PAUSE 1000
CLS
Year$ = in$
'Get year from user 4 digit
'
yrn = VAL(Year$)
'Check for number of year for leap year calculate
yrnum = yrn
'yrnum is for adding year in second January and display
getvar = 1
GOSUB LeapYear
GOSUB Easter
'
'
num = frstday
' set first month 1st day position for calendar
'_______________READ NUM OF DAYS _____________ INKEY LOOP for months
'includes January of next year 13 months
FOR month = 1 TO 13
ERASE Daxy
DIM Daxy(7, 6)
fst = num
'get first day number(day) from num for other months
'
'DAYS OF MONTH
SELECT CASE month
CASE 2
IF Lpy$ = "N" THEN days = 28
IF Lpy$ = "Y" THEN days = 29
CASE 4
days = 30
CASE 6
days = 30
CASE 9
days = 30
CASE 11
days = 30
CASE ELSE
' all other months have 31 days
days = 31
END SELECT
week = 1
'ASSIGN NUMBERS TO DAYS ARRAY
FOR d = 1 TO days
Daxy(num, week) = d
IF num = 7 THEN
num = 0
week = 1 + week
ENDIF
num = 1 + num
'SET NUMBER FOR NEXT MONTH
NEXT d
'
'>>>>>>>>>>>>>>>>>>>>>>>> SELECT HOLIDAYS
'
ERASE Hol
DIM Hol(4)
ERASE Rel
DIM Rel(4)
'for each month
mond = 0
tue = 0
thu = 0
'ADJUST FOR MONTHS WITHOUT DAY IN 1ST WEEK
IF Daxy(2, 1) = 0 THEN mond = 1
IF Daxy(5, 1) = 0 THEN thu = 1
IF Daxy(3, 1) = 0 THEN tue = 1
'
'holiday 2nd monday = Daxy(2, 3)
SELECT CASE month
CASE 1
mon$ = "JANUARY"
Hol(1) = 1
Hol(2) = Daxy(2, 3 + mond)
CASE 2
mon$ = "FEBRUARY"
Hol(1) = Daxy(2, 3 + mond)
CASE 3
mon$ = "MARCH"
IF EM = 3 THEN Rel(1) = ED
CASE 4
mon$ = "APRIL"
IF EM = 4 THEN Rel(1) = ED
CASE 5
mon$ = "MAY"
Hol(1) = Daxy(2, 4 + mond)
IF Daxy(2, 5 + mond) > 0 THEN
Hol(1) = Daxy(2, 5 + mond)
ENDIF
'last monday of month
CASE 6
mon$ = "JUNE"
CASE 7
mon$ = "JULY"
Hol(1) = 4
CASE 8
mon$ = "AUGUST"
CASE 9
mon$ = "SEPTEMBER"
Hol(1) = Daxy(2, 1 + mond)
CASE 10
mon$ = "OCTOBER"
Hol(1) = Daxy(2, 2 + mond)
CASE 11
mon$ = "NOVEMBER"
Hol(1) = Daxy(3, 1 + tue)
Hol(2) = 11
Hol(3) = Daxy(5, 4 + thu)
CASE 12
mon$ = "DECEMBER"
Hol(1) = 25
CASE 13
mon$ = "JANUARY"
Hol(1) = 1
Hol(2) = Daxy(2, 3 + mond)
END SELECT
tomonth$ = MID$(DATE$, 6, 2)
'Get todays month in time line
IF MID$(tomonth$, 1, 1) = "0" THEN
tomonth$ = MID$(DATE$, 7, 1)
ENDIF
'get month name
SELECT CASE tomonth$
CASE "1": moon$ = "Jan."
CASE "2": moon$ = "Feb."
CASE "3": moon$ = "Mar."
CASE "4": moon$ = "Apr."
CASE "5": moon$ = "May "
CASE "6": moon$ = "June"
CASE "7": moon$ = "July"
CASE "8": moon$ = "Aug."
CASE "9": moon$ = "Sep."
CASE "10": moon$ = "Oct."
CASE "11": moon$ = "Nov."
CASE "12": moon$ = "Dec."
END SELECT
'Get today's date
today$ = MID$(DATE$, 9, 2)
yr$ = MID$(DATE$, 1, 4)
'Figure name of the day of week near clock using actual date
IF month = 1 THEN
datenum = VAL(today$)
'find date number
monthnum = VAL(tomonth$)
'find month number
yrno = VAL(yr$)
' find year number
'check if leap Get first day position number
getvar = 2
GOSUB LeapYear
mon1st = fstday
FOR i = 1 TO monthnum - 1
SELECT CASE i
CASE 2
'Feb
IF Lp$ = "N" THEN mon1st = mon1st + 28
IF Lp$ = "Y" THEN mon1st = mon1st + 29
CASE 4
'April, June, Sept, Nov
mon1st = mon1st + 30
CASE 6
mon1st = mon1st + 30
CASE 9
mon1st = mon1st + 30
CASE 11
mon1st = mon1st + 30
CASE ELSE
' all others have 31 days
mon1st = mon1st + 31
END SELECT
NEXT i
IF Lp$ = "N" THEN lpno = 365
IF Lp$ = "Y" THEN lpno = 366
dayofyear = mon1st + datenum - fstday
IF Lp$ = "Y" AND dayofyear >= 60 THEN dayofyear = dayofyear + 1
fstofmo = mon1st MOD 7
'finds day value of 1st day of month
daynum = (datenum + fstofmo - 1) MOD 7
'finds value of actual day
'
'assign week day name
SELECT CASE daynum
CASE 0: wd$ = "Sat"
CASE 1: wd$ = "Sun"
CASE 2: wd$ = "Mon"
CASE 3: wd$ = "Tue"
CASE 4: wd$ = "Wed"
CASE 5: wd$ = "Thu"
CASE 6: wd$ = "Fri"
END SELECT
ENDIF
COLOR COL(8)
CLS
'
'*********************** PRINT CALENDER
COLOR COL(8)
LOCATE 23, 7
PRINT "Any key for next month! "
IF month = 13 THEN
BEEP
yrnum = yrnum + 1
' add 1 for next year
LOCATE 23, 7
PRINT " Any key ends program! "
ENDIF
COLOR COL(13)
LOCATE 2, 8
PRINT mon$
LOCATE 2, 24
PRINT yrnum
COLOR COL(1)
LOCATE 4, 8
PRINT "S M T W T F S "
COLOR COL(15)
LOCATE 21, 7
PRINT "Day Num"; dayofyear; " Left"; lpno - dayofyear
'LOCATE and PRINT day numbers............. from Daxy() Array
'week loop r begin
FOR r = 1 TO 6
FOR c = 1 TO 7
'day loop and colors
COLOR COL(14)
'normal day color
IF c = 1 OR c = 7 THEN
COLOR COL(5)
'color weekends
ENDIF
FOR i = 1 TO 3
IF Daxy(c, r) = Hol(i) THEN
COLOR COL(4)
' color holidays
ENDIF
IF Daxy(c, r) = Rel(i) THEN
COLOR COL(3)
' color Easter day
ENDIF
NEXT i
IF Daxy(c, r) = 0 THEN
LOCATE (2 * r) + 4, (3 * c) + 5
PRINT CHR$(32); CHR$(32);
ELSE
LOCATE (2 * r) + 4, (3 * c) + 4
PRINT Daxy(c, r);
ENDIF
NEXT c
NEXT r
'r week loop end
'**********************BOX around Calendar
LINE (80, 40)-(460, 264), hsv(160, 25, 80), b
'*******************************
'
LOCATE 18, 20
COLOR COL(4)
PRINT "Holidays"
IF month = EM THEN
COLOR COL(3)
LOCATE 18, 8
PRINT "Easter"
ENDIF
COLOR COL(9)
LOCATE 20, 7
PRINT wd$; ", "; moon$; datenum
'
WHILE -1
hour$ = LEFT$(TIME$, 2)
SELECT CASE hour$
CASE "00"
hr$ = "12"
CASE "01"
hr$ = " 1"
CASE "02"
hr$ = " 2"
CASE "03"
hr$ = " 3"
CASE "04"
hr$ = " 4"
CASE "05"
hr$ = " 5"
CASE "06"
hr$ = " 6"
CASE "07"
hr$ = " 7"
CASE "08"
hr$ = " 8"
CASE "09"
hr$ = " 9"
CASE "10"
hr$ = "10"
CASE "11"
hr$ = "11"
CASE "12"
hr$ = "12"
CASE "13"
hr$ = " 1"
CASE "14"
hr$ = " 2"
CASE "15"
hr$ = " 3"
CASE "16"
hr$ = " 4"
CASE "17"
hr$ = " 5"
CASE "18"
hr$ = " 6"
CASE "19"
hr$ = " 7"
CASE "20"
hr$ = " 8"
CASE "21"
hr$ = " 9"
CASE "22"
hr$ = "10"
CASE "23"
hr$ = "11"
CASE "24"
hr$ = "12"
END SELECT
'set AM PM
IF VAL(hour$) < 12 THEN aft$ = " AM"
IF VAL(hour$) >= 12 THEN aft$ = " PM"
minu$ = MID$(TIME$, 3, 3)
sec$ = RIGHT$(TIME$, 3)
'minutes & seconds
COLOR COL(9)
LOCATE 20, 20
PRINT hr$; minu$;
COLOR COL(9)
PRINT aft$
PAUSE 50
IF INKEY$ <> "" THEN
BREAK
ENDIF
WEND
NEXT month
CLOSE #1
CLS 3
'
LOCATE 4, 4
PRINT " CALENDOS "
LOCATE 7, 4
PRINT " Written by Ted Weissgerber"
LOCATE 10, 4
PRINT " burger2227@Gmail.com"
LOCATE 14, 4
PRINT " 2010"
LOCATE 18, 4
PRINT " QBasic and DOS Rule!"
'
PAUSE 3000
END
'
Easter:
c = yrn \ 100
'Century
G = yrn MOD 19
K = (c - 17) \ 25
i = (c - (c \ 4) - (c - K) \ 3 + (19 * G) + 15) MOD 30
i = i - (i \ 28) * (1 - (i \ 28) * (29 \ (i + 1)) * ((21 - G) \ 11))
J = (yrn + yrn \ 4 + i + 2 - c + c \ 4) MOD 7
L = i - J
EM = 3 + (L + 40) \ 44
'Month of Easter.
ED = L + 28 - 31 * (EM \ 4)
'Day of Easter.
RETURN
'
LeapYear:
'my LEAP YEAR and the First Day of Year routine based on year 2000
LpYear = 2000
firstday = 7
yrnm = 0
' the first day of 2000 was a saturday, the 7th day
' ** yrn INPUT
IF yrn >= 2000 THEN
'FORWARD LOOP 2000 up
yrnm = 1999
'start in 1999
WHILE -1
yrnm = yrnm + 1
' start in 2000 (1999 + 1)
IF yrnm > 2000 THEN firstday = firstday + 1
'add one day every year to first day (52 weeks + 1
IF firstday > 7 THEN firstday = firstday - 7
' ** firstday OUTPUT
'
IF yrnm = LpYear THEN Leap$ = "Y"
' ** Lp$ for print only
IF yrnm MOD 100 = 0 THEN nly = LpYear MOD 400
'test century leap 400
IF nly <> 0 THEN Leap$ = "N"
' if not divisible by 400
'
IF yrnm - 1 = LpYear THEN
' add day AFTER leap year
IF nly = 0 THEN firstday = firstday + 1
' add a leap day
IF firstday > 7 THEN firstday = firstday - 7
Leap$ = "N"
LpYear = LpYear + 4
' find next leap year by adding 4
ENDIF
nly = 0
' reset MOD value
IF yrnm = yrn THEN
BREAK
ENDIF
WEND
ENDIF
'end forward loop
'
IF yrn < 2000 THEN
'REVERSE LOOP 2000 down
yrnm = 2001
'start in 2001
WHILE -1
yrnm = yrnm - 1
' start in 2000 (2001 - 1)
IF yrnm < 2000 THEN firstday = firstday - 1
'subt one day every year to first day (52 weeks + 1
IF firstday = 0 THEN firstday = 7
IF yrnm MOD 100 = 0 THEN nly = LpYear MOD 400
' test century every 100
Leap$ = "N"
'
IF yrnm = LpYear THEN
' BEFORE leap year
IF nly = 0 AND LpYear <> 2000 THEN firstday = firstday - 1
' subt a leap day
IF firstday = 0 THEN firstday = 7
LpYear = LpYear - 4
' find next leap year
Leap$ = "Y"
IF nly <> 0 THEN Leap$ = "N"
' if not divisible by 400
ENDIF
nly = 0
' reset MOD value
IF yrnm = yrn THEN
BREAK
ENDIF
WEND
ENDIF
SELECT CASE getvar
CASE 1
yrn = yrn
Lpy$ = Leap$
frstday = firstday
CASE 2
yrno = yrn
Lp$ = Leap$
fstday = firstday
END SELECT
RETURN
Thanks to Pete from the N54 Qbasic Site for help converting the code!
http://www.network54.com/Index/10167