CHDIR ".\qbasicapps\unsorted" DECLARE SUB bar () DECLARE SUB help (a!) DECLARE SUB alarm (a!) DECLARE SUB gtw (y!, m!, t!, r!) DECLARE SUB daysm (y!, m!, d!) DECLARE SUB daysy (y!, d!) DECLARE SUB chdat () DECLARE SUB entcla () DECLARE SUB entcl () DECLARE SUB clrc (a!) DECLARE SUB scroll () DECLARE SUB ps (x!, y!, c!, s$) DECLARE SUB vbox (x1!, y1!, x2!, y2!, c!) DECLARE SUB quit () DECLARE SUB start () DECLARE SUB cns (a!, s$) DECLARE SUB getkey (a$) DECLARE SUB chkey (a$) DECLARE SUB entquit () DECLARE SUB ented () DECLARE SUB ed (p!) DECLARE SUB inpu (x!, y!, xl!, c!, a$) DECLARE SUB box (x!, y!, xl!, yl!, a$) DECLARE SUB sh () DIM SHARED celh(1 TO 20) DIM SHARED celm(1 TO 20) DIM SHARED cels(1 TO 20) DIM SHARED celm1$(1 TO 20) DIM SHARED celm2$(1 TO 20) DIM SHARED celc$(1 TO 20) DIM SHARED celt(1 TO 20)' 0 - empty 1 - onece 2 - every day 3 - specified days DIM SHARED celw(1 TO 20, 1 TO 7) DIM SHARED celx(1 TO 20) DIM SHARED virt(1 TO 80, 1 TO 25) DIM SHARED tmr DIM SHARED slp(1 TO 20) DIM SHARED alq(1 TO 20) DIM SHARED alarmo DIM SHARED alqm DIM SHARED br$ start sh 1 br$ = "Press F1 for help" getkey a$ IF a$ = "q" THEN entquit IF a$ = "e" THEN ented IF a$ = "c" THEN entcl IF a$ = "d" THEN entcla IF a$ = CHR$(0) + CHR$(59) THEN help 1: getkey a$: sh GOTO 1 SUB alarm (a) alq(a) = 1 alarmo = 1 'DIM SHARED celm1$(1 TO 20) 'DIM SHARED celm2$(1 TO 20) 'DIM SHARED celc$(1 TO 20) IF celc$(a) <> "" THEN SHELL celc$(a) END IF IF celm1$(a) <> "" OR celm2$(a) <> "" THEN OPEN "note.txt" FOR OUTPUT AS #1 PRINT #1, celm1$(a) PRINT #1, celm2$(a) CLOSE #1 SHELL "notepad note.txt" END IF FOR b = 100 TO 1000 STEP 20 SOUND b, .1 NEXT b END SUB SUB bar COLOR 0, 3 LOCATE 22, 72 PRINT CHR$(179) + TIME$ br$ = br$ + SPACE$(80) br$ = LEFT$(br$, 70) LOCATE 22, 1 PRINT " " + br$ COLOR 7, 0 END SUB SUB box (x, y, xl, yl, e$) vbox x, y, xl, yl, 1 ' 201 205 187 COLOR 11 a$ = "" d$ = "" FOR a = 1 TO xl - 2 a$ = a$ + CHR$(205) d$ = d$ + " " NEXT a b$ = CHR$(201) + a$ + CHR$(187) c$ = CHR$(200) + a$ + CHR$(188) d$ = CHR$(186) + d$ + CHR$(186) LOCATE y, x PRINT b$ LOCATE y + yl - 1, x PRINT c$ FOR a = 1 TO yl - 2 LOCATE y + a, x PRINT d$ NEXT a xt = INT(x + (xl / 2) - (LEN(e$) / 2) - 2) LOCATE y, xt PRINT "[ " xt = xt + 2 COLOR 10 LOCATE y, xt PRINT e$ xt = xt + LEN(e$) COLOR 11 LOCATE y, xt PRINT " ]" COLOR 7, 0 END SUB SUB chdat a$ = DATE$ qwy = VAL(RIGHT$(a$, 4)) qwm = VAL(LEFT$(a$, 2)) qwd = VAL(RIGHT$(LEFT$(a$, 5), 2)) gtw qwy, qwm, qwd, w a$ = TIME$ qes = VAL(RIGHT$(a$, 4)) qeh = VAL(LEFT$(a$, 2)) qem = VAL(RIGHT$(LEFT$(a$, 5), 2)) IF alqm <> qem THEN alqm = qem FOR b = 1 TO 20 alq(b) = 0 NEXT b END IF 'DIM SHARED celh(1 TO 20) 'DIM SHARED celm(1 TO 20) 'DIM SHARED cels(1 TO 20) FOR a = 1 TO 20 IF celt(a) = 0 THEN GOTO 19 IF celt(a) = 3 THEN IF celw(a, w) = 0 THEN GOTO 19 IF alq(a) = 1 THEN GOTO 19 IF celh(a) <> qeh THEN GOTO 19 IF celm(a) <> qem THEN GOTO 19 alarm a IF celt(a) = 1 THEN clrc a 19 NEXT a END SUB SUB chkey (a$) a$ = INKEY$ IF a$ = "" THEN IF tmr > 4 THEN scroll: tmr = 1 SOUND 0, 1 IF alarmo = 1 THEN SOUND 2000, 1 tmr = tmr + 1 chdat bar ELSE IF alarmo = 1 THEN alarmo = 0: a$ = "" END IF END SUB SUB clrc (a) celh(a) = 0 celm(a) = 0 cels(a) = 0 celt(a) = 0 celm1$(a) = "" celm2$(a) = "" celc$(a) = "" FOR b = 1 TO 7 celw(a, b) = 0 NEXT b END SUB SUB cns (a, s$) s$ = STR$(a) IF LEFT$(s$, 1) = " " THEN s$ = RIGHT$(s$, LEN(s$) - 1) IF LEN(s$) = 1 THEN s$ = "0" + s$ END SUB SUB daysm (y, m, d) SELECT CASE m CASE 1 d = 31 CASE 2 IF y / 4 = y \ 4 THEN d = 29 ELSE d = 28 CASE 3 d = 31 CASE 4 d = 30 CASE 5 d = 31 CASE 6 d = 30 CASE 7 d = 31 CASE 8 d = 31 CASE 9 d = 30 CASE 10 d = 31 CASE 11 d = 30 CASE 12 d = 31 END SELECT END SUB SUB daysy (y, d) d = 365 IF y / 4 = y \ 4 THEN d = 366 END SUB SUB ed (p) br$ = "Press F1 for help, ESC to close window, CTRL + ENTER accept" cns celh(p), s$ tth$ = s$ cns celm(p), s$ ttm$ = s$ cns cels(p), s$ tts$ = s$ ms1$ = celm1$(p) ms2$ = celm2$(p) cm1$ = celc$(p) DIM wks(1 TO 7) FOR a = 1 TO 7 wks(a) = celw(p, a) NEXT a typ = celt(p) IF typ = 0 THEN typ = 1 box 5, 5, 70, 11, "Edit entrie" LOCATE 7, 7 PRINT "Enter time (HH:MM:SS)" LOCATE 8, 23 PRINT ":" LOCATE 8, 26 PRINT ":" inpu 21, 8, 2, 1, tth$ inpu 24, 8, 2, 1, ttm$ inpu 27, 8, 2, 1, tts$ LOCATE 10, 7 PRINT "Enter message" inpu 21, 10, 52, 1, ms1$ inpu 21, 11, 52, 1, ms2$ LOCATE 13, 7 PRINT "Enter command" inpu 21, 13, 52, 1, cm1$ x = 1 y = 1 11 IF typ = 1 THEN COLOR 14, 4 ELSE COLOR 14, 0 LOCATE 7, 32 PRINT "O"; COLOR 7 PRINT "nce" IF typ = 2 THEN COLOR 14, 4 ELSE COLOR 14, 0 LOCATE 7, 38 PRINT "D"; COLOR 7 PRINT "aily" IF typ = 3 THEN COLOR 14, 4 ELSE COLOR 14, 0 LOCATE 7, 45 PRINT "S"; COLOR 7 PRINT "pecified weekdays" FOR a = 1 TO 7 IF wks(a) = 1 THEN COLOR 10, 0 ELSE COLOR 8, 0 LOCATE 8, 44 + (a * 2) PRINT a NEXT a c = 0 IF y = 1 THEN IF x = 1 THEN inpu 21, 8, 2, c, tth$ IF x = 2 THEN inpu 24, 8, 2, c, ttm$ IF x = 3 THEN inpu 27, 8, 2, c, tts$ END IF IF y = 2 THEN inpu 21, 10, 52, c, ms1$ IF y = 3 THEN inpu 21, 11, 52, c, ms2$ IF y = 4 THEN inpu 21, 13, 52, c, cm1$ IF c = 100 THEN GOTO 13 IF c = 102 THEN x = x + 1 IF c = 103 THEN x = x - 1 IF c = 104 THEN y = y - 1 IF c = 105 THEN y = y + 1 IF c = 106 THEN GOTO 12 tg = 0 IF c = 107 THEN tg = 1 IF c = 108 THEN tg = 2 IF c = 109 THEN tg = 3 IF c = 110 THEN tg = 4 IF c = 111 THEN tg = 5 IF c = 112 THEN tg = 6 IF c = 113 THEN tg = 7 IF c = 114 THEN typ = 1 IF c = 115 THEN typ = 2 IF c = 116 THEN typ = 3 IF c = 117 THEN help 2 IF tg > 0 THEN IF wks(tg) = 0 THEN wks(tg) = 1 ELSE wks(tg) = 0 END IF IF c = 101 THEN IF y = 1 THEN x = x + 1 ELSE y = y + 1 END IF IF y > 4 THEN y = 4 IF y < 1 THEN y = 1 IF x > 3 THEN x = 1: y = y + 1 IF x < 1 THEN x = 1 GOTO 11 12 celh(p) = VAL(tth$) celm(p) = VAL(ttm$) cels(p) = VAL(tts$) celm1$(p) = ms1$ celm2$(p) = ms2$ celc$(p) = cm1$ celt(p) = typ FOR a = 1 TO 7 celw(p, a) = wks(a) NEXT a 13 END SUB SUB entcl a$ = "01" box 20, 10, 40, 5, "Clear entrie" LOCATE 12, 23 PRINT "Which cell do you need to clear?" 15 inpu 55, 12, 2, c, a$ IF c = 100 THEN GOTO 16 IF c = 101 THEN clrc VAL(a$) GOTO 16 END IF GOTO 15 16 sh END SUB SUB entcla box 15, 10, 50, 6, "Clearing" 18 LOCATE 12, 21 PRINT "Are you sure you want to clear all cells?" LOCATE 13, 36 PRINT "[ Y / N ]" getkey a$ IF a$ = "y" OR a$ = "Y" THEN FOR a = 1 TO 20 clrc a NEXT a GOTO 17 END IF IF a$ = "n" OR a$ = "N" THEN GOTO 17 box 15, 10, 50, 8, "Clearing" LOCATE 15, 30 COLOR 28 PRINT "Use keys 'Y' or 'N'" COLOR 7 GOTO 18 17 sh END SUB SUB ented br$ = "Enter cell number in range of 1 to 20" a$ = "01" box 20, 10, 40, 5, "Edit entrie" 9 LOCATE 12, 23 PRINT "Which cell do you need to edit?" 'SUB inpu (x, y, xl, c, a$) 6 c = 0 inpu 55, 12, 2, c, a$ IF c = 100 THEN GOTO 7 IF c = 101 THEN b = VAL(a$) IF b = 0 THEN IF a$ = " 0" OR a$ = "0 " OR a$ = "00" OR a$ = "-0" THEN GOTO 10 box 20, 10, 40, 9, "Edit entrie" COLOR 12, 0 LOCATE 14, 23 PRINT " Letters aren't allowed" LOCATE 15, 23 PRINT " enter number, or press ESC " COLOR 7 GOTO 9 END IF IF b < 1 OR b > 20 THEN 10 box 20, 10, 40, 9, "Edit entrie" COLOR 12, 0 LOCATE 14, 23 PRINT " The entered number must be in" LOCATE 15, 23 PRINT " the range between 1 and 20" LOCATE 16, 23 PRINT "enter correct number, or press ESC" COLOR 7 GOTO 9 END IF IF (b > 0) AND (b < 21) THEN sh: ed b: GOTO 7 END IF GOTO 6 7 sh END SUB SUB entquit box 15, 10, 50, 6, "Quitting" 5 LOCATE 12, 21 PRINT "Are you really sure you want to quit?" LOCATE 13, 36 PRINT "[ Y / N ]" getkey a$ IF a$ = "y" OR a$ = "Y" THEN quit IF a$ = "n" OR a$ = "N" THEN GOTO 4 box 15, 10, 50, 8, "Quitting" LOCATE 15, 30 COLOR 28 PRINT "Use keys 'Y' or 'N'" COLOR 7 GOTO 5 4 sh END SUB SUB getkey (a$) 3 chkey a$ IF a$ = "" THEN GOTO 3 END SUB SUB gtw (y, m, t, r) d = 0 FOR a = 1500 TO y - 1 daysy a, b d = d + b NEXT a FOR a = 1 TO m - 1 daysm y, a, b d = d + b NEXT a d = d + t + 2 r = (d MOD 7) + 1 END SUB SUB help (a) SELECT CASE a CASE 1 box 20, 3, 41, 17, "Help" LOCATE 5, 24 PRINT "q - quit program" LOCATE 6, 24 PRINT "c - clear cell" LOCATE 7, 24 PRINT "d - clear all cells" LOCATE 8, 24 PRINT "e - edit cell" COLOR 14 LOCATE 10, 24 PRINT "This program allows you to" LOCATE 11, 24 PRINT "shedle messages and commands" LOCATE 12, 24 PRINT "to specified time: once, daily" LOCATE 13, 24 PRINT "and specified weekdays." LOCATE 15, 24 PRINT " Copyright" LOCATE 16, 24 PRINT "Vladimir German &" LOCATE 17, 24 PRINT "Svjatoslav Agejenko" br$ = "Press any key to close this window" CASE 2 box 3, 16, 76, 5, "Help: allowed keys" LOCATE 17, 5 PRINT "CTRL + F1..F7 - toggle weekdays CTRL + O/D/S - toggle modes" LOCATE 18, 5 PRINT "Arrow keys - to move around CTRL + ENTER - Accept" LOCATE 19, 5 PRINT "ESC - close window" br$ = "You can continue editing ..." END SELECT END SUB SUB inpu (x, y, xl, c, a$) x1 = 1 2 a$ = a$ + SPACE$(100) a$ = LEFT$(a$, xl) COLOR 11, 1 LOCATE y, x PRINT a$ IF c = 1 THEN GOTO 8 COLOR 30, 2 LOCATE y, x + x1 - 1 PRINT RIGHT$(LEFT$(a$, x1), 1) getkey b$ IF b$ = CHR$(27) THEN c = 100: GOTO 8 IF b$ = CHR$(13) THEN c = 101: GOTO 8 IF (ASC(b$) > 31) AND (ASC(b$) < 122) AND (LEN(b$) = 1) THEN a$ = LEFT$(a$, x1 - 1) + b$ + (RIGHT$(a$, xl - x1 + 1)) x1 = x1 + 1 END IF IF b$ = CHR$(8) THEN IF x1 > 1 THEN a$ = LEFT$(a$, x1 - 2) + RIGHT$(a$, xl - x1 + 1) x1 = x1 - 1 END IF END IF IF b$ = CHR$(0) + "M" THEN x1 = x1 + 1 IF b$ = CHR$(0) + "K" THEN x1 = x1 - 1 IF b$ = CHR$(0) + CHR$(94) THEN c = 107: GOTO 8 IF b$ = CHR$(0) + CHR$(95) THEN c = 108: GOTO 8 IF b$ = CHR$(0) + CHR$(96) THEN c = 109: GOTO 8 IF b$ = CHR$(0) + CHR$(97) THEN c = 110: GOTO 8 IF b$ = CHR$(0) + CHR$(98) THEN c = 111: GOTO 8 IF b$ = CHR$(0) + CHR$(99) THEN c = 112: GOTO 8 IF b$ = CHR$(0) + CHR$(100) THEN c = 113: GOTO 8 IF b$ = CHR$(0) + CHR$(59) THEN c = 117: GOTO 8 IF b$ = CHR$(0) + "S" THEN a$ = LEFT$(a$, x1 - 1) + RIGHT$(a$, xl - x1) IF x1 < 1 THEN x1 = 1: c = 103: GOTO 8 IF x1 > xl THEN x1 = xl: c = 102: GOTO 8 IF b$ = CHR$(0) + "H" THEN c = 104: GOTO 8 IF b$ = CHR$(0) + "P" THEN c = 105: GOTO 8 IF b$ = CHR$(10) THEN c = 106: GOTO 8 IF b$ = CHR$(15) THEN c = 114: GOTO 8 IF b$ = CHR$(4) THEN c = 115: GOTO 8 IF b$ = CHR$(19) THEN c = 116: GOTO 8 GOTO 2 8 a$ = a$ + SPACE$(100) a$ = LEFT$(a$, xl) COLOR 11, 1 LOCATE y, x PRINT a$ IF a$ = SPACE$(LEN(a$)) THEN a$ = "" ELSE 14 IF RIGHT$(a$, 1) = " " THEN a$ = LEFT$(a$, LEN(a$) - 1): GOTO 14 END IF COLOR 7, 0 END SUB SUB ps (x, y, c, s$) COLOR c FOR a = 1 TO LEN(s$) x1 = x + a - 1 IF (x1 > 21) AND (x1 < 81) THEN IF virt(x1, y) = 0 THEN LOCATE y, x1 PRINT RIGHT$(LEFT$(s$, a), 1) END IF END IF NEXT a END SUB SUB quit 'DIM SHARED celh(1 TO 20) 'DIM SHARED celm(1 TO 20) 'DIM SHARED cels(1 TO 20) 'DIM SHARED celm1$(1 TO 20) 'DIM SHARED celm2$(1 TO 20) 'DIM SHARED celc$(1 TO 20) 'DIM SHARED celt(1 TO 20)' 0 - empty 1 - onece 2 - every day 3 - specified days 'DIM SHARED celw(1 TO 20, 1 TO 7) OPEN "tim.dat" FOR OUTPUT AS #1 FOR a = 1 TO 20 PRINT #1, celh(a); celm(a); cels(a); celt(a) FOR b = 1 TO 6 PRINT #1, celw(a, b); NEXT b PRINT #1, celw(a, 7) PRINT #1, celm1$(a) PRINT #1, celm2$(a) PRINT #1, celc$(a) NEXT a CLOSE #1 SYSTEM END SUB SUB scroll 'ps RND * 60 + 1, RND * 20 + 1, RND * 13 + 1, "asi" 'DIM SHARED celm1$(1 TO 20) 'DIM SHARED celm2$(1 TO 20) 'DIM SHARED celc$(1 TO 20) 'DIM SHARED celx(1 TO 20) COLOR 7, 0 FOR a = 1 TO 20 le = LEN(celm1$(a) + celm2$(a) + celc$(a)) + 2 IF le > 59 THEN x = 22 - celx(a) IF slp(a) > 0 THEN slp(a) = slp(a) - 1 ELSE celx(a) = celx(a) + 1 IF x + le < 83 THEN slp(a) = 10 IF x + le < 82 THEN slp(a) = 10: celx(a) = 0 END IF ELSE x = 22 END IF ps x, a + 1, 10, celc$(a) + " " x = x + LEN(celc$(a)) + 1 ps x, a + 1, 14, celm1$(a) + " " x = x + LEN(celm1$(a)) + 1 ps x, a + 1, 14, celm2$(a) + " " NEXT a END SUB SUB sh vbox 1, 1, 80, 25, 0 CLS LOCATE 1, 1 COLOR 0, 3 PRINT "Num| Time | When? | Command & Message " COLOR 7, 0 FOR a = 1 TO 20 COLOR 14 IF a < 10 THEN LOCATE a + 1, 2 ELSE LOCATE a + 1, 1 PRINT a COLOR 3 LOCATE a + 1, 4 PRINT "|" LOCATE a + 1, 5 COLOR 14 IF celt(a) = 0 THEN PRINT "-- -- --" ELSE COLOR 14 cns celh(a), s$ PRINT s$ LOCATE a + 1, 8 cns celm(a), s$ PRINT s$ LOCATE a + 1, 11 cns cels(a), s$ PRINT s$ END IF COLOR 30 LOCATE a + 1, 7 PRINT ":" LOCATE a + 1, 10 PRINT ":" COLOR 3 LOCATE a + 1, 13 PRINT "|" LOCATE a + 1, 14 IF celt(a) = 1 THEN COLOR 14 PRINT " Once" END IF IF celt(a) = 2 THEN COLOR 14 PRINT " Daily" END IF IF celt(a) = 3 THEN COLOR 10 FOR b = 1 TO 7 'DIM SHARED celw(1 TO 20, 1 TO 7) LOCATE a + 1, 13 + b IF celw(a, b) = 1 THEN PRINT RIGHT$(STR$(b), 1) NEXT b END IF COLOR 3 LOCATE a + 1, 21 PRINT "|" NEXT a END SUB SUB start OPEN "tim.dat" FOR INPUT AS #1 FOR a = 1 TO 20 INPUT #1, celh(a), celm(a), cels(a), celt(a) FOR b = 1 TO 7 INPUT #1, celw(a, b) NEXT b LINE INPUT #1, celm1$(a) LINE INPUT #1, celm2$(a) LINE INPUT #1, celc$(a) NEXT a CLOSE #1 alarmo = 0 END SUB SUB vbox (x1, y1, x2, y2, c) FOR y = y1 TO y1 + y2 - 1 FOR x = x1 TO x1 + x2 - 1 virt(x, y) = c NEXT x NEXT y END SUB