home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / database / gsdb28 / gs_keyi.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-02-24  |  20.1 KB  |  460 lines
  1. unit GS_KeyI;
  2. {-----------------------------------------------------------------------------
  3.                            Keyboard Input Routines
  4.  
  5.        GS_KeyI Copyright (c)  Richard F. Griffin
  6.  
  7.         9 April 1990
  8.  
  9.        102 Molded Stone Pl
  10.        Warner Robins, GA  31088
  11.  
  12.        -------------------------------------------------------------
  13.        This unit handles the objects for all keyboard data entry
  14.        operations.
  15.  
  16.    Changes:
  17.  
  18.       02 Jun 91 - Made EditString a virtual method.
  19.  
  20.       20 Feb 92 - Added Done destructor for consistency to ensure a
  21.                   Done destructor exists for dynamic deallocation.
  22.  
  23.                   Added GSP_KeyI_Object as a pointer for dynamic
  24.                   allocation.
  25. ------------------------------------------------------------------------------}
  26.  
  27. interface
  28. {$D-}
  29.  
  30. uses
  31.    CRT, DOS, GS_Scrn;
  32.  
  33. const
  34.    BeepTime = 200;
  35.    BeepFreq = 600;
  36.  
  37.    Kbd_Null = #0;                     {Null Character}
  38.    Kbd_Nul  = #3;                     {Another Null}
  39.    Kbd_Bsp  = #8;                     {Backspace}
  40.    Kbd_Tab  = #9;                     {Tab}
  41.    Kbd_Ret  = #13;                    {Return}
  42.    Kbd_RTb  = #15;                    {Shift-Tab}
  43.    Kbd_AlQ  = #16;                    {Alt-Q}
  44.    Kbd_AlW  = #17;                    {Alt-W}
  45.    Kbd_AlE  = #18;                    {Alt-E}
  46.    Kbd_AlR  = #19;                    {Alt-R}
  47.    Kbd_AlT  = #20;                    {Alt-T}
  48.    Kbd_AlY  = #21;                    {Alt-Y}
  49.    Kbd_AlU  = #22;                    {Alt-U}
  50.    Kbd_AlI  = #23;                    {Alt-I}
  51.    Kbd_AlO  = #24;                    {Alt-O}
  52.    Kbd_AlP  = #25;                    {Alt-P}
  53.    Kbd_Esc  = #27;                    {Escape}
  54.    Kbd_AlA  = #30;                    {Alt-A}
  55.    Kbd_AlS  = #31;                    {Alt-S}
  56.    Kbd_AlD  = #32;                    {Alt-D}
  57.    Kbd_AlF  = #33;                    {Alt-F}
  58.    Kbd_AlG  = #34;                    {Alt-G}
  59.    Kbd_AlH  = #35;                    {Alt-H}
  60.    Kbd_AlJ  = #36;                    {Alt-J}
  61.    Kbd_AlK  = #37;                    {Alt-K}
  62.    Kbd_AlL  = #38;                    {Alt-L}
  63.    Kbd_AlZ  = #44;                    {Alt-Z}
  64.    Kbd_AlX  = #45;                    {Alt-X}
  65.    Kbd_AlC  = #46;                    {Alt-C}
  66.    Kbd_AlV  = #47;                    {Alt-V}
  67.    Kbd_AlB  = #48;                    {Alt-B}
  68.    Kbd_AlN  = #49;                    {Alt-N}
  69.    Kbd_AlM  = #50;                    {Alt-M}
  70.    Kbd_F1   = #59;                    {F1}
  71.    Kbd_F2   = #60;                    {F2}
  72.    Kbd_F3   = #61;                    {F3}
  73.    Kbd_F4   = #62;                    {F4}
  74.    Kbd_F5   = #63;                    {F5}
  75.    Kbd_F6   = #64;                    {F6}
  76.    Kbd_F7   = #65;                    {F7}
  77.    Kbd_F8   = #66;                    {F8}
  78.    Kbd_F9   = #67;                    {F9}
  79.    Kbd_F10  = #68;                    {F10}
  80.    Kbd_Home = #71;                    {Home}
  81.    Kbd_UpAr = #72;                    {Up Arrow}
  82.    Kbd_PgUp = #73;                    {Page Up}
  83.    Kbd_LfAr = #75;                    {Left Arrow}
  84.    Kbd_RtAr = #77;                    {Right Arrow}
  85.    Kbd_End  = #79;                    {End}
  86.    Kbd_DnAr = #80;                    {Down Arrow}
  87.    Kbd_PgDn = #81;                    {Page Down}
  88.    Kbd_Ins  = #82;                    {Insert}
  89.    Kbd_Del  = #83;                    {Delete}
  90.    Kbd_F11  = #84;                    {Shift-F1}
  91.    Kbd_F12  = #85;                    {Shift-F2}
  92.    Kbd_F13  = #86;                    {Shift-F3}
  93.    Kbd_F14  = #87;                    {Shift-F4}
  94.    Kbd_F15  = #88;                    {Shift-F5}
  95.    Kbd_F16  = #89;                    {Shift-F6}
  96.    Kbd_F17  = #90;                    {Shift-F7}
  97.    Kbd_F18  = #91;                    {Shift-F8}
  98.    Kbd_F19  = #92;                    {Shift-F9}
  99.    Kbd_F20  = #93;                    {Shift-F10}
  100.    Kbd_F21  = #94;                    {Ctrl-F1}
  101.    Kbd_F22  = #95;                    {Ctrl-F2}
  102.    Kbd_F23  = #96;                    {Ctrl-F3}
  103.    Kbd_F24  = #97;                    {Ctrl-F4}
  104.    Kbd_F25  = #98;                    {Ctrl-F5}
  105.    Kbd_F26  = #99;                    {Ctrl-F6}
  106.    Kbd_F27  = #100;                   {Ctrl-F7}
  107.    Kbd_F28  = #101;                   {Ctrl-F8}
  108.    Kbd_F29  = #102;                   {Ctrl-F9}
  109.    Kbd_F30  = #103;                   {Ctrl-F10}
  110.    Kbd_F31  = #104;                   {Alt-F1}
  111.    Kbd_F32  = #105;                   {Alt-F2}
  112.    Kbd_F33  = #106;                   {Alt-F3}
  113.    Kbd_F34  = #107;                   {Alt-F4}
  114.    Kbd_F35  = #108;                   {Alt-F5}
  115.    Kbd_F36  = #109;                   {Alt-F6}
  116.    Kbd_F37  = #110;                   {Alt-F7}
  117.    Kbd_F38  = #111;                   {Alt-F8}
  118.    Kbd_F39  = #112;                   {Alt-F9}
  119.    Kbd_F40  = #113;                   {Alt-F10}
  120.    Kbd_CPSc = #114;                   {Ctrl-PrtSc}
  121.    Kbd_CLAr = #115;                   {Ctrl-Left Arrow}
  122.    Kbd_CRAr = #116;                   {Ctrl-Right Arrow}
  123.    Kbd_CEnd = #117;                   {Ctrl-End}
  124.    Kbd_CPDn = #118;                   {Ctrl-Page Down}
  125.    Kbd_CHom = #119;                   {Ctrl-Home}
  126.    Kbd_Al1  = #120;                   {Alt-1}
  127.    Kbd_Al2  = #121;                   {Alt-2}
  128.    Kbd_Al3  = #122;                   {Alt-3}
  129.    Kbd_Al4  = #123;                   {Alt-4}
  130.    Kbd_Al5  = #124;                   {Alt-5}
  131.    Kbd_Al6  = #125;                   {Alt-6}
  132.    Kbd_Al7  = #126;                   {Alt-7}
  133.    Kbd_Al8  = #127;                   {Alt-8}
  134.    Kbd_Al9  = #128;                   {Alt-9}
  135.    Kbd_Al0  = #129;                   {Alt-0}
  136.    Kbd_AlHy = #130;                   {Alt-Hyphen}
  137.    Kbd_AlEq = #131;                   {Alt-Equal}
  138.    Kbd_CPUp = #132;                   {Ctrl-Page up}
  139.  
  140. type
  141.  
  142. {
  143.          ┌──────────────────────────────────────────────────────────┐
  144.          │  ********   Object for Keyboard Entry Action   *******   │
  145.          │                                                          │
  146.          │  This object type describes the structure for any child  │
  147.          │  so that the child object can use a virtual method to    │
  148.          │  handle processing of function keys.                     │
  149.          └──────────────────────────────────────────────────────────┘
  150. }
  151.  
  152.    GSP_KeyI_Objt = ^GS_KeyI_Objt;
  153.    GS_KeyI_Objt =  Object
  154.                       CPos        : Word;
  155.                                       {Holds the position within the string}
  156.                       Ch          : Char;
  157.                                       {Holds the last character read}
  158.                       First       : boolean;
  159.                                       {Flag to detect the first real character}
  160.                                       {entered from the keyboard}
  161.                       Modified    : boolean;
  162.                                       {Flag to signal whether the field was}
  163.                                       {mofified, or the default was returned}
  164.                       Wait_CR     : boolean;
  165.                                       {Flag to wait for Carriage Return before}
  166.                                       {exit.  If false, will exit when the}
  167.                                       {field is full}
  168.  
  169.                       constructor Init;
  170.                       destructor  Done;
  171.                       function    EditString(T : string; x, y, l : integer)
  172.                                             : string; virtual;
  173.                       procedure Check_Func_Keys; virtual;
  174.                                       {Note this method is virtual, so it may}
  175.                                       {be replaced by any child method for its}
  176.                                       {own processing of function key actions}
  177.                    end;
  178.  
  179.  
  180. var
  181.    GS_KeyI_Esc,
  182.    GS_KeyI_Fuc,
  183.    GS_KeyI_Ins,
  184.    GS_KeyI_Ret   : boolean;
  185.    GS_KeyI_Chr   : char;
  186.    GS_KeyI_Str   : string[255];
  187.  
  188. Function GS_KeyI_GetKey : char;       {Any program can call this to read a}
  189.                                       {character and test for function keys}
  190. procedure WaitForKey;
  191. procedure SoundBell( t,h : word);
  192. implementation
  193.  
  194. procedure SoundBell( t,h : word);
  195. begin
  196.    Sound(h);
  197.    Delay(t);
  198.    NoSound;
  199. end;
  200.  
  201. procedure WaitForKey;
  202. var
  203.    c  : char;
  204. begin
  205.    c := GS_KeyI_GetKey;
  206. end;
  207. {
  208.  
  209.                                GS_KEYI_GETKEY
  210.  
  211.      ╔══════════════════════════════════════════════════════════════════╗
  212.      ║                                                                  ║
  213.      ║   The GS_KeyI_GetKey function is used to read a character from   ║
  214.      ║   Keyboard.  It can be called from any program.                  ║
  215.      ║                                                                  ║
  216.      ║       Calling the Function:                                      ║
  217.      ║                                                                  ║
  218.      ║           Ch := GS_KeyI_GetKey                                   ║
  219.      ║                                                                  ║
  220.      ║               ( where Ch is of type char. )                      ║
  221.      ║                                                                  ║
  222.      ║       Result:                                                    ║
  223.      ║                                                                  ║
  224.      ║           A character is returned.  If it is a function key,     ║
  225.      ║           GS_KeyI_Func is set true.  The character is also       ║
  226.      ║           saved in GS_KeyI_Chr, a global variable (just in       ║
  227.      ║           case it is needed at a later date)                     ║
  228.      ║                                                                  ║
  229.      ╚══════════════════════════════════════════════════════════════════╝
  230.  
  231. }
  232.  
  233.  
  234. Function GS_KeyI_GetKey : char;
  235. var
  236.    ch: char;
  237. begin
  238.   Ch := ReadKey;                      {Use TP ReadKey Function}
  239.   If (Ch = #0) then                   {It must be a function key }
  240.   begin
  241.     Ch := ReadKey;                    {So read the function code}
  242.     GS_KeyI_Fuc := true;              {Set function flag}
  243.   end
  244.   else GS_KeyI_Fuc := false;
  245.   GS_KeyI_Chr := Ch;                  {Save in a global variable for general}
  246.                                       {principle.}
  247.   GS_KeyI_GetKey := Ch;               {Return character}
  248. end;
  249.  
  250.  
  251. constructor GS_KeyI_Objt.Init;
  252. begin
  253.    Wait_CR := true;                   {Wait for Carriage Return on field edit}
  254. end;
  255.  
  256. destructor GS_KeyI_Objt.Done;
  257. begin
  258. end;
  259.  
  260. {
  261.  
  262.                                  EDITSTRING
  263.  
  264.      ╔══════════════════════════════════════════════════════════════════╗
  265.      ║                                                                  ║
  266.      ║   The EDITSTRING method will allow onscreen editing of a data    ║
  267.      ║   string.  It allows use of cursor keys and tabs as well.        ║
  268.      ║                                                                  ║
  269.      ║       Calling the Method:                                        ║
  270.      ║                                                                  ║
  271.      ║           objectname.EditString(St,x,y,lgth)                     ║
  272.      ║                                                                  ║
  273.      ║               ( where objectname is of type GS_KeyI_Objt         ║
  274.      ║                       St is a string default value,              ║
  275.      ║                       x is the screen column position to start,  ║
  276.      ║                       y is the screen row position to start,     ║
  277.      ║                       lgth is the maximum field length )         ║
  278.      ║                                                                  ║
  279.      ║       Result:                                                    ║
  280.      ║                                                                  ║
  281.      ║           An edited string is returned.  If Escape is pressed,   ║
  282.      ║           the original default value is returned.                ║
  283.      ║                                                                  ║
  284.      ╚══════════════════════════════════════════════════════════════════╝
  285.  
  286. }
  287. {
  288.          ┌──────────────────────────────────────────────────────────┐
  289.          │  ********        Function Key Processor        *******   │
  290.          │                                                          │
  291.          │  This routine processes any function key that is pressed │
  292.          │  during edit mode.  If it is one ether insert is on or   │
  293.          │  off.  BIOS calls are used.                              │
  294.          └──────────────────────────────────────────────────────────┘
  295. }
  296.  
  297.  
  298. procedure GS_KeyI_Objt.Check_Func_Keys;
  299. begin
  300.    case Ch of
  301.             Kbd_Home  : CPos := 1;    {Home key sets cursor to start}
  302.             Kbd_End   : CPos := Succ(Length(GS_KeyI_Str));
  303.                                       {End key sets cursor to string length + 1}
  304.  
  305.             Kbd_Ins   : begin         {Insert Key switches insert flag}
  306.                            GS_KeyI_Ins := not GS_KeyI_Ins;
  307.                                       {Set insert flag to opposite}
  308.                            GS_Scrn_SetCursor(GS_KeyI_Ins);
  309.                                       {Go set cursor to line or large based on}
  310.                                       {insert flag true/false}
  311.                         end;
  312.             Kbd_LfAr  : if CPos > 1 then Dec(CPos);
  313.                                       {Left Arrow will backup cursor 1 position}
  314.             Kbd_RtAr  : if CPos <= Length(GS_KeyI_Str) then Inc(CPos);
  315.                                       {Right Arrow will advance cursor}
  316.             Kbd_Bsp   :               {Backspace will delete char to the left}
  317.                         if CPos > 1 then
  318.                         begin
  319.                            Delete(GS_KeyI_Str, Pred(CPos), 1);
  320.                            Dec(CPos);
  321.                         end;
  322.             Kbd_Del   :               {Delete will delete char at cursor}
  323.                         if CPos <= Length(GS_KeyI_Str) then
  324.                            Delete(GS_KeyI_Str, CPos, 1);
  325. {
  326.          ┌──────────────────────────────────────────────────────────┐
  327.          │  The following keys will simulate the Return key being   │
  328.          │  pressed.  The actual key pressed can be tested by the   │
  329.          │  calling program using the character in GS_KeyI_Chr,     │
  330.          │  using the Kbd_xxx constant values.                      │
  331.          └──────────────────────────────────────────────────────────┘
  332. }
  333.             Kbd_Tab,                  {Tab Key}
  334.             Kbd_Rtb,                  {Shift-Tab key}
  335.             Kbd_UpAr,                 {Up Arrow}
  336.             Kbd_DnAr,                 {Down Arrow}
  337.             Kbd_PgUp,                 {Page Up}
  338.             Kbd_PgDn,                 {Page Down}
  339.             Kbd_CEnd,                 {Ctrl-End}
  340.             Kbd_CHom,                 {Ctrl-Home}
  341.             Kbd_Ret   : begin         {Return}
  342.                            GS_KeyI_Ret := true;
  343.                                       {Set Return Flag true}
  344.                            Ch := Kbd_Ret;
  345.                         end;
  346.  
  347.  
  348.             Kbd_Esc   : begin         {Escape Key causes an exit with the}
  349.                                       {original default value returned}
  350.                            GS_KeyI_Str := '';
  351.                            GS_KeyI_Esc := True;
  352.                         end;
  353.    end;
  354. end;
  355. {
  356.          ┌──────────────────────────────────────────────────────────┐
  357.          │  ********        Edit String Procedure         *******   │
  358.          │                                                          │
  359.          │  This is the main method to edit an input string.  The   │
  360.          │  usual cursor keys are processed through a method that   │
  361.          │  may be replaced by a child object's virtual method.     │
  362.          │  The Escape key will terminate and return the default    │
  363.          │  value to the calling program.                           │
  364.          └──────────────────────────────────────────────────────────┘
  365. }
  366.  
  367.  
  368. function GS_KeyI_Objt.EditString(T : string; x, y, l : integer) : string;
  369. begin
  370.    GS_KeyI_Ins := True;               {Start in insert mode}
  371.    GS_KeyI_Esc := False;              {Set the Escape flag false}
  372.    GS_KeyI_Ret := false;              {Set Return flag false}
  373.    Modified := false;                 {Flag for field not modified}
  374.    First := True;                     {Flag set for no characters yet entered}
  375.    GS_KeyI_Str := T;                  {Store default value in work string}
  376.    GS_Scrn_SetCursor(GS_KeyI_Ins);    {Go set cursor size}
  377.    CPos := 1;                         {Set cursor position on line to start}
  378.    repeat
  379.       gotoxy(x,y);                    {Go to proper location on screen}
  380.       write(GS_KeyI_Str,'':l-length(GS_KeyI_Str));
  381.                                       {Display the work string}
  382.       GotoXY(CPos+x-1, y);            {Go to current position in the string}
  383.       Ch := GS_KeyI_GetKey;           {Get the next keyboard entry}
  384.       if (GS_KeyI_Fuc) or (Ch in [#0..#31]) then
  385.                                       {See if function key or control char}
  386.       begin
  387.          Check_Func_Keys;             {If it is, go process it.  Note this is}
  388.                                       {a virtual method that may go to a child}
  389.                                       {object's method}
  390.       end
  391.       else                            {Otherwise add character to the string}
  392.       begin
  393.  
  394. {
  395.               ┌─────────────────────────────────────────────┐
  396.               │  If this is the very first character to     │
  397.               │  be pressed, clear the work string first.   │
  398.               │  This allows editing of the work string     │
  399.               │  if cursor keys are used before a character │
  400.               │  is entered, or total replacement by        │
  401.               │  pressing a character key first.            │
  402.               └─────────────────────────────────────────────┘
  403. }
  404.  
  405.          if First then
  406.          begin
  407.             GS_KeyI_Str := '';
  408.          end;
  409. {
  410.               ┌─────────────────────────────────────────────┐
  411.               │  If insert is on then insert the character. │
  412.               │  Otherwise, if at the end of the string,    │
  413.               │  just add the new character.  If insert is  │
  414.               │  off and not at the end of the string,      │
  415.               │  replace the existing character.            │
  416.               └─────────────────────────────────────────────┘
  417. }
  418.          if (GS_KeyI_Ins) then Insert(Ch, GS_KeyI_Str, CPos)
  419.             else if CPos > Length(GS_KeyI_Str) then
  420.                GS_KeyI_Str := GS_KeyI_Str + Ch
  421.                   else GS_KeyI_Str[CPos] := Ch;
  422.  
  423.          Inc(CPos);                   {Step to the next location in the string}
  424.       end;
  425.       First := False;                 {Set first character flag to false}
  426.       if length(GS_KeyI_Str) > l then
  427.                                       {If string is longer than allowed}
  428.       begin
  429.          SoundBell(BeepTime,BeepFreq);
  430.          delete(GS_KeyI_Str,length(GS_KeyI_Str),1);
  431.                                       {Remove the last character in the string}
  432.          dec(CPos);                   {Back up one position}
  433.       end;
  434.       if (CPos > l) then
  435.          if (not Wait_CR) and (Ch <> Kbd_End) then
  436.          begin
  437.             Ch := Kbd_Ret;
  438.             GS_KeyI_Ret := true;      {If field is full and no need to wait}
  439.          end                          {for a carriage return, simulate one}
  440.          else CPos := l;
  441.    until (Ch = Kbd_Ret) or (Ch = Kbd_Esc);
  442.                                       {Continue until Return or Escape pressed}
  443.    GS_Scrn_SetCursor(False);          {Set cursor size to small cursor}
  444.    if T = GS_KeyI_Str then Modified := false else Modified := true;
  445.    if GS_KeyI_Esc then EditString := T else
  446.                        EditString := GS_KeyI_Str;
  447.                                       {If Escape key pressed, then return the}
  448.                                       {default value.  Otherwise return work}
  449.                                       {string}
  450. end; { EditString }
  451.  
  452. begin
  453.    GS_KeyI_Esc := false;
  454.    GS_KeyI_Fuc := false;
  455.    GS_KeyI_Ins := false;
  456.    GS_KeyI_Ret := false;
  457.    GS_KeyI_Chr := #0;                 {Initialize character to null}
  458. end.
  459.  
  460.