turbobasic/1998/1PROGRAM.BAS

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