Dec 112017
Various routines for use with Turbo Pascal 5.5. TPU only, no source.
File KPAS.ZIP from The Programmer’s Corner in
Category Pascal Source Code
Various routines for use with Turbo Pascal 5.5. TPU only, no source.
File Name File Size Zip Size Zip Type
COLORS.TPU 6448 1663 deflated
EDITCOLO.PAS 8158 1629 deflated
KEYBOARD.TPU 3008 1379 deflated
KPASCAL.DOC 9127 3479 deflated
KPASCAL.TPU 10464 4935 deflated

Download File KPAS.ZIP Here

Contents of the KPASCAL.DOC file

KPASCAL Unit for TP 5.5

Type - StringOf2; StringOf80; AttrStr;
Var -
Monochrome; {boolean true if monochrome monitor}
VideoBase; {word RAM base of video}
Cursor; {boolean true if cursor on}
Default_Attr; {byte default text attribute number}

(P) CursorOn - makes Cursor true - turns cursor on
(P) CursorOff - makes Cursor false - turns cursor off

(F) BStr(boolean) : returns string "TRUE" or "FALSE"
(F) RStr(number) : returns string or number with or w/o deci point
(F) ItoS(number,b) : returns string of integer, b is len of str
(F) RtoS(number,b1,b2)
| : returns string of real, b1 is len of str,
| b2 is # of decimals
(F) StoI(string) : returns LongInt of string
(F) StoR(string) : returns real of string

(F) Caps(string) : returns string in all caps
(F) StringOf(n,c) : returns a string n long of c
(F) Trim(string) : returns string with no spaces on end

(P) ClrLn(y) - Clears line y
(P) DoNothing - does absolutely nothing
(F) SayAttr(attr) : returns '`a###' AttrStr for attr (byte) in Say msg
(F) SayLen(number) : returns '`l##' for length in Say msg
(P) Say(x,y,msg) - puts msg at x,y;
(P) SWrite(msg) - 'emulate' Write using Say
(P) SWriteLn(msg) - 'emulate' WriteLn using Say

Instructions for use of SAY:
- SAY( x, y, msg );
- Say is sensitive to the window command. In otherwords if a window has
been set up (Window(x1,y1,x2,y2)), x=1 and y=1 would be in the upper
left corner of the window (x1,y1)

x, y : position on screen of input msg
- if x or y are 0 input will use WhereX or/and WhereY
- if x = 90, msg will be centered in the current window/screen
- if x >= 100, msg will be right justified to x-100
msg : message to be displayed, the following command can be included
`a### = ### is a 3 digit attribute code;
`c## `x## = ## is a new x (column 1..80) position
`r## `y## = ## is a new y (row 1..25) position
`f## = ## is a function
01 = align left
02 = align with col 1
03 = produce a physical linefeed with WriteLn;
04 = move cursor to end when finished
05 = ignore window x,y position limitations
10..18 = slow text (10=fastest, 18=slowest)
19 = return to fast text after 10..18
`m = move cursor to end of say string when finished
`h##x = horizontal repitition ## times of the character x
`=## = print only next ## characters of this string
`l## = print only next ## characters of this string w/trailing
character if more
`v##x = vertical repitition ## times of the character x
`t## = write the character ## on the screen (for use with chr(1..31))


Say( 90,12, SayAttr(120)+'This is centered on the screen' );
Say( 10,10, '`f13This text is printed slowly across the screen' );
Say( 10,11, '`f15This is slow `f19This is VERY fast (normal speed)' );
Say(140,14, '`a150The right margin of this is at pos 140' );
Say( 30,16, 'This is on line 16`f01This is on line 17' );
Say( 50,18, 'Now at 50,18`x20`y10Now at 20,10' );
Say( 01,01, '`h80-`x01`y03`h80=' );
Say( 15,20, '`=20Only the first 20 char of this message are printed' );
Say( 01,05, '`a001This `a002msg `a003has `a004many `a005colors' );
Say( 01,06, SayAttr(1)+'This '+SayAttr(2)+'msg '+SayAttr(3)+'has '+
SayAttr(4)+'many '+SayAttr(5)+'colors' );

counter := 45;
Say( 90,19, 'counter = '+ItoS(counter,0) );
displays 'counter = 45' centered on line 19

s1 := 'AG-382A-472 BLUE'
Say( 20,17, 'MODEL: '+ SayLen(10)+ s1 );
displays 'MODEL: AG-382A-47' over 20 on line 17

