Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/MADTRB07.ZIP/PTOOLENT.INC

Text File | 1985-02-23 | 20.4 KB | 485 lines

{ PTOOLENT.INC   Copyright 1984  R D Ostrander                   Version 1.0
                                 Ostrander Data Services
                                 5437 Honey Manor Dr
                                 Indianapolis  IN  46241

 This Turbo Pascal include file is a display and data entry tool. It Displays
 a given String (or Character Array), Integer, or Real (Dollar) data field
 in a given screen area and allows the operator to make changes via the
 keyboard. It allows the operator to end the editing using many ending
 keys and passes information about those keys to the calling program.

 This program has been placed in the Public Domain by the author and copies
 may be freely made for non-commercial, demonstration, or evaluation purposes.
 Use of these subroutines in a program for sale or for commercial purposes in
 a place of business requires a $20 fee be paid to the author at the address
 above.  Personal non-commercial users may also elect to pay the $20 fee to
 encourage further development of this and similar programs. With payment you
 will be able to receive update notices, diskettes and printed documentation
 of this and other PTOOLs from Ostrander Data Services.

 PTOOL, and PTOOLxxx are Copyright Trademarks of Ostrander Data Services

 Turbo Pascal is a Copyright of Borland International Inc.

 Call format is:

    Set Data            <String, Integer, or Real>      initial display value.
    Set DataType        <Char>                                   type of edit.
    Set DisplaySize     <Integer>                number of spaces for display.
    Set DisplayDecimals <Integer>                       for Real numbers only.
    Set ReturnCode      <Integer>      need not be set but must be a variable.
    GoToXY (X, Y)                            to set the Display Area location.
    PTOOLENT (Data, DataType, DisplaySize, DisplayDecimals, ReturnCode);

    Examples:     Var CustomerName : String [24];
                      ReturnCode   : Integer;
                  Begin
                  CustomerName := ' ';
                  Gotoxy (1,1)
                  PTOOLENT (CustomerName, 'S', 24, 0, ReturnCode);

    See companion program PTOOLENT.PAS for further examples.

    Note that the DisplaySize must be > DisplayDecimals + 1.

    Invalid data and cursor movements cause beeps to the operator.

 Editing Keys are:

         Left Arrow       : Move cursor to left
         Right Arrow      : Move cursor to right
         Ctrl-Left Arrow  : Move cursor to 1st position
         Ctrl-Right Arrow : Move cursor past last character
         Tab              : Move cursor right to next word
         Shift-Tab        : Move cursor left to previous word
         Backspace        : Erase character to left of cursor
         Del              : Erase character under cursor
         Ctrl-E           : Erase editing area
         Ctrl-F           : Fill field with character to left of cursor
         Ctrl-X           : Erase all characters from cursor on
         Ctrl-L           : Left justify data
         Ctrl-R           : Right justify data
         Ctrl-S           : Start Editing over
         Ctrl-N or Ctrl-Q : Quit with no change in data
         Ctrl-P           : Retreive Previous data or Ctrl-E(rased) data
         Ctrl-U           : Change all data to Upper Case
         Ctrl-D           : Change all data to Lower Case
         Ins              : Toggle Insert function on/off
         Alt-Numerics may be used to enter character graphics codes

  Edit Return codes are:

                  0 = Esc
                  1 = C/R or Ctrl-N or Ctrl-Q
                  2 = (Filled Field)
                  3 = Ctrl-Break/Ctrl-C (if $C- not set)
16-26, 30-38, 44,50 = Alt-Alphabetics
              59-68 = F1 - F10
                 71 = Home
                 72 = Up Arrow
                 73 = PgUp
                 79 = End
                 80 = Down Arrow
                 81 = PgDn
              84-93 = Shift F1 - F10
             94-103 = Ctrl F1 - F10
            104-113 = Alt F1 - F10
                114 = Ctrl-PrtSc
                117 = Ctrl-End
                118 = Ctrl-PgDn
                119 = Ctrl-Home
                132 = Ctrl-PgUp                        }

