Dec 122017
 
Turbo Pascal 4.0 unit to aid processing of user input and display output.
File FLDIO1.ZIP from The Programmer’s Corner in
Category Pascal Source Code
Turbo Pascal 4.0 unit to aid processing of user input and display output.
File Name File Size Zip Size Zip Type
CNVRTHLP.PAS 4939 1288 deflated
FIELDIO.DOC 41483 8435 deflated
FIELDIO.TPU 33664 14276 deflated
TESTHELP.PAS 1192 595 deflated

Download File FLDIO1.ZIP Here

Contents of the FIELDIO.DOC file


{$v-}
unit Fieldio;

interface { FIELDIO.TPU a Turbo Pascal (R) unit }
{ for field input and output }
uses
Crt, { version 1.0 }
Dos; { Copyright (c) 1988 by W. Lee Passey }
{ All rights reserved



FieldIO is a separately compiled unit for Turbo Pascal ver. 4.0 from
Borland International, Inc. FieldIO may be linked to a user's source pro-
grams, and will provide routines for "Bullet Proof" data entry.

What follows is a copy of the FieldIO interface section, with each
procedure and significant variable annotated as to its function and use.

}

type
String5 = string[5];
String10 = string[10];
String15 = string[15];
String20 = string[20];
String25 = string[25];
String30 = string[30];
String35 = string[35];
String40 = string[40];
String45 = string[45];
String50 = string[50];
String55 = string[55];
String60 = string[60];
String65 = string[65];
String70 = string[70];
String75 = string[75];
String80 = string[80];
String85 = string[85];
String90 = string[90];
String130 = string[130];
String150 = string[150];
datetype = string[9];

setofchar = set of char;

wordpointer = ^wordheap; { These are the variable types }
wordheap = record { for a linked list of words or }
NextWord, { phrases on the heap. They }
PrevWord : wordpointer; { used by the 'DisplayWords' }
Word : string[25]; { and 'GetList' routines. }
end;

TextRec = record { This is the record type for }
NextRec : longint; { the help file. Record zero }
case byte of { contains a header array for }
0 : (Text { the first 30 help screens (0 }

: string[123]); { is unused in the first header,}
1 : (Header
: array [0 .. 30] of longint);
end;
{ although it is in subsequent }
{ headers) where each element }
{ in the array is the first }
{ record of of the correspond- }
{ ing help screen. For header }
{ records, 'NextRec' points to }
{ the next header and for text }
{ records it points to the next }
{ text. Text is automatically }
{ word wrapped when displayed, }
{ so all text records, except }
{ the last on each screen, }
{ should be packed with a full }
{ 123 bytes. }

const { constants for cursor control keys - mostly self- }
Up = ^E; { explanatory }
Down = ^X;
Right = ^D;
Left = ^S;
WdRt = ^F;
WdLt = ^A;
ScUp = ^Z;
ScDn = ^W;
Ret = ^M;
InLin = ^N;
PgUp = ^R;
PgDn = ^C;
Reform = ^B;
Esc = #27;
Del = #127;
DelFd = ^G;
DelWd = ^T;
DelLn = ^Y;
Space = #32;
Null = #0;
Tab = ^I;
BkSp = ^H;
HelpKey = #187; { These three numbers are the return codes for }
Home = #199; { these keys with the high bit set. GetChar sets }
EndKey = #207; { the high bit for all extended key codes. }

TB : char = #205; { These characters are used to create the top, }
SID : char = #186; { bottom (TB), sides (SID) and each of the four }
TLC : char = #201; { corners (TLC, TRC, BLC, BRC) of the help window }
TRC : char = #187; { border. They can be changed to whatever you }
BLC : char = #200; { like. These values make a double border. }
BRC : char = #188;

AllChars : setofchar = [' ' .. '}'];
ControlSet : setofchar = [^A .. ^Z, Esc, Del];
NumChars : setofchar = ['0' .. '9'];
NameChars : setofchar = ['A' .. 'Z', 'a' .. 'z', '-', '.', '_'];
SpaceChars : setofchar = [' ', '-', '/', ','];

BeepOnError : boolean = false; { When this variable is true, }
{ an unacceptable response, }
{ e.g. a letter in a number }
{ field, will cause the speaker }
{ to beep. }

NoFuture : boolean = false; { When this variable is true, }
{ the GetDateStr routine will }
{ not accept a future date, }
{ i.e. one in advance of the }
{ 'TodaysDate', which is init- }
{ ialized by this unit to the }
{ system date. }

