1 CHDIR ".\qbasicapps\unsorted"
\r
5 DECLARE SUB help (a!)
\r
6 DECLARE SUB alarm (a!)
\r
7 DECLARE SUB gtw (y!, m!, t!, r!)
\r
8 DECLARE SUB daysm (y!, m!, d!)
\r
9 DECLARE SUB daysy (y!, d!)
\r
10 DECLARE SUB chdat ()
\r
11 DECLARE SUB entcla ()
\r
12 DECLARE SUB entcl ()
\r
13 DECLARE SUB clrc (a!)
\r
14 DECLARE SUB scroll ()
\r
15 DECLARE SUB ps (x!, y!, c!, s$)
\r
16 DECLARE SUB vbox (x1!, y1!, x2!, y2!, c!)
\r
18 DECLARE SUB start ()
\r
19 DECLARE SUB cns (a!, s$)
\r
20 DECLARE SUB getkey (a$)
\r
21 DECLARE SUB chkey (a$)
\r
22 DECLARE SUB entquit ()
\r
23 DECLARE SUB ented ()
\r
25 DECLARE SUB inpu (x!, y!, xl!, c!, a$)
\r
26 DECLARE SUB box (x!, y!, xl!, yl!, a$)
\r
29 DIM SHARED celh(1 TO 20)
\r
30 DIM SHARED celm(1 TO 20)
\r
31 DIM SHARED cels(1 TO 20)
\r
33 DIM SHARED celm1$(1 TO 20)
\r
34 DIM SHARED celm2$(1 TO 20)
\r
35 DIM SHARED celc$(1 TO 20)
\r
37 DIM SHARED celt(1 TO 20)' 0 - empty 1 - onece 2 - every day 3 - specified days
\r
38 DIM SHARED celw(1 TO 20, 1 TO 7)
\r
39 DIM SHARED celx(1 TO 20)
\r
41 DIM SHARED virt(1 TO 80, 1 TO 25)
\r
43 DIM SHARED slp(1 TO 20)
\r
44 DIM SHARED alq(1 TO 20)
\r
54 br$ = "Press F1 for help"
\r
57 IF a$ = "q" THEN entquit
\r
58 IF a$ = "e" THEN ented
\r
59 IF a$ = "c" THEN entcl
\r
60 IF a$ = "d" THEN entcla
\r
61 IF a$ = CHR$(0) + CHR$(59) THEN help 1: getkey a$: sh
\r
67 'DIM SHARED celm1$(1 TO 20)
\r
68 'DIM SHARED celm2$(1 TO 20)
\r
69 'DIM SHARED celc$(1 TO 20)
\r
71 IF celc$(a) <> "" THEN
\r
75 IF celm1$(a) <> "" OR celm2$(a) <> "" THEN
\r
76 OPEN "note.txt" FOR OUTPUT AS #1
\r
80 SHELL "notepad note.txt"
\r
84 FOR b = 100 TO 1000 STEP 20
\r
92 PRINT CHR$(179) + TIME$
\r
94 br$ = br$ + SPACE$(80)
\r
95 br$ = LEFT$(br$, 70)
\r
102 SUB box (x, y, xl, yl, e$)
\r
103 vbox x, y, xl, yl, 1
\r
109 FOR a = 1 TO xl - 2
\r
110 a$ = a$ + CHR$(205)
\r
113 b$ = CHR$(201) + a$ + CHR$(187)
\r
114 c$ = CHR$(200) + a$ + CHR$(188)
\r
115 d$ = CHR$(186) + d$ + CHR$(186)
\r
119 LOCATE y + yl - 1, x
\r
122 FOR a = 1 TO yl - 2
\r
127 xt = INT(x + (xl / 2) - (LEN(e$) / 2) - 2)
\r
147 qwy = VAL(RIGHT$(a$, 4))
\r
148 qwm = VAL(LEFT$(a$, 2))
\r
149 qwd = VAL(RIGHT$(LEFT$(a$, 5), 2))
\r
150 gtw qwy, qwm, qwd, w
\r
153 qes = VAL(RIGHT$(a$, 4))
\r
154 qeh = VAL(LEFT$(a$, 2))
\r
155 qem = VAL(RIGHT$(LEFT$(a$, 5), 2))
\r
157 IF alqm <> qem THEN
\r
166 'DIM SHARED celh(1 TO 20)
\r
167 'DIM SHARED celm(1 TO 20)
\r
168 'DIM SHARED cels(1 TO 20)
\r
172 IF celt(a) = 0 THEN GOTO 19
\r
173 IF celt(a) = 3 THEN IF celw(a, w) = 0 THEN GOTO 19
\r
174 IF alq(a) = 1 THEN GOTO 19
\r
175 IF celh(a) <> qeh THEN GOTO 19
\r
176 IF celm(a) <> qem THEN GOTO 19
\r
178 IF celt(a) = 1 THEN clrc a
\r
187 IF tmr > 4 THEN scroll: tmr = 1
\r
189 IF alarmo = 1 THEN SOUND 2000, 1
\r
194 IF alarmo = 1 THEN alarmo = 0: a$ = ""
\r
217 IF LEFT$(s$, 1) = " " THEN s$ = RIGHT$(s$, LEN(s$) - 1)
\r
218 IF LEN(s$) = 1 THEN s$ = "0" + s$
\r
221 SUB daysm (y, m, d)
\r
227 IF y / 4 = y \ 4 THEN d = 29 ELSE d = 28
\r
264 IF y / 4 = y \ 4 THEN d = 366
\r
268 br$ = "Press F1 for help, ESC to close window, CTRL + ENTER accept"
\r
282 wks(a) = celw(p, a)
\r
285 IF typ = 0 THEN typ = 1
\r
287 box 5, 5, 70, 11, "Edit entrie"
\r
289 PRINT "Enter time (HH:MM:SS)"
\r
294 inpu 21, 8, 2, 1, tth$
\r
295 inpu 24, 8, 2, 1, ttm$
\r
296 inpu 27, 8, 2, 1, tts$
\r
299 PRINT "Enter message"
\r
300 inpu 21, 10, 52, 1, ms1$
\r
301 inpu 21, 11, 52, 1, ms2$
\r
304 PRINT "Enter command"
\r
305 inpu 21, 13, 52, 1, cm1$
\r
311 IF typ = 1 THEN COLOR 14, 4 ELSE COLOR 14, 0
\r
317 IF typ = 2 THEN COLOR 14, 4 ELSE COLOR 14, 0
\r
323 IF typ = 3 THEN COLOR 14, 4 ELSE COLOR 14, 0
\r
327 PRINT "pecified weekdays"
\r
330 IF wks(a) = 1 THEN COLOR 10, 0 ELSE COLOR 8, 0
\r
331 LOCATE 8, 44 + (a * 2)
\r
339 IF x = 1 THEN inpu 21, 8, 2, c, tth$
\r
340 IF x = 2 THEN inpu 24, 8, 2, c, ttm$
\r
341 IF x = 3 THEN inpu 27, 8, 2, c, tts$
\r
344 IF y = 2 THEN inpu 21, 10, 52, c, ms1$
\r
345 IF y = 3 THEN inpu 21, 11, 52, c, ms2$
\r
346 IF y = 4 THEN inpu 21, 13, 52, c, cm1$
\r
348 IF c = 100 THEN GOTO 13
\r
349 IF c = 102 THEN x = x + 1
\r
350 IF c = 103 THEN x = x - 1
\r
351 IF c = 104 THEN y = y - 1
\r
352 IF c = 105 THEN y = y + 1
\r
353 IF c = 106 THEN GOTO 12
\r
356 IF c = 107 THEN tg = 1
\r
357 IF c = 108 THEN tg = 2
\r
358 IF c = 109 THEN tg = 3
\r
359 IF c = 110 THEN tg = 4
\r
360 IF c = 111 THEN tg = 5
\r
361 IF c = 112 THEN tg = 6
\r
362 IF c = 113 THEN tg = 7
\r
364 IF c = 114 THEN typ = 1
\r
365 IF c = 115 THEN typ = 2
\r
366 IF c = 116 THEN typ = 3
\r
368 IF c = 117 THEN help 2
\r
371 IF wks(tg) = 0 THEN wks(tg) = 1 ELSE wks(tg) = 0
\r
375 IF y = 1 THEN x = x + 1 ELSE y = y + 1
\r
379 IF y > 4 THEN y = 4
\r
380 IF y < 1 THEN y = 1
\r
381 IF x > 3 THEN x = 1: y = y + 1
\r
382 IF x < 1 THEN x = 1
\r
387 celh(p) = VAL(tth$)
\r
388 celm(p) = VAL(ttm$)
\r
389 cels(p) = VAL(tts$)
\r
398 celw(p, a) = wks(a)
\r
406 box 20, 10, 40, 5, "Clear entrie"
\r
409 PRINT "Which cell do you need to clear?"
\r
412 inpu 55, 12, 2, c, a$
\r
413 IF c = 100 THEN GOTO 16
\r
426 box 15, 10, 50, 6, "Clearing"
\r
430 PRINT "Are you sure you want to clear all cells?"
\r
436 IF a$ = "y" OR a$ = "Y" THEN
\r
442 IF a$ = "n" OR a$ = "N" THEN GOTO 17
\r
443 box 15, 10, 50, 8, "Clearing"
\r
446 PRINT "Use keys 'Y' or 'N'"
\r
457 br$ = "Enter cell number in range of 1 to 20"
\r
459 box 20, 10, 40, 5, "Edit entrie"
\r
463 PRINT "Which cell do you need to edit?"
\r
464 'SUB inpu (x, y, xl, c, a$)
\r
468 inpu 55, 12, 2, c, a$
\r
469 IF c = 100 THEN GOTO 7
\r
474 IF a$ = " 0" OR a$ = "0 " OR a$ = "00" OR a$ = "-0" THEN GOTO 10
\r
475 box 20, 10, 40, 9, "Edit entrie"
\r
478 PRINT " Letters aren't allowed"
\r
480 PRINT " enter number, or press ESC "
\r
485 IF b < 1 OR b > 20 THEN
\r
487 box 20, 10, 40, 9, "Edit entrie"
\r
490 PRINT " The entered number must be in"
\r
492 PRINT " the range between 1 and 20"
\r
494 PRINT "enter correct number, or press ESC"
\r
499 IF (b > 0) AND (b < 21) THEN sh: ed b: GOTO 7
\r
510 box 15, 10, 50, 6, "Quitting"
\r
514 PRINT "Are you really sure you want to quit?"
\r
520 IF a$ = "y" OR a$ = "Y" THEN quit
\r
521 IF a$ = "n" OR a$ = "N" THEN GOTO 4
\r
522 box 15, 10, 50, 8, "Quitting"
\r
525 PRINT "Use keys 'Y' or 'N'"
\r
537 IF a$ = "" THEN GOTO 3
\r
541 SUB gtw (y, m, t, r)
\r
543 FOR a = 1500 TO y - 1
\r
561 box 20, 3, 41, 17, "Help"
\r
564 PRINT "q - quit program"
\r
566 PRINT "c - clear cell"
\r
568 PRINT "d - clear all cells"
\r
570 PRINT "e - edit cell"
\r
574 PRINT "This program allows you to"
\r
576 PRINT "shedle messages and commands"
\r
578 PRINT "to specified time: once, daily"
\r
580 PRINT "and specified weekdays."
\r
585 PRINT "Vladimir German &"
\r
587 PRINT "Svjatoslav Agejenko"
\r
588 br$ = "Press any key to close this window"
\r
591 box 3, 16, 76, 5, "Help: allowed keys"
\r
593 PRINT "CTRL + F1..F7 - toggle weekdays CTRL + O/D/S - toggle modes"
\r
595 PRINT "Arrow keys - to move around CTRL + ENTER - Accept"
\r
597 PRINT "ESC - close window"
\r
598 br$ = "You can continue editing ..."
\r
607 SUB inpu (x, y, xl, c, a$)
\r
612 a$ = a$ + SPACE$(100)
\r
619 IF c = 1 THEN GOTO 8
\r
621 LOCATE y, x + x1 - 1
\r
622 PRINT RIGHT$(LEFT$(a$, x1), 1)
\r
626 IF b$ = CHR$(27) THEN c = 100: GOTO 8
\r
627 IF b$ = CHR$(13) THEN c = 101: GOTO 8
\r
629 IF (ASC(b$) > 31) AND (ASC(b$) < 122) AND (LEN(b$) = 1) THEN
\r
630 a$ = LEFT$(a$, x1 - 1) + b$ + (RIGHT$(a$, xl - x1 + 1))
\r
634 IF b$ = CHR$(8) THEN
\r
636 a$ = LEFT$(a$, x1 - 2) + RIGHT$(a$, xl - x1 + 1)
\r
641 IF b$ = CHR$(0) + "M" THEN x1 = x1 + 1
\r
642 IF b$ = CHR$(0) + "K" THEN x1 = x1 - 1
\r
643 IF b$ = CHR$(0) + CHR$(94) THEN c = 107: GOTO 8
\r
644 IF b$ = CHR$(0) + CHR$(95) THEN c = 108: GOTO 8
\r
645 IF b$ = CHR$(0) + CHR$(96) THEN c = 109: GOTO 8
\r
646 IF b$ = CHR$(0) + CHR$(97) THEN c = 110: GOTO 8
\r
647 IF b$ = CHR$(0) + CHR$(98) THEN c = 111: GOTO 8
\r
648 IF b$ = CHR$(0) + CHR$(99) THEN c = 112: GOTO 8
\r
649 IF b$ = CHR$(0) + CHR$(100) THEN c = 113: GOTO 8
\r
650 IF b$ = CHR$(0) + CHR$(59) THEN c = 117: GOTO 8
\r
652 IF b$ = CHR$(0) + "S" THEN a$ = LEFT$(a$, x1 - 1) + RIGHT$(a$, xl - x1)
\r
653 IF x1 < 1 THEN x1 = 1: c = 103: GOTO 8
\r
654 IF x1 > xl THEN x1 = xl: c = 102: GOTO 8
\r
655 IF b$ = CHR$(0) + "H" THEN c = 104: GOTO 8
\r
656 IF b$ = CHR$(0) + "P" THEN c = 105: GOTO 8
\r
658 IF b$ = CHR$(10) THEN c = 106: GOTO 8
\r
659 IF b$ = CHR$(15) THEN c = 114: GOTO 8
\r
660 IF b$ = CHR$(4) THEN c = 115: GOTO 8
\r
661 IF b$ = CHR$(19) THEN c = 116: GOTO 8
\r
667 a$ = a$ + SPACE$(100)
\r
673 IF a$ = SPACE$(LEN(a$)) THEN
\r
677 IF RIGHT$(a$, 1) = " " THEN a$ = LEFT$(a$, LEN(a$) - 1): GOTO 14
\r
683 SUB ps (x, y, c, s$)
\r
685 FOR a = 1 TO LEN(s$)
\r
687 IF (x1 > 21) AND (x1 < 81) THEN
\r
688 IF virt(x1, y) = 0 THEN
\r
690 PRINT RIGHT$(LEFT$(s$, a), 1)
\r
697 'DIM SHARED celh(1 TO 20)
\r
698 'DIM SHARED celm(1 TO 20)
\r
699 'DIM SHARED cels(1 TO 20)
\r
701 'DIM SHARED celm1$(1 TO 20)
\r
702 'DIM SHARED celm2$(1 TO 20)
\r
703 'DIM SHARED celc$(1 TO 20)
\r
705 'DIM SHARED celt(1 TO 20)' 0 - empty 1 - onece 2 - every day 3 - specified days
\r
706 'DIM SHARED celw(1 TO 20, 1 TO 7)
\r
709 OPEN "tim.dat" FOR OUTPUT AS #1
\r
711 PRINT #1, celh(a); celm(a); cels(a); celt(a)
\r
713 PRINT #1, celw(a, b);
\r
715 PRINT #1, celw(a, 7)
\r
717 PRINT #1, celm1$(a)
\r
718 PRINT #1, celm2$(a)
\r
726 'ps RND * 60 + 1, RND * 20 + 1, RND * 13 + 1, "asi"
\r
728 'DIM SHARED celm1$(1 TO 20)
\r
729 'DIM SHARED celm2$(1 TO 20)
\r
730 'DIM SHARED celc$(1 TO 20)
\r
731 'DIM SHARED celx(1 TO 20)
\r
735 le = LEN(celm1$(a) + celm2$(a) + celc$(a)) + 2
\r
739 slp(a) = slp(a) - 1
\r
741 celx(a) = celx(a) + 1
\r
742 IF x + le < 83 THEN slp(a) = 10
\r
743 IF x + le < 82 THEN slp(a) = 10: celx(a) = 0
\r
749 ps x, a + 1, 10, celc$(a) + " "
\r
750 x = x + LEN(celc$(a)) + 1
\r
751 ps x, a + 1, 14, celm1$(a) + " "
\r
752 x = x + LEN(celm1$(a)) + 1
\r
753 ps x, a + 1, 14, celm2$(a) + " "
\r
760 vbox 1, 1, 80, 25, 0
\r
764 PRINT "Num| Time | When? | Command & Message "
\r
769 IF a < 10 THEN LOCATE a + 1, 2 ELSE LOCATE a + 1, 1
\r
779 IF celt(a) = 0 THEN
\r
803 IF celt(a) = 1 THEN
\r
808 IF celt(a) = 2 THEN
\r
813 IF celt(a) = 3 THEN
\r
816 'DIM SHARED celw(1 TO 20, 1 TO 7)
\r
817 LOCATE a + 1, 13 + b
\r
818 IF celw(a, b) = 1 THEN PRINT RIGHT$(STR$(b), 1)
\r
832 OPEN "tim.dat" FOR INPUT AS #1
\r
834 INPUT #1, celh(a), celm(a), cels(a), celt(a)
\r
836 INPUT #1, celw(a, b)
\r
839 LINE INPUT #1, celm1$(a)
\r
840 LINE INPUT #1, celm2$(a)
\r
841 LINE INPUT #1, celc$(a)
\r
848 SUB vbox (x1, y1, x2, y2, c)
\r
849 FOR y = y1 TO y1 + y2 - 1
\r
850 FOR x = x1 TO x1 + x2 - 1
\r