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