TYPE SETFKE.PAS
 PROGRAM Set_FKeys(input,output); 
 
 {********************************************************************} 
 {                                                                    } 
 {     This program will set Function keys from DOS and will display  } 
 {     it on line 25 as in BASIC. You can set the keys in two         } 
 {     different format. One is immediate where you don't need to     } 
 {     hit return, while the other one is delay where you can hit     } 
 {     return after hitting the function key or after adding any      } 
 {     thing to the string and then hitting return. Please refer      } 
 {     to SETFKEYS.DOC for more information.                          } 
 {                                                                    } 
 {********************************************************************} 
 
 TYPE 
   defstring = lstring(20); 
 
 FUNCTION vdoxqq(command:word): word; EXTERN; 
 
 { FUNCTION vdoxqq is an undocumented function in IBM Pascal. This } 
 { function is used to control your screen using INT 10h. Variable } 
 { vrbxqq, vrcxqq and vrdxqq have to be declared as EXTERN to use  } 
 { this function.                                                  } 
 
 VAR [EXTERN] vrbxqq, vrcxqq, vrdxqq : word; 
 
 PROCEDURE ID;  { Introduction of program to user } 
 
 BEGIN 
   Write(chr(27), '[2J');   { Clear the screen and home cursor } 
   Writeln(' Program to Set Up Function Keys using ANSI.SYS keyboard'); 
   Writeln(' Driver under DOS 2.0'); 
   Writeln; 
   Writeln(' The ANSI.SYS keyboard driver must be installed before'); 
   Writeln(' this program is run.'); 
   Writeln; 
   Writeln(' This program was taken from PC Tech Journal, Vol. 1, No.6 and was'); 
   Writeln(' modefied by Ravil Desai to make the set keys display on the bottom'); 
   Writeln(' of the screen and also other modification of delay and immediate'); 
   Writeln(' settings. '); 
   Writeln; 
   Writeln('                      SETFKEYS.EXE '); 
   Writeln('                            by    '); 
   Writeln('                       Ravil Desai'); 
   Writeln; 
   Writeln('                        72406,2365'); 
   Writeln; 
 END; 
 
 PROCEDURE DisplayIt (functionkey : Integer; newstring : defstring; mode : char); 
 
 VAR 
   position,cur_pstn,j  : integer; 
   video_out,charac : word; 
 
 BEGIN 
   cur_pstn := (8*functionkey - 8); 
   vrbxqq := byword(00,112);                { Character attribute - reverse (112) } 
   vrcxqq := byword(00,01);                 { Number of characters to write } 
   vrdxqq := byword(24,lobyte(cur_pstn));   { Set cursor using INT 10h } 
   EVAL(vdoxqq(#0200));                     { Function 2 } 
   write(functionkey : 2); 
   cur_pstn := cur_pstn + 1 ; 
   For j := 1 to 5 do 
     Begin 
       charac := wrd(newstring[j]); 
       position := cur_pstn + j; 
       vrdxqq := byword(24,lobyte(position));        { Set cursor using INT 10h } 
       EVAL(vdoxqq(#0200));                          { Function 2 } 
       video_out := byword(09,lobyte(charac));       { Print a character using } 
       EVAL(vdoxqq(video_out));                      { INT 10h function 9 } 
     End; 
     vrdxqq := byword(24,lobyte(position +1));   { Set cursor using INT 10h } 
     EVAL(vdoxqq(#0200));                        { Function 2 } 
     If mode = '*' Then 
       Begin 
         video_out := byword(09,027); 
         EVAL(vdoxqq(video_out)); 
       End 
     Else 
       Begin 
         video_out := byword(09,032); 
         EVAL(vdoxqq(video_out)); 
       End; 
 END; 
 
 PROCEDURE DefineKey (functionkey : Integer; newstring : defstring; mode : char); 
 
 { Sends code to ANSI.SYS keyboard driver to redefine a function key; 
   function keys have extended ASCII codes, with a 0 followed by a 
   number 59-69 for function keys 1-10, respectively. } 
 
 VAR 
   length,i   : byte; 
 
 BEGIN 
   Write(chr(27), '[0;'); 
   Write((functionkey + 58) : 2, ';"'); 
   length := newstring.len; 
   For i := 1 to length do  { This routine will save the extra bytes which are } 
     Begin                  { left as blanks and also controls the cursor for  } 
       write(newstring[i]); { delay mode. } 
     End; 
   If mode = '*' Then 
     Write('";13p')         { If immediate then add 13 for enter } 
   Else 
     Write('";32p');        { else just put one space and no enter } 
 END; 
 
 PROCEDURE SetupKeys; 
 
 { Ask user which key to redefine and what new definition is } 
 
 VAR 
   number     : integer; 
   definition : defstring; 
   mode       : char; 
 
 BEGIN 
   Repeat 
     Writeln(' Please enter the number (1-10) of a function key to '); 
     Writeln(' redefine or enter 0 if all key redefinition has been '); 
     Writeln(' completed. '); 
     Write(' Function Key Number: '); 
     Readln(number); 
     If number in [1..10] 
       Then 
         Begin 
           Writeln(' Enter definition for F', number : 1, '.'); 
           Write(' Definition String: '); 
           Readln(definition); 
           Writeln(' Enter * for immediate or anything else for delay mode: '); 
           readln(mode); 
           DefineKey(number,definition,mode); 
           DisplayIt (number,definition,mode); 
           Write(chr(27), '[2J');        { Clear the screen and home cursor } 
         End 
   Until not (number in [1..10]); 
   Writeln; 
   Writeln(' Function key setup ended.') 
 END;

 BEGIN   { Main }
   ID;
   SetupKeys;
 END.    { Main }



XA 4 - Programming : Func