home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TP5MENU.ZIP / BEEPKEY4.PAS next >
Encoding:
Pascal/Delphi Source File  |  1989-01-11  |  4.1 KB  |  186 lines
  1. {
  2. Copyright (c) 1988 BittWare Computing, ALL RIGHTS RESERVED
  3. }
  4. unit beepkey4;
  5. interface
  6.  
  7. uses
  8.         menuvars,
  9.         crt;
  10.  
  11. const
  12. {coded constants}
  13.         func_key        = 0;
  14.         carr_rtn        = 1;
  15.         valid_num       = 2;
  16.         lt_arr          = 4;
  17.         rt_arr          = 5;
  18.         up_arr          = 6;
  19.         dn_arr          = 7;
  20.         fn_home         = 8;
  21.         fn_end          = 9;
  22.         fn_pgdn         = 10;
  23.         fn_pgup         = 11;
  24.         escape          = 12;
  25.         back_spc        = 13;
  26.         ch_i            = 14;
  27.         ch_o            = 15;
  28.         ch_r            = 16;
  29.         ch_s            = 17;
  30.         ch_t            = 18;
  31.         space           = 20;
  32.         f1              = 21;
  33.         f2              = 22;
  34.         f3              = 23;
  35.         f4              = 24;
  36.         f5              = 25;
  37.         f6              = 26;
  38.         f7              = 27;
  39.         f8              = 28;
  40.         f9              = 29;
  41.         f10             = 30;
  42.         sh_lt_arr       = 31;
  43.         sh_rt_arr       = 32;
  44.         ctl_rt_arr      = 33;
  45.         ctl_lt_arr      = 34;
  46.         plus_key        = 35;
  47.         minus_key       = 36;
  48.         HotKey          = 37;
  49.         UnSuppFuncKey   = 38;
  50.         InsKey          = 39;
  51.         DelKey          = 40;
  52.         other_ch        = 255;
  53.  
  54.         lt_arr_asc      = 'K';
  55.         rt_arr_asc      = 'M';
  56.         up_arr_asc      = 'H';
  57.         dn_arr_asc      = 'P';
  58.         fn_end_asc      = 'O';
  59.         fn_home_asc     = 'G';
  60.         fn_pgdn_asc     = 'I';
  61.         fn_pgup_asc     = 'Q';
  62.         f1_asc          = ';';
  63.         f2_asc          = '<';
  64.         f3_asc          = '=';
  65.         f4_asc          = '>';
  66.         f5_asc          = '?';
  67.         f6_asc          = '@';
  68.         f7_asc          = 'A';
  69.         f8_asc          = 'B';
  70.         f9_asc          = 'C';
  71.         f10_asc         = 'D';
  72.         ins_asc         = 'R';
  73.         del_asc         = 'S';
  74.         ctl_lt_asc      = 's';
  75.         ctl_rt_asc      = 't';
  76.         back_spc_asc    = '';
  77.  
  78. type
  79.         linestring = string[80];
  80. {
  81.         ch_set = set of char;
  82. }
  83.  
  84. var
  85.         func_key_bool   :boolean;
  86.         indx            :integer;
  87.  
  88. procedure DelayOrKey(Pause:integer);
  89. procedure inkey(char_set:ch_set;var ch:char);
  90. procedure in_carr_rtn;
  91. procedure InEsc;
  92. procedure in_space;
  93. procedure up_case_func(var in_str:linestring);
  94. procedure bad_beep;
  95. procedure good_beep;
  96.  
  97. implementation
  98.  
  99. procedure good_beep;
  100. begin
  101.         sound(700);
  102.         delay(30);
  103.         nosound
  104. end;
  105.  
  106. procedure bad_beep;
  107. begin
  108.         sound(200);
  109.         delay(150);
  110.         nosound
  111. end;
  112.  
  113. procedure DelayOrKey(Pause:integer);
  114. var
  115.      ch   :char;
  116.      indx :integer;
  117. begin
  118.      indx := 0;
  119.      repeat
  120.           delay(20);
  121.           inc(indx);
  122.      until((indx=pause) or KeyPressed);
  123.      if KeyPressed then
  124.           repeat
  125.                ch := readkey;
  126.           until(not(KeyPressed));
  127. end;
  128.  
  129. procedure up_case_func(var in_str:linestring);
  130. var
  131.    ch    :string[1];
  132. begin
  133.      for indx := 1 to length(in_str) do begin
  134.               ch := copy(in_str,indx,1);
  135.               delete(in_str,indx,1);
  136.               insert(upcase(ch[1]),in_str,indx);
  137.      end;
  138. end;
  139.  
  140. procedure in_space;
  141. var
  142.         ch:char;
  143. begin
  144.       repeat
  145.              ch := readkey;
  146.              if ch <> ' ' then bad_beep;
  147.       until ch = ' ';
  148. end;
  149.  
  150. procedure in_carr_rtn;
  151. var
  152.         ch:char;
  153. begin
  154.       repeat
  155.            ch := readkey;
  156.              if ch <> #13 then bad_beep;
  157.       until ch = #13;
  158. end;
  159.  
  160. procedure InEsc;
  161. var
  162.         ch:char;
  163. begin
  164.       repeat
  165.            ch := readkey;
  166.            if ch <> #27 then bad_beep;
  167.       until ch = #27;
  168. end;
  169.  
  170. procedure inkey(char_set:ch_set;var ch:char);
  171. begin
  172.      repeat
  173.            ch := readkey;
  174.            ch := upcase(ch);
  175.            if not (ch in char_set) then begin
  176.                 if ch=#0 then begin
  177.                       ch := readkey;
  178.                       ch := #255;
  179.                 end;
  180.                 bad_beep;
  181.            end;
  182.     until ch in char_set;
  183. end;
  184.  
  185. end.
  186.