ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/PASCAL/TSPA2550.ZIP/TSUNTD.INT

Text File | 1991-10-27 | 7.1 KB | 168 lines

{$B-,D-,F-,I+,N-,R-,S+,V+}

(*
Timo Salmi UNiT D
A Turbo Pascal unit for string manipulation and so on.
All rights reserved 2-Aug-89,
Updated 3-Aug-89, 19-Aug-89, 26-Sep-89, 13-Jun-90, 15-Jul-90, 5-Jan-91

This unit contains mainly string manipulation routines. There is not anything
novel about the string routines. Just that I have tried to make them compact
and fast. No inline code, though, is involved in this (nor the other) units.
Well, starting from the 15-Jul-90 release (in tspas20.arc) this no longer
holds. I have tried to upderstand some assembler and have included also
inline code. Be warned that I cannot give any guarantees that the inline
coded routines won't cause confusion.  Where inline code has been used,
I have stated so.

This unit may be used and distributed freely for PRIVATE, NON-COMMERCIAL,
NON-INSTITUTIONAL purposes, provided it is not changed in any way. For
ANY other usage, such as use in a business enterprise or a university,
contact the author for the terms of registration.

The units are under development. Comments and contacts are solicited. If
you have any questions, please do not hesitate to use electronic mail for
communication.
InterNet address: [e-mail]         (preferred)
Funet address:    GADO::SALMI
Bitnet address:   SALMI@FINFUN

The author shall not be liable to the user for any direct, indirect or
consequential loss arising from the use of, or inability to use, any unit,
program or file howsoever caused. No warranty is given that the units and
programs will work under all circumstances.

Timo Salmi
Professor of Accounting and Business Finance
School of Business Studies, University of Vaasa
P.O. BOX 297, SF-65101 Vaasa, Finland
*)

unit TSUNTD;

(* ======================================================================= *)
                          interface
(* ======================================================================= *)

uses Dos;

(* =======================================================================
                   String handling routines
   ======================================================================= *)

(* Trim a string right *)
function TRIMRGFN (original : string; atcolumn : byte) : string;

(* Trim a string left *)
function TRIMLFFN (original : string; atcolumn : byte) : string;

(* Lead a string with a suitable number of chosen characters *)
function LEADFN (original     : string;
                 total_length : byte;
                 leadwith     : char) : string;

(* Trail a string with a suitable number of chosen characters *)
function TRAILFN (original     : string;
                  total_length : byte;
                  trailwith    : char) : string;

(* The opposite of Turbo Pascal's own UpCase function. This one is inline
   coded so that it should be fast. *)
function LOWCASFN (ch : char) : char;

(* =======================================================================
                   String parsing routines
   ======================================================================= *)

const parse_parts_max   = 255;
type parseVectorType    = array [1..parse_parts_max] of string;
     parseVectorPtrType = ^parseVectorType;

(* Extract all substrings from a string *)
procedure PARSE
  (original          : string;
   parse_parts_max   : integer;
   separators        : string;
   var nber_of_parts : integer;
   var partPtr       : parseVectorPtrType;
   var ok            : boolean);          {no errors detected}

(* This, and the following function, are alternatives to the PARSE procedure.
   STRCNTFN and SPARTFN resemble more closely the inbuilt ParamCount and
   ParamStr function. They do not require using pointers as PARSE does.
   These two functions first appear in release tspas14.arc.
   The purpose of STRCNTFN is to return the number of substrings in a string.
   This is "the second generation" of my string parsers.
*)
function STRCNTFN (s : string; separators : string) : integer;

(* Returns the specified substring in a string *)
function SPARTFN (s          : string;
                  separators : string;
                  PartNumber : integer) : string;

(* Number of substrings in a string.
   This is "the third generation" of my string parsers.
   This is much faster and more concise, but it uses all the ascii
   characters below ascii 33 as separators, that is, there is no choice *)
function PARSENFN (sj : string) : integer;

(* Get a substring from a string.
   Returns '' if PartNumber is out of range.
   This is "the third generation" of my string parsers.
   This is much faster and more concise, but it uses all the ascii
   characters below ascii 33 as separators, that is, there is no choice *)
function PARSERFN (sj : string; PartNumber : integer) : string;

(* =======================================================================
                      Crt replacements
   ======================================================================= *)

(*
Turbo Pascal's own units may occasionally cause problems when run on
poorly compatible computers. In particular, the Ctr unit is problematic
in this respect. The dosdelay procedure is a replacement of Turbo Pascal's
own Delay procedure which is in the Crt unit. The accuracy of dosdelay
is not as good as Delay's. Another reason for avoiding Crt is the potential
problems if the program uses redirection.
*)
procedure DOSDELAY (milliseconds : word);

(*
AUDIO is a replacement and enhancement of Turbo Pascal's sound procedure.
AUDIO does not need the Crt unit, and it takes the duration of the sound
as a parameter in milliseconds. This procedure first appears in release
tspas19 of this collection. AUDIO has been written in collaboration with
Ari Hovila, [e-mail].
*)
procedure AUDIO (frequency : longint; duration : word);

(* =======================================================================
                  What about the printer
   ======================================================================= *)

(* Is the parallel printer online. This works for the printers I have, but
   there are differences in computer-printer configurations which may
   affect this function. In fact, I've now found configurations where
   this test fails and I've written an alternative method which is below *)
function PRTONLFN : boolean;

(* Is the first (lpt1) printer online. An alternative for cases where prtonln
   fails. Elicits a very quick response directly from the printer I/O *)
function LPTONLFN : boolean;

(* Send the current screen to printer. First check the printer status. *)
procedure PRTSCR;

(* Get the number of times I/O is attempted for the printer in the first
   parallel port before an error condition arises. The default is normally
   20 times. (As you know I/O errors can be trapped with IORresult if I/O
   checking has been turned off using the $I- compiler directive. *)
function GETPRTFN : byte;

(* Set the number of times I/O is attempted to the printers for all the
   parallel ports before an error condition arises. If the argument
   is zero, the ports are not reset *)
procedure SETPRT (NumberOfRetrys : byte);