Dec 232017
 
TP5WIO is a Turbo Pascal version 4.0+ TPU of procedures and functions which assist in screen input/output. Includes full source code.
File TPWIO42.ZIP from The Programmer’s Corner in
Category Pascal Source Code
TP5WIO is a Turbo Pascal version 4.0+ TPU of procedures and functions which assist in screen input/output. Includes full source code.
File Name File Size Zip Size Zip Type
TP5MISC.PAS 18048 3972 deflated
TP5WIO.DOC 26694 7871 deflated
TP5WIO.INC 45823 9329 deflated
TP5WIO.PAS 43211 10140 deflated

Download File TPWIO42.ZIP Here

Contents of the TP5WIO.DOC file


Tp5wio is a Turbo Pascal Version 4.0,5.x,6.x Unit which consists of a
collection of procedures and functions which assist in screen
input/output. Many other uses in general programming are available as
well. The strings used are defined as Pascal strings (string[255]) so
you must be careful the string you are using is suitable for the
screen. This was done to allow the routines to be used for printer or
disk report generation as well as the screen. NOTE: This Pascal Unit
will not work with Turbo Pascal Version 3.x without a lot of
modification.

This file contains the interface sections of tp5misc.pas and tp5wio.pas
which defines the various routines and has a short comment about each
one. Note that there are now two units created, TP5MISC.TPU and
TP5WIO.TPU the tp5misc.pas file must be compiled and listed in the uses
statement of your program first! The units must be compiled with the
compiler you are using (either Version 4.0 or 5.0 or 5.5, or 6.0, etc.).

All variables must be initialized by the user before calling a routine
in this package or unusual results will happen (normal for Pascal
anyway). The variables expected by the windowing routines are
initialized on program startup to default values.

The global variables fld and scrn deserve a short mention here, they
are used to allow full screen and multi-screen input. Each variable is
designed to be used in a repeat -- until loop where they will be
adjusted by the program by the up/down arrow keys and the PgUp/Pgdn
keys.

The fld variable is updated after each screen input function (i.e.
read_str, read_int, etc). Below is a short program fragment to show
how this variable is used.

fld := 1; { expecting to use the first case element }
repeat
case fld of
1 :read_int(intvar,3,20,5);
2 :read_str(name,20,20,6);
3 :read_str(address,30,20,7);
end; {case}
until (fld < 1) or (fld > 3);

In the above example the cursor will start at x=20, y=5 and wait for a
3 character input which will be returned in the integer variable
intvar. Return or down arrow will accept the input and move to the
next field at x=20, y=6. Going off the top, off the bottom, Page Up,
or Page Down will terminate the entries and exit the repeat - until
loop.

The scrn variable is used in an outer repeat - until loop which calls
inner repeat - until loops (procedures) and allows multi-page input
screens to be built. The scrn variable is not done automatically,
you must call the procedure do_scrn_ctl to update it to a new value.
Be sure to set the scrn variable to the starting screen before calling
the routine which uses it.