Procedure PTOOLENT (VAR Data;                  { Note - Untyped     }
                        TypeData   : Char;     { Must be I, R, or S }
                        Size,                  { Must be 1 to 80    }
                        Decimals   : Integer;  { Only for type R    }
                    VAR OutEndCode : Integer); { Return Code        }


Var

   PassI        : Integer       absolute Data;  { Initial Data               }
   PassR        : Real          absolute Data;
   PassS        : String [80]   absolute Data;
   Ch, Ch2      : Char;                         { Keyboard Input             }
   CurrS, SaveS : String [80];                  { Working Data               }
   I, J         : Integer;                      { Position Pointers          }
   DispX, DispY : Integer;                      { Initial Cursor Location    }
   Done         : Boolean;                      { Switch for end of edit     }
   ErrCode      : Integer;                      { Used for String to Numeric }
   Dot          : Char;                         { Space character on screen  }


Const

   InsertKey : Boolean = False;                   { Insert On/Off Switch    }
   PrevS     : String [80] = 'No data available'; { Holding area for Ctrl-P }


Function PowerOf (Number, Power : Integer) : Real;  { Exponentiation Routine }

     Var
        J    : Integer;
        Work : Real;

     Begin
          Work := Number;
          For J := 1 to Power - 1 do
              Work := Work * 10;
          PowerOf := Work;
     End;


Function LowCase (Ch : Char) : Char;      { Convert Upper to Lower Case }

     Begin
          If Ord (Ch) in [65 .. 90] then
             LowCase := Char (Ord (Ch) + 32)
          else
             LowCase := Ch;
     End;


Procedure Beep;                   { Make a short sound }

     Begin
          Sound (880);
          Delay (150);
          NoSound;
     End;

Procedure Display;                 { Display the Current Data }

     Begin
          Gotoxy (DispX, DispY);
          CurrS [0] := Char(Size);
          Write (CurrS);
     End;

Procedure AddASpace;              { Put a Dot at the Right end of the Data }

     Begin
          Insert (Dot, CurrS, Size + 1);
     End;

Procedure LeftJustify;                  { Left Justify the data }

     Begin
          For J := 1 to Size do
              If CurrS [1] = Dot then
                 Begin
                      Delete (CurrS, 1, 1);
                      AddASpace;
                 End;
     End;

Procedure InsertSwitch;         { Turn Insert On or Off (Toggle) }

type
    BiosCall = Record
               Ax, Bx, Cx, Dx, Bp, Si, Ds, Es, Flags : Integer;
               End;
    XferArea = Record
               Case Boolean of
                    True  : (Lo, Hi : Byte);
                    False : (I : Integer);
               End;

var
    BiosRec            : BiosCall;
    XferRec            : XferArea;


Begin                                              { Begin of InsertSwitch }
     If InsertKey = True then InsertKey := False
                         else InsertKey := True;

     XferRec.Lo := 0;                 { This calls IBM DOS BIOS to }
     XferRec.Hi := 1;                 { alter the cursor mode.     }
     BiosRec.Ax := XferRec.I;
     XferRec.Lo := 7;
     If InsertKey = True then XferRec.Hi := 4
                         else XferRec.Hi := 6;
     BiosRec.Cx := XferRec.I;
     Intr(16, BiosRec);
End;


Label

     DisplayPoint;     { If there are errors in numeric data the program
                         returns to DisplayPoint.                        }