SWrite(msg) is equivelent to Say( 0,0, msg+'`m' );
SWriteLn(msg) " Say( 0,0, msg+'`f03' );

BStr(true) returns 'TRUE'
BStr(false) returns 'FALSE'
RStr(5) returns '5'
RStr(38.238) returns '38.238'
RStr(1.50000000000) return '1.5'
ItoS(5,4) returns ' 5'
ItoS(3278,4) returns '3278'
RtoS(47.5,6,2) returns ' 47.50'

StringOf(20,'*') returns '********************'
Caps('hello') returns 'HELLO'
Trim('Hello ') returns 'Hello'

KEYBOARD Unit for TP 5.5

Const - RightShift = $01; {keyboard flags}
LeftShift = $02;
CtrlShift = $04;
AltShift = $08;
ScrollLock = $10;
NumLock = $20;
CapsLock = $40;
InsertLock = $80;
(P) ClearKeyBuffer;
- clears the internal 125 char buffer
(F) CheckKeyboard : boolean;
- false if internal buffer is empty (used by GetKey,
can be used to dump BIOS 16 char keyboard buffer
into the internal 125 char buffer)
(F) GetKey( var func : boolean ) : char;
- returns the key pressed from the buffer (FIFO),
func returns true if it is a two-code key (F#, ALT)
GetKey returns #00 if no character waiting.
(F) GetScan( var kbdflag : byte ) : byte;
- optionally called after a GetKey, returns the scan
code of the key; kbdflag returns the combination of
which shift keys were down when the key was pressed.


ch : char;
func : boolean;
scan : byte;

wait for key:
ch := GetKey( func );
UNTIL (ch <> #00);

wait for key then get scan codes:
ch := GetKey( func );
UNTIL (ch <> #00)
scan := GetScan( kbd );

wait for a capital A typed using the right shift key:
ch := GetKey( func );
scan := GetScan( kbd );
UNTIL (ch = 'A') and (kbd and RightShift = RightShift);

COLORS Unit for TP 5.5

a_dh, { data highlight }
a_dl, { data lowlight, default SAY attr }
a_mh, { menu highlight - used in KWINDOWS unit }
a_ml, { menu lowlight - used in KWINDOWS }
a_ms, { menu selected - used in KWINDOWS }
a_mn, { menu not selected - used in KWINDOWS }
a_st, { status line }
a_pr, { input prompt }
a_inp, { input field - used in KINPUT unit }
a_ed, { after input - used in KINPUT }
a_border, { border color }
a_tm, { time, date, etc. }
a_err, { error messages }
a_ins : AttrStr; { insert message }
a_back : byte; { background for ClrScr }
fieldblank : char; { char for blank in Input field - used in KINPUT }

(F) GetColors( Drive : char ) : boolean;
- reads disk file 'CONFIG.CCS' off root dir of DRIVE
if DRIVE = 'X' then uses current disk
(F) SaveColors( Drive : char ) : boolean;
- saves colors to file 'CONFIG.CCS' in root dir of
DRIVE. {see GetColors}

The unit initializes the attribute strings to colors that are "OK"
for both color and mono monitors so your program does not _have_ to
do a GetColors at the beginning. If you put a GetColors statement at
the beginning of all your programs they will all have the same standard
colors; and when you change the color file with "EDITCOLO" the colors
will change in all your programs. Very convenient.


tf : boolean;

if (not GetColors('X'))
then tf := SaveColors('X');
TextAttr := a_back;

Say( 10,10, a_dl+ 'This is in standard data color, '+
a_dh+ 'while this is highlighted.' );

TextAttr := 07;

{see/run EDITCOLO.PAS}

The source to this is available for $49.95. There are also many other
"K" units built around this KPASCAL unit available, including:
KINPUT - complex keyboard entry field for
Boolean, String, long Strings, Integers,
Real, Dollar, Character, Yes/No.
KWINDOWS - windowing system for overlaping windows also has
Menus and Selection windows. Uses Object Oriented Prog.
KDATES - Date manipulation, similar to functions in DBase
plus others.
KTIMES - Similar to KDATES except with Time.
KHELP - Pop up context sensitive help screens. Req KWindows.
Others include:

Please write to:
Contemporary Computer Services
P.O. Box 308
Sylvania, OH 43560-0308
(or EMAIL with your address to 73457,2221)
for further information, (or EMail me your ideas/opinions).

 December 11, 2017  Add comments

Leave a Reply