home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / INPFLD11.ZIP / INPFLD.INC < prev   
Encoding:
Text File  |  1987-07-02  |  16.3 KB  |  360 lines
  1. { ===================================================================== }
  2. { INPFLD.INC - Get a field of characters. All attributes concerning     }
  3. {    the field are user-definable. InpFld was concieved from a routine  }
  4. {    contained in the Borland International Turbo Database Toolbox.     }
  5. {                                                                       }
  6. {    The following procedures are also contained in the package         }
  7. {    WINDOxx.ARC and are duplicated here for ease of use:               }
  8. {        DispLine   Set_Cursor                                          }
  9. {                                                                       }
  10. {     Author:   Michael Burton                                          }
  11. {               15540 Boot Hill Rd.                                     }
  12. {               Hayden Lake, ID 83835                                   }
  13. {               (208) 772-9347 (after 1800 PST)                         }
  14. {     Revision: 1.1                                                     }
  15. {     Date:     02 July 1987                                            }
  16. {                                                                       }
  17. {  Copyright (C) 1987 by Michael Burton                                 }
  18. {                                                                       }
  19. {  This is a 'Shareware' program.  If you find it to be of significant  }
  20. {  use to you, a $10 donation to the above address would be greatly     }
  21. {  appreciated.  This would also place you on our mailing list to keep  }
  22. {  you informed of upgrades to InpFld and of new programs.              }
  23. {                                                                       }
  24. { Modifications:                                                        }
  25. { DATE       Rev  Description                                           }
  26. { 16 Jun 87  1.0  Initial release                                       }
  27. { 02 Jul 87  1.1  Add right justified field option                      }
  28. { ===================================================================== }
  29. Type
  30.    option_type = set of 0..7;
  31.    strg80 = string[80];
  32.    strg255 = string[255];
  33.    ifrec  = record case integer of
  34.                   1: (ax,bx,cx,dx,bp,si,di,ds,es,flags: integer);
  35.                   2: (al,ah,bl,bh,cl,ch,dl,dh: byte);
  36.                 end;
  37.  
  38. Const
  39.    IFCR   = 13;
  40.    IFESC  = 27;
  41.    IFCTLS = 19;
  42.    IFCTLD = 4;
  43.    IFCTLA = 1;
  44.    IFCTLF = 6;
  45.    IFCTLG = 7;
  46.    IFBKSP = 8;
  47.    IFCTBS = 127;
  48.    IFINS  = 338;
  49.    IFLARW = 331;
  50.    IFRARW = 333;
  51.    IFHOME = 327;
  52.    IFEND  = 335;
  53.    IFDEL  = 339;
  54.    IFTAB  = 9;
  55.    IFBTAB = 271;
  56.    IFUARW = 328;
  57.    IFDARW = 336;
  58.    IFCRAR = 372;
  59.    IFCLAR = 371;
  60.    IFCEND = 373;
  61.  
  62. { ===================================================================== }
  63. { DISPLINE - Display a string of characters on the CRT (with the same   }
  64. {            attributes)                                                }
  65. {           The row and column inputs are relative to zero and are      }
  66. {           also relative to the entire screen, not any open window.    }
  67. {                                                                       }
  68. {    Inputs:                                                            }
  69. {       colb      : byte;       Starting column  (0 - 79)               }
  70. {       rowb      : byte;       Starting row     (0 - 24)               }
  71. {       attrib    : byte;       Line attributes                         }
  72. {       fromstrng : string[80]; String to display                       }
  73. { ===================================================================== }
  74. Procedure DispLine(colb,rowb,attrib : byte; VAR fromstrng : strg80);
  75. Begin
  76.    Inline(
  77.       $1E/                    {           PUSH   DS               }
  78.       $8A/$86/rowb/           {           MOV    AL,rowb[BP]      }
  79.       $B3/$50/                {           MOV    BL,80            }
  80.       $F6/$E3/                {           MUL    BL               }
  81.       $2B/$DB/                {           SUB    BX,BX            }
  82.       $8A/$9E/colb/           {           MOV    BL,colb[BP]      }
  83.       $03/$C3/                {           ADD    AX,BX            }
  84.       $03/$C0/                {           ADD    AX,AX            }
  85.       $8B/$F8/                {           MOV    DI,AX            }
  86.       $8A/$BE/attrib/         {           MOV    BH,attrib[BP]    }
  87.       $C4/$B6/fromstrng/      {           LES    SI,fromstrng[BP] }
  88.       $2B/$C9/                {           SUB    CX,CX            }
  89.       $26/$8A/$0C/            {           MOV    CL,ES:[SI]       }
  90.       $2B/$C0/                {           ADD    AX,AX            }
  91.       $8E/$D8/                {           MOV    DS,AX            }
  92.       $A0/$49/$04/            {           MOV    AL,DS:[0449H]    }
  93.       $22/$C9/                {           AND    CL,CL            }
  94.       $74/$34/                {           JZ     DONE             }
  95.       $2C/$07/                {           SUB    AL,7             }
  96.       $74/$21/                {           JZ     MONO             }
  97.       $BA/$00/$B8/            {           MOV    DX,0B800H        }
  98.       $8E/$DA/                {           MOV    DS,DX            }
  99.       $BA/$DA/$03/            {           MOV    DX,03DAH         }
  100.       $46/                    { GETCHAR:  INC    SI               }
  101.       $26/$8A/$1C/            {           MOV    BL,ES:[SI]       }
  102.       $EC/                    { TESTLOW:  IN     AL,DX            }
  103.       $A8/$01/                {           TEST   AL,1             }
  104.       $75/$FB/                {           JNZ    TESTLOW          }
  105.       $FA/                    {           CLI                     }
  106.       $EC/                    { TESTHI:   IN     AL,DX            }
  107.       $A8/$01/                {           TEST   AL,1             }
  108.       $74/$FB/                {           JZ     TESTHI           }
  109.       $89/$1D/                {           MOV    DS:[DI],BX       }
  110.       $47/                    {           INC    DI               }
  111.       $47/                    {           INC    DI               }
  112.       $E2/$EB/                {           LOOP   GETCHAR          }
  113.       $2A/$C0/                {           SUB    AL,AL            }
  114.       $74/$0F/                {           JZ     DONE             }
  115.       $BA/$00/$B0/            { MONO:     MOV    DX,0B000H        }
  116.       $8E/$DA/                {           MOV    DS,DX            }
  117.       $46/                    { MONO1:    INC    SI               }
  118.       $26/$8A/$1C/            {           MOV    BL,ES:[SI]       }
  119.       $89/$1D/                {           MOV    DS:[DI],BX       }
  120.       $47/                    {           INC    DI               }
  121.       $47/                    {           INC    DI               }
  122.       $E2/$F6/                {           LOOP   MONO1            }
  123.       $1F);                   { DONE:     POP    DS               }
  124. End;
  125.  
  126. { ======================================================================== }
  127. { NAME: Set_Cursor                  VERSION: 1.0   DATE: 27 January 1986   }
  128. { AUTHOR:                                                                  }
  129. { DESCRIPTION: Set the cursor size                                         }
  130. { INPUTS: The number of cursor lines to display (0 -7, 0-14)               }
  131. {                                                                          }
  132. { ======================================================================== }
  133. Procedure Set_Cursor (n: byte);
  134. Var regpak      : ifrec;
  135.     top, bottom : byte;
  136. Begin
  137.    If Mem[$0040:$0049] = 7 Then bottom := 13
  138.    Else bottom := 7;
  139.    regpak.ax:= $100;
  140.    If n <= bottom Then top := bottom - n + 1
  141.    Else top := 0;
  142.    regpak.cx := top shl 8 or bottom;
  143.    Intr($10,regpak)
  144. End;
  145.  
  146. { --------------------------------------------------------- }
  147. { ReadChar - Get a character from the keyboard. Returns an  }
  148. {    integer from 0 to 512. Double keys have 256 added to   }
  149. {    them, e.g., F1 (27 59) returns 315 (59 + 256)          }
  150. { --------------------------------------------------------- }
  151. function ReadChar: integer;
  152. Var
  153.    ch : char;
  154.  
  155. begin
  156.    Read(kbd,ch);
  157.    if ch = Chr(IFESC) then
  158.       if KeyPressed then
  159.       begin
  160.          Read(kbd,ch);
  161.          ReadChar := Ord(ch) + 256;
  162.          Exit;
  163.       end;
  164.    ReadChar := Ord(ch);
  165. end;
  166.  
  167. { --------------------------------------------------------- }
  168. { FindPos - find the next occurrence of a character with-   }
  169. {    in a string. Returns 0 if character not found.         }
  170. { --------------------------------------------------------- }
  171. Function FindPos(s : strg255; startpos : integer; direction : boolean): integer;
  172. Const
  173.    delimiters : set of char = [' ','/','\',':','-','.',',','_','='];
  174.  
  175. Var i : integer;
  176.     found : boolean;
  177.  
  178. begin
  179.    i := startpos;
  180.    found := False;
  181.    if (((startpos = 0) and (direction = False)) or
  182.        ((startpos = length(s)) and (direction = True))) then
  183.    begin
  184.       FindPos := startpos;
  185.       Exit;
  186.    end;
  187.    repeat
  188.       if direction then i := Succ(i)
  189.       else i := Pred(i);
  190.       if ((i = 0) or (i = length(s))) then found := True
  191.       else
  192.          if (s[i] in delimiters) then found := True;
  193.    until found;
  194.    FindPos := i;
  195. end;
  196.  
  197. { --------------------------------------------------------- }
  198. { StrConst - Return a string of length n filled with char-  }
  199. {    acter c.                                               }
  200. { --------------------------------------------------------- }
  201. function StrConst(c : char; n : integer) : strg80;
  202. Var
  203.   s : strg80;
  204. begin
  205.   if n < 0 then n := 0;
  206.   s[0] := Chr(n);
  207.   FillChar(s[1],n,c);
  208.   StrConst := s;
  209. end;
  210.  
  211. { --------------------------------------------------------- }
  212. { DispField - Display the field and position the cursor.    }
  213. { --------------------------------------------------------- }
  214. Procedure DispField(x,y,size,attr,pcol : integer; ibuf : strg255);
  215. Const
  216.   fieldfiller  =  ' ';   { fill the rest of the field with this character }
  217. var
  218.    s : strg80;
  219.    regpack : ifrec;
  220.  
  221. begin
  222.    s := ibuf + StrConst(fieldfiller,size - Length(ibuf));
  223.    DispLine(x - 1,y - 1,attr,s); { Display the field }
  224.    regpack.ah := 2;
  225.    regpack.bx := 0;
  226.    regpack.dh := y - 1;
  227.    regpack.dl := x + pcol - 1;
  228.    Intr($10,regpack);            { Position the cursor }
  229.    Gotoxy(wherex,wherey);        { adjust for turbo windos }
  230. end;
  231.  
  232. { --------------------------------------------------------- }
  233. { InpFld - Get a field of characters. Upon return, keyval   }
  234. {    has the last character entered. Legal contains all the }
  235. {    legal characters. If legal is empty, all characters    }
  236. {    are legal. Ibuf is the string returned. Attr is the    }
  237. {    screen attributes to use for the field. x and y are    }
  238. {    the position on the display to get input. Size is the  }
  239. {    maximum size of the field. Option are the input        }
  240. {    options. Options are:                                  }
  241. {       []   = No options chosen                            }
  242. {       [1]  = Perform uppercase translation                }
  243. {       [5]  = Exit from field if field is full.            }
  244. {       [6]  = Right justify field upon exit                }
  245. {       [7]  = Display and use initial value of ibuf.       }
  246. {              Otherwise ibuf will be emptied before use.   }
  247. {   Field Editing Keys are:                                 }
  248. {      Left arrow,                                          }
  249. {      Ctl-S        - Move one character left.              }
  250. {                                                           }
  251. {      Right arrow,                                         }
  252. {      Ctl-D        - Move one character right.             }
  253. {                                                           }
  254. {      Home,                                                }
  255. {      Ctl-A        - Move to the start of the field.       }
  256. {                                                           }
  257. {      End,                                                 }
  258. {      Ctl-F        - Move to the current end of the field. }
  259. {                                                           }
  260. {      Del,                                                 }
  261. {      Ctl-G        - Delete the char under the cursor.     }
  262. {                                                           }
  263. {      BackSpace    - Delete the char to the left of cursor.}
  264. {                                                           }
  265. {      Ctl-BackSpace- Delete the entire field.              }
  266. {                                                           }
  267. {      Ins          - Toggle insert/overwrite mode.         }
  268. {                                                           }
  269. {      Ctl-End      - Delete to the end of the line.        }
  270. {                                                           }
  271. {      Ctl-Left arw - Move left one word.                   }
  272. {                                                           }
  273. {      Ctl-Right arw- Move right one word.                  }
  274. {                                                           }
  275. {      To end field editing, use one of Enter, Esc, Tab,    }
  276. {      BackTab, Up arrow or Down arrow; or fill the field   }
  277. {      if option 5 is selected.                             }
  278. { --------------------------------------------------------- }
  279. procedure InpFld(var keyval: integer;
  280.                    var Legal : strg255;
  281.                    var ibuf  : strg255;
  282.                        attr  : Integer;
  283.                        x,y,size : Integer;
  284.                        option: option_type);
  285. Var
  286.   pcol   : integer;
  287.   ich : integer;
  288.   s   : strg80;
  289.   insmode : boolean;
  290.  
  291. begin
  292.   insmode := False;
  293.   if option >= [7] then else ibuf := '';
  294.   pcol := 0;
  295.   repeat
  296.      DispField(x,y,size,attr,pcol,ibuf);
  297.      ich := ReadChar;
  298.      case ich of
  299.      32..126   : begin
  300.                     if option >= [1] then ich := Ord(Upcase(Chr(ich)));
  301.                     if ((Length(legal) = 0) or (Pos(Chr(ich),legal) <> 0)) then
  302.                     begin
  303.                        if pcol < size then
  304.                        begin
  305.                          if ((insmode) and (Length(ibuf) < size)) then
  306.                          begin
  307.                             pcol := Succ(pcol);
  308.                             Insert(Chr(ich),ibuf,pcol);
  309.                          end
  310.                          else
  311.                             if ((pcol < size) and (insmode = False)) then
  312.                             begin
  313.                                pcol := Succ(pcol);
  314.                                ibuf[pcol] := Chr(ich);
  315.                                if length(ibuf) < pcol then ibuf[0] := Chr(pcol);
  316.                             end;
  317.                        end;
  318.                     end;
  319.                  end;
  320.       IFCTLS,IFLARW : if pcol > 0 then   { left arrow }
  321.                          pcol := Pred(pcol);
  322.       IFCTLD,IFRARW : if pcol < Length(ibuf) then  { right arrow }
  323.                          pcol := Succ(pcol);
  324.       IFCTLA,IFHOME : pcol := 0;              { home }
  325.       IFCTLF,IFEND  : pcol := Length(ibuf);   { end }
  326.       IFCTLG,IFDEL  : if pcol < Length(ibuf) then    { del }
  327.                          begin
  328.                            Delete(ibuf,pcol + 1,1);
  329.                          end;
  330.       IFBKSP        : if pcol > 0 then        { backspace }
  331.                          begin
  332.                            Delete(ibuf,pcol,1);
  333.                            pcol := Pred(pcol);
  334.                       end;
  335.       IFCTBS        : begin               { delete line }
  336.                          ibuf := '';
  337.                          pcol := 0;
  338.                       end;
  339.       IFINS         : begin
  340.                          insmode := not insmode;
  341.                          if insmode then Set_Cursor(5)
  342.                          else Set_Cursor(2);
  343.                       end;
  344.       IFCEND        : Delete(ibuf,pcol+1,(length(ibuf)-pcol));
  345.       IFCRAR        : pcol := FindPos(ibuf,pcol,True);
  346.       IFCLAR        : pcol := FindPos(ibuf,pcol,False);
  347.     end;  {of case}
  348.   until ((ich = IFCR) or (ich = IFESC) or (ich = IFTAB) or (ich = IFBTAB) or
  349.      (ich = IFUARW) or (ich = IFDARW) or
  350.      ((option >= [5]) and (Length(ibuf) = size)));
  351.   pcol := Length(ibuf);
  352.   if option >= [6] then
  353.      s := StrConst(' ',size - Length(ibuf)) + ibuf
  354.   else
  355.      s := ibuf + StrConst(' ',size - Length(ibuf));
  356.   DispLine(x-1,y-1,attr,s);
  357.   keyval := ich;
  358.   Set_Cursor(2);
  359. end;
  360.