Dec 232017
 
A Turbo Pascal 6.0 unit that includes several useful routines. No source code, just TPU file.
File UTIL13.ZIP from The Programmer’s Corner in
Category Pascal Source Code
A Turbo Pascal 6.0 unit that includes several useful routines. No source code, just TPU file.
File Name File Size Zip Size Zip Type
UTILITY.DOC 58458 10376 deflated
UTILITY.TPU 49600 18152 deflated

Download File UTIL13.ZIP Here

Contents of the UTILITY.DOC file


{

This UNIT was written for TURBO PASCAL 6.0 by:

GEMINI SYSTEMS
7748 Lake Ridge Drive
Union Lake, MI 48387

BBS Support (313) 360-4931
FAX Support (313) 360-6407

To use in your programs, simply state UTILITY in your uses clause and
compile your program with the $V- compiler directive.

example: PROGRAM prog_name;
USES utility;

Modification History:

Version Number Date Change Made

10.0 03/14/90 Added JULIAN, JULTOMDY,
DAYWEEK
Modified READSTR_BIG to correct
Insert Problem.
10.1 03/26/90 Write last char entered from
READSTR_BIG to screen.
10.2 05/11/90 Calling PATHEXEC now does not
require using the $M directive.
UTILITY calculates the memory
requirements at the time of the
call and handles it for you.
Changed format of DATE from.
MM/DD/YY TO MM-DD-YY This
allows the date to be used as a
filename if desired.
10.3 05/14/90 ADD DYNAMIC_PATHEXEC Variable
10.4 06/06/90 DYNAMIC_PATHEXEC defaults to
FALSE. There is a problem
using DYNAMIC ALLOCATION in
combination with B-Tree Filer.
10.5 06/16/90 ADDED ELAP_TIME_STR
10.6 06/21/90 ADDED DUP and POP_WINDOW
10.7 06/25/90 Change format of ELAP_TIME_STR
10.9 07/01/90 Fix Bug in POP_WINDOW
11.0 07/25/90 Added PAD_LEFT & PAD_CH
11.1 07/31/90 Shadow on POP_WINDOW is optional
11.2 08/10/90 Add GET_FILE_INFO
11.3 09/05/90 Improve WRITE_X80_Y25
11.4 09/11/90 Error in DAYWEEK
11.5 09-11-90 Add SAVE_LINE & REBUILD_LINE
11.6 09-17-90 Modify DAYWEEK procedure
11.7 10-04-90 Add Program Name to SHOW_VERSION
11.8 10-13-90 Minor change to READ_REAL
11.9 10-18-90 Eliminate char 0 in PAD
12.0 11-21-90 Added FILL_SCREEN, REBOOT and
PROGRAM_LOCATION
13.1 12-03-90 Conversion to TP v6.0
Added BLINK_ON, BLINK_OFF,
and VGA_INSTALLED, SCREEN_ON &
SCREEN_OFF
13.2 12-06-90 Changed SHADOW on POP_WINDOW

}



UNIT UTILITY;
INTERFACE
USES CRT, DOS, PRINTER;

CONST
VERSION : STRING[15] = 'UTILITY 13.2'; { Reset in Application if Desired }
{ Example: VERSION := 'V1.0'; }
FUNC1 = #127;
FUNC2 = #128;
FUNC3 = #129;
FUNC4 = #130;
FUNC5 = #131;
FUNC6 = #132;
FUNC7 = #133;
FUNC8 = #134;
FUNC9 = #135;
FUNC10 = #136;
AF1 = #139;
AF2 = #140;
AF3 = #141;
AF4 = #142;
AF5 = #143;
AF6 = #144;
AF7 = #145;
AF8 = #146;
AF9 = #147;
AF10 = #148;
ALT_A = #151;
ALT_B = #152;
ALT_C = #153;
ALT_D = #154;
ALT_E = #155;
ALT_F = #156;
ALT_G = #157;
ALT_H = #158;
ALT_I = #159;
ALT_J = #160;
ALT_K = #161;
ALT_L = #162;
ALT_M = #163;
ALT_N = #164;
ALT_O = #165;
ALT_P = #166;
ALT_Q = #167;
ALT_R = #168;
ALT_S = #169;
ALT_T = #170;
ALT_U = #171;
ALT_V = #172;
ALT_W = #173;
ALT_X = #174;
ALT_Y = #175;
ALT_Z = #176;
CF1 = #177;
PGUP = #178;
PGDN = #179;
UP = #180;
DOWN = #181;
LEFT = #191;
RIGHT = #192;
BACKUP = #194;
HOMEKEY = #196;
ENDKEY = #197;
INSKEY = #198;
DELKEY = #199;
BACKSPACE= #8;
TAB = #9;
ENTER = #13;
RETURN = #13;
ESCAPE = #27;

