Dec 112017
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))
EXAMPLES:
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.
EXAMPLES:
var
ch : char;
func : boolean;
kbd,
scan : byte;
wait for key:
REPEAT
ch := GetKey( func );
UNTIL (ch <> #00);
wait for key then get scan codes:
REPEAT
ch := GetKey( func );
UNTIL (ch <> #00)
scan := GetScan( kbd );
wait for a capital A typed using the right shift key:
REPEAT
ch := GetKey( func );
scan := GetScan( kbd );
UNTIL (ch = 'A') and (kbd and RightShift = RightShift);
---------------------------------------------------------------------
COLORS Unit for TP 5.5
var
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.
EXAMPLES:
var
tf : boolean;
BEGIN
if (not GetColors('X'))
then tf := SaveColors('X');
TextAttr := a_back;
ClrScr;
Say( 10,10, a_dl+ 'This is in standard data color, '+
a_dh+ 'while this is highlighted.' );
TextAttr := 07;
ClrScr;
END.
{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.
(uses KPASCAL, KEYBOARD, COLORS, {KDATES})
KWINDOWS - windowing system for overlaping windows also has
Menus and Selection windows. Uses Object Oriented Prog.
(uses KPASCAL, KEYBOARD, COLORS)
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.
(uses KPASCAL, KEYBOARD, KWINDOWS)
Others include:
KSCREEN, KMOUSE, KFILES, KBIT, KEMS;
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).
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 =
02 =
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))
EXAMPLES:
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.
EXAMPLES:
var
ch : char;
func : boolean;
kbd,
scan : byte;
wait for key:
REPEAT
ch := GetKey( func );
UNTIL (ch <> #00);
wait for key then get scan codes:
REPEAT
ch := GetKey( func );
UNTIL (ch <> #00)
scan := GetScan( kbd );
wait for a capital A typed using the right shift key:
REPEAT
ch := GetKey( func );
scan := GetScan( kbd );
UNTIL (ch = 'A') and (kbd and RightShift = RightShift);
---------------------------------------------------------------------
COLORS Unit for TP 5.5
var
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.
EXAMPLES:
var
tf : boolean;
BEGIN
if (not GetColors('X'))
then tf := SaveColors('X');
TextAttr := a_back;
ClrScr;
Say( 10,10, a_dl+ 'This is in standard data color, '+
a_dh+ 'while this is highlighted.' );
TextAttr := 07;
ClrScr;
END.
{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.
(uses KPASCAL, KEYBOARD, COLORS, {KDATES})
KWINDOWS - windowing system for overlaping windows also has
Menus and Selection windows. Uses Object Oriented Prog.
(uses KPASCAL, KEYBOARD, COLORS)
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.
(uses KPASCAL, KEYBOARD, KWINDOWS)
Others include:
KSCREEN, KMOUSE, KFILES, KBIT, KEMS;
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