turbobasic/1998/TELEFON1.BAS

   1 start:
   2 CLS
   3 COLOR 14,1
   4 SCREEN 0
   5 LOCATE 2,2
   6 INPUT " ZADEJTE VSTUPNÍ PIN " ;A
   7 IF A<>4545 THEN START
   8
   9  GOTO POKR
  10
  11 POKR :
  12 CLS
  13 SCREEN 8 : CLS
  14 COLOR 14,1
  15 RESTORE BARVY
  16 BARVY :
  17
  18     DATA 8,7,15,15,7,8
  19 FOR A=1 TO 6
  20    READ C
  21    LINE (A,A)-(640-A,A),C
  22    LINE (A,106-A)-(640-A,106-A),C
  23    LINE (A,A)-(A,106-A),C
  24    LINE (640-A,A)-(640-A,106-A),C
  25    LINE (A,110+A)-(640-A,110+A),C
  26    LINE (A,200-A)-(640-A,200-A),C
  27    LINE (A,110+A)-(A,200-A),C
  28    LINE (640-A,110+A)-(640-A,200-A),C
  29 NEXT A
  30
  31 DO
  32    A$="POZDRAV1  POMOC2  TELEFON3   HELP4  ESC Q"
  33    D=5:X=5:Y=17:C=14
  34    GOSUB MENU
  35    ON MENU GOSUB TELEFON,DIR,LOAD,HELP,KONEC
  36 LOOP
  37
  38 '-----------------------------------------------------------------------------
  39 TELEFON :
  40 print "HLAVNE KDYZ POZDRAVITE:DOBRY DEN TADY----- -----."
  41 RETURN
  42 '-----------------------------------------------------------------------------
  43 DIR :
  44 LOCATE 8,23
  45 PRINT "PRAVE STE SE DOVOLALI NA TEL.Č.:158"
  46 LOCATE 10,10
  47 print "TADY POLICIE H.L.M.PRAHY"
  48 RETURN
  49 '-----------------------------------------------------------------------------
  50 KONEC :
  51 print "stlač klávesu*ENTER*"
  52 END
  53 '-----------------------------------------------------------------------------
  54 HELP :
  55 A$="ZKOUSKA OVLADANI TELEFONU"
  56 CALL ECHO (5,16,A$,13)
  57 A$="STISKNĚTE TELEFON1 NEBO POMOC"
  58 CALL ECHO (7,17,A$,13)
  59 A$="VIDITE UŽ TELEFONUJETE PO SITI MUDRUŇKANET"
  60 CALL ECHO (7,18,A$,13)
  61
  62
  63 CALL ANYKEY
  64 CALL CLWD
  65 RETURN
  66 '-----------------------------------------------------------------------------
  67 LOAD :
  68 PRINT " DOBRY DEN DOVOLALI JSTE SE NA TEL.:56 18 243 "
  69 LOCATE 9,23
  70 PRINT " TADY TOMAS MUDRUNKA "
  71
  72
  73 RETURN
  74 '-----------------------------------------------------------------------------
  75
  76
  77 END
  78 '-----------------------------------------------------------------------------
  79 '                    podprogram ECHO
  80 ' postupny tisk textu obsazeneho v retezcove promenne A$
  81 ' na souradnice X a Y
  82 ' barvou C
  83
  84 SUB ECHO(X,Y,A$,C)
  85    COLOR C
  86    LOCATE Y,X
  87    FOR A=1 TO LEN(A$)
  88       PRINT MID$ (A$,A,1);
  89       SOUND 1200,.2
  90       SOUND 900,.2
  91       SOUND 600,.2
  92       FOR I=1 TO 200
  93       NEXT I
  94    NEXT A
  95 END SUB
  96
  97 '--------------------------------------------------------------------------
  98
  99 MENU :
 100    ' PODPROGRAM 'MENU'
 101
 102    ' X a Y jsou textove souradnice menu-okna
 103    ' A$ obsahuje text okna
 104    ' D je pocet polozek (radku) v menu
 105    ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu
 106    ' C je barva okna
 107    ' v promenne MENU podprogram vraci cislo zvolene polozky
 108
 109    L=LEN (A$)/D : MENU = 1 : M = MENU+.0001
 110    COLOR C,9:LOCATE Y,X
 111    PRINT CHR$(201);
 112    FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A
 113    PRINT CHR$ (187);
 114    FOR A= 1 TO LEN(A$) STEP L
 115       LOCATE Y+A/L+1,X
 116       PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186);
 117    NEXT A
 118    LOCATE Y+A/L+1,X: PRINT CHR$(200);
 119    FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A
 120    PRINT CHR$(188);
 121    IF W=1 THEN W=0 : RETURN
 122
 123   DO
 124    I$ = INKEY$
 125    IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1
 126    IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1
 127    IF MENU < 1     THEN MENU = D
 128    IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP
 129    IF MENU > D THEN MENU = 0 : EXIT LOOP
 130    IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " ";
 131    IF MENU <> M THEN LOCATE Y+MENU,X+L+2:COLOR 11:PRINT CHR$(174);:LOCATE Y+MENU,X+1:PRINT CHR$(175);:COLOR C
 132    M = MENU
 133   LOOP
 134    I=MENU
 135    W=1:C=0:GOSUB MENU
 136    MENU = I : COLOR 15
 137 RETURN
 138 '-----------------------------------------------------------------------------
 139 SUB CLWD
 140    'Clear window
 141    FOR A=120 TO 190
 142       LINE (8,A)-(632,A),0
 143    NEXT A
 144 END SUB
 145 '-----------------------------------------------------------------------------
 146 SUB ANYKEY
 147    DO
 148       IF INKEY$<>"" THEN EXIT LOOP
 149       C=C+1:IF C>15 THEN C=1
 150       COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU";
 151    LOOP
 152 END SUB
 153 '-----------------------------------------------------------------------------
 154
 155 \1a