2 DECLARE SUB help (a!)
\r
3 DECLARE SUB alarm (a!)
\r
4 DECLARE SUB gtw (y!, m!, t!, r!)
\r
5 DECLARE SUB daysm (y!, m!, d!)
\r
6 DECLARE SUB daysy (y!, d!)
\r
8 DECLARE SUB entcla ()
\r
10 DECLARE SUB clrc (a!)
\r
11 DECLARE SUB scroll ()
\r
12 DECLARE SUB ps (x!, y!, c!, s$)
\r
13 DECLARE SUB vbox (x1!, y1!, x2!, y2!, c!)
\r
15 DECLARE SUB start ()
\r
16 DECLARE SUB cns (a!, s$)
\r
17 DECLARE SUB getkey (a$)
\r
18 DECLARE SUB chkey (a$)
\r
19 DECLARE SUB entquit ()
\r
20 DECLARE SUB ented ()
\r
22 DECLARE SUB inpu (x!, y!, xl!, c!, a$)
\r
23 DECLARE SUB box (x!, y!, xl!, yl!, a$)
\r
26 DIM SHARED celh(1 TO 20)
\r
27 DIM SHARED celm(1 TO 20)
\r
28 DIM SHARED cels(1 TO 20)
\r
30 DIM SHARED celm1$(1 TO 20)
\r
31 DIM SHARED celm2$(1 TO 20)
\r
32 DIM SHARED celc$(1 TO 20)
\r
34 DIM SHARED celt(1 TO 20)' 0 - empty 1 - onece 2 - every day 3 - specified days
\r
35 DIM SHARED celw(1 TO 20, 1 TO 7)
\r
36 DIM SHARED celx(1 TO 20)
\r
38 DIM SHARED virt(1 TO 80, 1 TO 25)
\r
40 DIM SHARED slp(1 TO 20)
\r
41 DIM SHARED alq(1 TO 20)
\r
51 br$ = "Press F1 for help"
\r
54 IF a$ = "q" THEN entquit
\r
55 IF a$ = "e" THEN ented
\r
56 IF a$ = "c" THEN entcl
\r
57 IF a$ = "d" THEN entcla
\r
58 IF a$ = CHR$(0) + CHR$(59) THEN help 1: getkey a$: sh
\r
64 'DIM SHARED celm1$(1 TO 20)
\r
65 'DIM SHARED celm2$(1 TO 20)
\r
66 'DIM SHARED celc$(1 TO 20)
\r
68 IF celc$(a) <> "" THEN
\r
72 IF celm1$(a) <> "" OR celm2$(a) <> "" THEN
\r
73 OPEN "note.txt" FOR OUTPUT AS #1
\r
77 SHELL "notepad note.txt"
\r
81 FOR b = 100 TO 1000 STEP 20
\r
89 PRINT CHR$(179) + TIME$
\r
91 br$ = br$ + SPACE$(80)
\r
92 br$ = LEFT$(br$, 70)
\r
99 SUB box (x, y, xl, yl, e$)
\r
100 vbox x, y, xl, yl, 1
\r
106 FOR a = 1 TO xl - 2
\r
107 a$ = a$ + CHR$(205)
\r
110 b$ = CHR$(201) + a$ + CHR$(187)
\r
111 c$ = CHR$(200) + a$ + CHR$(188)
\r
112 d$ = CHR$(186) + d$ + CHR$(186)
\r
116 LOCATE y + yl - 1, x
\r
119 FOR a = 1 TO yl - 2
\r
124 xt = INT(x + (xl / 2) - (LEN(e$) / 2) - 2)
\r
144 qwy = VAL(RIGHT$(a$, 4))
\r
145 qwm = VAL(LEFT$(a$, 2))
\r
146 qwd = VAL(RIGHT$(LEFT$(a$, 5), 2))
\r
147 gtw qwy, qwm, qwd, w
\r
150 qes = VAL(RIGHT$(a$, 4))
\r
151 qeh = VAL(LEFT$(a$, 2))
\r
152 qem = VAL(RIGHT$(LEFT$(a$, 5), 2))
\r
154 IF alqm <> qem THEN
\r
163 'DIM SHARED celh(1 TO 20)
\r
164 'DIM SHARED celm(1 TO 20)
\r
165 'DIM SHARED cels(1 TO 20)
\r
169 IF celt(a) = 0 THEN GOTO 19
\r
170 IF celt(a) = 3 THEN IF celw(a, w) = 0 THEN GOTO 19
\r
171 IF alq(a) = 1 THEN GOTO 19
\r
172 IF celh(a) <> qeh THEN GOTO 19
\r
173 IF celm(a) <> qem THEN GOTO 19
\r
175 IF celt(a) = 1 THEN clrc a
\r
184 IF tmr > 4 THEN scroll: tmr = 1
\r
186 IF alarmo = 1 THEN SOUND 2000, 1
\r
191 IF alarmo = 1 THEN alarmo = 0: a$ = ""
\r
214 IF LEFT$(s$, 1) = " " THEN s$ = RIGHT$(s$, LEN(s$) - 1)
\r
215 IF LEN(s$) = 1 THEN s$ = "0" + s$
\r
218 SUB daysm (y, m, d)
\r
224 IF y / 4 = y \ 4 THEN d = 29 ELSE d = 28
\r
261 IF y / 4 = y \ 4 THEN d = 366
\r
265 br$ = "Press F1 for help, ESC to close window, CTRL + ENTER accept"
\r
279 wks(a) = celw(p, a)
\r
282 IF typ = 0 THEN typ = 1
\r
284 box 5, 5, 70, 11, "Edit entrie"
\r
286 PRINT "Enter time (HH:MM:SS)"
\r
291 inpu 21, 8, 2, 1, tth$
\r
292 inpu 24, 8, 2, 1, ttm$
\r
293 inpu 27, 8, 2, 1, tts$
\r
296 PRINT "Enter message"
\r
297 inpu 21, 10, 52, 1, ms1$
\r
298 inpu 21, 11, 52, 1, ms2$
\r
301 PRINT "Enter command"
\r
302 inpu 21, 13, 52, 1, cm1$
\r
308 IF typ = 1 THEN COLOR 14, 4 ELSE COLOR 14, 0
\r
314 IF typ = 2 THEN COLOR 14, 4 ELSE COLOR 14, 0
\r
320 IF typ = 3 THEN COLOR 14, 4 ELSE COLOR 14, 0
\r
324 PRINT "pecified weekdays"
\r
327 IF wks(a) = 1 THEN COLOR 10, 0 ELSE COLOR 8, 0
\r
328 LOCATE 8, 44 + (a * 2)
\r
336 IF x = 1 THEN inpu 21, 8, 2, c, tth$
\r
337 IF x = 2 THEN inpu 24, 8, 2, c, ttm$
\r
338 IF x = 3 THEN inpu 27, 8, 2, c, tts$
\r
341 IF y = 2 THEN inpu 21, 10, 52, c, ms1$
\r
342 IF y = 3 THEN inpu 21, 11, 52, c, ms2$
\r
343 IF y = 4 THEN inpu 21, 13, 52, c, cm1$
\r
345 IF c = 100 THEN GOTO 13
\r
346 IF c = 102 THEN x = x + 1
\r
347 IF c = 103 THEN x = x - 1
\r
348 IF c = 104 THEN y = y - 1
\r
349 IF c = 105 THEN y = y + 1
\r
350 IF c = 106 THEN GOTO 12
\r
353 IF c = 107 THEN tg = 1
\r
354 IF c = 108 THEN tg = 2
\r
355 IF c = 109 THEN tg = 3
\r
356 IF c = 110 THEN tg = 4
\r
357 IF c = 111 THEN tg = 5
\r
358 IF c = 112 THEN tg = 6
\r
359 IF c = 113 THEN tg = 7
\r
361 IF c = 114 THEN typ = 1
\r
362 IF c = 115 THEN typ = 2
\r
363 IF c = 116 THEN typ = 3
\r
365 IF c = 117 THEN help 2
\r
368 IF wks(tg) = 0 THEN wks(tg) = 1 ELSE wks(tg) = 0
\r
372 IF y = 1 THEN x = x + 1 ELSE y = y + 1
\r
376 IF y > 4 THEN y = 4
\r
377 IF y < 1 THEN y = 1
\r
378 IF x > 3 THEN x = 1: y = y + 1
\r
379 IF x < 1 THEN x = 1
\r
384 celh(p) = VAL(tth$)
\r
385 celm(p) = VAL(ttm$)
\r
386 cels(p) = VAL(tts$)
\r
395 celw(p, a) = wks(a)
\r
403 box 20, 10, 40, 5, "Clear entrie"
\r
406 PRINT "Which cell do you need to clear?"
\r
409 inpu 55, 12, 2, c, a$
\r
410 IF c = 100 THEN GOTO 16
\r
423 box 15, 10, 50, 6, "Clearing"
\r
427 PRINT "Are you sure you want to clear all cells?"
\r
433 IF a$ = "y" OR a$ = "Y" THEN
\r
439 IF a$ = "n" OR a$ = "N" THEN GOTO 17
\r
440 box 15, 10, 50, 8, "Clearing"
\r
443 PRINT "Use keys 'Y' or 'N'"
\r
454 br$ = "Enter cell number in range of 1 to 20"
\r
456 box 20, 10, 40, 5, "Edit entrie"
\r
460 PRINT "Which cell do you need to edit?"
\r
461 'SUB inpu (x, y, xl, c, a$)
\r
465 inpu 55, 12, 2, c, a$
\r
466 IF c = 100 THEN GOTO 7
\r
471 IF a$ = " 0" OR a$ = "0 " OR a$ = "00" OR a$ = "-0" THEN GOTO 10
\r
472 box 20, 10, 40, 9, "Edit entrie"
\r
475 PRINT " Letters aren't allowed"
\r
477 PRINT " enter number, or press ESC "
\r
482 IF b < 1 OR b > 20 THEN
\r
484 box 20, 10, 40, 9, "Edit entrie"
\r
487 PRINT " The entered number must be in"
\r
489 PRINT " the range between 1 and 20"
\r
491 PRINT "enter correct number, or press ESC"
\r
496 IF (b > 0) AND (b < 21) THEN sh: ed b: GOTO 7
\r
507 box 15, 10, 50, 6, "Quitting"
\r
511 PRINT "Are you really sure you want to quit?"
\r
517 IF a$ = "y" OR a$ = "Y" THEN quit
\r
518 IF a$ = "n" OR a$ = "N" THEN GOTO 4
\r
519 box 15, 10, 50, 8, "Quitting"
\r
522 PRINT "Use keys 'Y' or 'N'"
\r
534 IF a$ = "" THEN GOTO 3
\r
538 SUB gtw (y, m, t, r)
\r
540 FOR a = 1500 TO y - 1
\r
558 box 20, 3, 41, 17, "Help"
\r
561 PRINT "q - quit program"
\r
563 PRINT "c - clear cell"
\r
565 PRINT "d - clear all cells"
\r
567 PRINT "e - edit cell"
\r
571 PRINT "This program allows you to"
\r
573 PRINT "shedle messages and commands"
\r
575 PRINT "to specified time: once, daily"
\r
577 PRINT "and specified weekdays."
\r
580 PRINT " This program is property of"
\r
582 PRINT "Vova German & Svjatoslav Agejenko"
\r
584 PRINT " All rights reserved."
\r
585 br$ = "Press any key to close this window"
\r
588 box 3, 16, 76, 5, "Help: allowed keys"
\r
590 PRINT "CTRL + F1..F7 - toggle weekdays CTRL + O/D/S - toggle modes"
\r
592 PRINT "Arrow keys - to move around CTRL + ENTER - Accept"
\r
594 PRINT "ESC - close window"
\r
595 br$ = "You can continue editing ..."
\r
604 SUB inpu (x, y, xl, c, a$)
\r
609 a$ = a$ + SPACE$(100)
\r
616 IF c = 1 THEN GOTO 8
\r
618 LOCATE y, x + x1 - 1
\r
619 PRINT RIGHT$(LEFT$(a$, x1), 1)
\r
623 IF b$ = CHR$(27) THEN c = 100: GOTO 8
\r
624 IF b$ = CHR$(13) THEN c = 101: GOTO 8
\r
626 IF (ASC(b$) > 31) AND (ASC(b$) < 122) AND (LEN(b$) = 1) THEN
\r
627 a$ = LEFT$(a$, x1 - 1) + b$ + (RIGHT$(a$, xl - x1 + 1))
\r
631 IF b$ = CHR$(8) THEN
\r
633 a$ = LEFT$(a$, x1 - 2) + RIGHT$(a$, xl - x1 + 1)
\r
638 IF b$ = CHR$(0) + "M" THEN x1 = x1 + 1
\r
639 IF b$ = CHR$(0) + "K" THEN x1 = x1 - 1
\r
640 IF b$ = CHR$(0) + CHR$(94) THEN c = 107: GOTO 8
\r
641 IF b$ = CHR$(0) + CHR$(95) THEN c = 108: GOTO 8
\r
642 IF b$ = CHR$(0) + CHR$(96) THEN c = 109: GOTO 8
\r
643 IF b$ = CHR$(0) + CHR$(97) THEN c = 110: GOTO 8
\r
644 IF b$ = CHR$(0) + CHR$(98) THEN c = 111: GOTO 8
\r
645 IF b$ = CHR$(0) + CHR$(99) THEN c = 112: GOTO 8
\r
646 IF b$ = CHR$(0) + CHR$(100) THEN c = 113: GOTO 8
\r
647 IF b$ = CHR$(0) + CHR$(59) THEN c = 117: GOTO 8
\r
649 IF b$ = CHR$(0) + "S" THEN a$ = LEFT$(a$, x1 - 1) + RIGHT$(a$, xl - x1)
\r
650 IF x1 < 1 THEN x1 = 1: c = 103: GOTO 8
\r
651 IF x1 > xl THEN x1 = xl: c = 102: GOTO 8
\r
652 IF b$ = CHR$(0) + "H" THEN c = 104: GOTO 8
\r
653 IF b$ = CHR$(0) + "P" THEN c = 105: GOTO 8
\r
655 IF b$ = CHR$(10) THEN c = 106: GOTO 8
\r
656 IF b$ = CHR$(15) THEN c = 114: GOTO 8
\r
657 IF b$ = CHR$(4) THEN c = 115: GOTO 8
\r
658 IF b$ = CHR$(19) THEN c = 116: GOTO 8
\r
664 a$ = a$ + SPACE$(100)
\r
670 IF a$ = SPACE$(LEN(a$)) THEN
\r
674 IF RIGHT$(a$, 1) = " " THEN a$ = LEFT$(a$, LEN(a$) - 1): GOTO 14
\r
680 SUB ps (x, y, c, s$)
\r
682 FOR a = 1 TO LEN(s$)
\r
684 IF (x1 > 21) AND (x1 < 81) THEN
\r
685 IF virt(x1, y) = 0 THEN
\r
687 PRINT RIGHT$(LEFT$(s$, a), 1)
\r
694 'DIM SHARED celh(1 TO 20)
\r
695 'DIM SHARED celm(1 TO 20)
\r
696 'DIM SHARED cels(1 TO 20)
\r
698 'DIM SHARED celm1$(1 TO 20)
\r
699 'DIM SHARED celm2$(1 TO 20)
\r
700 'DIM SHARED celc$(1 TO 20)
\r
702 'DIM SHARED celt(1 TO 20)' 0 - empty 1 - onece 2 - every day 3 - specified days
\r
703 'DIM SHARED celw(1 TO 20, 1 TO 7)
\r
706 OPEN "tim.dat" FOR OUTPUT AS #1
\r
708 PRINT #1, celh(a); celm(a); cels(a); celt(a)
\r
710 PRINT #1, celw(a, b);
\r
712 PRINT #1, celw(a, 7)
\r
714 PRINT #1, celm1$(a)
\r
715 PRINT #1, celm2$(a)
\r
723 'ps RND * 60 + 1, RND * 20 + 1, RND * 13 + 1, "asi"
\r
725 'DIM SHARED celm1$(1 TO 20)
\r
726 'DIM SHARED celm2$(1 TO 20)
\r
727 'DIM SHARED celc$(1 TO 20)
\r
728 'DIM SHARED celx(1 TO 20)
\r
732 le = LEN(celm1$(a) + celm2$(a) + celc$(a)) + 2
\r
736 slp(a) = slp(a) - 1
\r
738 celx(a) = celx(a) + 1
\r
739 IF x + le < 83 THEN slp(a) = 10
\r
740 IF x + le < 82 THEN slp(a) = 10: celx(a) = 0
\r
746 ps x, a + 1, 10, celc$(a) + " "
\r
747 x = x + LEN(celc$(a)) + 1
\r
748 ps x, a + 1, 14, celm1$(a) + " "
\r
749 x = x + LEN(celm1$(a)) + 1
\r
750 ps x, a + 1, 14, celm2$(a) + " "
\r
757 vbox 1, 1, 80, 25, 0
\r
761 PRINT "Num| Time | When? | Command & Message "
\r
766 IF a < 10 THEN LOCATE a + 1, 2 ELSE LOCATE a + 1, 1
\r
776 IF celt(a) = 0 THEN
\r
800 IF celt(a) = 1 THEN
\r
805 IF celt(a) = 2 THEN
\r
810 IF celt(a) = 3 THEN
\r
813 'DIM SHARED celw(1 TO 20, 1 TO 7)
\r
814 LOCATE a + 1, 13 + b
\r
815 IF celw(a, b) = 1 THEN PRINT RIGHT$(STR$(b), 1)
\r
829 OPEN "tim.dat" FOR INPUT AS #1
\r
831 INPUT #1, celh(a), celm(a), cels(a), celt(a)
\r
833 INPUT #1, celw(a, b)
\r
836 LINE INPUT #1, celm1$(a)
\r
837 LINE INPUT #1, celm2$(a)
\r
838 LINE INPUT #1, celc$(a)
\r
845 SUB vbox (x1, y1, x2, y2, c)
\r
846 FOR y = y1 TO y1 + y2 - 1
\r
847 FOR x = x1 TO x1 + x2 - 1
\r