home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TP5WIO.ZIP / TP5WIO.DOC < prev    next >
Encoding:
Text File  |  1989-07-29  |  21.0 KB  |  418 lines
  1. Tp5wio is a Turbo Pascal Version 4.0 or 5.x Unit which consists of a
  2. collection of procedures and functions which assist in
  3. screen input/output.  Many other uses in general programming are
  4. available as well.  The strings used are defined as Pascal strings
  5. (string[255]) so you must be careful the string you are using is
  6. suitable for the screen.  This was done to allow the routines to be
  7. used for printer or disk report generation as well as the screen.
  8. NOTE: This Pascal Unit will not work with Turbo Pascal Version 3.x
  9. without a lot of modification.
  10.  
  11. This file contains the interface sections of tp5misc.pas and tp5wio.pas
  12. which defines the various routines and has a short comment about each one.
  13. Note that there are now two units created, TP5MISC.TPU and TP5WIO.TPU the
  14. tp5misc.pas file must be compiled and listed in the uses statement of your
  15. program first!  The units must be compiled with the compiler you are
  16. using (either Version 4.0 or 5.0 or 5.5).
  17.  
  18. All variables must be initialized by the user before calling a routine
  19. in this package or unusual results will happen (normal for Pascal
  20. anyway).
  21.  
  22. The global variables fld and scrn deserve a short mention here, they
  23. are used to allow full screen and multi-screen input.  Each variable
  24. is designed to be used in a repeat -- until loop where they will be
  25. adjusted by the program by the up/down arrow keys and the PgUp/Pgdn
  26. keys.
  27.  
  28. The fld variable is updated after each screen input function (i.e.
  29. read_str, read_int, etc).  Below is a short program fragment to show
  30. how this variable is used.
  31.  
  32. fld := 1;   { expecting to use the first case element }
  33. repeat
  34.    case fld of
  35.       1 :read_int(intvar,3,20,5);
  36.       2 :read_str(name,20,20,6);
  37.       3 :read_str(address,30,20,7);
  38.    end;  {case}
  39. until (fld < 1) or (fld > 3);
  40.  
  41. In the above example the cursor will start at x=20, y=5 and wait for a
  42. 3 character input which will be returned in the integer variable
  43. intvar.  Return or down arrow will accept the input and move to the
  44. next field at x=20, y=6.  Going off the top, off the bottom, Page Up,
  45. or Page Down will terminate the entries and exit the repeat - until
  46. loop.
  47.  
  48. The scrn variable is used in an outer repeat - until loop which calls
  49. inner repeat - until loops (procedures) and allows multi-page input
  50. screens to be built.  The scrn variable is not done automatically but
  51. you must call the procedure do_scrn_ctl to update it to a new value.
  52. Be sure to set the scrn variable to the starting screen before calling
  53. the routine which uses it.
  54.  
  55. The window system is very simple but is adequate for many projects.
  56. There are only 10 windows allowed (though you may change it if
  57. desired) and if an error (invalid screen coordinates, out of heap space,
  58. to many windows) occurs, a message to that effect, including the reason
  59. for the error will be presented in the middle of the screen in a semi
  60. window (remember all windows are used).  Any key will return to the DOS
  61. prompt with all windows already defined deleted.  This should not happen
  62. in a production program, but is handy when developing a program.
  63.  
  64. The endwindows procedure should be placed as the last statment in your
  65. program (if you are using the windows) to insure all windows are
  66. closed.
  67.  
  68. Added the inv_col_flag which is set by the init section and is true if
  69. a color card is found.  Along with this is the inv_color which is set
  70. to green, this color is used instead of inverting the foreground and
  71. background for highlighting.  Both of these may be changed by the user
  72. program.
  73.  
  74. This work has and is released to the Public Domain for whatever
  75. purposes you desire.  Credit has been given to other authors where
  76. needed.  Have fun with it --- Gerry Rohr --- Below is the definition
  77. of all procedures and functions available to the user.
  78.  
  79. unit tp4wio;
  80. {  -- Global I/O procedures to include in programs generally
  81.   Much credit is due Bill Meacham who wrote the original file IO22.INC
  82.   and released it to the public domain.  Using that work this unit was
  83.   created and added to by Gerald Rohr of Homogenized Software.  As
  84.   with Bill's work, this program is released to the Public Domain for
  85.   all to use and modify.
  86.                        REVISION  HISTORY
  87.   ---------------------------------------------------------------------
  88.   Ver 2.22 - Converted to a Turbo pascal V4 units.        30 Dec 87 gbr
  89.   Ver 2.30 - Converted dates to longint types             19 Jan 88 gbr
  90.   Ver 2.42 - Added global inv_flag for all write routines 08 Apr 88 gbr
  91.   Ver 2.43 - Added long integer read and write routines   01 May 88 gbr
  92.   Ver 2.43 - Added month and month/day routines           10 May 88 gbr
  93.   Ver 3.00 - Replaced Window procedures/Reformated file   15 Jul 88 gbr
  94.   Ver 3.10 - Moved Window error routines here             26 Aug 88 gbr
  95.   Ver 3.20 - Added code and globals for color hi lights   27 Aug 88 gbr
  96.   Ver 3.21 Fixed leading decimal point in read_real       02 Sep 88 gbr
  97.   Ver 3.25 Added longint to/from packed string[4]         02 Sep 88 gbr
  98.   Ver 3.26 Added sys_time global variable                 07 Sep 88 gbr
  99.   Ver 3.30 Recompiled with Turbo Pascal Version 5.0       29 Sep 88 gbr
  100.   Ver 3.40 Added Month Name (string)                      05 Oct 88 gbr
  101.   Ver 3.50 Changed to use actual scan codes               30 Oct 88 gbr
  102.   Ver 3.60 Added RW word, byte                            18 Nov 88 gbr
  103.   Ver 3.70 Moved many routines to tp5misc.tpu             10 Dec 88 gbr
  104.   Ver 3.80 Added Vtp5wio function                         24 Mar 89 gbr
  105.   Ver 3.90 Added mk_dt_sts() date without century         28 Mar 89 gbr
  106.   Ver 4.00 Added color definitions to windows             06 Jul 89 gbr
  107.   Ver 4.10 Added openwind to open window with default col.07 Jul 89 gbr
  108.   --------------------------------------------------------------------- }
  109.  
  110. interface
  111.  
  112. uses
  113.    crt,dos;
  114.  
  115. const
  116.    fdslen     = 29 ;  { length of fulldatestring }
  117.  
  118. type
  119.    datestring = string[10] ;  { 'MM/DD/YYYY' }
  120.  
  121.    fulldatestring = string[fdslen] ;
  122.  
  123.    juldate = record
  124.       yr  : integer ; { 0 .. 9999 }
  125.       day : integer ; { 1 .. 366 }
  126.    end ;
  127.  
  128.    juldatestring = string[8] ; { 'YYYY/DDD' }
  129.  
  130.    montharray = array [1 .. 13] of integer ;
  131.  
  132.    intst     = string[2];                   { string of an integer }
  133.  
  134. var
  135.    sys_date      :longint;
  136.    null_date     :longint;
  137.    null_date_str : datestring;
  138.  
  139.    fld, scrn     : integer ; { For field & screen cursor control }
  140.    macro         :array[1..10] of string; { Function key macro storage }
  141.    inv_flag      :boolean;  { if true all write routines inverse the screen,
  142.                               set to false by initialization. User uses
  143.                               this flag to control the screen attributes.}
  144.    col_inv_flag  :boolean;  { true if color monitor, false if monochrome,
  145.                               set by initialization routine,  User may change. }
  146.    inv_color     :byte;     { color to use for inverse data if col_inv_flag
  147.                               is true. Defaults to green, but user may change. }
  148.    in_window     :boolean;  { if true then we are in a window, used by the
  149.                               screen writing routines to high light screen
  150.                               data.  NOTE high lighting can only be done when
  151.                               in_window flag is true. }
  152.    reserv_wind   :integer;  { number of windows to reserve (not close) with
  153.                               endwindows procedure.  Initialized to 0, use
  154.                               with multiple program files. }
  155.    text_fg,                 { Text foreground color }
  156.    text_bg,                 { Text background color }
  157.    framefgnd,               { window border color }
  158.    framebkgnd,              { window background color }
  159.    title_color,             { window title color }
  160.    err_fg,                  { error message foreground }
  161.    err_bg,                  { error message background }
  162.    msg_fg,                  { message foreground }
  163.    msg_bg                   { message background }
  164.                 :byte;
  165.  
  166. The following procedures and functions are contained in TP5MISC.PAS:
  167.  
  168. function wdtostr(n:word):st2;
  169.          { converts word to packed two char string }
  170. function strtowd(s:st2):word;
  171.          { converts packed two char string to word }
  172. function bttostr(n:byte):st2;
  173.          { converts byte to packed char string }
  174. function strtobt(s:st2):byte;
  175.          { converts packed char string to byte }
  176. function dbasetodate(s:string):longint;
  177.          { convert the dbase sdf date dump (YYYYMMDD) to a longint with
  178.            the same format }
  179. function datetodbase(var dbdate:longint):string;
  180.          { convert the hs date record to dbase sdf date dump (YYYYMMDD) }
  181. function strtointeger(st:st5):integer;
  182.          { Converts a string to integer value, returns -1 on error }
  183. function strtoword(st:st5):word;
  184.          { Converts a string to word value, returns 0 on error }
  185. function strtobyte(st:st5):byte;
  186.          { Converts a string to byte value, returns 0 on error }
  187. FUNCTION PAD (st : string ; ch : char ; i : integer) : string ;
  188.          { Pad string with ch to length of i. }
  189. FUNCTION UPPER (st :string):string;
  190.          { returns upper case of st }
  191. FUNCTION STRIPCH (instr:string ; inchar:char) : string ;
  192.          {Strips leading instances of the character from the string}
  193. FUNCTION TRIM (st:string;len:integer):string;
  194.          { Chops spaces from string or truncates at l length }
  195. FUNCTION CHOPCH (instr:string ; inchar:char) : string ;
  196.          {Chops trailing instances of the character from the string}
  197. FUNCTION INTTOSTR(n:integer):st2;
  198.          { converts integer to packed two char string }
  199. FUNCTION STRTOINT(s:st2):integer;
  200.          { converts packed two char string to integer }
  201. FUNCTION LINTTOST4(n:longint):st4;
  202.          { converts long integer to packed 4 character string }
  203. FUNCTION ST4TOLINT(s:st4):longint;
  204.          { converts packed four character string to longint }
  205. { --- File tools --- }
  206. FUNCTION EXIST(FN : String) : boolean;
  207.          { Returns true if file named by FN exists }
  208. FUNCTION REMOVE(FN : string):boolean;
  209.          { Erases the file named by FN, returns TRUE if erased }
  210.  
  211. The following functions and procedures are contained in tp5wio.pas, the
  212. file tp5wio.inc is included at compile time.  Some of these functions
  213. and procedures require that tp5misc.tpu be available.
  214.  
  215. PROCEDURE CLRLINE (col,row : integer);
  216. PROCEDURE BEEP ;
  217. PROCEDURE DO_FLD_CTL (key : integer);
  218.          { Adjusts global FLD based on value of key, the ordinal value
  219.            of last key pressed }
  220. PROCEDURE DO_SCRN_CTL ;
  221.          { Checks value of FLD and adjusts value of SCRN accordingly }
  222. PROCEDURE WRITE_STR (st:string ; col,row:integer);
  223. PROCEDURE WRITE_TEMP(var ln:string;tmp:string;x,y:integer);
  224.          { writes a string using a template.  the string (ln) is printed
  225.            left justified in the template using the filler locations.
  226.            quits when the template is complete on the screen.  Fills unused
  227.            template filler locations with space. }
  228. PROCEDURE WRITE_INT (i:integer ; width,col,row:integer);
  229. PROCEDURE WRITE_WORD(i:word; width,col,row:integer);
  230. PROCEDURE WRITE_BYTE(i:byte;width,col,row:integer);
  231. PROCEDURE WRITE_LINT(lint:longint;width,col,row:integer);
  232. PROCEDURE SET_BOOL (var bool : boolean);
  233.          { Sets boolean to be undefined, neither true nor false.
  234.            Boolean is stored as one byte:
  235.                $80 = undefined
  236.                $01 = true
  237.                $00 = false.
  238.            Note : Turbo interprets $80 as true because it is greater than zero! }
  239. FUNCTION DEFINED (bool : boolean) : boolean ;
  240.          { Determines whether the boolean is defined or not }
  241. PROCEDURE WRITE_BOOL (bool:boolean ; col, row:integer);
  242. PROCEDURE WRITE_REAL (r:real ; width,frac,col,row:integer);
  243. FUNCTION BUILD_STR (ch : char ; n : integer) : string ;
  244.          { returns a string of length n of the character ch }
  245. PROCEDURE READ_STR (var st:string ; maxlen, col, row:integer);
  246.          { Read String.  This procedure gets input from the keyboard one
  247.            character at a time and edits on the fly, rejecting invalid
  248.            characters.  COL and ROW tell where to begin the data input
  249.            field, and MAXLEN is the maximum length of the string to be
  250.            returned.
  251.            Only use the Function keys for string input data, for other
  252.            types of input will beep. }
  253. PROCEDURE READ_TEMP(var st:string;tmp:string;col, row:integer);
  254.            { Read string with a template.  This procedure gets input from
  255.            the keyboard one character at a time and edits on the fly,
  256.            rejecting invalid characters.  tmp is a template which is filled
  257.            in where filler characters exist, any other characters are displayed
  258.            on the screen.  Returned string does NOT have the template imbeded in
  259.            it.  COL and ROW tell where to begin the data input
  260.            field, Max length of the string is the max length of the template.
  261.            }
  262. PROCEDURE READ_INT (var int:integer ; maxlen, col, row:integer);
  263.          { Read Integer.  This procedure gets input from the keyboard
  264.            one character at a time and edits on the fly, rejecting
  265.            invalid characters.  COL and ROW tell where to begin the data
  266.            input field, and MAXLEN is the maximum length of the integer
  267.            to be returned. }
  268. PROCEDURE READ_LINT (var lint:longint ; maxlen, col, row:integer);
  269.          { Read LongInt.  This procedure gets input from the keyboard
  270.            one character at a time and edits on the fly, rejecting
  271.            invalid characters.  COL and ROW tell where to begin the data
  272.            input field, and MAXLEN is the maximum length of the integer
  273.            to be returned. }
  274. PROCEDURE READ_WORD(var wd:word; maxlen,col,row:integer);
  275.          { Read Word.  This procedure gets input from the keyboard
  276.            one character at a time and edits on the fly, rejecting
  277.            invalid characters.  COL and ROW tell where to begin the data
  278.            input field, and MAXLEN is the maximum length of the word
  279.            to be returned. }
  280. PROCEDURE READ_BYTE(var bt:byte; maxlen,col,row:integer);
  281.          { Read byte.  This procedure gets input from the keyboard
  282.            one character at a time and edits on the fly, rejecting
  283.            invalid characters.  COL and ROW tell where to begin the data
  284.            input field, and MAXLEN is the maximum length of the byte
  285.            to be returned. }
  286.  
  287. FUNCTION EQUAL (r1,r2 : real) : boolean ;
  288.          { tests functional equality of two real numbers -- 4/30/85 }
  289. FUNCTION GREATER (r1,r2 : real) : boolean ;
  290.          { tests functional inequality of two real numbers -- 5/1/85 }
  291. PROCEDURE READ_REAL (var r:real ; maxlen,frac,col,row:integer);
  292.          { Read Real.  This procedure gets input from the keyboard
  293.            one character at a time and edits on the fly, rejecting
  294.            invalid characters.  COL and ROW tell where to begin the data
  295.            input field; MAXLEN is the maximum length of the string
  296.            representation of the real number, including sign and decimal
  297.            point; FRAC is the fractional part, the number of digits to
  298.            right of the decimal point.
  299.  
  300.            Note -- In Turbo the maximum number of significant digits in
  301.            decimal (not scientific) representation is 11.  In TurboBCD,
  302.            the maximum number of significant digits is 18.  It is the
  303.            programmer's responsibility to limit input and computed output
  304.            to the maximum significant digits. }
  305. PROCEDURE READ_YN (var bool:boolean; col,row:integer);
  306.          { Inputs "Y" OR "N" to boolean at column and row specified,
  307.            prints "YES" or "NO."
  308.            Note -- use this when the screen control will not return
  309.            to the question and the boolean IS NOT defined before the
  310.            user answers the question.  Does not affect global FLD. }
  311. PROCEDURE READ_BOOL (var bool:boolean; col,row:integer);
  312.          { Displays boolean at column and row specified, inputs "Y"
  313.            or "N" to set new value of boolean, prints "YES" or "NO."
  314.            Boolean is "forced;" user cannot cursor forward past undefined
  315.            boolean.  Pressing "Y" or "N" terminates entry.
  316.            Boolean is stored as one byte:
  317.                $80 = undefined
  318.                $01 = true
  319.                $00 = false.
  320.            Note : Turbo interprets $80 as true because it is greater
  321.            than zero! }
  322. PROCEDURE PAUSE ;
  323.          {Prints message on bottom line, waits for user response.
  324.           Changed from line 24 to line 23 for windows  gbr}
  325. PROCEDURE HARD_PAUSE ;
  326.          { Like Pause, but only accepts space bar or Escape and only
  327.            goes forward. Changed from line 24 to line 23 for windows.  gbr }
  328. PROCEDURE SHOW_MSG (msg : string);
  329.          { Beeps, displays message centered on line 22, pauses }
  330.          { changed from line 23 to line 22 for windows. gbr }
  331. FUNCTION MK_DT_ST (dt :longint) : datestring ;
  332.          { Makes a string out of a date -- used for printing dates,
  333.            includes century (ie MM/DD/YYYY) }
  334. FUNCTION MK_DT_STS(dt :longint) : datestring ;
  335.          { Makes a string out of a date -- used for printing dates,
  336.            does not include century (ie MM/DD/YY) }
  337. PROCEDURE WRITE_DATE (dt: longint ; col, row: integer);
  338.          { Writes date at column and row specified }
  339. FUNCTION MK_JUL_DT_ST (jdt : juldate) : juldatestring ;
  340.          { makes a string out of a julian date }
  341. PROCEDURE READ_DATE (var dt: longint ; col, row: integer);
  342.          { Read date at column and row specified.  If the user enters
  343.            only two digits for the year, the procedure plugs the
  344.            century as 1900 or 2000, but the user can enter all four
  345.            digits to override the plug. }
  346. FUNCTION GREATER_DATE (dt1, dt2 : longint) : integer ;
  347.          { Compares two dates, returns 0 if both equal, 1 if first is
  348.            greater, 2 if second is greater. }
  349. PROCEDURE GREG_TO_JUL (dt : longint ; var jdt : juldate);
  350.          { converts a gregorian date to a julian date }
  351. PROCEDURE JUL_TO_GREG (jdt : juldate ; var dt : longint);
  352.          { converts a julian date to a gregorian date }
  353. PROCEDURE NEXT_DAY (var dt : longint);
  354.          { Adds one day to the date }
  355. PROCEDURE PREV_DAY (var dt : longint);
  356.          { Subtracts one day from the date }
  357. FUNCTION DATE_DIFF (dt1, dt2 : longint) : longint ;
  358.          { computes the number of days between two dates }
  359. FUNCTION MONTH_DIFF (dt1, dt2 : longint ) : integer ;
  360.          { Computes number of months between two dates, rounded.
  361.            30.4167 = 356/12, average number of days in a month. }
  362. FUNCTION EQUAL_DATE (dt1, dt2 : longint) : boolean ;
  363.          { Tests whether two dates are equal }
  364. FUNCTION BUILD_FULL_DATE_STR (dt : longint) : fulldatestring ;
  365.          { Build printable string of current date -- from ROS 3.4
  366.            source code. }
  367. FUNCTION MONTH(dt:longint):integer;
  368.          { returns the month portion of a date.}
  369. FUNCTION DAY(dt:longint):integer;
  370.          { returns the day from the date }
  371. FUNCTION YEAR(dt:longint;centry:boolean):integer;
  372.          { returns the year of a date.  if the centry flag is true
  373.            returns 4 digit year otherwise returns two digit year. }
  374. FUNCTION MONTH_NAME(mon:integer):string;
  375.          { returns the month name given the month number (1-12) }
  376.  
  377. { ---- window procedures Derived from article in Computer Language
  378.   Magazine June 1988 by James Kerr ---- }
  379. PROCEDURE OPENWIND(wtitle:string;x1,y1,x2,y2:byte);
  380.          { Works just like openwindow except uses the default colors
  381.            for text foreground and background.  Actually just calls
  382.            openwindow with text_fg and text_bg
  383.          }
  384. PROCEDURE OPENWINDOW(wtitle:string;x1,y1,x2,y2:byte;
  385.                      fgnd,bkgnd: byte);
  386.          { wtitle is centered on the top border line of the window, x
  387.          and y are the window coordinates, fgnd and bkgnd are the
  388.          colors of the inside of the window (note the border is always
  389.          white, if a window can not be opened, a message as to why will
  390.          be displayed and the program exits
  391.          }
  392. PROCEDURE CLOSEWINDOW;
  393.          { closes the current open window, does nothing if no
  394.            window to close. }
  395. PROCEDURE ENDWINDOWS;
  396.          { close any open windows when exiting the windows system.  Use
  397.            as the last statment in program to insure return to
  398.            enviroment you came from.  The global reserv_wind is normally
  399.            set to 0 allowing all windows to be closed, if using a
  400.            multi file window program, reserv_wind can be set to the
  401.            number of windows to be left open when a particular program
  402.            terminates.  Always set reserv_wind to 0 before the final
  403.            program call to endwindows.
  404.          }
  405.  
  406. FUNCTION VTP5WIO:string;
  407.         { Return a string which contains the version of this set of
  408.           routines }
  409.  
  410. I hope you enjoy these procedures and functions, and they help you
  411. develope programs as they have me.
  412.  
  413.                                 Gerry Rohr
  414.                                 Homogenized Software
  415.                                 RR#3
  416.                                 Anamosa, Iowa 52205
  417.  
  418.