InsertOn : boolean = false; { When this variable is true, }
{ newly added characters will }
{ be inserted into the field at }
{ the cursor position. When }
{ false, overwriting occurs. }

Escape : boolean = false; { This variable will be set to }
{ true whenever the escape key }
{ is pressed, and reset to }
{ false whenever any other key }
{ is pressed. Note: most of }
{ following routines stop col- }
{ lecting characters and return }
{ when this occurs. }

ErrMsg : boolean = false; { This variable will be set to }
{ true if an error message was }
{ printed on the last line of }
{ the screen. These messages }
{ get cleared upon the next }
{ key-press. }

Reference : boolean = false; { When this variable is true, }
{ the last sentence of a help }
{ screen is considered to be a }
{ reference (to the manual, }
{ etc.) and will be printed in }
{ the lower right corner of the }
{ help screen. If the last }
{ sentence is the single char- }
{ acter '#', the number of the }
{ help screen will be displayed.}

RefMark : string15 = '#-'; { If the option to print help }
{ screen numbers is selected, }
{ this short string will be }
{ displayed on the last help }
{ line, immediately before the }
{ help screen number. }

Hercules : boolean = true; { This variable is used to in- }
{ dicate the presence of a Mono }
{ graphics adapter in the sys- }
{ tem (not necessarily Herc- }
{ ules). When true, the saved }
{ portion of the screen is }
{ saved in extra memory on the }
{ card, beginning at offset }
{ $1000, rather than in main }
{ memory. This storage will }
{ always take place for CGA }
{ cards, regardless of the }
{ value of this variable. Set }
{ this to true for EGA cards. }

StartField : char = '>'; { Characters used to mark a }
EndField : char = '<'; { field when selected for input }

HelpFG : byte = 7; { Foreground color for the help }
{ windows. }
HelpBG : byte = 0; { Background color for help. }
BordFG : byte = 7; { Forground color for the help }
{ window border. }
BordBG : byte = 0; { Border background color. }
{ Defaults are for monochrome }
var
TodaysDate : datetype;
HelpFileName : string15; { Store here the name of your }
{ help file, before calling }
{ Help. }

ScreenWidth : byte absolute $0040:$004A; { the screen width }
{ as set by mode. }

screenlength : byte; { This variable is initialized }
{ by this unit to 25. }

(************************************************************************
* *
* CHARSTRING *
* *
* This function returns a string of the character passed having a *
* length equal to the Number passed. *
* *
************************************************************************)

function CharString (Character : char;
Number : byte) : String;


(************************************************************************
* *
* TRIMLENGTH *
* *
* This function returns the length of a string, not including *
* trailing spaces or carriage returns. *
* *
************************************************************************)

function TrimLength (line : string) : byte;


(************************************************************************
* *
* ALLCAPS *
* *
* This function returns a string identical to the string passed, *
* except that all lower case letters are converted to upper case. *
* *
************************************************************************)

function AllCaps (CapsStr : String) : String;


(*************************************************************************
* *
* LASTSPACE *
* *
* This procedure searches the 'Line' passed, backward, starting at *
* 'SpacePos', for a space, comma, slash or hyphen. The position of *
* the space character in the string is returned in 'SpacePos'. *
* *
*************************************************************************)

procedure LastSpace ( Line : String;
var SpacePos : byte);


(*************************************************************************
* *
* HELP *
* *
* This procedure creates a bordered window of 5 lines on the top *
* half of the screen if the current cursor location is in the bottom *
* half, or vice-versa, then opens the file specified by HelpFileName *
* in the current directory, reads a linked list of text records on *
* to the heap, and then displays them in the help window. if more *
* than 5 lines of help are available, the user can scoll or page *
* the window, or use Home or End to go to the beginning or end of *
* the help screen. RETurn or ESCape will restore the prior screen *
* and in addition ESCape will set the variable Escape to true. If *
* 'HelpNum' is zero, the routine will return with no response. *
* *
*************************************************************************)

procedure Help (HelpNum : word);


(*************************************************************************
* *
* MESSAGE *
* *
* This procedure prints the text passed on the bottom line of the *
* currently active window. If 'Error' is true, 'ErrMsg' is set to *
* treu, and if 'BeepOnError' is true it also beeps. *
* *
*************************************************************************)

procedure Message (Error : boolean;
text : string80);


(************************************************************************
* *
* SHOWYESNO *
* *
* This procedure writes 'Yes' or 'No' on the screen at position *
* (x,y) depending on whether the default passed is true or false. *
* If 'flen' (field length) is less than 3, 'Y' or 'N' will be *
* displayed. *
* *
************************************************************************)

