News:

Printed Amstrad Addict magazine announced, check it out here!

Main Menu
avatar_CPCIak

Disketten-Menu-Generator

Started by CPCIak, 19:49, 30 December 09

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Print
Go Down Pages1
User actions

CPCIak

19:49, 30 December 09 Last Edit: 12:20, 03 January 10 by CPCIak
Ich habe gerade ein nützliches Programm in der AA Ausgabe vom November '93 gefunden:
Es handelt sich um einen Menügenerator für Disketteninhalte. Das Programm besteht aus zwei Teilen.
Allerdings funktioniert bereits der erste nicht korrekt: Das Programm nimmt keinerlei Befehle der Cursor-Tasten an. Wer kann mir bei der Fehlersuche helfen?

Programm 1
Code Select

1000 'REVISION JAN 2009
1010 'Menu Generator by R A Shaw
1020 'for Amstrad Action November 1993
1030 MODE 2:WINDOW 1,80,2,25:WINDOW#1,3,38,5,16:WINDOW#2,41,70,2,19:WINDOW#3,1,80,21,23:WINDOW#4,10,80,24,25:WINDOW#5,1,80,1,1
1040 PEN#5,0:PAPER#5,1
1050 maxops=12
1060 msg$="Use curson keys and press ENTER to choose; press space bar to return to menu"
1070 DIM name$(maxops+1),prog$(maxops+1),op$(4)
1080 op$(1)="Add Choices":op$(2)="Delete Choices":op$(3)="Change Choices":op$(4)="Quit"
1090 CLS#5:PRINT#5,TAB(33)"Menu Generator"TAB(65)CHR$(164)" R A Shaw 1993"
1100 LOCATE 16,11:PRINT CHR$(24)" Please insert disk in drive and press a key... "CHR$(24)
1110 i$="":WHILE i$="":i$=INKEY$:WEND
1120 CLS
1130 ON ERROR GOTO 1730
1140 PEN 0
1150 OPENIN"menu.dat"
1160 CLS#1
1170 INPUT#9,nops
1180 FOR n=1 TO nops
1190 INPUT#9,name$(n),prog$(n)
1200 PRINT#1,name$(n);TAB(23)prog$(n)
1210 NEXT
1220 CLOSEIN
1230 PEN 1:LOCATE 3,2:PRINT"Name on Menu"TAB(25)"Program";
1240 GOSUB 1880
1250 CLS#4:PRINT#4,op$(1)"   "op$(2)"   "op$(3)"   "op$(4)
1260 WINDOW SWAP 2:CLS:|DIR,"*.b*":WINDOW SWAP 2:nl=VPOS(#2)-2
1270 x=1:y=1:v=1:strlen=17:hilen=15:cols=4:w=4:GOSUB 1750
1280 ON op GOSUB 1300,1420,1550,1660
1290 GOTO 1270
1300 'Add Choice
1310 IF nops=maxops THEN RETURN
1320 PRINT#3,msg$
1330 n=nops+1
1340 x=1:y=4:v=nl:strlen=15:hilen=12:cols=2:w=2:GOSUB 1750
1350 CLS#3
1360 IF i$=" " THEN RETURN
1370 prog$(n)=x$
1380 LOCATE#1,23,n:PRINT#1,x$;CHR$(13);
1390 INPUT#3,"Name to Appear on Menu: ",n$:IF n$="" THEN 1340
1400 name$(n)=LEFT$(n$,20):PRINT#1,name$(n):CLS#3
1410 nops=nops+1:GOTO 1310
1420 'Delete Choice
1430 IF nops=0 THEN RETURN
1440 PRINT#3,msg$
1450 strlen=20:hilen=20:w=1:cols=1:x=1:y=1:v=nops:GOSUB 1750
1460 CLS#3
1470 IF i$=" " THEN RETURN
1480 v=y
1490 FOR n=v TO nops
1500 name$(m)=name$(m+1):prog$(m)=prog$(m+1)
1510 LOCATE#1,1,m:PRINT#1,SPACE$(20)CHR$(13)name$(m):LOCATE#1,23,m:PRINT#1,SPACE$(12):LOCATE#1,23,m:PRINT#1,prog$(m);
1520 NEXT
1530 name$(nops)="":prog$(nops)="":nops=nops-1
1540 GOTO 1430
1550 'Change Choice
1560 IF nops=0 THEN RETURN
1570 PRINT#3,msg$
1580 strlen=20:hilen=20:w=1:cols=1:x=1:y=1:v=nops:GOSUB 1750
1590 CLS#3
1600 IF i$=" " THEN RETURN
1610 n=y
1620 INPUT#3,"Name to Appear on Menu: ",n$
1630 IF n$<>"" THEN name$(n)=LEFT$(n$,20):LOCATE#1,1,n:PRINT#1,SPACE$(20)CHR$(13)n$
1640 CLS#3
1650 GOTO 1560
1660 'Save and End
1670 OPENOUT"menu.dat"
1680 PRINT#9,nops
1690 FOR n=1 TO nops
1700 PRINT#9,name$(n):PRINT#9,prog$(n)
1710 NEXT
1720 CLOSEOUT:END
1730 'Error Handler
1740 IF DERR <> 146 THEN END ELSE RESUME 1230
1750 '
1760 'Highlighting routine - parms are x,y,v(=no of rows),hilen(=no of chars to highlight),strlen(=total chars in column),cols(=no o
1770 '
1780 xs=x:ys=y:xop=1:yop=1
1790 x$="":FOR a=0 TO hilen-1:LOCATE#w, x+a,y:c$=COPYCHR$(#w)
1800 x$=x$+c$:NEXT:LOCATE#w, x,y:PRINT#w, CHR$(24)x$CHR$(24)
1810 i$=LOWER$(INKEY$):IF i$="" THEN 1810 ELSE IF i$=CHR$(13) OR i$=" " THEN op=x\strlen+1:LOCATE#w,x,y:PRINT#w,x$:RETURN
1820 IF i$<CHR$(249) OR i$>CHR$(243) THEN 1810
1830 yn=y+(i$=CHR$(240))-(i$=CHR$(241)):xn=x+strlen*((i$=CHR$(242))-(i$=CHR$(243)))
1840 IF yn<ys OR yn>v OR xn<xs OR xn>(cols-1)*strlen+1 THEN 1810 ELSE LOCATE#w, xn,yn:c$=COPYCHR$(#w)
1850 IF c$=" " THEN 1810
1860 IF yn>y THEN yop=yop+1 ELSE IF yn<y THEN yop=yop-1 ELSE IF xn>x THEN xop=xop+1 ELSE xop=xop-1
1870 LOCATE#w,x,y:PRINT#w,x$:x=xn:y=yn:GOTO 1790
1880 'Draw Box
1890 LOCATE 2,3:PRINT CHR$(150)STRING$(21,154)CHR$(158)STRING$(14,154)CHR$(156);
1900 FOR n=4 TO 15:LOCATE 2,n:PRINT CHR$(149);:LOCATE 24,n:PRINT CHR$(149);:LOCATE 39,n:PRINT CHR$(149);:NEXT
1910 LOCATE 2,16:PRINT CHR$(147)STRING$(21,154)CHR$(155)STRING$(14,154)CHR$(153);
1920 RETURN


Programm 2
Code Select
1000 '
1010 'Menu Program by R A Shaw May 1993
1020 '
1030 'In the following line m is the mode, either 1 or 2, lines is the spacing i.e. 1=single, 2=double etc.
1040 m=1:lines=1
1050 MODE m:cols=20*2^m
1060 DIM msg$(2)
1070 msg$(0)="   Choose with cursor keys,  ":msg$(1)="    space bar or joystick.   ":msg$(2)=" Press fire or enter to return. "
1080 lc=(cols-LEN(msg$(0)))\2
1090 WINDOW#1,lc,lc+LEN(msg$(1)),23,25
1100 PEN#1,0:PAPER#1,1
1110 DIM name$(12),prog$(12)
1120 maxlen=0
1130 PRINT CHR$(24);SPACE$((cols-4)/2);"Menu";TAB(cols-13)CHR$(164)"R A Shaw 1993"CHR$(24)
1140 OPENIN"menu.dat":INPUT#9,nops
1150 FOR n=1 TO nops:INPUT#9,name$(n),prog$(n)
1160 l=LEN(name$(n)):IF l>maxlen THEN maxlen=1
1170 NEXT
1180 CLOSEIN
1190 sc=(cols-maxlen)\2:sr=12-(1+nops*lines)\2:LOCATE sc,sr
1200 FOR n=1 TO nops
1210 PRINT name$(n);TAB(sc);
1220 FOR m=1 TO lines-1:PRINT:PRINT TAB(sc);:NEXT
1230 NEXT
1240 FOR n=0 TO 2:LOCATE#1,1,n+1:PRINT#1,msg$(n);:NEXT
1250 LOCATE sc,sr:GOSUB 1290
1260 CLS#1:LOCATE#1,10,2:PRINT#1,"Loading   "
1270 RUN prog$(op)
1280 END
1290 '
1300 'Highlighting Subroutine
1310 '
1320 op=1:r=sr:pe=1:pa=0
1330 IF lines=0 THEN lines=1
1340 GOSUB 1500
1350 i$=INKEY$:IF i$="" THEN 1350
1360 i=ASC(i$):IF i=13 OR i=88 OR i=90 THEN PRINT CHR$(24):RETURN
1370 IF i=241 OR i=10 OR i=32 THEN 1390 ELSE IF i=240 OR i=11 THEN 1450 ELSE 1350
1380 '
1390 'Down
1400 '
1410 GOSUB 1500
1420 op=op+1:IF op>nops THEN op=1:r=sr ELSE r=r+lines
1430 GOTO 1340
1440 '
1450 'Up
1460 '
1470 GOSUB 1500
1480 op=op-1:IF op=0 THEN op=nops:r=r+(nops-1)*1 lines ELSE r=r-lines
1490 GOTO 1340
1500 LOCATE sc,r:pe=3-pe:pa:PEN pe:PAPER pa:PRINT name$(op);SPACE$(maxlen-LEN(name$(op)));:RETURN

Johnny Olsen

#1
01:20, 04 January 10
Now is working.

Program 1
Code Select
1000 'REVISION JAN 2009
1010 'Menu Generator by R A Shaw
1020 'For Amstrad Action November 1993 no.98
1030 MODE 2:WINDOW 1,80,2,25:WINDOW#1,3,38,5,16:WINDOW#2,41,70,2,19:WINDOW#3,1,80,21,23:WINDOW#4,10,80,24,25:WINDOW#5,1,80,1,1
1040 PEN#5,0:PAPER#5,1
1050 maxops=12
1060 msg$="Use cursor keys and press ENTER to choose; press space bar to return to menu"
1070 DIM name$(maxops+1),prog$(maxops+1),op$(4)
1080 op$(1)="Add Choices   ":op$(2)="Delete Choices":op$(3)="Change Choices":op$(4)="Quit          "
1090 CLS#5:PRINT#5,TAB(33)"Menu Generator"TAB(65)CHR$(164)" R A Shaw 1993"
1100 LOCATE 16,11:PRINT CHR$(24)" Please insert disk in drive and press a key... "CHR$(24)
1110 i$="":WHILE i$="":i$=INKEY$:WEND
1120 CLS
1130 ON ERROR GOTO 1730
1140 PEN 0
1150 OPENIN"menu.dat"
1160 CLS#1
1170 INPUT#9,nops
1180 FOR n=1 TO nops
1190 INPUT#9,name$(n),prog$(n)
1200 PRINT#1,name$(n);TAB(23)prog$(n)
1210 NEXT
1220 CLOSEIN
1230 PEN 1:LOCATE 3,2:PRINT"Name on Menu"TAB(25)"Program";
1240 GOSUB 1880
1250 CLS#4:PRINT#4,op$(1)"   "op$(2)"   "op$(3)"   "op$(4)
1260 WINDOW SWAP 2:CLS:|DIR,"*.b*":WINDOW SWAP 2:nl=VPOS(#2)-2
1270 x=1:y=1:v=1:strlen=17:hilen=15:cols=4:w=4:GOSUB 1750
1280 ON op GOSUB 1300,1420,1550,1660
1290 GOTO 1270
1300 'Add choice
1310 IF nops=maxops THEN RETURN
1320 PRINT#3,msg$
1330 n=nops+1
1340 x=1:y=4:v=nl:strlen=15:hilen=12:cols=2:w=2:GOSUB 1750
1350 CLS#3
1360 IF i$=" " THEN RETURN
1370 prog$(n)=x$
1380 LOCATE#1,23,n:PRINT#1,x$;CHR$(13);
1390 INPUT#3,"Name to Appear on Menu: ",n$:IF n$="" THEN 1340
1400 name$(n)=LEFT$(n$,20):PRINT#1,name$(n):CLS#3
1410 nops=nops+1:GOTO 1310
1420 'Delete Choice
1430 IF nops=0 THEN RETURN
1440 PRINT#3,msg$
1450 strlen=20:hilen=20:w=1:cols=1:x=1:y=1:v=nops:GOSUB 1750
1460 CLS#3
1470 IF i$=" " THEN RETURN
1480 v=y
1490 FOR m=v TO nops
1500  name$(m)=name$(m+1):prog$(m)=prog$(m+1)
1510  LOCATE#1,1,m:PRINT#1,SPACE$(20)CHR$(13)name$(m):LOCATE#1,23,m:PRINT#1,SPACE$(12):LOCATE#1,23,m:PRINT#1,prog$(m);
1520 NEXT
1530 name$(nops)="":prog$(nops)="":nops=nops-1
1540 GOTO 1430
1550 'Change choice
1560 IF nops=0 THEN RETURN
1570 PRINT#3,msg$
1580 strlen=20:hilen=20:w=1:cols=1:x=1:y=1:v=nops:GOSUB 1750
1590 CLS#3
1600 IF i$=" " THEN RETURN
1610 n=y
1620 INPUT#3,"Name to Appear on Menu: ",n$
1630 IF n$<>"" THEN name$(n)=LEFT$(n$,20):LOCATE#1,1,n:PRINT#1,SPACE$(20)CHR$(13)n$
1640 CLS#3
1650 GOTO 1560
1660 'Save and end
1670 OPENOUT"menu.dat"
1680 PRINT#9,nops
1690 FOR n=1 TO nops
1700  PRINT#9,name$(n):PRINT#9,prog$(n)
1710 NEXT
1720 CLOSEOUT:END
1730 'Error handler
1740 IF DERR <> 146 THEN END ELSE RESUME 1230
1750 '
1760 'Highlighting routine - parms are x,y,v(=no. of rows),hilen(=no. of chars to highlight),strlen(=total chars in column),cols(=no.of columns),w(=window no.)
1770 '
1780 xs=x:ys=y:xop=1:yop=1
1790 x$="":FOR a=0 TO hilen-1:LOCATE#w, x+a,y:c$=COPYCHR$(#w)
1800 x$=x$+c$:NEXT:LOCATE#w, x,y:PRINT#w, CHR$(24)x$CHR$(24)
1810 i$=LOWER$(INKEY$):IF i$="" THEN 1810 ELSE IF i$=CHR$(13) OR i$=" " THEN op=x\strlen+1:LOCATE#w,x,y:PRINT#w,x$:RETURN
1820 IF i$<CHR$(240) OR i$>CHR$(243) THEN 1810
1830 yn=y+(i$=CHR$(240))-(i$=CHR$(241)):xn=x+strlen*((i$=CHR$(242))-(i$=CHR$(243)))
1840 IF yn<ys OR yn>v OR xn<xs OR xn>(cols-1)*strlen+1 THEN 1810 ELSE LOCATE#w, xn,yn:c$=COPYCHR$(#w)
1850 IF c$=" " THEN 1810
1860 IF yn>y THEN yop=yop+1 ELSE IF yn<y THEN yop=yop-1 ELSE IF xn>x THEN xop=xop+1 ELSE xop=xop-1
1870 LOCATE#w,x,y:PRINT#w,x$:x=xn:y=yn:GOTO 1790
1880 'Draw Box
1890 LOCATE 2,3:PRINT CHR$(150)STRING$(21,154)CHR$(158)STRING$(14,154)CHR$(156);
1900 FOR n=4 TO 15:LOCATE 2,n:PRINT CHR$(149);:LOCATE 24,n:PRINT CHR$(149);:LOCATE 39,n:PRINT CHR$(149);:NEXT
1910 LOCATE 2,16:PRINT CHR$(147)STRING$(21,154)CHR$(155)STRING$(14,154)CHR$(153);
1920 RETURN


Program 2
Code Select
1000 '
1010 'Menu Program by R A Shaw May 1993
1020 'Amstrad Action november 1993 no.98
1030 'In the following line m is the mode, either 1 or 2, lines is the spacing i.e. 1=single, 2=double etc.
1040 m=1:lines=1
1050 MODE m:cols=20*2^m
1060 DIM msg$(2)
1070 msg$(0)="   Choose with cursor keys,  ":msg$(1)="    space bar or joystick.   ":msg$(2)=" Press fire or enter to run. "
1080 lc=(cols-LEN(msg$(0)))\2
1090 WINDOW#1,lc,lc+LEN(msg$(1)),23,25
1100 PEN#1,0:PAPER#1,1
1110 DIM name$(12),prog$(12)
1120 maxlen=0
1130 PRINT CHR$(24);SPACE$((cols-4)/2);"Menu";TAB(cols-13)CHR$(164)"R A Shaw 1993"CHR$(24)
1140 OPENIN"menu.dat":INPUT#9,nops
1150 FOR n=1 TO nops:INPUT#9,name$(n),prog$(n)
1160 l=LEN(name$(n)):IF l>maxlen THEN maxlen=l
1170 NEXT
1180 CLOSEIN
1190 sc=(cols-maxlen)\2:sr=12-(1+nops*lines)\2:LOCATE sc,sr
1200 FOR n=1 TO nops
1210 PRINT name$(n);TAB(sc);
1220 FOR m=1 TO lines-1:PRINT:PRINT TAB(sc);:NEXT
1230 NEXT
1240 FOR n=0 TO 2:LOCATE#1,1,n+1:PRINT#1,msg$(n);:NEXT
1250 LOCATE sc,sr:GOSUB 1290
1260 CLS#1:LOCATE#1,10,2:PRINT#1,"Loading..."
1270 RUN prog$(op)
1280 END
1290 '
1300 'Highlighting Subroutine
1310 '
1320 op=1:r=sr:pe=1:pa=0
1330 IF lines=0 THEN lines=1
1340 GOSUB 1500
1350 i$=INKEY$:IF i$="" THEN 1350
1360 i=ASC(i$):IF i=13 OR i=88 OR i=90 THEN PRINT CHR$(24):RETURN
1370 IF i=241 OR i=10 OR i=32 THEN 1390 ELSE IF i=240 OR i=11 THEN 1450 ELSE 1350
1380 '
1390 'Down
1400 '
1410 GOSUB 1500
1420 op=op+1:IF op>nops THEN op=1:r=sr ELSE r=r+lines
1430 GOTO 1340
1440 '
1450 'Up
1460 '
1470 GOSUB 1500
1480 op=op-1:IF op=0 THEN op=nops:r=r+(nops-1)*lines ELSE r=r-lines
1490 GOTO 1340
1500 LOCATE sc,r:pe=3-pe:pa=3-pa:PEN pe:PAPER pa:PRINT name$(op);SPACE$(maxlen-LEN(name$(op)));:RETURN



Put this file on the DSK and you have an explanation for the 2 files

Code Select
10 MODE 2:LIST
20 'R.Shawn has provided us with a nifty little program
30 'for creating menus for disk programs.
40 'Run the first program to create a data file,
50 'saving that data file on to a disk where you
60 'want your menu to be.Next,save the second
70 'program to the destinations disk,and run it;it
80 'loads up and uses the data file you created with
90 'the first program.

Gryzor

#2
09:55, 04 January 10
Hm... a shame I hadn't seen it back in the day, this is useful... all those disks that have scribblings like RUN"BARBARIA.BAS on the labels... :D

CPCIak

#3
10:04, 04 January 10
Thanks a lot Johnny
Print
Go Up Pages1
User actions
Powered by SMFPacks Menu Editor Mod