The window system is very simple incorporating popup windows, but is
adequate for many projects. The number of windows allowed is only
limited by heap available. If an error (invalid screen coordinates or
out of heap space occurs, a message to that effect, including the
reason for the error will be presented in the middle of the screen in a
semi window (we may be out of heap space and not able to create a new
normal window). Any key will return to the DOS prompt with all windows
already defined closed and deleted. This should not happen in a
production program, but is very likely when developing a program.

The endwindows procedure should be placed as the last statment in your
program (if you are using the windows) to insure all windows are
closed. Usually the program manages the opening and closing of the
windows, endwindows will insure there are no windows left on the screen
when the application ends.

The inv_col_flag is set by the init section and is true if a color card
is found. Along with this is the inv_color which is set to green, this
color is used instead of inverting the foreground and background for
highlighting. Both of these may be changed by the user program. For
those machines which have a color card but use a monochrome monitor the
procedure set_mono will force the monochrome color set.

This work has and is released to the Public Domain for whatever
purposes you desire. Credit has been given to other authors where
needed. Have fun with it --- Gerry Rohr --- Below is the definition of
all procedures and functions available to the user.

{ TP5MISC.PAS creates a unit which performs misc functions on
strings. These have been extracted from tp5wio and the various
application programs to enable us to manage the source code more
effectively. Added File management functions.

Revision History
------------------------------------------------------------------
Rel 1.00 Collected procedures and functions from elsewhere gbr
Rel 1.10 24 Mar 89 Added File management functions gbr
Rel 1.20 03 Mar 90 Added string to numeric functions gbr
Rel 1.22 08 Mar 90 Added ConvertError Variable gbr
Rel 1.24 16 Aug 90 Added GetUniqFileName gbr
Rel 1.26 20 Nov 90 Added OpenNetFile gbr
Rel 1.28 17 Feb 91 Fixed GetUniqFileName gbr
Rel 1.30 31 Mar 91 Added DirExist function gbr
}
UNIT tp5misc;

{ -------------- }
INTERFACE

USES
DOS;

VAR
ConvertError :Integer; { holds error code for conversions, may be
the location of the error. }

{ -- These routines work on packed strings (database index type) -- }
FUNCTION wdtostr(n:Word):STRING;
{ converts word to packed two char string }

FUNCTION strtowd(s:STRING):Word;
{ converts packed two char string to word }

FUNCTION bttostr(n:Byte):STRING;
{ converts byte to packed char string }

FUNCTION strtobt(s:STRING):Byte;
{ converts packed char string to byte }

FUNCTION INTTOSTR(n:Integer):STRING;
{ converts integer to packed two char string }

FUNCTION STRTOINT(s:STRING):Integer;
{ converts packed two char string to integer }

FUNCTION LINTTOST4(n:LongInt):STRING;
{ converts long integer to packed 4 character string }

FUNCTION ST4TOLINT(s:STRING):LongInt;
{ converts packed four character string to longint }

{ -- Dbase date to longint date routines -- }

FUNCTION DbaseToDate(s:STRING):LongInt;
{ convert the dbase sdf date dump (YYYYMMDD) to a longint with
the same format. Sets ConvertError to the following:
0 = Success
1 = Month error
2 = Day error
4 = Year error (can never happen)
}

FUNCTION DateToDbase(VAR dbdate:LongInt):STRING;
{ convert the hs date record to dbase sdf date dump (YYYYMMDD) }

{ -- functions to convert regular strings to numeric values -- }

FUNCTION StringToInteger(st:STRING):Integer;
{ Converts a string to integer value, sets ConvertError to the
location in the string where the error occured or sets it
to 0 if no error.
}

FUNCTION StringTolongint(st:STRING):LongInt;
{ Converts a string to longint value, sets ConvertError to the
location in the string where the error occured or sets it to
0 if no error.
}

FUNCTION StringToword(st:STRING):Word;
{ Converts a string to word value, sets ConvertError to the
location in the string where the error occured or sets it
to 0 if no error.
}

FUNCTION StringTobyte(st:STRING):Byte;
{ Converts a string to byte value, sets ConvertError to the
location in the string where the error occured or sets it
to 0 if no error.
}

FUNCTION StringToreal(st:STRING):Real;
{ Converts a string to real value, sets ConvertError to the
location in the string where the error occured or sets it
to 0 if no error.
}

{ -- General string routines -- }

FUNCTION PAD (st : STRING ; ch : Char ; i : Integer) : STRING ;
{ Pad string with ch to length of i. }

FUNCTION UPPER (st :STRING):STRING;
{ returns upper case of st }

FUNCTION STRIPCH (instr:STRING ; inchar:Char) : STRING ;
{Strips leading instances of the character from the string}

FUNCTION TRIM (st:STRING;len:Integer):STRING;
{ Chops spaces from string or truncates at l length }

FUNCTION CHOPCH (instr:STRING ; inchar:Char) : STRING ;
{ Chops trailing instances of the character from the string}

{ --- File tools --- }

FUNCTION EXIST(FN : STRING) : Boolean;
{ Returns true if file named by FN exists }

FUNCTION DirExist(FN :STRING):Boolean;
{ Returns true if drive:directory named by FN exists }

FUNCTION REMOVE(FN : STRING):Boolean;
{ Erases the file named by FN, returns TRUE if erased }

FUNCTION GetUniqFileName(PathN:STRING;TempFile:STRING;FileExt:STRING;
VAR UniqFileName:STRING;wkstationno:Integer;
UserNetType:Char):Boolean;
{ Puts a Unique filename (PathN + tempfile + XX where is
0 through 99) into users variable UniqFileName. Note that the
extension is used to determine if the filename will be a unique
name but is NOT added to the UniqFileName, the dot is not added
either. Returns true if uniq file name is found, else false.
}

FUNCTION OpenNetFile(Var Fhandle:text;FileMode:integer):Word;
{ Tries to open the file assigned to the handle Fhandle in the mode FileMode.
Returns the following:
0 = operation successful
n = Error code returned by the open function desired
Note: 162 is returned if the file is already open for write or append.
}

{ --------------------------------------------------------------- }

{ !!!! NOTE: THE FILE TP5MISC.TPU MUST BE COMPILED FIRST !!!!
-- Global I/O procedures to include in programs generally
Much credit is due Bill Meacham who wrote the original file IO22.INC
and released it to the public domain. Using that work this unit was
created and added to by Gerald Rohr of Homogenized Software. As
with Bill's work, this program is released to the Public Domain for
all to use and modify.

REVISION HISTORY
---------------------------------------------------------------------
Ver 2.22 Converted to a Turbo pascal V4 units. 30 Dec 87 gbr
Ver 2.30 Converted dates to longint types 19 Jan 88 gbr
Ver 2.42 Added global inv_flag for all write routines 08 Apr 88 gbr
Ver 2.43 Added long integer read and write routines 01 May 88 gbr
Ver 2.43 Added month and month/day routines 10 May 88 gbr
Ver 3.00 Replaced Window procedures/Reformated file 15 Jul 88 gbr
Ver 3.10 Moved Window error routines here 26 Aug 88 gbr
Ver 3.20 Added code and globals for color hi lights 27 Aug 88 gbr
Ver 3.21 Fixed leading decimal point in read_real 02 Sep 88 gbr
Ver 3.25 Added longint to/from packed string[4] 02 Sep 88 gbr
Ver 3.26 Added sys_time global variable 07 Sep 88 gbr
Ver 3.30 Recompiled with Turbo Pascal Version 5.0 29 Sep 88 gbr
Ver 3.40 Added Month Name (string) 05 Oct 88 gbr
Ver 3.50 Changed to use actual scan codes 30 Oct 88 gbr
Ver 3.60 Added RW word, byte 18 Nov 88 gbr
Ver 3.70 Moved many routines to tp5misc.tpu 10 Dec 88 gbr
Ver 3.80 Added Vtp5wio function 24 Mar 89 gbr
Ver 3.90 Added mk_dt_sts() date without century 28 Mar 89 gbr
Ver 4.00 Added color definitions to windows 06 Jul 89 gbr
Ver 4.10 Added openwind to open window with default col.07 Jul 89 gbr
Ver 4.11 Fixed mono command line parameter for window 15 Dec 89 gbr
Ver 4.12 Added next_month and prev_month 05 Jul 90 gbr
Ver 4.14 Added mk_temp_st() function to fill templates 12 Aug 90 gbr
Ver 4.15 Added GetUniqFileName function to tp5misc 16 Aug 90 gbr
Ver 4.16 Changed windows to use pointers 01 Oct 90 gbr
Ver 4.18 Changed window border colors 13 Nov 90 gbr
Ver 4.20 Added ShowMsg without beep for info messages 31 Mar 91 gbr
---------------------------------------------------------------------
}
UNIT tp5wio;

INTERFACE

USES
crt,dos,tp5misc;

CONST
fdslen = 29 ; { length of fulldatestring }

TYPE
datestring = STRING[10] ; { 'MM/DD/YYYY' }

fulldatestring = STRING[fdslen] ;

juldate = RECORD
yr : Integer ; { 0 .. 9999 }
day : Integer ; { 1 .. 366 }
END ;

juldatestring = STRING[8] ; { 'YYYY/DDD' }

montharray = ARRAY [1 .. 13] OF Integer ;

intst = STRING[2]; { packed string of an integer }
lintst = STRING[4]; { packed string of an longint }

VAR
sys_date :LongInt;
null_date :LongInt;
null_date_str : datestring;
sys_time :STRING[8]; { storage for the system time }

fld, scrn : Integer ; { For field & screen cursor control }
macro :ARRAY[1..10] OF STRING; { Function key macro storage }
inv_flag :Boolean; { if true all write routines inverse the screen,
set to false by initialization. User uses
this flag to control the screen attributes.}
col_inv_flag :Boolean; { true if color monitor, false if monochrome,
set by initialization routine, User may change. }
inv_color :Byte; { color to use for inverse data if col_inv_flag
is true. Defaults to green, but user may change. }
in_window :Boolean; { if true then we are in a window, used by the
screen writing routines to high light screen
data. NOTE high lighting can only be done when
in_window flag is true. }
reserv_wind :Integer; { number of windows to reserve (not close) with
endwindows procedure. Initialized to 0, use
with multiple program files. }
text_fg, { Text foreground color }
text_bg, { Text background color }
framefgnd, { window border color }
framebkgnd, { window background color }
title_color, { window title color }
err_fg, { error message foreground }
err_bg, { error message background }
msg_fg, { message foreground }
msg_bg { message background }
:Byte;

PROCEDURE CLRLINE (col,row : Integer);

PROCEDURE BEEP ;

PROCEDURE DO_FLD_CTL (key : Integer);
{ Adjusts global FLD based on value of key, the ordinal value
of last key pressed
}
PROCEDURE DO_SCRN_CTL ;
{ Checks value of FLD and adjusts value of SCRN accordingly }

PROCEDURE WRITE_STR (st:STRING ; col,row:Integer);

PROCEDURE WRITE_TEMP(VAR Ln:STRING;tmp:STRING;x,y:Integer);
{ writes a string using a template. the string (ln) is printed
left justified in the template using the filler locations.
quits when the template is complete on the screen. Fills unused
template filler locations with space.
}

PROCEDURE WRITE_INT (i:Integer ; width,col,row:Integer);

PROCEDURE WRITE_WORD(i:Word; width,col,row:Integer);

PROCEDURE WRITE_BYTE(i:Byte;width,col,row:Integer);

PROCEDURE WRITE_LINT(lint:LongInt;width,col,row:Integer);

PROCEDURE SET_BOOL (VAR bool : Boolean);
{ Sets boolean to be undefined, neither true nor false.
Boolean is stored as one byte:
$80 = undefined
$01 = true
$00 = false.
Note : Turbo interprets $80 as true because it is greater than zero!
}

FUNCTION DEFINED (bool : Boolean) : Boolean ;
{ Determines whether the boolean is defined or not }

PROCEDURE WRITE_BOOL (bool:Boolean ; col, row:Integer);

PROCEDURE WRITE_REAL (r:Real ; width,Frac,col,row:Integer);

FUNCTION BUILD_STR (ch : Char ; n : Integer) : STRING ;
{ returns a string of length n of the character ch }

PROCEDURE READ_STR (VAR st:STRING ; maxlen, col, row:Integer);
{ Read String. This procedure gets input from the keyboard one
character at a time and edits on the fly, rejecting invalid
characters. COL and ROW tell where to begin the data input
field, and MAXLEN is the maximum length of the string to be
returned.
Only use the Function keys for string input data, for other
types of input will beep.
}

PROCEDURE READ_TEMP(VAR st:STRING;tmp:STRING;col, row:Integer);
{ Read string with a template. This procedure gets input
from the keyboard one character at a time and edits on the
fly, rejecting invalid characters. tmp is a template
which is filled in where filler characters exist, any
other characters are displayed on the screen. Returned
string does NOT have the template imbeded in it. COL and
ROW tell where to begin the data input field, Max length
of the string is the max length of the template.
}

PROCEDURE READ_INT (VAR Int:Integer ; maxlen, col, row:Integer);
{ Read Integer. This procedure gets input from the keyboard
one character at a time and edits on the fly, rejecting
invalid characters. COL and ROW tell where to begin the data
input field, and MAXLEN is the maximum length of the integer
to be returned.
}

PROCEDURE READ_LINT (VAR lint:LongInt ; maxlen, col, row:Integer);
{ Read LongInt. This procedure gets input from the keyboard
one character at a time and edits on the fly, rejecting
invalid characters. COL and ROW tell where to begin the data
input field, and MAXLEN is the maximum length of the integer
to be returned.
}

PROCEDURE READ_WORD(VAR wd:Word; maxlen,col,row:Integer);
{ Read Word. This procedure gets input from the keyboard
one character at a time and edits on the fly, rejecting
invalid characters. COL and ROW tell where to begin the data
input field, and MAXLEN is the maximum length of the word
to be returned.
}

PROCEDURE READ_BYTE(VAR bt:Byte; maxlen,col,row:Integer);
{ Read byte. This procedure gets input from the keyboard
one character at a time and edits on the fly, rejecting
invalid characters. COL and ROW tell where to begin the data
input field, and MAXLEN is the maximum length of the byte
to be returned.
}

FUNCTION EQUAL (r1,r2 : Real) : Boolean ;
{ tests functional equality of two real numbers -- 4/30/85 }

FUNCTION GREATER (r1,r2 : Real) : Boolean ;
{ tests functional inequality of two real numbers -- 5/1/85 }

PROCEDURE READ_REAL (VAR r:Real ; maxlen,Frac,col,row:Integer);
{ Read Real. This procedure gets input from the keyboard
one character at a time and edits on the fly, rejecting
invalid characters. COL and ROW tell where to begin the data
input field; MAXLEN is the maximum length of the string
representation of the real number, including sign and decimal
point; FRAC is the fractional part, the number of digits to
right of the decimal point.

Note -- In Turbo the maximum number of significant digits in
decimal (not scientific) representation is 11. In TurboBCD,
the maximum number of significant digits is 18. It is the
programmer's responsibility to limit input and computed output
to the maximum significant digits.
}

PROCEDURE READ_YN (VAR bool:Boolean; col,row:Integer);
{ Inputs "Y" OR "N" to boolean at column and row specified,
prints "YES" or "NO."
Note -- use this when the screen control will not return
to the question and the boolean IS NOT defined before the
user answers the question. Does not affect global FLD.
}

PROCEDURE READ_BOOL (VAR bool:Boolean; col,row:Integer);
{ Displays boolean at column and row specified, inputs "Y"
or "N" to set new value of boolean, prints "YES" or "NO."
Boolean is "forced;" user cannot cursor forward past undefined
boolean. Pressing "Y" or "N" terminates entry.
Boolean is stored as one byte:
$80 = undefined
$01 = true
$00 = false.
Note : Turbo interprets $80 as true because it is greater
than zero!
}

PROCEDURE PAUSE ;
{Prints message on bottom line, waits for user response.}

PROCEDURE HARD_PAUSE ;
{ Like Pause, but only accepts space bar or Escape and only
goes forward.
}

PROCEDURE SHOW_MSG (msg : STRING);
{ Beeps, displays message in the message window in the lower
right corner of the screen.
}

PROCEDURE SHOWMSG(msg : STRING);
{ displays message centered on line 22, pauses, similar to
show_msg but does not beep.
}

FUNCTION MK_TEMP_ST(VAR st:STRING;tp:STRING):STRING;
{ Returns a string containing st put into template tp }

FUNCTION MK_DT_ST (dt :LongInt):datestring ;
{ Makes a string out of a date -- used for printing dates,
includes century (ie MM/DD/YYYY)
}

FUNCTION MK_DT_STS(dt :LongInt) : datestring ;
{ Makes a string out of a date -- used for printing dates,
does not include century (ie MM/DD/YY)
}

PROCEDURE WRITE_DATE (dt: LongInt ; col, row: Integer);
{ Writes date at column and row specified }

FUNCTION MK_JUL_DT_ST (jdt : juldate) : juldatestring ;
{ makes a string out of a julian date }

PROCEDURE READ_DATE (VAR dt: LongInt ; col, row: Integer);
{ Read date at column and row specified. If the user enters
only two digits for the year, the procedure plugs the
century as 1900 or 2000, but the user can enter all four
digits to override the plug.
}

FUNCTION GREATER_DATE (dt1, dt2 : LongInt) : Integer ;
{ Compares two dates, returns 0 if both equal, 1 if first is
greater, 2 if second is greater.
}


PROCEDURE GREG_TO_JUL (dt : LongInt ; VAR jdt : juldate);
{ converts a gregorian date to a julian date }

PROCEDURE JUL_TO_GREG (jdt : juldate ; VAR dt : LongInt);
{ converts a julian date to a gregorian date }

PROCEDURE NEXT_DAY (VAR dt : LongInt);
{ Adds one day to the date }

PROCEDURE PREV_DAY (VAR dt : LongInt);
{ Subtracts one day from the date }

PROCEDURE NEXT_MONTH(VAR dt : LongInt);
{ Adds one month to the date }

PROCEDURE PREV_MONTH(VAR dt : LongInt);
{ Subtracts one month from the date }


FUNCTION DATE_DIFF (dt1, dt2 : LongInt) : LongInt ;
{ computes the number of days between two dates }

FUNCTION MONTH_DIFF (dt1, dt2 : LongInt ) : Integer ;
{ Computes number of months between two dates, rounded.
30.4167 = 356/12, average number of days in a month.
}

FUNCTION EQUAL_DATE (dt1, dt2 : LongInt) : Boolean ;
{ Tests whether two dates are equal }

FUNCTION BUILD_FULL_DATE_STR (dt : LongInt) : fulldatestring ;
{ Build printable string of current date -- from ROS 3.4
source code.
}

FUNCTION MONTH(dt:LongInt):Integer;
{ returns the month portion of a date.}

FUNCTION day(dt:LongInt):Integer;
{ returns the day from the date }

FUNCTION YEAR(dt:LongInt;centry:Boolean):Integer;
{ returns the year of a date. if the centry flag is true
returns 4 digit year otherwise returns two digit year.
}

FUNCTION MONTH_NAME(mon:Integer):STRING;
{ returns the month name given the month number (1-12) }

PROCEDURE SET_MONO;
{ Sets flags and colors for mono screen on color card }

{ ---- window procedures, Idea Derived from article in Computer
Language Magazine June 1988 by James Kerr ---- }

PROCEDURE OPENWIND(wtitle:STRING;x1,y1,x2,y2:Byte);
{ Works just like openwindow except uses the default colors
for text foreground and background. Actually just calls
openwindow with text_fg and text_bg
}

PROCEDURE OPENWINDOW(wtitle:STRING;x1,y1,x2,y2:Byte;
fgnd,bkgnd: Byte);
{ wtitle is centered on the top border line of the window, x
and y are the window coordinates, fgnd and bkgnd are the
colors of the inside of the window (note the border is
always white, if a window can not be opened, a message as to
why will be displayed and the program exits
}

PROCEDURE CLOSEWINDOW;
{ closes the current open window, does nothing if no
window to close.
}

PROCEDURE ENDWINDOWS;
{ close any open windows when exiting the windows system. Use
as the last statment in program to insure return to
enviroment you came from. The global reserv_wind is
normally set to 0 allowing all windows to be closed, if
using a multi file window program, reserv_wind can be set to
the number of windows to be left open when a particular
program terminates. Always set reserv_wind to 0 before the
final program call to endwindows.
}

FUNCTION VTP5WIO:STRING;
{ Return a string which contains the version of this set of
routines
}

{ ---------------------------------------------------------------- }

I hope you enjoy these procedures and functions, and they help you
develope programs as they have me.

Gerry Rohr
Homogenized Software
RR#3
Anamosa, Iowa 52205



 December 23, 2017  Add comments

Leave a Reply