TYPE
STR3 = STRING [3];
STR8 = STRING [8];
STR16 = STRING [16];
STR20 = STRING [20];
STR80 = STRING [80];
BUFFER = ARRAY [1..4000] OF CHAR; { Use for calls to SAVE_SCREEN }
BUF160 = ARRAY [1..160] OF BYTE; { Use for calls to SAVE_LINE }
LINE_SET = SET OF 1..80; { Use for calls to SET_ATTR }
CURTYPE = (BLOCK, { Use for calls to SET_CURSOR }
UNDERLINE,
NONE,
HALF);
ETYPE = SET OF CHAR;
CTYPE = SET OF 1..80;
TYPEN = (RNUM,LNUM,INUM);

VAR
CH : CHAR; { Global CHAR Variable }
NOCONV : CHAR; { If included in EXITCH to READSTR }
{ LEFT or RIGHT is not converted to }
{ UP or DOWN if in first or last
{ position. }
CLEAR : CHAR; { If included in EXITCH to READSTR }
{ the value being edited is set to }
{ spaces. }
CGA_PRESENT: BOOLEAN; { Is TRUE if CGA-ABILITY is Present }
EGA_PRESENT: BOOLEAN; { Is TRUE if EGA-ABILITY is Present }
VGA_PRESENT: BOOLEAN; { Is TRUE if VGA-ABILITY is Present }
SHOW_ERROR : BOOLEAN; { If set to FALSE in Application, }
{ Error Handler is De-Activated. }

DOS_VER : STRING [4]; { Contains DOS Version at Startup }
{ i.e. "3.31" }

TIME : STR8; { Is set to Current Time at Startup }
DATE : STR20; { Is set to Current Date at Startup }
{ Date & Time are updated when any }
{ of the following routines are }
{ called: }
{ READSTR Updates Time }
{ READSTR_BIG Updates Time }
{ READ_REAL Updates Time }
{ READ_INT Updates Time }
{ READCHTIME Updates Time }
{ WRITE_TIME Updates Time }
{ READCHT Updates Time }
{ WRITE_DATE Updates Date }
TIM : LONGINT; { Is used with START_TIMER at Entry }
{ or can be used by application. }

P : ^BUFFER; { Pointer to Video Memory }
CUR : CURTYPE; { Stores the Current Cursor Shape }
DISPLAY : CHAR;
NUM_INPUTS : INTEGER;
ENTER_KEY : STRING[3]; { Contains the Symbol for Enter Key }

CHANGED : BOOLEAN; { Set to TRUE or FALSE after each }
{ call to:
READSTR
READ_REAL
READ_INT
depending if that value has changed.}
DOW : WORD; { Contains Day-of-Week after a call to
WRITE_DATE }
DYNAMIC_PATHEXEC : BOOLEAN; { Defaults to FALSE. If TRUE you do not
need to set the $M compiler directive
to use PATHEXEC. Memory is dynamically
allocated at the time of the call
Do not use this in programs that
directly use the B-Tree Filer }
NOW : INTEGER; { After each all to WRITE_TIME this
integer contains the number of minutes
since 12:00 midnight }

(**)
PROCEDURE BEEP;

(* Nicer than CHR(7). *)
(**)
PROCEDURE BIN_LED(L : BYTE);

{ USES KEYBOARD LED'S TO TURN ON A BINARY NUMBER FROM 0 TO 7 }
{ }
{ BIN_LED(5) Used for Debugging, }
{ 0 Turns OFF CAPS, SCROLL, NUM }
{ 1 Turns ON SCROLL, OFF CAPS, NUM }
{ 2 Turns ON NUM, OFF CAPS, SCROLL }
{ BINARY VALUE 3 Turns ON SCROLL, NUM OFF CAPS }
{ CAPS NUM SCROLL 4 Turns ON CAPS, OFF SCROLL, NUM }
{ 5 Turns ON CAPS, SCROLL, OFF NUM }
{ 4 2 1 6 Turns ON CAPS, NUM, OFF SCROLL }
{ 7 Turns ON CAPS, NUM, SCROLL }
(**)
PROCEDURE BLINK_OFF;

{ If an EGA or VGA card is installed }
{ this call will change the blink }
{ attribute to a high-intensity attr. }
{ This allows you to use hi-intensity }
{ colors for a background color }
(**)
PROCEDURE BLINK_ON;
{ If an EGA or VGA card is installed }
{ this call will change the blink }
{ attribute back to normal. See }
{ BLINK_OFF above. }
(**)
PROCEDURE SET_BORDER(COLOR : INTEGER);

{ Sets the border to COLOR. }
(**)
FUNCTION CAPS_ARE_ON : BOOLEAN;

{ Returns TRUE if CAPS LOCK is ON. }
(**)
PROCEDURE CAPS_OFF;

{ Turns CAPS LOCK KEY off. }
(**)
PROCEDURE CAPS_ON;

{ Turns CAPS LOCK KEY on. }
(**)
PROCEDURE CENTER(Y, ATTRIB : INTEGER; LINE : STRING);

{ Centers LINE on Line y }
{ using ATTRIB for colors. }
(**)
PROCEDURE CENTER_PRINT(LINE : STRING;
LEN : INTEGER;
VAR NEXTPOS : INTEGER;
CR : BOOLEAN);

{ Prints LINE on Printer Centered on }
{ a line LEN characters long. }
{ NEXTPOS returns the cursor position }
{ off the print head. Set CR to True }
{ to issue a WRITELN or False to issue}
{ a WRITE. }
(**)
FUNCTION CHECK_KEYBOARD : CHAR;

{ If a key was pressed returns the }
{ character entered, else returns }
{ character #0. }
(**)
PROCEDURE CLEAR_BUFFER(VAR SCREEN : BUFFER;
ATTR : INTEGER);

{ Clears a BUFFER variable to spaces }
{ with the screen attributes ATTR }
(**)
FUNCTION COMBINE(S1, S2 : STRING;
MAX : INTEGER;
INSERT_COMMA : BOOLEAN) : STRING;
{ }
{ S1 := 'Tom '; }
{ S2 := 'Hunter '; }
{ WRITELN(COMBINE(S2,S1,20,TRUE)); }
{ }
{ Result: Combines the two variables S1 & S2 }
{ Hunter, Tom removing trailing blanks from S1. }
{ If passed TRUE it will insert a }
{ comma between the two variables. }

(**)
FUNCTION COMMA(VAR VALUE; FIELDWIDTH,
PLACES : INTEGER;
NTYPE : TYPEN) : STRING;


{ WRITE(COMMA(R,I,J,RNUM)); Will take the real value }
{ R and return a string I }
{ R := 1234567.89 characters long with J }
{ WRITE(COMMA(R,12,2,RNUM)); decimal places. }
{ }
{ Result: }
{ 1,234,567.89 RNUM for REAL Numbers }
{ INUM for INTEGER Numbers }
{ LNUM for LONGINT Numbers }
{ }
(**)
FUNCTION DATE_TIME_KEY : STR16;

{ Returns a string in the form of: }
{ 1990022013211222 YYYYMMDDHHMMSSHH }
{ YEAR,MONTH,DAY,HOUR,MINURES,SECONDS,HUNDREDS }
{ See KEY_TO_DATE Function. }
(**)
procedure DayWeek(DT : STR8; var DayNum: integer;
var DayName: Str3);
{ }
{ Pass this routine a date in the form }
{ of mm-dd-yy, and it will return the }
{ DAYNUM (sun=0, sat=6) and a string }
{ of 3 for the day name (SUN,MON,ETC) }
(**)
PROCEDURE DISP_NOPROMPT_MESSAGE(X,Y,LEN,ATTR : INTEGER; MESS : STR80);

{ Displays a message on screen at X,Y }
{ in the color ATTR. Mess is padded }
{ with spaces to make it LEN in length. }
(**)
FUNCTION DUP(MASK : CHAR; N : INTEGER) : STRING;

{ Returns a string N characters long, }
{ with all characters equal to MASK. }
(**)
FUNCTION CREATE_NEW_FILE(FILENAME, MESS : STR80) : BOOLEAN;

{ Displays a message on screen that }
{ says FILENAME is not found and program}
{ is being aborted. Informs user to }
{ contact MESS for information. }
{ Pressing ALT-F1 at this message will }
{ return TRUE, any other key returns }
{ FALSE. }
(**)
PROCEDURE DISP_MESSAGE(X,Y,LEN,ATTR : INTEGER; MESS : STR80);

{ Displays a message on screen at X,Y }
{ in the color ATTR. Mess is padded }
{ with spaces to make it LEN in length. }
{ Program is halted until a key is }
{ pressed. That char is returned in CH.}
(**)
PROCEDURE DOWN_SOUND;

{ Makes a Sound of Decreasing Pitch. }
(**)
FUNCTION DRIVE_READY(DRIVE : CHAR) : BOOLEAN;

{ IF DRIVE_READY('A') THEN Returns TRUE if drive is ready. }
{ ASSIGN(F,'A:TEST.DTA'); }
{ }
(**)
FUNCTION ELAP_TIME(T : LONGINT) : LONGINT;

{ ELAP_TIME(TIM); Will Return the number of seconds }
{ that have elapsed since the last }
{ call to START_TIMER with TIM, or }
{ any other LONGINT variable. }
{ See START_TIMER. }
(**)
FUNCTION ELAP_TIME_STR(TIM : LONGINT) : STRING;

{ ELAP_TIME_STR(TIM); Will Return the amount of time }
{ that have elapsed since the last }
{ call to START_TIMER with TIM, or }
{ any other LONGINT variable. }
{ The returned string will be in the}
{ form of:
{ 2 days, 11 hrs, 12 mins, 21 sec }
{ }
{ Leading numbers will not be shown }
{ if they are zero. }
{ }
{ If a timer is left running for }
{ 25 years, the longest string that }
{ would be returned would be 35 }
{ characters in length. }
{ (Always PADDED to 35 chars.) }
(**)
PROCEDURE ENCRYPT(VAR LINE : STRING; I : INTEGER);

{ Encrypts a string using I as a key. }
{ See UN_ENCRYPT }
(**)
FUNCTION FILE_EXIST(FILENAME : STRING) : BOOLEAN;

(* Returns True if File exists or
false if it does not. *)
(* Can be used on any type File. *)
(**)
FUNCTION FILE_OPEN(VAR F) : BOOLEAN;

(* Returns True if File F is Open or
returns False if it is closed. *)
(**)
PROCEDURE FILL_SCREEN(X1,Y1,X2,Y2 : INTEGER; CH : CHAR; ATTR : INTEGER);

{ FILL_SCREEN(1,1,80,25,'',$1F); Fills the section of the screen }
{ definded by X1, Y1, X2, X2 with }
{ character CH, in the text attribute }
{ of ATTR. }
(**)
PROCEDURE FW(X,Y : INTEGER; ATTR : BYTE; LINE : STR80);

{ FW(X,Y,$07,S); Writes the value of string }
{ or S at X,Y with 0 Background }
{ FW(X,Y,$01,S1+S2+'X'); color and 7 Foreground. }
{ This Procedure Supports }
{ 43 line mode. (1 >= Y <= 43 }
(**)
PROCEDURE FWB(VAR SCREEN : BUFFER;
X,Y,ATTR : INTEGER;
INSTRING : STR80);

{ Same as FW procedure except it writes}
{ INSTRING to a BUFFER variable. }
(**)
FUNCTION GET_FILE_INFO(FILENAME : STRING) : STR80;

{ INSTRING := GET_FILE_INFO('C:\AUTOEXEC.BAT'); }

{ Returns a string containing }
{ file size, date, and time. }
{ }
{ " 345 6/04/90 12:44p" }
(**)
FUNCTION GET_FILE_NAME(MASK : STRING; DEL : BOOLEAN) : STRING;

{ INSTRING := GET_FILE_NAME('*.*',TRUE);

{ Pops up a window displaying }
{ filenames matching filespec. }
{ Returns a selected filename }
{ and allows deletions if TRUE. }
(**)
PROCEDURE GOTOXY43(X,Y : INTEGER);

{ GOTOXY43(10,43); This will move the cursor to }
{ 10,43 if 43 line mode is active }
(**)
FUNCTION INT_STR(I,LEN : INTEGER) : STR80;

{ INT_STR(2300,6); This will return a string }
{ " 2300" }
(**)
FUNCTION JULIAN(DT : STR8) : LONGINT;

{ JULIAN(DATE) Returns a LONGINT value that }
{ can be used to calculate the }
{ difference between two dates. }
{ DT must be in the form mm-dd-yy }
(**)
FUNCTION JulToMDY(JulianDay: longint) : STR8;

{ JULTOMDY(LONG) Returns a DATE in the form of }
{ mm-dd-yy. See JULIAN. }
(**)
FUNCTION KEY_TO_DATE(ST : STRING) : STRING;

{ Converts a DATE_TIME_KEY back }
{ to a valid date and time. }
{ See DATE_TIME_KEY Function. }
(**)
PROCEDURE LINES25;

{ After a call to LINES43, this }
{ will return you to 25 line mode.}
(**)
PROCEDURE LINES43;

{ If EGA card is present this }
{ will put you in 43 line mode. }
(**)
FUNCTION LONGINT_STR(I : LONGINT; LEN : INTEGER) : STR80;

{ LONGINT_STR(230000,10); This will return a string }
{ " 230000" }
(**)
FUNCTION NUM_LOCK_IS_ON : BOOLEAN;

{ Returns TRUE if NUM-LOCK is ON. }
(**)
PROCEDURE NUM_LOCK_OFF;

{ Turns NUM LOCK KEY off. }
(**)
PROCEDURE NUM_LOCK_ON;

{ Turns NUM LOCK KEY on. }
(**)
FUNCTION PAD(S : STRING; LEN : INTEGER) : STRING;

{ PAD(S,20); Will return S + spaces exactly 20 }
{ characters long. Padded with spaces }
{ at the end of S. }
(**)
FUNCTION PAD_LEFT(S : STRING; LEN : INTEGER) : STRING;

{ PAD_LEFT(S,20); Will return S + spaces exactly 20 }
{ characters long. Padded with spaces }
{ at the beginning of S. }
(**)
FUNCTION PAD_CH(S : STRING; LEN : INTEGER; CH : CHAR) : STRING;

{ PAD_CH(S,20,'A'); Will return S + spaces exactly 20 }
{ characters long. S will be padded }
{ with 'A's until it is 20 characters }
{ in length. }
(**)
PROCEDURE PATHEXEC(COMMAND : PATHSTR; PARMS : STRING);

{ Like Turbo Pascal's EXEC, except }
{ Searches the DOS path. }
{ Do not call SwapVectors before and }
{ after this routine as with Turbo's }
{ EXEC procedure. }
{ It is not necessary to set the $M }
{ directive as it is with Borlands }
{ EXEC procedure. }
{ Do not set DYNAMIC_ALLOCATION to }
{ TRUE if using B-Tree Filer. }
(**)
PROCEDURE POP_WINDOW(X1,Y1,X2,Y2 : INTEGER; STYLE : INTEGER; ATTR : BYTE);

{ Pops up a Window. The window size }
{ is determined by X1,Y1,X2,Y2. }
{ These parameters work exactly as }
{ the window command in Turbo Pascal. }
{ }
{ If STYLE is set to 0, there will be }
{ no border around the window. If it }
{ is set to 1 there will be a single }
{ line border. If it is set to 2 }
{ the border will be a double line. }
{ 0,1,2 will place a shadow at bottom }
{ and right side. }
{ }
{ If STYLE is set to 10, there will be }
{ no border around the window. If it }
{ is set to 11 there will be a single }
{ line border. If it is set to 12 }
{ the border will be a double line. }
{ 10,11,12 will not place a shadow. }
{ }
{ ATTR is the color attribute of the }
{ window. }
(**)
PROCEDURE PRINT_SCREEN(X1,Y1,X2,Y2 : INTEGER; EXT : BOOLEAN);

{ }
{ PRINT_SCREEN(1,1,80,25,TRUE); Prints a section of the screen, }
{ bounded by the coordinates. The }
{ screen coordinates are the same as }
{ Turbo Pascal's WINDOW procedure. }
{ To print IBM Extended Graphic }
{ characters use TRUE. FALSE will }
{ print spaces instead of graphics. }
{ The above example would print the }
{ entire screen. }
(**)
FUNCTION PRINTER_NOT_READY : BOOLEAN;

{ Returns TRUE if the Line Printer is not ready. }
(**)
FUNCTION PRINTER_READY : BOOLEAN;
{ }
{ IF PRINTER_READY THEN If Printer is NOT READY, pops up }
{ WRITELN(LST,'HELLO WORLD'); a Window, asking for you to ready }
{ it. Pressing returns FALSE. }
{ Turning Print ON, (or if it was }
{ already on) returns TRUE. }
(**)
FUNCTION PROGRAM_LOCATION : STRING;
{ }
{ Returns a string containing the }
{ drive and complete pathname of }
{ where the currenly executing program }
{ is located. }
(**)
FUNCTION RANDOM_NUMBER(LOW, HIGH : INTEGER) : INTEGER;

(* Produces a Random number between
0 and 99. if LOW is less than 0
or HIGH is greater than 99 will
always return 0. Do not call this
routine from a loop. It uses 1/100
of a second from the system clock
to generate the numbers. If called
from within a loop it will return
a sequence or pattern to its numbers.
Works fine for a ocassional Random
Number. *)
(**)
PROCEDURE READCH(VAR CH : CHAR; ECHO : BOOLEAN);

{ READCH(CH,TRUE); TRUE for echo on screen. }
{ FALSE for no echo. }
{ If ALT-F10 is pressed it }
{ will call SHOW_VERSION. }
{ also converts F-KEYS to FUNC1..FUNC10, HOMEKEY, }
{ UP, DOWN, LEFT, RIGHT, ECT. }
{ }
{ READCH(CH,TRUE); }
{ IF CH = FUNC1 THEN CALL_HELP; }
(**)
PROCEDURE READCHT(VAR CH : CHAR; ECHO : BOOLEAN; TOO : LONGINT);

{ Waits TOO seconds for a key to be pressed, IF no key is pressed }
{ within TOO seconds, Routine is exited leaving CH unchanged. }
{ }
{ READCHT(CH,FALSE,10); Waits 10 seconds for a key to be }
{ pressed, If not CH is unchanged. }
(**)
PROCEDURE READCHTIME(VAR CH : CHAR; ECHO : BOOLEAN; X,Y : INTEGER);

{ Continually Updates TIME at X,Y }
{ until a key is pressed. That }
{ key is returned in CH. }
{ If CH = 'M' Time will be in }
{ Military Time Format. }
(**)
PROCEDURE READ_INT(X,Y,LEN : INTEGER;
PATTR : INTEGER;
PROMPT : STR80;
IATTR : INTEGER;
VAR R : INTEGER;
LOW,HIGH : INTEGER;
EXITCH : ETYPE;
ICOMA : BOOLEAN;
TX, TY : INTEGER;
CH : CHAR);
(*

WHERE X = X Location of where Prompt will start.
Y = Y Location of where Prompt will start.
LEN = Maximum Length of Field to be input.
PATTR = Color attributes of Prompt.
PROMPT = Prompt that will appear AT X,Y
IATTR = Color attributes of Input Field.
R = Variable Parameter being Edited.
LOW = Lowest Value Allowed.
HIGH = Highest Value Allowed.
EXITCH = Characters Entered From Keyboard used to Exit Edit.
ICOMA = True for comma insertion, false for no comma.
TX,
TY = Location on screen to update time (TX = 0 for
no time)
CH = 'M' for Military Time, else AM/PM

If NOCONV is included in EXITCH then
LEFT or RIGHT is not converted to
UP or DOWN if in first or last
position.

If CLEAR is included in EXITCH then
the value being edited is set to
spaces.

Insert keys & Delete keys are active

*)
(**)
PROCEDURE READ_ONLY(NAME : STRING);

{ Sets Filename "NAME" to READ-ONLY.}
(**)
PROCEDURE READ_REAL(X,Y,LEN : INTEGER;
PATTR : INTEGER;
PROMPT : STR80;
IATTR : INTEGER;
VAR R : REAL;
DPLACES : INTEGER;
LOW,HIGH : REAL;
EXITCH : ETYPE;
ICOMA : BOOLEAN;
TX, TY : INTEGER;
CH : CHAR);
(*

WHERE X = X Location of where Prompt will start.
Y = Y Location of where Prompt will start.
LEN = Length of Field to be Input.
PATTR = Color Attributes of Prompt.
PROMPT = Prompt that will appear at X,Y
IATTR = Color Attributes of Input Field.
R = Variable Parameter being Edited.
DPLACES = Number of Decimal Places.
LOW = Lowest Value Allowed.
HIGH = Highest Value Allowed.
EXITCH = Characters Entered From Keyboard Used to Exit Edit.
ICOMA = True for Comma Insertion, False for no commas.
TX,
TY = Location on Screen to Update Time (TX = 0 for
no Time.)
CH = 'M' for Military Time, else AM/PM

If NOCONV is included in EXITCH then
LEFT or RIGHT is not converted to
UP or DOWN if in first or last
position.

If CLEAR is included in EXITCH then
the value being edited is set to
spaces.

Insert keys & Delete keys are active
*)
(**)
FUNCTION READ_SCREEN(X,Y : INTEGER) : CHAR;

{ CH := READ_SCREEN(10,15); }
{ Returns the character on the screen }
{ at X,Y. (at 10,15 in this case) }
(**)
PROCEDURE READSTR(X,Y,LEN : INTEGER;
PATTR : INTEGER;
PROMPT : STR80;
IATTR : INTEGER;
VAR INSTRING : STR80;
VALID : ETYPE;
CANEDIT : CTYPE;
EXITCH : ETYPE;
XLOC,
YLOC : INTEGER;
CH1 : CHAR);
(*

WHERE X = X Location of Where Prompt will start.
Y = Y Location of Where Prompt will start.
LEN = Maximum Length of Input Field.
PATTR = Color Attributes of Prompt.
PROMPT = Prompt that will appear at X,Y.
IATTR = Color Attributes of Input Field.
INSTRING = Variable Parameter being Edited.
VALID = Valid Characters that can be entered for Field.
CANEDIT = Which Positions of Field that can be edited.
EXITCH = Characters Entered from Keyboard Used to Exit Edit.
XLOC,
YLOC = Location on screen to Update Time (XLOC = 0 for
no time.) Add 100 to XLOC to initialize the
cursor at the end of the input field instead of at
the beginning.
(Add 100 to YLOC for Auto Capitilization of Words)
(Add 200 to YLOC for Auto Caps of all characters )
CH1 = 'M' for Military Time, else AM/PM


If you are in the first position of a field and press the RIGHT
ARROW, CH is converted to UP. If you are in the last position of
a field and press RIGHT ARROW, CH is converted to DOWN.

UNLESS: If you include NOCONV in your EXITCH, conversion does
not take place. If you are in the first postion of a field,
pressing LEFT ARROW will cause you to exit and leave the value
of CH set to LEFT. If you are in the last position of a field
pressing RIGHT ARROW will cause you to exit and leave the value
CH set to RIGHT.

If CLEAR is included in EXITCH then the value being edited is
set to spaces.

Insert keys & Delete keys are active.

*)
(**)
PROCEDURE READSTR_BIG(X,Y,LEN : INTEGER;
PATTR : INTEGER;
PROMPT : STR80;
IATTR : INTEGER;
VAR INSTRING : STRING;
VALID : ETYPE;
CANEDIT : CTYPE;
EXITCH : ETYPE;
XLOC,
YLOC : INTEGER;
CH1 : CHAR;
WIN : INTEGER);

(* Scrolling string Input. *)
(* All parameters are the same as *)
(* READSTR except the addition of WIN.*)
(* WIN is the size of the input field *)
(* for this input, LEN is the total *)
(* possible length of INSTRING. *)
(* *)
(* *** CANEDIT is set automaticall *)
(* to all positions **** *)
(* *)
(* Insert keys & Delete keys are *)
(* active. *)
(**)
PROCEDURE READ_WRITE(NAME : STRING);

{ Sets Filename "NAME" to READ-WRITE.}
(**)
FUNCTION REAL_STR(R : REAL; LEN, PLACES : INTEGER) : STR80;

{ REAL_STR(123.22,10,2); This would return a string }
{ " 123.22" }
(**)
PROCEDURE REBOOT;

{ Performs a re-boot of the computer }
(**)
PROCEDURE REBUILD_LINE(Y : INTEGER; STR : BUF160);

{ DEFINE A VARIABLE: }
{ VAR }
{ S : BUF160; }
{ }
{ SAVE_LINE(5,S); Saves Line 5 in S. }
{ REBUILD_LINE(5,S); Restores Line 5 from S. }
{ }
{ This routine saves screen characters and attributes }
{ }
{ CAUTION ! IN 43 LINE MODE, USE ONLY FOR FIRST 25 LINES }
(**)
PROCEDURE REBUILD_SCREEN(VAR SCREEN : BUFFER);

{ SEE SAVE_SCREEN }
{ }
{ CAUTION ! In 43 Line Mode, Will only Restore top 25 lines.}
(**)
PROCEDURE SAVE_LINE(Y : INTEGER; VAR STR : BUF160);

{ DEFINE A VARIABLE: }
{ VAR }
{ S : BUF160; }
{ }
{ SAVE_LINE(5,S); Saves Line 5 in S. }
{ REBUILD_LINE(5,S); Restores Line 5 from S. }
{ }
{ This routine saves screen characters and attributes }
{ }
{ CAUTION ! IN 43 LINE MODE, USE ONLY FOR FIRST 25 LINES }
(**)
PROCEDURE SAVE_SCREEN(VAR SCREEN : BUFFER);

{ DEFINE A VARIABLE: }
{ VAR }
{ S : BUFFER; }
{ }
{ SAVE_SCREEN(S); Saves Current Screen in S. }
{ REBUILD_SCREEN(S); Restores Screen to S. }
{ }
{ CAUTION ! IN 43 LINE MODE, WILL ONLY SAVE TOP 25 LINES }
(**)
FUNCTION SCREEN_ATTR(X,Y : INTEGER) : BYTE;

{ TEXTATTR := SCREEN_ATTR(10,20); }
{ Returns the Screen Color at X,Y. }
(**)
PROCEDURE SET_ATTR(X : LINE_SET; Y : INTEGER;ATTRIB : BYTE);

{ SET_ATTR([1..4,10],Y,$07); }

{ Sets the Columns 1 thru 4 and 10 on line Y }
{ to Background Color 0 (BLACK) }
{ and Foreground COLOR 7 (LIGHTGRAY) }
{ CAUTION ! Use this only above line 26 if in 43 line mode. }
{ Leaves text on screen unchanged }
(**)
PROCEDURE SCREEN_ON;

{ Turns the Screen back on after }
{ it has been turned off with }
{ SCREEN_OFF }
(**)
PROCEDURE SCREEN_OFF;

{ Turns the Screen off to a black }
{ screen. Use SCREEN_ON to turn }
{ it back on . }
(**)
PROCEDURE SCROLL_LOCK_ON;
{ }
{ Turns the Scroll Lock key on. }
(**)
PROCEDURE SCROLL_LOCK_OFF;
{ }
{ Turns the Scroll Lock key off. }
(**)
FUNCTION SCROLL_LOCK_IS_ON : BOOLEAN;
{ }
{ Returns TRUE if the Scroll Lock Key is on else returns FALSE. }
(**)
PROCEDURE SET_ATTR_BUFFER(VAR SC : BUFFER;
X : LINE_SET;
Y : INTEGER;
ATTRIB : BYTE);

{ SET_ATTR_BUFFER(SC,[1..4,10],Y,$07); }

{ This routine alters the attributes of a BUFFER }
{ screen, not the active video screen. }

{ Sets the Columns 1 thru 4 and 10 on line Y }
{ to Background Color 0 (BLACK) }
{ and Foreground COLOR 7 (LIGHTGRAY) }
{ CAUTION ! Use this only above line 26 if in 43 line mode. }
{ Leaves text on screen unchanged }
(**)
PROCEDURE SET_ATTR_BOX(X1,Y1,X2,Y2,ATT : INTEGER);

(* Sets Screen Attributes of the box
X1,Y1,X2,Y2 to the Colors of ATT.
Coordinates are the same as Turbo
Pascals Window Procedure. *)
{ Leaves text on screen unchanged }
(**)
PROCEDURE SET_CURSOR(CURS : CURTYPE);

{ SET_CURSOR(NONE); Makes Cursor Invisable. }
{ SET_CURSOR(UNDERLINE); Makes Normal Cursor. }
{ SET_CURSOR(BLOCK); Makes Block Cursor. }
{ SET_CURSOR(HALF); Makes a Half Cursor. }

{ Cursor is returned to }
{ normal on exit of program. }
(**)
PROCEDURE SHOW_VERSION;

{ Displays a Window and the contents of the }
{ global variable VERSION. }

{ Also displays the version of UTILITY your program }
{ was compiled with. }
(**)
FUNCTION SPACES(NUM : Word) : STRING;

{ S := SPACES(25); Will Initialize the variable S }
{ to 25 spaces. }
(**)
FUNCTION STRIP(ST : STRING; IMBED : BOOLEAN) : STRING;

{ Removes Leading and Trailing }
{ spaces from a string variable. }
{ If IMBED is set to true it will }
{ also remove double imbedded blanks}
(**)
PROCEDURE START_TIMER(VAR T : LONGINT);

{ START_TIMER(TIM); Will Start a timer by setting the }
{ value of TIM (or any LONGINT) to }
{ a time related value. }
{ By calling ELAP_TIME with this }
{ same variable, you can tell how }
{ many seconds has elapsed. }
{ This routine works accurately }
{ for over 30 years. }
(**)
PROCEDURE UN_ENCRYPT(VAR LINE : STRING; I : INTEGER);

{ UN-ENCRYPTS A STRING USING I AS KEY.}
{ See ENCRYPT. }

(**)
FUNCTION UPPERCASE(S : STRING) : STRING;

{ S := UPPERCASE(S); Will Uppercase all Lowercase }
{ characters in the string S. }
(**)
FUNCTION VGA_INSTALLED : BOOLEAN;

{ Returns TRUE if a VGA card is present }
(**)
PROCEDURE UP_SOUND;

{ Makes a Sound of Increasing Pitch. }
(**)
FUNCTION WHOAMI : STRING;

{ S := WHOAMI; Returns the complete Drive & }
{ Pathname & Filename of the }
{ C:\TEST\FILENAME.EXE program being executed. }
(**)
PROCEDURE WRITE_DATE(X, Y : INTEGER; WORDS : CHAR);

{ WRITE_DATE(X,Y,'W'); Will display the current }
{ date in words at screen }
{ location X,Y. }
{ March 2, 1988 }
{ 03/02/88 Any character except W }
{ will display it in }
{ 03/02/88 format. }
{ }
{ Also update the Global }
{ variable DATE to the }
{ current date. If X=0 }
{ DATE is updated without }
{ anything being written }
{ to the screen. }
(**)
PROCEDURE WRITE_TIME(X, Y : INTEGER; MILITARY : CHAR);

{ WRITE_TIME(X,Y,'M'); Will display the current }
{ time in Military Format }
{ 14:52 at screen location X,Y. }
{ 2:52 pm }
{ Any Character Except M }
{ will display time in AM/PM.}
{ The Colon Will Blink. }
{ }
{ Also update the Global }
{ variable TIME to the }
{ current time. If X=0 }
{ TIME is updated without }
{ anything being written }
{ to the screen. }
(**)
PROCEDURE WRITE_X80_Y25(CH : CHAR; ATTRIB : INTEGER);

(* Writes CH at Column 80 on Line 25
in the Colors of ATTRIB without
scrolling. *)
(**)
FUNCTION _REAL(INSTRING : STRING) : REAL;

{ Returns a REAL value from string. }
{ Spaces in string are ignored. }
(**)
FUNCTION _INTEGER(INSTRING : STRING) : INTEGER;

{ Returns an INTEGER value from string.}
{ Spaces in string are ignored. }
(**)
FUNCTION _LONGINT(INSTRING : STRING) : LONGINT;

{ Returns a LONGINT from a string. }
{ Spaces in string are ignored. }
(**)


 December 23, 2017  Add comments

Leave a Reply