home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / USCX / PTOOLS.ZIP / PTOOLENT.INC < prev    next >
Text File  |  1985-02-23  |  21KB  |  485 lines

  1. { PTOOLENT.INC   Copyright 1984  R D Ostrander                   Version 1.0
  2.                                  Ostrander Data Services
  3.                                  5437 Honey Manor Dr
  4.                                  Indianapolis  IN  46241
  5.  
  6.  This Turbo Pascal include file is a display and data entry tool. It Displays
  7.  a given String (or Character Array), Integer, or Real (Dollar) data field
  8.  in a given screen area and allows the operator to make changes via the
  9.  keyboard. It allows the operator to end the editing using many ending
  10.  keys and passes information about those keys to the calling program.
  11.  
  12.  This program has been placed in the Public Domain by the author and copies
  13.  may be freely made for non-commercial, demonstration, or evaluation purposes.
  14.  Use of these subroutines in a program for sale or for commercial purposes in
  15.  a place of business requires a $20 fee be paid to the author at the address
  16.  above.  Personal non-commercial users may also elect to pay the $20 fee to
  17.  encourage further development of this and similar programs. With payment you
  18.  will be able to receive update notices, diskettes and printed documentation
  19.  of this and other PTOOLs from Ostrander Data Services.
  20.  
  21.  PTOOL, and PTOOLxxx are Copyright Trademarks of Ostrander Data Services
  22.  
  23.  Turbo Pascal is a Copyright of Borland International Inc.
  24.  
  25.  Call format is:
  26.  
  27.     Set Data            <String, Integer, or Real>      initial display value.
  28.     Set DataType        <Char>                                   type of edit.
  29.     Set DisplaySize     <Integer>                number of spaces for display.
  30.     Set DisplayDecimals <Integer>                       for Real numbers only.
  31.     Set ReturnCode      <Integer>      need not be set but must be a variable.
  32.     GoToXY (X, Y)                            to set the Display Area location.
  33.     PTOOLENT (Data, DataType, DisplaySize, DisplayDecimals, ReturnCode);
  34.  
  35.     Examples:     Var CustomerName : String [24];
  36.                       ReturnCode   : Integer;
  37.                   Begin
  38.                   CustomerName := ' ';
  39.                   Gotoxy (1,1)
  40.                   PTOOLENT (CustomerName, 'S', 24, 0, ReturnCode);
  41.  
  42.     See companion program PTOOLENT.PAS for further examples.
  43.  
  44.     Note that the DisplaySize must be > DisplayDecimals + 1.
  45.  
  46.     Invalid data and cursor movements cause beeps to the operator.
  47.  
  48.  Editing Keys are:
  49.  
  50.          Left Arrow       : Move cursor to left
  51.          Right Arrow      : Move cursor to right
  52.          Ctrl-Left Arrow  : Move cursor to 1st position
  53.          Ctrl-Right Arrow : Move cursor past last character
  54.          Tab              : Move cursor right to next word
  55.          Shift-Tab        : Move cursor left to previous word
  56.          Backspace        : Erase character to left of cursor
  57.          Del              : Erase character under cursor
  58.          Ctrl-E           : Erase editing area
  59.          Ctrl-F           : Fill field with character to left of cursor
  60.          Ctrl-X           : Erase all characters from cursor on
  61.          Ctrl-L           : Left justify data
  62.          Ctrl-R           : Right justify data
  63.          Ctrl-S           : Start Editing over
  64.          Ctrl-N or Ctrl-Q : Quit with no change in data
  65.          Ctrl-P           : Retreive Previous data or Ctrl-E(rased) data
  66.          Ctrl-U           : Change all data to Upper Case
  67.          Ctrl-D           : Change all data to Lower Case
  68.          Ins              : Toggle Insert function on/off
  69.          Alt-Numerics may be used to enter character graphics codes
  70.  
  71.   Edit Return codes are:
  72.  
  73.                   0 = Esc
  74.                   1 = C/R or Ctrl-N or Ctrl-Q
  75.                   2 = (Filled Field)
  76.                   3 = Ctrl-Break/Ctrl-C (if $C- not set)
  77. 16-26, 30-38, 44,50 = Alt-Alphabetics
  78.               59-68 = F1 - F10
  79.                  71 = Home
  80.                  72 = Up Arrow
  81.                  73 = PgUp
  82.                  79 = End
  83.                  80 = Down Arrow
  84.                  81 = PgDn
  85.               84-93 = Shift F1 - F10
  86.              94-103 = Ctrl F1 - F10
  87.             104-113 = Alt F1 - F10
  88.                 114 = Ctrl-PrtSc
  89.                 117 = Ctrl-End
  90.                 118 = Ctrl-PgDn
  91.                 119 = Ctrl-Home
  92.                 132 = Ctrl-PgUp                        }
  93.  
  94. Procedure PTOOLENT (VAR Data;                  { Note - Untyped     }
  95.                         TypeData   : Char;     { Must be I, R, or S }
  96.                         Size,                  { Must be 1 to 80    }
  97.                         Decimals   : Integer;  { Only for type R    }
  98.                     VAR OutEndCode : Integer); { Return Code        }
  99.  
  100.  
  101. Var
  102.  
  103.    PassI        : Integer       absolute Data;  { Initial Data               }
  104.    PassR        : Real          absolute Data;
  105.    PassS        : String [80]   absolute Data;
  106.    Ch, Ch2      : Char;                         { Keyboard Input             }
  107.    CurrS, SaveS : String [80];                  { Working Data               }
  108.    I, J         : Integer;                      { Position Pointers          }
  109.    DispX, DispY : Integer;                      { Initial Cursor Location    }
  110.    Done         : Boolean;                      { Switch for end of edit     }
  111.    ErrCode      : Integer;                      { Used for String to Numeric }
  112.    Dot          : Char;                         { Space character on screen  }
  113.  
  114.  
  115. Const
  116.  
  117.    InsertKey : Boolean = False;                   { Insert On/Off Switch    }
  118.    PrevS     : String [80] = 'No data available'; { Holding area for Ctrl-P }
  119.  
  120.  
  121. Function PowerOf (Number, Power : Integer) : Real;  { Exponentiation Routine }
  122.  
  123.      Var
  124.         J    : Integer;
  125.         Work : Real;
  126.  
  127.      Begin
  128.           Work := Number;
  129.           For J := 1 to Power - 1 do
  130.               Work := Work * 10;
  131.           PowerOf := Work;
  132.      End;
  133.  
  134.  
  135. Function LowCase (Ch : Char) : Char;      { Convert Upper to Lower Case }
  136.  
  137.      Begin
  138.           If Ord (Ch) in [65 .. 90] then
  139.              LowCase := Char (Ord (Ch) + 32)
  140.           else
  141.              LowCase := Ch;
  142.      End;
  143.  
  144.  
  145. Procedure Beep;                   { Make a short sound }
  146.  
  147.      Begin
  148.           Sound (880);
  149.           Delay (150);
  150.           NoSound;
  151.      End;
  152.  
  153. Procedure Display;                 { Display the Current Data }
  154.  
  155.      Begin
  156.           Gotoxy (DispX, DispY);
  157.           CurrS [0] := Char(Size);
  158.           Write (CurrS);
  159.      End;
  160.  
  161. Procedure AddASpace;              { Put a Dot at the Right end of the Data }
  162.  
  163.      Begin
  164.           Insert (Dot, CurrS, Size + 1);
  165.      End;
  166.  
  167. Procedure LeftJustify;                  { Left Justify the data }
  168.  
  169.      Begin
  170.           For J := 1 to Size do
  171.               If CurrS [1] = Dot then
  172.                  Begin
  173.                       Delete (CurrS, 1, 1);
  174.                       AddASpace;
  175.                  End;
  176.      End;
  177.  
  178. Procedure InsertSwitch;         { Turn Insert On or Off (Toggle) }
  179.  
  180. type
  181.     BiosCall = Record
  182.                Ax, Bx, Cx, Dx, Bp, Si, Ds, Es, Flags : Integer;
  183.                End;
  184.     XferArea = Record
  185.                Case Boolean of
  186.                     True  : (Lo, Hi : Byte);
  187.                     False : (I : Integer);
  188.                End;
  189.  
  190. var
  191.     BiosRec            : BiosCall;
  192.     XferRec            : XferArea;
  193.  
  194.  
  195. Begin                                              { Begin of InsertSwitch }
  196.      If InsertKey = True then InsertKey := False
  197.                          else InsertKey := True;
  198.  
  199.      XferRec.Lo := 0;                 { This calls IBM DOS BIOS to }
  200.      XferRec.Hi := 1;                 { alter the cursor mode.     }
  201.      BiosRec.Ax := XferRec.I;
  202.      XferRec.Lo := 7;
  203.      If InsertKey = True then XferRec.Hi := 4
  204.                          else XferRec.Hi := 6;
  205.      BiosRec.Cx := XferRec.I;
  206.      Intr(16, BiosRec);
  207. End;
  208.  
  209.  
  210. Label
  211.  
  212.      DisplayPoint;     { If there are errors in numeric data the program
  213.                          returns to DisplayPoint.                        }
  214.  
  215. BEGIN                              { Begin of PTOOLENT Procedure }
  216.  
  217.      Dot     := Char (250);        { A Little tiny Dot }
  218.      Done    := False;
  219.      ErrCode := 0;
  220.      DispX   := WhereX;
  221.      DispY   := WhereY;
  222.      FillChar (CurrS, Size + 1, Dot);
  223.      Case TypeData of                                                { Move  }
  224.           'I' : If PassI <> 0 then Str (PassI:Size, CurrS);          { input }
  225.           'R' : If PassR <> 0 then Str (PassR:Size:Decimals, CurrS); { data  }
  226.           'S' : CurrS := PassS;                                      { to    }
  227.           End; {Case}                                                { CurrS }
  228.      If (TypeData = 'I') or (TypeData = 'R') then    { Left Justify }
  229.           For I := 1 to Size do                      { Numeric Data }
  230.               If CurrS [1] = ' ' then
  231.                  Begin
  232.                       Delete (CurrS, 1, 1);
  233.                       AddASpace;
  234.                  End;
  235.      For I := 1 to Size do
  236.          If CurrS [I] = ' ' then CurrS [I] := Dot;
  237.      CurrS [0] := Char (Size);
  238.      I := 1;
  239.      SaveS := CurrS;
  240.   DisplayPoint:
  241.      Display;
  242.      While NOT Done Do                      { Main editing loop }
  243.            Begin
  244.                 If I < 1 then                       { Check cursor position }
  245.                    Begin
  246.                         I := 1;
  247.                         Beep;
  248.                    End;
  249.                 If I > Size then
  250.                    Begin
  251.                         I := Size;
  252.                         Beep;
  253.                    End;
  254.                 Gotoxy (DispX + I - 1, DispY);
  255.                 Ch  := Char(00);                    { Get Keyboard input    }
  256.                 Ch2 := Char(00);                    { This handles extended }
  257.                 Read (KBD, Ch);                     { Keystrokes            }
  258.                 If Keypressed then Read (KBD, Ch2);
  259.                 If Ord(Ch) = 27 then                { If CH is 027 then     }
  260.                    Case Ord(Ch2) of                 { check second part     }
  261.        {Back Tab       }  15 : Begin
  262.                                     I := I - 1;
  263.                                     While ((CurrS [I] = Dot) or
  264.                                            (CurrS [I] = '.'))
  265.                                       and (I > 1) do
  266.                                           I := I - 1;
  267.                                     While (CurrS [I] <> Dot)
  268.                                       and (CurrS [I] <> '.')
  269.                                       and (I > 1) do
  270.                                           I := I - 1;
  271.                                     If (CurrS [I] = Dot) or
  272.                                        (CurrS [I] = '.') then I := I + 1;
  273.                                End;
  274.        {Left Arrow     }  75 : I := I -1;
  275.        {Right Arrow    }  77 : I := I +1;
  276.        {Ins            }  82 : InsertSwitch;
  277.        {Del            }  83 : Begin
  278.                                     Delete (CurrS, I, 1);
  279.                                     AddASpace;
  280.                                     Display;
  281.                                End;
  282.        {Ctrl-LeftArrow } 115 : If I = 1 then Beep
  283.                                         else I := 1;
  284.        {Ctrl-RightArrow} 116 : Begin
  285.                                     I := Size;
  286.                                     While (CurrS [I] = Dot)
  287.                                       and (I > 0) do
  288.                                           I := I - 1;
  289.                                     If I < Size then
  290.                                        I := I + 1;
  291.                                End;
  292.                           else Begin
  293.                                     Done := True;
  294.                                     OutEndCode := Ord(Ch2);
  295.                                End;
  296.                         End {Case}
  297.                     else
  298.                    Begin                       { If not 027 the check first }
  299.                         If Ord (Ch) = 32 then
  300.                            Ch := Dot;            { Make space bar a dot }
  301.                         Case Ord(Ch) of
  302.        {Ctrl-C  End    }      3 : Begin
  303.                                        Done := True;
  304.                                        OutEndCode := 3;
  305.                                   End;
  306.        {Ctrl-D  LowCase}      4 : Begin
  307.                                        For J := 1 to Size do
  308.                                            CurrS [J] := LowCase (CurrS [J]);
  309.                                        Display;
  310.                                   End;
  311.        {Ctrl-E  Erase  }      5 : Begin
  312.                                        PrevS := CurrS;
  313.                                        FillChar (CurrS [1], Size, Dot);
  314.                                        Display;
  315.                                        I := 1;
  316.                                   End;
  317.        {Ctrl-F  Fill   }      6:  Begin
  318.                                        If I > 1 then J := I - 1
  319.                                                 else J := 1;
  320.                                        FillChar (CurrS [J + 1], Size - J,
  321.                                                  CurrS [J]);
  322.                                        Display;
  323.                                   End;
  324.        {Backspace      }      8 : If I > 1 then
  325.                                      Begin
  326.                                           Delete (CurrS, I - 1, 1);
  327.                                           AddASpace;
  328.                                           Display;
  329.                                           I := I - 1;
  330.                                      End
  331.                                      else Beep;
  332.        {Tab            }      9 : Begin
  333.                                        While (CurrS [I] <> Dot)
  334.                                          and (CurrS [I] <> '.')
  335.                                          and (I < Size) do
  336.                                              I := I + 1;
  337.                                        While ((CurrS [I] = Dot) or
  338.                                               (CurrS [I] = '.'))
  339.                                          and (I < Size) do
  340.                                              I := I + 1;
  341.                                   End;
  342.        {Ctrl-L  L-Just }     12 : Begin
  343.                                        LeftJustify;
  344.                                        Display;
  345.                                        I := 1;
  346.                                   End;
  347.        {C/R    End     }     13 : Begin
  348.                                        Done := True;
  349.                                        OutEndCode := 1;
  350.                                   End;
  351.        {Ctrl-N  Quit   }     14 : Begin
  352.                                        CurrS := SaveS;
  353.                                        Done := True;
  354.                                        OutEndCode := 1;
  355.                                   End;
  356.        {Ctrl-P  Prev.  }     16 : Begin
  357.                                        For I := 1 to Size do
  358.                                            CurrS [I] := PrevS [I];
  359.                                        I := 1;
  360.                                        Display;
  361.                                   End;
  362.        {Ctrl-Q  Quit   }     17 : Begin
  363.                                        CurrS := SaveS;
  364.                                        Done := True;
  365.                                        OutEndCode := 1;
  366.                                   End;
  367.        {Ctrl-R  R-Just }     18 : Begin
  368.                                        I := Size;
  369.                                        While (CurrS [I] = Dot)
  370.                                          and (I > 0) do
  371.                                              I := I - 1;
  372.                                        If I < Size then
  373.                                           Begin
  374.                                                J := Size - I;
  375.                                                For I := 1 to J do
  376.                                                    Insert (Dot, CurrS, 1);
  377.                                           End;
  378.                                        I := 1;
  379.                                        While CurrS [I] = Dot do
  380.                                              I := I + 1;
  381.                                        Display
  382.                                   End;
  383.        {Ctrl-S  Restart}     19 : Begin
  384.                                        CurrS := SaveS;
  385.                                        I := 1;
  386.                                        Goto DisplayPoint;
  387.                                   End;
  388.        {Ctrl-U  UpCase }     21 : Begin
  389.                                        For J := 1 to Size do
  390.                                            CurrS [J] := UpCase (CurrS [J]);
  391.                                        Display;
  392.                                   End;
  393.        {Ctrl-X  ClrEol }     24 : Begin
  394.                                        FillChar (CurrS [I], Size - I + 1,
  395.                                                  Dot);
  396.                                        Display;
  397.                                   End;
  398.                         else If InsertKey = False then
  399.                                 Begin
  400.                                      Write (Ch);
  401.                                      CurrS [I] := Ch;
  402.                                      I := I + 1;
  403.                                      If I > Size then
  404.                                         Begin
  405.                                              Done := True;
  406.                                              OutEndCode := 2;
  407.                                         End;
  408.                                 End
  409.                                  else
  410.                                 Begin
  411.                                      Insert (Ch, CurrS, I);
  412.                                      I := I + 1;
  413.                                      Display;
  414.                                      If I > Size then
  415.                                         Begin
  416.                                              Done := True;
  417.                                              OutEndCode := 2;
  418.                                         End;
  419.                                 End;
  420.                         End; {Case}
  421.                    End;
  422.            End;
  423.  
  424.     If (TypeData = 'I')                { Left Justify Numeric data and }
  425.     or (TypeData = 'R') then           { check for imbedded spaces     }
  426.        Begin
  427.             LeftJustify;
  428.             I := 1;
  429.             While (CurrS [I] <> Dot)
  430.               and (I <= Size) do
  431.                   I := I + 1;
  432.             For J := I to Size do
  433.                 If CurrS [J] <> Dot then
  434.                    Begin
  435.                         Beep;
  436.                         I := J - 1;
  437.                         Done := False;
  438.                         Goto DisplayPoint;
  439.                    End;
  440.             CurrS [0] := Char (I - 1);
  441.        End;
  442.     If InsertKey = True then InsertSwitch;       { Turn off insert }
  443.     ErrCode := 0;
  444.     If TypeData = 'I' then
  445.        Val (CurrS, PassI, ErrCode);
  446.     If TypeData = 'R' then                    { Check size of Real data -    }
  447.        Begin                                  { must leave room for decimals }
  448.             Val (CurrS, PassR, ErrCode);
  449.             If Decimals > 0 then
  450.                If (PassR >= PowerOf (10, Size - Decimals - 1))
  451.                or (PassR <= PowerOf (10, Size - Decimals - 2) * -1) then
  452.                   Begin
  453.                        Beep;
  454.                        I := 1;
  455.                        Done := False;
  456.                        Goto DisplayPoint;
  457.                   End;
  458.        End;
  459.     If ErrCode <> 0 then            { If numeric data errors, transfer }
  460.        Begin                        { back to re-edit data.            }
  461.             Beep;
  462.             Done := False;
  463.             I := ErrCode;
  464.             Goto DisplayPoint;
  465.        End;
  466.     If TypeData = 'S' then                    { Move String data }
  467.        Begin
  468.             For I := 1 to Size do
  469.                 If CurrS [I] = Dot then CurrS [I] := ' ';
  470.             CurrS [0] := Char (Size);
  471.             PassS := CurrS;
  472.        End;
  473.  
  474.     FillChar (PrevS, 80, Dot);                 { Save data }
  475.     PrevS := CurrS;
  476.     Gotoxy (DispX, DispY);                     { Display data }
  477.     Case TypeData of
  478.          'S' : Write (PassS);
  479.          'I' : Write (PassI:Size);
  480.          'R' : Write (PassR:Size:Decimals);
  481.          End; {case}
  482.     Gotoxy (DispX, DispY);                     { Reset cursor }
  483.  
  484. END;
  485.