Borland TurboBASIC & TurboPASCAL stuff from 1998 when i started with programming...

[mirrors/Programs.git] / turbobasic / 3RD-PA.RTY / MENU.BAS

diff --git a/turbobasic/3RD-PA.RTY/MENU.BAS b/turbobasic/3RD-PA.RTY/MENU.BAS
new file mode 100755 (executable)
index 0000000..1740e7d
--- /dev/null
+++ b/turbobasic/3RD-PA.RTY/MENU.BAS
@@ -0,0 +1,143 @@
+ GOTO POKR\r
+\r
+POKR :\r
+SCREEN 8 : CLS\r
+COLOR 14,1\r
+RESTORE BARVY\r
+BARVY :\r
+\r
+    DATA 8,7,15,15,7,8\r
+FOR A=1 TO 6\r
+   READ C\r
+   LINE (A,A)-(640-A,A),C\r
+   LINE (A,106-A)-(640-A,106-A),C\r
+   LINE (A,A)-(A,106-A),C\r
+   LINE (640-A,A)-(640-A,106-A),C\r
+   LINE (A,110+A)-(640-A,110+A),C\r
+   LINE (A,200-A)-(640-A,200-A),C\r
+   LINE (A,110+A)-(A,200-A),C\r
+   LINE (640-A,110+A)-(640-A,200-A),C\r
+NEXT A\r
+\r
+DO\r
+   A$="TELEFON  DIR    exit   HELP   TELEF "\r
+   D=5:X=5:Y=17:C=14\r
+   GOSUB MENU\r
+   ON MENU GOSUB TELEFON,DIR,KONEC,HELP,LOAD\r
+LOOP\r
+\r
+'-----------------------------------------------------------------------------\r
+TELEFON :\r
+print "ahoj"\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+DIR :\r
+\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+KONEC :\r
+print "stla\9f kl vesu Enter A CEKEJ "\r
+end\r
+'-----------------------------------------------------------------------------\r
+HELP :\r
+A$="Jste uzivatelem pocitacove site C&P NETWORK. Jste vybaven harddiskem se"\r
+CALL ECHO (5,16,A$,13)\r
+A$="softwarovym vybavenim. Mate k dispozici modem, takze muzete navazat"\r
+CALL ECHO (7,17,A$,13)\r
+A$="spojeni s jinym uzivatelem C&P NETWORK."\r
+CALL ECHO (7,18,A$,13)\r
+stop\r
+\r
+CALL ANYKEY\r
+CALL CLWD\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+LOAD :\r
+PRINT " DOBRY DEN DOVOLALI JSTE SE NA TEL.:56 18 243 "\r
+LOCATE 9,23\r
+PRINT " TADY TOMAS MUDRUNKA "\r
+\r
+\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+\r
+\r
+END\r
+'-----------------------------------------------------------------------------\r
+'                    podprogram ECHO\r
+' postupny tisk textu obsazeneho v retezcove promenne A$\r
+' na souradnice X a Y\r
+' barvou C\r
+\r
+SUB ECHO(X,Y,A$,C)\r
+   COLOR C\r
+   LOCATE Y,X\r
+   FOR A=1 TO LEN(A$)\r
+      PRINT MID$ (A$,A,1);\r
+      SOUND 1200,.2\r
+      SOUND 900,.2\r
+      SOUND 600,.2\r
+      FOR I=1 TO 200\r
+      NEXT I\r
+   NEXT A\r
+END SUB\r
+\r
+'--------------------------------------------------------------------------\r
+\r
+MENU :\r
+   ' PODPROGRAM 'MENU'\r
+\r
+   ' X a Y jsou textove souradnice menu-okna\r
+   ' A$ obsahuje text okna\r
+   ' D je pocet polozek (radku) v menu\r
+   ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu\r
+   ' C je barva okna\r
+   ' v promenne MENU podprogram vraci cislo zvolene polozky\r
+\r
+   L=LEN (A$)/D : MENU = 1 : M = MENU+.0001\r
+   COLOR C,9:LOCATE Y,X\r
+   PRINT CHR$(201);\r
+   FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+   PRINT CHR$ (187);\r
+   FOR A= 1 TO LEN(A$) STEP L\r
+      LOCATE Y+A/L+1,X\r
+      PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186);\r
+   NEXT A\r
+   LOCATE Y+A/L+1,X: PRINT CHR$(200);\r
+   FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+   PRINT CHR$(188);\r
+   IF W=1 THEN W=0 : RETURN\r
+\r
+  DO\r
+   I$ = INKEY$\r
+   IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1\r
+   IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1\r
+   IF MENU < 1     THEN MENU = D\r
+   IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP\r
+   IF MENU > D THEN MENU = 0 : EXIT LOOP       \r
+   IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " ";\r
+   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\r
+   M = MENU\r
+  LOOP\r
+   I=MENU\r
+   W=1:C=0:GOSUB MENU\r
+   MENU = I : COLOR 15\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+SUB CLWD\r
+   'Clear window\r
+   FOR A=120 TO 190\r
+      LINE (8,A)-(632,A),0\r
+   NEXT A\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+SUB ANYKEY\r
+   DO\r
+      IF INKEY$<>"" THEN EXIT LOOP\r
+      C=C+1:IF C>15 THEN C=1\r
+      COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU";\r
+   LOOP\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+\r
+\1a
\ No newline at end of file