5 ' key redefintion program   04/23/83
6 ' Program by Marty Smith, SOURCE ST2259, COMPUSERVE 72155,1214
7 ' 310 Cinnamon Oak Lane, Houston TX
8 ' (713) 661-1241 (Office), (713) 464-6737 (Home)
10 DEFINT A-Z : KEY OFF : I=0 : QL=127 : CR$="\" : DIM K$(132)
20 CLS
30 COLOR 0,7 : PRINT "KEYS.BAS -- ANSI.SYS keyboard redefintion.";: COLOR 7,0 : PRINT
35 GOSUB 740
40 PRINT "DOS 2.0 only. The ANSI.SYS device driver must be in your CONFIG.SYS file."
50 PRINT : PRINT "First you are asked for symbol to use for a RETURN in the string."
52 PRINT "This defaults to the backslash (\), but can be any key."
55 PRINT "Then you are asked for a filename to store your new keys."
60 PRINT : PRINT "    Then:"
70 PRINT "(1) Press the key to be redefined (or combination, such as ALT+x),"
80 PRINT "(2) Enter the string, up to 127 characters, followed by a RETURN."
90 PRINT : PRINT "When finished you can redefine these keys by TYPEing the file created from DOS."
95 PRINT : PRINT "Please enter a key to use for a RETURN character." :PRINT "Default = ";CR$;"  ";
97 INPUT NCR$ : IF NCR$<>"" THEN CR$=NCR$
100 PRINT : FS$="" : LINE INPUT "Please enter a filename for the keys: ";FS$
105 IF FS$="" THEN PRINT "Need a filespec to store key definitions." : GOTO 500
110 FOR I=1 TO 10 : KEY I,"" : NEXT
120 OPEN FS$ FOR OUTPUT AS #1
200 PRINT "Press the key or combo to be redefined, Esc to end ";: LOCATE ,,1
210 I$="" : WHILE I$="" : I$=INKEY$ : WEND : IF I$=CHR$(27) THEN 400 ELSE PRINT
220 IF LEN(I$)=1 THEN KEYS=1 : J$="["+MID$(STR$(ASC(I$)),2,3)+";"
230 IF LEN(I$)=2 THEN KEYS=2 : J$="[0;"+MID$(STR$(ASC(RIGHT$(I$,1))),2,3)+";"
240 IF LEN(I$)>2 OR LEN(I$)<1 THEN BEEP : PRINT "Only one key or combination at a time." : GOTO 200
245 II$=I$ : GOSUB 600
250 PRINT "Type string to redefine ";:COLOR 15,0: PRINT WHATKEY$;: COLOR 7,0 : PRINT ", use ";CR$;" for a RETURN."
260 COLOR 15,0 : GOSUB 800 : D$=Q$ : COLOR 7,0 : PRINT
270 PRINT "Is this OK?"; : LOCATE ,,1 : K$="" : WHILE K$="" : K$=INKEY$ : WEND
280 IF K$="N" OR K$="n" THEN PRINT :GOTO 200 ELSE PRINT
310 IF RIGHT$(D$,1)=CHR$(13) THEN D$=LEFT$(D$,LEN(D$)-1) : CR=-1 ELSE CR=0
320 IF ALT THEN J$=J$+D$ ELSE J$=J$+CHR$(34)+D$+CHR$(34)
330 IF CR THEN J$=J$+";13p" ELSE J$=J$+"p"
340 PRINT #1,WHATKEY$+" = ";D$; : IF CR THEN PRINT #1,CR$ ELSE PRINT #1,""
350 PRINT #1,CHR$(27)+J$
360 GOTO 200
400 CLOSE : CLS
410 OPEN FS$ FOR INPUT AS #1
415 PRINT "Keys in file ";:COLOR 0,7: PRINT FS$;: COLOR 7,0 : PRINT " to be redefined as:"
420 WHILE NOT EOF(1)
430 LINE INPUT #1,A$
440 IF LEFT$(A$,1)=CHR$(27) THEN 460
450 PRINT A$
460 WEND : CLOSE : PRINT "Just TYPE ";FS$;" from DOS to put these keys into effect."
470 PRINT : PRINT "Create another set of keys?";:LOCATE ,,1
480 I$="" : WHILE I$="" : I$=INKEY$ : WEND
490 IF I$="Y" OR I$="y" THEN 100
500 KEY 1,"LIST " : KEY 2,"RUN"+CHR$(13) : KEY 3,"LOAD"+CHR$(34) : KEY 4,"SAVE"+CHR$(34) : KEY 5,"CONT"+CHR$(13)
510 KEY 6,","+CHR$(34)+"LPT1" : KEY 7,"TRON"+CHR$(13) : KEY 8,"TROFF"+CHR$(13) : KEY 9,"KEY "
515 KEY 10,"SCREEN 0,0,0"+CHR$(13)
520 KEY ON : END
600 ' Put key press into whatkey$
610 IF KEYS=1 THEN WHATKEY$=II$+CHR$(32) : GOTO 630
620 WHATKEY$=K$(ASC(RIGHT$(II$,1)))+CHR$(32)
630 RETURN
700 DATA NUL,Shift Tab,Q,W,E,R,T,Y,U,I,O,P,A,S,D,F,G,H,J,K,L,Z,X,C,V,B,N,M
710 DATA F1,F2,F3,F4,F5,F6,F7,F8,F9,F10,Home,Cursor Up,Pg Up,Cursor Left,Cursor Right,End,Cursor Down,Pg Dn
720 DATA Ins,Del,Ctrl-PrtSc,Ctrl-Cursor Left,Ctrl-Cursor Right,Ctrl-End,Ctrl-Pg Dn,Ctrl-Home
730 DATA 1,2,3,4,5,6,7,8,9,0,-,=,Ctrl-Pg Up
740 READ K$(3) : READ K$(15)
750 FOR I=16 TO 25 : READ K$(I) : K$(I)="Alt-"+K$(I) : NEXT
752 FOR I=30 TO 38 : READ K$(I) : K$(I)="Alt-"+K$(I) : NEXT
754 FOR I=44 TO 50 : READ K$(I) : K$(I)="Alt-"+K$(I) : NEXT
760 FOR I=59 TO 68 : READ K$(I) : K$(I+25)="Shift-"+K$(I) : K$(I+35)="Ctrl-"+K$(I) : K$(I+45)="Alt-"+K$(I) : NEXT
770 FOR I=71 TO 73 : READ K$(I) : NEXT : READ K$(75) : READ K$(77)
775 FOR I=79 TO 83 : READ K$(I) : NEXT : FOR I=114 TO 119 : READ K$(I) : NEXT
780 FOR I=120 TO 131 : READ K$(I) : K$(I)="Alt-"+K$(I) : NEXT
790 READ K$(132) : RETURN
800 ' Q-String subroutine, courtest Andy Fleugleman
810 ' Q$=string returned,  QL=max length
820 LOCATE ,,1 : ALT=0
830 Q$="" : IF QL=0 THEN QL=255
840 QI$=INKEY$ : IF QI$="" THEN 840
850 IF QI$=CHR$(13) THEN RETURN
860 IF QI$<>CHR$(8) THEN 890
870 IF Q$="" THEN BEEP : GOTO 840
880 GOSUB 980 : Q$=LEFT$(Q$,LEN(Q$)-1) : GOTO 840
890 IF LEN(Q$)=QL THEN BEEP : GOTO 840
900 IF LEN(QI$)=1 THEN 930
910 IF QI$<>CHR$(0)+CHR$(3) THEN GOTO 1000
920 QI$=CHR$(0) : GOTO 940
930 IF ASC(QI$)>31 THEN PRINT QI$;: GOTO 950
940 COLOR 15:PRINT CHR$(ASC(QI$)+64);:COLOR 7
950 IF QI$=CR$ THEN Q$=Q$+CHR$(13):GOTO 840
960 Q$=Q$+QI$:GOTO 840
970 '
980 PRINT CHR$(29);" ";CHR$(29);:RETURN
990 ' return ext. key set up
1000 Q$=STR$(ASC(RIGHT$(QI$,1))) : MID$(Q$,1,1)=";" : Q$="0"+Q$ : ALT=-1
1010 II$=QI$ : GOSUB 600 : PRINT WHATKEY$; : RETURN
1020 ' end subroutine
(QI$,1))) : MID$(Q$,1,1)=";" : Q$="0"+Q$ : ALT=-1
1010 II$=QI$ : GOSUB 600 : PRINT WHATKEY$; : RETURN
1020 ' end subrouti