procedure ShowYesNo (x, y, flen : byte;
default : boolean);


(*************************************************************************
* *
* DISPSTRING *
* *
* This procdure goes to position 'x', 'y' on the screen and dis- *
* plays 'OutStr' in a field which is 'FldLnth' characters wide. *
* All unused parts of the field are cleared. If 'RightJust' is *
* true 'OutStr' is right justified in the field. *
* *
*************************************************************************)

procedure DispString (x, y,
FldLnth : byte;
RightJust : boolean;
OutStr : string80);


(************************************************************************
* *
* DISPLAYWORDS *
* *
* This procedure displays a list of words from a linked list on *
* the heap, on a single line beginning at 'X', 'Y'. If there are *
* more words in the list than can be displayed on a single line, *
* the procedure will display all possible and then print '[MORE]'. *
* If the space character is included in 'ExtraChars' then each *
* word (or phrase) will be separated by a comma and a space, *
* otherwise they will be separated only by a space. *
* *
************************************************************************)

procedure DisplayWords (WordPtr : wordpointer;
X, Y : integer;
ExtraChars : setofchar);


(*************************************************************************
* *
* ADDCOMMAS *
* *
* This procedure takes the string passed, 'NumStr', which should *
* consist only of numerals, a decimal point, and a leading '+' or *
* '-' and adds a comma every three characters in front of the right- *
* most decimal point. *
* *
*************************************************************************)

procedure AddCommas (var NumStr : string30);


(*************************************************************************
* *
* DISPREAL *
* *
* This procedure displays a real number at position 'X', 'Y' in a *
* field which is 'FldLnth' characters wide. Zeros are added or *
* the number is truncated, as needed, to display 'Decimals' number *
* of digits past the decimal point. Commas are added as needed. *
* If RightJust is true, the number is right-justified in the field. *
* *
*************************************************************************)

procedure DispReal (x, y,
FldLnth,
Decimals : byte;
RightJust : boolean;
OutReal : real);


(*************************************************************************
* *
* DISPINTEGER *
* *
* This procedure displays any integer number at position 'X', 'Y' *
* in a field which is 'FldLnth' characters wide. Commas are added *
* as needed. If RightJust is true, the number is right-justified *

* in the field. *
* *
*************************************************************************)

procedure DispInteger (x, y,
FldLnth : byte;
RightJust : boolean;
OutInt : longint);


(*************************************************************************
* *
* DATETOSTR *
* *
* This function returns a date string from a variable of type *
* 'datetype' according to a requested format. Format '0' is *
* MM/DD/YYYY, format '1' is DD MON YYYY, and Format '2' is *
* Month DD, YYYY. *
* *
*************************************************************************)

function DateToStr (DateStr : datetype;
format : byte) : string20;


(*************************************************************************
* *
* MAKEFRACTION *
* *
* This function converts a the decimal part of a real number to a *
* fraction, e.g. if the decimal portion is .25, .33, .50., .67, or *
* .75 (as well as some others) the string returned will be a space *
* and then 1/4, 1/3, 1/2, etc. as appropriate. If the number *
* cannot be converted to a fraction the decimal part will be return *
* as a decimal point followed by a two digit string. The function *
* will convert everything within two one-hundredths of the target. *
* *
*************************************************************************)

function MakeFraction (IOReal : real) : String5;


(************************************************************************
* *
* GETCHAR *
* *
* This function repeatedly reads a character from the keyboard, *
* until the character is in the set of acceptable characters. *
* ESCape is always acceptable. If the pre-defined help key is *
* pressed, the appropriate help message is displayed. When a *
* valid key is pressed, it is returned. *
* *
************************************************************************)

function GetChar ( OKSet : setofchar;
HelpNum : word) : char;


(************************************************************************
* *
* GETYESNO *
* *
* This procedure goes to position 'x', 'y' on the screen and waits *
* for a keyboard response of Y, N, or Ret. It returns true for *
* yes, or false for no. If a Return or Escape is pressed it *
* returns the value of the default. The input is displayed by *
* ShowYesNo, so a field length must be passed. *
* *
************************************************************************)

function GetYesNo (x, y, flen : byte;
HelpNum : word;
default : boolean) : boolean;


(************************************************************************
* *
* CORRECT *
* *
* This function goes to position (x,y) on the screen and asks if *
* the above is correct. If the response is yes, the function *
* returns true, otherwise it returns false. *
* *
************************************************************************)

