turbobasic/1998/CH.BAS

   1  GOTO POKR
   2
   3 POKR :
   4 SCREEN 8 : CLS
   5 COLOR 14,1
   6 RESTORE BARVY
   7 BARVY :
   8
   9     DATA 8,7,15,15,7,8,0,8,7,15,15,7,8,0,8,7,15,15,7,8,0,0,8,8,8,8,8,7,7,7,7,7,7,15,15,15,15,15,7,7,7,7,7,8,8,8,8,8,8,8,8,8,
  10 FOR A=1 TO 10
  11 REM ZAPLNENO 52
  12 REM 1 CARA 6 NEBO 7
  13 REM 2 CARY 13 NEBO 14
  14 REM PUL CARY 3
  15 REM PUL 2.CARY 10
  16 REM PUL ZAPLNENI 35
  17    READ C
  18    LINE (A,A)-(640-A,A),C
  19    LINE (A,106-A)-(640-A,106-A),C
  20    LINE (A,A)-(A,106-A),C
  21    LINE (640-A,A)-(640-A,106-A),C
  22    LINE (A,110+A)-(640-A,110+A),C
  23    LINE (A,200-A)-(640-A,200-A),C
  24    LINE (A,110+A)-(A,200-A),C
  25    LINE (640-A,110+A)-(640-A,200-A),C
  26 NEXT A
  27
  28 DO
  29    A$="TELEFON  DIR    exit   HELP   LOAD "
  30    D=5:X=5:Y=17:C=14
  31    GOSUB MENU
  32    ON MENU GOSUB TELEFON,DIR,KONEC,HELP,LOAD
  33 LOOP
  34
  35 '-----------------------------------------------------------------------------
  36 TELEFON :
  37 print "ahoj"
  38 RETURN
  39 '-----------------------------------------------------------------------------
  40 DIR :
  41 CALL ANYKEY
  42 CALL CLWD
  43 RETURN
  44 RETURN
  45 '-----------------------------------------------------------------------------
  46 KONEC :
  47 print "stlač klávesu Enter"
  48 end
  49 '-----------------------------------------------------------------------------
  50 HELP :
  51 A$="Jste uzivatelem pocitacove site C&P NETWORK. Jste vybaven harddiskem se"
  52 CALL ECHO (5,16,A$,13)
  53 A$="softwarovym vybavenim. Mate k dispozici modem, takze muzete navazat"
  54 CALL ECHO (7,17,A$,13)
  55 A$="spojeni s jinym uzivatelem C&P NETWORK."
  56 CALL ECHO (7,18,A$,13)
  57
  58
  59 CALL ANYKEY
  60 CALL CLWD
  61 RETURN
  62 '-----------------------------------------------------------------------------
  63 LOAD :
  64 FOR R=0 TO 4000
  65 NEXT R
  66 CLS
  67 COLOR 14,1
  68 FOR A=0 TO 2000
  69 Q=RND*55
  70 T=RND*55
  71 CIRCLE (Q,T),50
  72 FOR L=0 TO 5000
  73 NEXT L
  74 NEXT A
  75 LOCATE 8,23
  76 PRINT " KONEC "
  77 STOP
  78 '-----------------------------------------------------------------------------
  79
  80
  81 END
  82 '-----------------------------------------------------------------------------
  83 '                    podprogram ECHO
  84 ' postupny tisk textu obsazeneho v retezcove promenne A$
  85 ' na souradnice X a Y
  86 ' barvou C
  87
  88 SUB ECHO(X,Y,A$,C)
  89    COLOR C
  90    LOCATE Y,X
  91    FOR A=1 TO LEN(A$)
  92       PRINT MID$ (A$,A,1);
  93       SOUND 1200,.2
  94       SOUND 900,.2
  95       SOUND 600,.2
  96       FOR I=1 TO 200
  97       NEXT I
  98    NEXT A
  99 END SUB
 100
 101 '--------------------------------------------------------------------------
 102
 103 MENU :
 104    ' PODPROGRAM 'MENU'
 105
 106    ' X a Y jsou textove souradnice menu-okna
 107    ' A$ obsahuje text okna
 108    ' D je pocet polozek (radku) v menu
 109    ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu
 110    ' C je barva okna
 111    ' v promenne MENU podprogram vraci cislo zvolene polozky
 112
 113    L=LEN (A$)/D : MENU = 1 : M = MENU+.0001
 114    COLOR C,9:LOCATE Y,X
 115    PRINT CHR$(201);
 116    FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A
 117    PRINT CHR$ (187);
 118    FOR A= 1 TO LEN(A$) STEP L
 119       LOCATE Y+A/L+1,X
 120       PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186);
 121    NEXT A
 122    LOCATE Y+A/L+1,X: PRINT CHR$(200);
 123    FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A
 124    PRINT CHR$(188);
 125    IF W=1 THEN W=0 : RETURN
 126
 127   DO
 128    I$ = INKEY$
 129    IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1
 130    IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1
 131    IF MENU < 1     THEN MENU = D
 132    IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP
 133    IF MENU > D THEN MENU = 0 : EXIT LOOP
 134    IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " ";
 135    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
 136    M = MENU
 137   LOOP
 138    I=MENU
 139    W=1:C=0:GOSUB MENU
 140    MENU = I : COLOR 15
 141 RETURN
 142 '-----------------------------------------------------------------------------
 143 SUB CLWD
 144    'Clear window
 145    FOR A=120 TO 190
 146       LINE (8,A)-(632,A),0
 147    NEXT A
 148 END SUB
 149 '-----------------------------------------------------------------------------
 150 SUB ANYKEY
 151    DO
 152       IF INKEY$<>"" THEN EXIT LOOP
 153       C=C+1:IF C>15 THEN C=1
 154       COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU";
 155    LOOP
 156 END SUB
 157 '-----------------------------------------------------------------------------
 158
 159 \1a