turbobasic/1998/PROGRAM2.BAS

   1  GOTO POKR
   2
   3
   4
   5 POKR :
   6 SCREEN 8 : CLS
   7 COLOR 14,1
   8 RESTORE BARVY
   9 BARVY :
  10
  11     DATA 8,7,15,15,7,8
  12 FOR A=1 TO 6
  13    READ C
  14    LINE (A,A)-(640-A,A),C
  15    LINE (A,106-A)-(640-A,106-A),C
  16    LINE (A,A)-(A,106-A),C
  17    LINE (640-A,A)-(640-A,106-A),C
  18    LINE (A,110+A)-(640-A,110+A),C
  19    LINE (A,200-A)-(640-A,200-A),C
  20    LINE (A,110+A)-(A,200-A),C
  21    LINE (640-A,110+A)-(640-A,200-A),C
  22 NEXT A
  23
  24 REM zadani polozek adresare
  25 DO
  26    A$="NASOB AHOJ  POZDR NASO2 KONEC "
  27    D=5:X=5:Y=17:C=14
  28    GOSUB MENU
  29    ON MENU GOSUB NASOB,TEXT,NIC1,NASOB2,KONEC
  30 LOOP
  31
  32 '-----------------------------------------------------------------------------
  33 TEXT :
  34 SOUND RND*10000+12,13
  35 SOUND RND*100+99,80
  36 print "ahoj"
  37 RETURN
  38 '-----------------------------------------------------------------------------
  39 NASOB :
  40 SCREEN 0
  41 CLS
  42 SOUND RND*1000+20,70
  43 COLOR 14,1
  44 N=0
  45 S=0
  46 V=0
  47 SOUND RND*300+12,13
  48 SOUND RND*10000+12,13
  49 OPET:
  50 N=N+1
  51 CLS
  52 LOCATE 4,23
  53 PRINT "PROGRAM PRO ZKOUSENI MALE NASOBILKY"
  54 A=INT(RND(5)*10+1)
  55 B=INT(RND(4)*10+1)
  56 LOCATE 10,5
  57 PRINT "NAPIS VYSLEDEK" A "x" B "="
  58 INPUT "    STISKNI ENTER";C
  59 D=A*B
  60 IF D=C THEN ANO
  61 SOUND RND*10000+90,90
  62 PRINT "    SPATNY VYSLEDEK"
  63 SOUND RND*10000+12,13
  64 S=S+1
  65 GOTO VOLBA
  66 SOUND RND*100+12,13
  67 ANO:
  68 SOUND RND*100+90,90
  69 PRINT "    SPRAVNE"
  70 V=V+1
  71 VOLBA:
  72 LOCATE 18,10
  73 SOUND RND* 10000+55,55
  74 SOUND RND* 100+55,55
  75 PRINT "Z" N "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH"
  76 LOCATE 20,10
  77 PRINT "POKUD CHCES POKRACOVAT ZMACKNI ENTER"
  78 LOCATE 21,10
  79 INPUT "POKUD CHCES SKONCIT NAPIS 1 A ZMACKNI 2 x ENTER";E
  80 IF E<>1 THEN OPET
  81 REM  pise chybu     sound rnd*100+12,13
  82 RETURN
  83 '-----------------------------------------------------------------------------
  84 KONEC :
  85 SOUND RND*100+55,100
  86 print "stlac klavesu Enter"
  87 end
  88 '-----------------------------------------------------------------------------
  89 NIC1 :
  90 SOUND RND*100+55,55
  91 A$="Zdravi Vas Tomas Mudrunka"
  92 CALL ECHO (5,16,A$,13)
  93 A$="Jak se mate?"
  94 CALL ECHO (7,17,A$,13)
  95 A$="Jak se Vam libi tento program?"
  96 CALL ECHO (7,18,A$,13)
  97 stop
  98
  99 CALL ANYKEY
 100 CALL CLWD
 101 RETURN
 102 '-----------------------------------------------------------------------------
 103 NASOB2 :
 104
 105 SCREEN 0
 106 CLS
 107 rem           SOUND RND*1000+20,70
 108 COLOR 4,15
 109 S=0
 110 V=0
 111 rem       SOUND RND*300+12,13
 112 rem     SOUND RND*10000+12,13
 113
 114 FOR I=1 TO 10
 115  rem   nechat pokud nebude vadit         CLS
 116   LOCATE 4,20
 117         PRINT "PROGRAM PRO ZKOUSENI MALE NASOBILKY - 10 PRIKLADU"
 118
 119         A=INT(RND(5)*10+1)
 120         B=INT(RND(4)*10+1)
 121         LOCATE 10,5
 122           REM vymaze radek
 123           PRINT "                                     "
 124           PRINT "                                     "
 125           LOCATE 10,5
 126         PRINT "NAPIS VYSLEDEK" A "x" B "="
 127         INPUT "    STISKNI ENTER";C
 128         D=A*B
 129
 130         IF D=C THEN ANO2
 131         SOUND RND*10000+55,55
 132         PRINT "    SPATNY VYSLEDEK"
 133         rem        SOUND RND*10000+12,13
 134         S=S+1
 135         GOTO VOLBA2
 136         rem       SOUND RND*100+12,13
 137         ANO2:
 138         SOUND RND*100+55,55
 139         PRINT "    SPRAVNE"
 140         V=V+1
 141         VOLBA2:
 142    LOCATE 18,10
 143    PRINT "Z" I "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH"
 144          REM zdrzeni programu
 145          FOR G=1 TO 10
 146              rem    SOUND RND*1000+12,13
 147          NEXT G
 148 NEXT I
 149
 150 LOCATE 18,10
 151 PRINT "Z" S+V "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH"
 152
 153 IF S=>4 THEN T=5
 154 IF S=3 THEN T=4
 155 IF S=2 THEN T=3
 156 IF S=1 THEN T=2
 157 IF S=0 THEN T=1
 158 LOCATE 20,10
 159 PRINT "VYSLEDNA ZNAMKA" T
 160
 161 Input "Ukonci stiskem klavesy ENTER";A
 162 RETURN
 163 '-----------------------------------------------------------------------------
 164 '                    podprogram ECHO
 165 ' postupny tisk textu obsazeneho v retezcove promenne A$
 166 ' na souradnice X a Y
 167 ' barvou C
 168
 169 SUB ECHO(X,Y,A$,C)
 170    COLOR C
 171    LOCATE Y,X
 172    FOR A=1 TO LEN(A$)
 173       PRINT MID$ (A$,A,1);
 174       SOUND 1200,.2
 175       SOUND 900,.2
 176       SOUND 600,.2
 177       FOR I=1 TO 200
 178       NEXT I
 179    NEXT A
 180 END SUB
 181
 182 '--------------------------------------------------------------------------
 183
 184 MENU :
 185    ' PODPROGRAM 'MENU'
 186
 187    ' X a Y jsou textove souradnice menu-okna
 188    ' A$ obsahuje text okna
 189    ' D je pocet polozek (radku) v menu
 190    ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu
 191    ' C je barva okna
 192    ' v promenne MENU podprogram vraci cislo zvolene polozky
 193
 194    L=LEN (A$)/D : MENU = 1 : M = MENU+.0001
 195    COLOR C,9:LOCATE Y,X
 196    PRINT CHR$(201);
 197    FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A
 198    PRINT CHR$ (187);
 199    FOR A= 1 TO LEN(A$) STEP L
 200       LOCATE Y+A/L+1,X
 201       PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186);
 202    NEXT A
 203    LOCATE Y+A/L+1,X: PRINT CHR$(200);
 204    FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A
 205    PRINT CHR$(188);
 206    IF W=1 THEN W=0 : RETURN
 207
 208   DO
 209    I$ = INKEY$
 210    IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1
 211    IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1
 212    IF MENU < 1     THEN MENU = D
 213    IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP
 214    IF MENU > D THEN MENU = 0 : EXIT LOOP
 215    IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " ";
 216    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
 217    M = MENU
 218   LOOP
 219    I=MENU
 220    W=1:C=0:GOSUB MENU
 221    MENU = I : COLOR 15
 222 RETURN
 223 '-----------------------------------------------------------------------------
 224 SUB CLWD
 225    'Clear window
 226    FOR A=120 TO 190
 227       LINE (8,A)-(632,A),0
 228    NEXT A
 229 END SUB
 230 '-----------------------------------------------------------------------------
 231 SUB ANYKEY
 232    DO
 233       IF INKEY$<>"" THEN EXIT LOOP
 234       C=C+1:IF C>15 THEN C=1
 235       COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU";
 236    LOOP
 237 END SUB
 238 '-----------------------------------------------------------------------------
 239
 240 \1a