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