BEGIN                              { Begin of PTOOLENT Procedure }

     Dot     := Char (250);        { A Little tiny Dot }
     Done    := False;
     ErrCode := 0;
     DispX   := WhereX;
     DispY   := WhereY;
     FillChar (CurrS, Size + 1, Dot);
     Case TypeData of                                                { Move  }
          'I' : If PassI <> 0 then Str (PassI:Size, CurrS);          { input }
          'R' : If PassR <> 0 then Str (PassR:Size:Decimals, CurrS); { data  }
          'S' : CurrS := PassS;                                      { to    }
          End; {Case}                                                { CurrS }
     If (TypeData = 'I') or (TypeData = 'R') then    { Left Justify }
          For I := 1 to Size do                      { Numeric Data }
              If CurrS [1] = ' ' then
                 Begin
                      Delete (CurrS, 1, 1);
                      AddASpace;
                 End;
     For I := 1 to Size do
         If CurrS [I] = ' ' then CurrS [I] := Dot;
     CurrS [0] := Char (Size);
     I := 1;
     SaveS := CurrS;
  DisplayPoint:
     Display;
     While NOT Done Do                      { Main editing loop }
           Begin
                If I < 1 then                       { Check cursor position }
                   Begin
                        I := 1;
                        Beep;
                   End;
                If I > Size then
                   Begin
                        I := Size;
                        Beep;
                   End;
                Gotoxy (DispX + I - 1, DispY);
                Ch  := Char(00);                    { Get Keyboard input    }
                Ch2 := Char(00);                    { This handles extended }
                Read (KBD, Ch);                     { Keystrokes            }
                If Keypressed then Read (KBD, Ch2);
                If Ord(Ch) = 27 then                { If CH is 027 then     }
                   Case Ord(Ch2) of                 { check second part     }
       {Back Tab       }  15 : Begin
                                    I := I - 1;
                                    While ((CurrS [I] = Dot) or
                                           (CurrS [I] = '.'))
                                      and (I > 1) do
                                          I := I - 1;
                                    While (CurrS [I] <> Dot)
                                      and (CurrS [I] <> '.')
                                      and (I > 1) do
                                          I := I - 1;
                                    If (CurrS [I] = Dot) or
                                       (CurrS [I] = '.') then I := I + 1;
                               End;
       {Left Arrow     }  75 : I := I -1;
       {Right Arrow    }  77 : I := I +1;
       {Ins            }  82 : InsertSwitch;
       {Del            }  83 : Begin
                                    Delete (CurrS, I, 1);
                                    AddASpace;
                                    Display;
                               End;
       {Ctrl-LeftArrow } 115 : If I = 1 then Beep
                                        else I := 1;
       {Ctrl-RightArrow} 116 : Begin
                                    I := Size;
                                    While (CurrS [I] = Dot)
                                      and (I > 0) do
                                          I := I - 1;
                                    If I < Size then
                                       I := I + 1;
                               End;
                          else Begin
                                    Done := True;
                                    OutEndCode := Ord(Ch2);
                               End;
                        End {Case}
                    else
                   Begin                       { If not 027 the check first }
                        If Ord (Ch) = 32 then
                           Ch := Dot;            { Make space bar a dot }
                        Case Ord(Ch) of
       {Ctrl-C  End    }      3 : Begin
                                       Done := True;
                                       OutEndCode := 3;
                                  End;
       {Ctrl-D  LowCase}      4 : Begin
                                       For J := 1 to Size do
                                           CurrS [J] := LowCase (CurrS [J]);
                                       Display;
                                  End;
       {Ctrl-E  Erase  }      5 : Begin
                                       PrevS := CurrS;
                                       FillChar (CurrS [1], Size, Dot);
                                       Display;
                                       I := 1;
                                  End;
       {Ctrl-F  Fill   }      6:  Begin
                                       If I > 1 then J := I - 1
                                                else J := 1;
                                       FillChar (CurrS [J + 1], Size - J,
                                                 CurrS [J]);
                                       Display;
                                  End;
       {Backspace      }      8 : If I > 1 then
                                     Begin
                                          Delete (CurrS, I - 1, 1);
                                          AddASpace;
                                          Display;
                                          I := I - 1;
                                     End
                                     else Beep;
       {Tab            }      9 : Begin
                                       While (CurrS [I] <> Dot)
                                         and (CurrS [I] <> '.')
                                         and (I < Size) do
                                             I := I + 1;
                                       While ((CurrS [I] = Dot) or
                                              (CurrS [I] = '.'))
                                         and (I < Size) do
                                             I := I + 1;
                                  End;
       {Ctrl-L  L-Just }     12 : Begin
                                       LeftJustify;
                                       Display;
                                       I := 1;
                                  End;
       {C/R    End     }     13 : Begin
                                       Done := True;
                                       OutEndCode := 1;
                                  End;
       {Ctrl-N  Quit   }     14 : Begin
                                       CurrS := SaveS;
                                       Done := True;
                                       OutEndCode := 1;
                                  End;
       {Ctrl-P  Prev.  }     16 : Begin
                                       For I := 1 to Size do
                                           CurrS [I] := PrevS [I];
                                       I := 1;
                                       Display;
                                  End;
       {Ctrl-Q  Quit   }     17 : Begin
                                       CurrS := SaveS;
                                       Done := True;
                                       OutEndCode := 1;
                                  End;
       {Ctrl-R  R-Just }     18 : Begin
                                       I := Size;
                                       While (CurrS [I] = Dot)
                                         and (I > 0) do
                                             I := I - 1;
                                       If I < Size then
                                          Begin
                                               J := Size - I;
                                               For I := 1 to J do
                                                   Insert (Dot, CurrS, 1);
                                          End;
                                       I := 1;
                                       While CurrS [I] = Dot do
                                             I := I + 1;
                                       Display
                                  End;
       {Ctrl-S  Restart}     19 : Begin
                                       CurrS := SaveS;
                                       I := 1;
                                       Goto DisplayPoint;
                                  End;
       {Ctrl-U  UpCase }     21 : Begin
                                       For J := 1 to Size do
                                           CurrS [J] := UpCase (CurrS [J]);
                                       Display;
                                  End;
       {Ctrl-X  ClrEol }     24 : Begin
                                       FillChar (CurrS [I], Size - I + 1,
                                                 Dot);
                                       Display;
                                  End;
                        else If InsertKey = False then
                                Begin
                                     Write (Ch);
                                     CurrS [I] := Ch;
                                     I := I + 1;
                                     If I > Size then
                                        Begin
                                             Done := True;
                                             OutEndCode := 2;
                                        End;
                                End
                                 else
                                Begin
                                     Insert (Ch, CurrS, I);
                                     I := I + 1;
                                     Display;
                                     If I > Size then
                                        Begin
                                             Done := True;
                                             OutEndCode := 2;
                                        End;
                                End;
                        End; {Case}
                   End;
           End;

    If (TypeData = 'I')                { Left Justify Numeric data and }
    or (TypeData = 'R') then           { check for imbedded spaces     }
       Begin
            LeftJustify;
            I := 1;
            While (CurrS [I] <> Dot)
              and (I <= Size) do
                  I := I + 1;
            For J := I to Size do
                If CurrS [J] <> Dot then
                   Begin
                        Beep;
                        I := J - 1;
                        Done := False;
                        Goto DisplayPoint;
                   End;
            CurrS [0] := Char (I - 1);
       End;
    If InsertKey = True then InsertSwitch;       { Turn off insert }
    ErrCode := 0;
    If TypeData = 'I' then
       Val (CurrS, PassI, ErrCode);
    If TypeData = 'R' then                    { Check size of Real data -    }
       Begin                                  { must leave room for decimals }
            Val (CurrS, PassR, ErrCode);
            If Decimals > 0 then
               If (PassR >= PowerOf (10, Size - Decimals - 1))
               or (PassR <= PowerOf (10, Size - Decimals - 2) * -1) then
                  Begin
                       Beep;
                       I := 1;
                       Done := False;
                       Goto DisplayPoint;
                  End;
       End;
    If ErrCode <> 0 then            { If numeric data errors, transfer }
       Begin                        { back to re-edit data.            }
            Beep;
            Done := False;
            I := ErrCode;
            Goto DisplayPoint;
       End;
    If TypeData = 'S' then                    { Move String data }
       Begin
            For I := 1 to Size do
                If CurrS [I] = Dot then CurrS [I] := ' ';
            CurrS [0] := Char (Size);
            PassS := CurrS;
       End;

    FillChar (PrevS, 80, Dot);                 { Save data }
    PrevS := CurrS;
    Gotoxy (DispX, DispY);                     { Display data }
    Case TypeData of
         'S' : Write (PassS);
         'I' : Write (PassI:Size);
         'R' : Write (PassR:Size:Decimals);
         End; {case}
    Gotoxy (DispX, DispY);                     { Reset cursor }

END;