home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9203 / pastrick / skey.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1992-03-27  |  1.0 KB  |  67 lines
  1. uses DOS,CRT;
  2. (* Edwin SChwarz *)
  3.  
  4. const I16=$1000;
  5.  
  6. var reg:Registers;
  7.     Key:Word;
  8.     KeyHi,KeyLo:Byte;
  9.     Esc:String;
  10.     f:Text;
  11.  
  12. function GetKey:word;
  13. begin
  14.  reg.ax:=I16;
  15.  intr($16,reg);
  16.  GetKey:=reg.ax
  17. end;
  18.  
  19. function LSP:boolean;
  20. begin
  21.  LSP:=false;
  22.  reg.ax:=$0200;
  23.  intr($16,reg);
  24.  if reg.ax and 2  = 2 then LSP:=true
  25. end;
  26.  
  27. procedure PutKey(x:word);
  28. var s:string;
  29. begin
  30.  Str(LO(x),s);
  31.  Esc:=Esc+s+';';
  32.  if (Lo(x)=0) or ((Lo(x)=$E0) and (Hi(x)<>0)) then
  33.   begin
  34.   write(#249);
  35.   Str(Hi(x),s);
  36.   Esc:=Esc+s+';'
  37.   end
  38.  else write(chr(Lo(x)))
  39. end;
  40.  
  41. procedure GetKeyDef;
  42. begin
  43. repeat
  44.  Key:=GetKey;
  45.  if (Lo(Key)=13) and LSP then exit;
  46.  if (Lo(Key)=$E0) and (Hi(Key)<>0) then Key:=Key and $FF00;
  47.  PutKey(Key);
  48. until false
  49. end;
  50.  
  51. begin
  52. Assign(f,'');
  53. Rewrite(f);
  54. repeat
  55.  Esc:=#27+'[';
  56.  writeln;
  57.  write('Alt? ');
  58.  Key:=GetKey;
  59.  if (Lo(Key)=13) and LSP then begin close(f); HALT end;
  60.  PutKey(Key);
  61.  writeln;
  62.  write('Neu? ');
  63.  GetKeyDef;
  64.  write(f,Esc+';p');
  65.  until false
  66. end.
  67.