function Correct (x, y, flen : byte;
HelpNum : word;
default : boolean) : boolean;


(************************************************************************
* *
* EDITLINE *
* *
* This procedure allows editing of the 'Line' passed. The routine *
* will first write the line at 'X', 'Y', clearing the remainder *
* of the field. Only those characters included in OKSet will be *
* accepted. The routine will end upon receipt of any character *
* included in ExitSet or by pressing ESCape or RETurn, or when the *
* cursor position in the line exceeds the field length. Pressing *
* the Help key (usually F1, but can be changed) will display the *
* help screen specified by 'HelpNum.' 'Cursor' contains the *
* position of the cursor in the field, and can be used to start *
* the editing at greater than position 1. If Upper is true, each *
* character entered will be forced to upper case. If FieldIn is *
* true, the procedure will not terminate when the 'Line' length *
* becomes longer than the specified 'FldLnth', rather, 'Line' will *
* be truncated to fit. In addition, pressing Ctrl-left arrow, *
* Ctrl-right arrow, Ctrl-A or Ctrl-F will terminate the procedure. *
* If FieldIn is false, these actions will not be taken, and in *
* addition, the row and cursor numbers, and insert status will be *
* displayed on the last line of the screen. The tab key (or ^I) *
* will move the cursor to the next multiple of 5, and if 'InsertOn' *
* is true, spaces will be added. Key will return the control *
* character which caused the routine to terminate, or #1F if the *
* cursor moved past the end of the field. *
* *
************************************************************************)

procedure EditLine (var Line : String90;
X, Y,
FldLnth : byte;
OKSet,
ExitSet : setofchar;
HelpNum : word;
var Cursor : byte;
UpperC,
FieldIn : Boolean;
var control : char);


(*************************************************************************
* *
* SELECTFIELD *
* *
* Calling this procedure will mark the field starting at 'X', 'Y' *
* and having length 'FldLnth' with the characters stored in *
* 'StartField' and 'EndField', or, if StartField is in the range *
* 0 .. 8, will set the BackGround color to ORD (StartField), and *
* the foreground color to ORD (EndField). The field will be cleared *
* and set to the background color. Note that if characters are used *
* to mark the field, they will be placed at X - 1 and X + FldLnth + *
* 1, so X must never be less than 2 and X + FldLnth must not be *
* allowed to exceed the screen width. If MarkField is false, the *
* field will be cleared, but not marked. *
* *
*************************************************************************)

procedure SelectField (x, y,
FldLnth : byte;
MarkField : boolean);


(*************************************************************************
* *
* DESELECTFIELD *
* *
* This procedure will remove the markings left at 'X', 'Y' by *
* 'SelectField', and restore the prior background color. If the *
* field was marked by SelectField, be sure that MarkField is true. *
* *
*************************************************************************)

procedure DeselectField (x, y,
fldlnth : byte;
MarkField : boolean);


(*************************************************************************
* *
* GETFIELD *
* *
* This function will return a string input into a field at 'X', 'Y'. *
* 'FldLnth' is the length of the field, 'MinLnth' is the minimum *
* acceptable length for the input, 'StrtPos' is the starting posi- *
* tion for the cursor, and 'HelpNum' is the number of the help *
* screen associated with this field. If 'UpperCase' is true all *
* input will be forced to upper case, and if 'RightJust' is true *
* the input will be right justified in the field when the function *
* returns. 'OKSet' contains the characters which are acceptable as *
* input and 'MarkField' is true if you want the field marked. *
* 'Contents' contains the string to be edited, if any, and 'Key' *
* returns the control key which terminated the function; these *
* keys are Up, Down, Right, Left, PgUp, PgDn, Home, EndKey, WdRt, *
* WdLt, Ret and Esc (see the type declaration for control-key *
* equivilencies). *
* *
*************************************************************************)

function GetField ( x, y,
FldLnth,
MinLnth,
StrtPos : byte;
HelpNum : word;
UpperCase,
RightJust : boolean;
OKSet : setofchar;
MarkField : boolean;
Contents : string;
var control : char) : String;


(*************************************************************************
* *
* GETLIST *
* *
* This routine gets or edits a words on a single line, which are *
* contained on a linked list on the heap. Each word is marked as *
* it is edited, and cannot exceed 25 characters. Only those *
* characters contained in NameChars and ExtraChars are acceptable *
* input. A comma or a space will end a word, as well as RETurn or *
* ESCape, so long as either is NOT in ExtraChars. *
* *
*************************************************************************)

