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