procedure GetList ( x, y,
WordLen : byte;
HelpNum : word;
UpperCase : boolean;
ExtraChars : setofchar;
var WordPtr : wordpointer;
var control : char);


(*************************************************************************
* *
* GETREAL *
* *
* This function inputs a real number in a manner similar to that of *
* 'GetField.' 'Min' and 'Max' are the minimum and maximum accep- *
* table values for this field, and 'Decimals' is the number of *
* decimal places accepted. IOReal is the beginning value. *
* *
*************************************************************************)

function GetReal ( X, Y,
FldLnth : byte;
HelpNum : word;
Min, Max : real;
Decimals : byte;
RightJust,
MarkField : boolean;
IOReal : real;
var Control : char) : real;


(*************************************************************************
* *
* GETINTEGER *
* *
* This function inputs any integer number in a manner similar to *
* that of 'GetField.' 'Min' and 'Max' are the minimum and maximum *
* acceptable values for this field. IOInteger is the beginning *
* value for the field. *
* *
*************************************************************************)

function GetInteger ( X, Y,
FldLnth : byte;
Help : word;
Min, Max : longint;
RightJust,
MarkField : boolean;
IOInteger : longint;
var Control : char) : longint;


(*************************************************************************
* *
* GETDATESTR *
* *
* This function reads a date string in almost any format and con- *
* verts to a value of type 'datetype.' 'Format' specifies how the *
* date will be displayed when the function ends. If 'Precise' is *
* true, approximate dates (dates containing question marks) will *
* not be allowed, and if 'NoFuture' is true, dates beyond *
*' 'TodaysDate' will not be allowed. 'DateStr' passes the default. *
* *
*************************************************************************)

function GetDateStr ( X, Y,
FldLnth,
format : byte;
helpNum : word;
precise : boolean;
Markfield : boolean;
DateStr : datetype;
var Control : char) : datetype;


(*************************************************************************
* *
* GETFRACTION *
* *
* This function gets a string of numbers, which may contain a *
* fraction, and converts it to a real number. IOReal passes the *
* default, which is converted to a string containing a fraction for *
* input, if possible. *
* *
*************************************************************************)

function GetFraction ( X, Y : byte;
HelpNum : word;
RightJust,
MarkField : boolean;
IOReal : real;
var Control : char) : real;


(*************************************************************************
* *
* MENUOPTION *
* *
* This function goes to 'X', 'Y' and prints: *
* *
* 'Enter your selection > <, or press ESC to exit.' *
* *
* It then waits for the user to enter one of the characters included *
* in 'Options', which is converted to upper case and returned, or *
* ESCape if that key was pressed in response. *
* *
*************************************************************************)

function MenuOption (x, y : byte;
HelpNum : word;
Options : setofchar ) : char;



{ FieldIO is shareware, which means that it, like most shareware, may
be freely copied and distributed so long as no consideration is required
for its distribution, except a copying and media charge not to exceed
$3.00, including the cost of the means of distribution (i.e., diskette).
Users who find the program of value to them should consider sending a
donation to Pass-Key Software.

Users sending a donation of $25.00 or more are registered, will
receive notification of upgrades and modifications to this product, and
are entitled to receive source code and future updates, upon request, for
the cost of a diskette and postage. Non-registered users may not incor-
porate this unit into any commercially distributed software, including
shareware, while registered users may do so freely.

FieldIO is a copyrighted program, and is protected by the laws of
the United States and each of its several states, as well as interna-
tional treaties and conventions. A licence is hereby granted to all
persons to use this program according to the terms and restrictions con-
tained herein. All programs which incorporate all or any part of this
program must include the following phrase both in the source code and in
any accompanying documentation:

Portions of this program Copyright (c) 1988 by W. Lee Passey.

This program is distributed as is, and by its use each person agrees
to the terms and conditions of this license, and acknowledges that W. Lee
Passey and Pass-Key Software have made no warranties, either express or
implied, concerning the performance of this software, including warran-
ties of merchantability or fitness for a particular purpose.

Please send all comments, suggestions, information regarding pos-
sible bugs, donations and registration information to:

Pass-Key Software
119 MacArthur Ave.
Salt Lake City, UT 84115

or use your modem to call The Motherboard, (801) 485-7211, 8 data,
1 stop, no parity, 300/1200/2400 baud, 24 hours/day, 7 days/week (except
when I'm using the computer).

I am also looking for a job in the data processing field, and this
unit is a good example of my programming skills. If any employers are
interested in using me as an employee, please contact me in the same way.

}


 December 12, 2017  Add comments

Leave a Reply