home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
PASCAL
/
TBTREE16.ZIP
/
COMPARE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-07-13
|
18KB
|
455 lines
(* TBTree16 Copyright (c) 1988,1989 Dean H. Farwell II *)
unit Compare;
(*****************************************************************************)
(* *)
(* D A T A C O M P A R I S O N R O U T I N E S *)
(* *)
(*****************************************************************************)
(* This unit contains two routines which will compare two values and
determine whether the first value is LESSTHAN, EQUALTO, or GREATERTHAN the
second value. The following predefined Turbo Pascal types are supported:
Byte
ShortInt
Integer
LongInt
Word
String (any sizes)
Real
Single
Double
Extended
Comp
ByteArray
Note - To use Single, Double, Extended and Comp (8087 types) you must
compile the unit using {$N+}.
Additionally, the ByteArray type is also handled. This type is defined in
the Numbers unit.
This unit also contains three routines for determining if a substring
starts a target string, ends a target string, or is contained in a target
string. These routines are placed in this unit, because the strings are
passed in as untyped parameters just like in the first two routines in
this unit. *)
(*\*)
(* Version Information
Version 1.1 - Added SubstringCompare routine
- Added ContainsSubstring routine
- Added StartsWithSubstring routine
- Added EndsWithSubstring routine
Version 1.2 - No Changes
Version 1.3 - No Changes
Version 1.4 - Moved the ValueType type definition from this unit to the
Numbers unit in order to preclude a circular definition
error.
- Upgraded CompareValues to handle BYTEARRAYVALUEs
- Fixed error in EndsWithSubstring routine. Previously, a
search for a string such as 'xxx' would not find a match for
a string ending with 'xxxx' using this routine. This has
been corrected
- Added the ContainsSubstringAtPosition routine
- Now use an {$IFOPT N+} conditional compilation directive to
handle 8087 types
Version 1.5 - Changed code internally to use Inc and Dec where practical
Version 1.6 - No Changes *)
(*////////////////////////// I N T E R F A C E //////////////////////////////*)
interface
uses
ByteData,
Numbers;
type
Comparison = (LESSTHAN,EQUALTO,GREATERTHAN);
(*\*)
(* This routine will compare two values and return the result of the comparison.
The result is of type Comparison and LESSTHAN, EQUALTO, or GREATERTHAN will
be returned. The values compared must be of the same type. Legal types are
those enumerated in the type ValueType. The type of the values is passed in
as a parameter along with the values.
note : the values must reside in a variable since a var parameter is used.
This is necessary since the address is needed to facilitate the use of this
routine with multiple types. *)
function CompareValues(var paramValue1;
var paramValue2;
vType : ValueType) : Comparison;
(* This routine will compare two values of type STRINGVALUE and look for a
partial match. The first parameter (paramValue1) contains a substring which
will be searched for in paramValue2. The search is only to see if
paramValue2 starts with substring paramValue1. If paramValue2 starts with
paramValue1 then EQUALTO will be returned. Otherwise if paramValue1 is
less that paramValue2 then LESSTHAN will be returned. If paramValue1 is
greater that paramValue2 then GREATERTHAN will be returned. *)
function SubstringCompare(var paramValue1;
var paramValue2) : Comparison;
(* This routine will check to see if the substring passed in as paramValue1
is contained in the string passed in as paramValue2. It will return TRUE
if paramValue1 is contained in paramValue2 and FALSE otherwise. *)
function ContainsSubstring(var paramValue1;
var paramValue2) : Boolean;
(* This routine will check to see if the substring passed in as paramValue1
is contained in the string passed in as paramValue2 at the location in
paramValue2 specified by position. In other words, it looks for a partial
string match at one particular location within the target string. It will
return TRUE if paramValue1 is contained in paramValue2 at the specified
position and FALSE otherwise. *)
function ContainsSubstringAtPosition(var paramValue1;
var paramValue2;
position : Byte) : Boolean;
(*\*)
(* This routine will check to see if the substring passed in as paramValue1
starts the string passed in as paramValue2. It will return TRUE if
paramValue1 starts paramValue2 and FALSE otherwise. *)
function StartsWithSubstring(var paramValue1;
var paramValue2) : Boolean;
(* This routine will check to see if the substring passed in as paramValue1
ends the string passed in as paramValue2. It will return TRUE if
paramValue1 ends paramValue2 and FALSE otherwise. *)
function EndsWithSubstring(var paramValue1;
var paramValue2) : Boolean;
(*!*)
(*\*)
(*///////////////////// I M P L E M E N T A T I O N /////////////////////////*)
implementation
(* This routine will compare two values and return the result of the comparison.
The result is of type Comparison and LESSTHAN, EQUALTO, or GREATERTHAN will
be returned. The values compared must be of the same type. Legal types are
those enumerated in the type ValueType. The type of the values is passed in
as a parameter along with the values.
note : the values must reside in a variable since a var parameter is used.
This is necessary since the address is needed to facilitate the use of this
routine with multiple types. *)
function CompareValues(var paramValue1;
var paramValue2;
vType : ValueType) : Comparison;
var
byteValue1 : Byte absolute paramValue1;
byteValue2 : Byte absolute paramValue2;
shortIntValue1 : ShortInt absolute paramValue1;
shortIntValue2 : ShortInt absolute paramValue2;
integerValue1 : Integer absolute paramValue1;
integerValue2 : Integer absolute paramValue2;
longIntValue1 : LongInt absolute paramValue1;
longIntValue2 : LongInt absolute paramValue2;
wordValue1 : Word absolute paramValue1;
wordValue2 : Word absolute paramValue2;
stringValue1 : String absolute paramValue1;
stringValue2 : String absolute paramValue2;
realValue1 : Real absolute paramValue1;
realValue2 : Real absolute paramValue2;
singleValue1 : Single absolute paramValue1;
singleValue2 : Single absolute paramValue2;
doubleValue1 : Double absolute paramValue1;
doubleValue2 : Double absolute paramValue2;
extendedValue1 : Extended absolute paramValue1;
extendedValue2 : Extended absolute paramValue2;
compValue1 : Comp absolute paramValue1;
compValue2 : Comp absolute paramValue2;
byteArrayValue1 : ByteArray absolute paramValue1;
byteArrayValue2 : ByteArray absolute paramValue2;
cnt : ByteArrayRange;
begin
case vType of
BYTEVALUE :
begin
if byteValue1 < byteValue2 then CompareValues := LESSTHAN
else if byteValue1 = byteValue2 then CompareValues := EQUALTO
else CompareValues := GREATERTHAN;
end;
SHORTINTVALUE :
begin
if shortIntValue1 < shortIntValue2 then CompareValues := LESSTHAN
else if shortIntValue1 = shortIntValue2 then CompareValues :=EQUALTO
else CompareValues := GREATERTHAN;
end;
INTEGERVALUE :
begin
if integerValue1 < integerValue2 then CompareValues := LESSTHAN
else if integerValue1 = integerValue2 then CompareValues := EQUALTO
else CompareValues := GREATERTHAN;
end;
LONGINTVALUE :
begin
if longIntValue1 < longIntValue2 then CompareValues := LESSTHAN
else if longIntValue1 = longIntValue2 then CompareValues := EQUALTO
else CompareValues := GREATERTHAN;
end;
WORDVALUE :
begin
if wordValue1 < wordValue2 then CompareValues := LESSTHAN
else if wordValue1 = wordValue2 then CompareValues := EQUALTO
else CompareValues := GREATERTHAN;
end;
STRINGVALUE:
begin
if stringValue1 < stringValue2 then CompareValues := LESSTHAN
else if stringValue1 = stringValue2 then CompareValues := EQUALTO
else CompareValues := GREATERTHAN;
end;
REALVALUE :
begin
if realValue1 < realValue2 then CompareValues := LESSTHAN
else if realValue1 = realValue2 then CompareValues := EQUALTO
else CompareValues := GREATERTHAN;
end;
(* The following types are only for 8087 - and are compiled only if the unit
is compiled using {$N+} *)
{$IFOPT N+}
SINGLEVALUE :
begin
if singleValue1 < singleValue2 then CompareValues := LESSTHAN
else if singleValue1 = singleValue2 then CompareValues := EQUALTO
else CompareValues := GREATERTHAN;
end;
DOUBLEVALUE :
begin
if doubleValue1 < doubleValue2 then CompareValues := LESSTHAN
else if doubleValue1 = doubleValue2 then CompareValues := EQUALTO
else CompareValues := GREATERTHAN;
end;
EXTENDEDVALUE :
begin
if extendedValue1 < extendedValue2 then CompareValues := LESSTHAN
else if extendedValue1 = extendedValue2 then CompareValues :=EQUALTO
else CompareValues := GREATERTHAN;
end;
COMPVALUE :
begin
if compValue1 < compValue2 then CompareValues := LESSTHAN
else if compValue1 = compValue2 then CompareValues := EQUALTO
else CompareValues := GREATERTHAN;
end;
{$ENDIF}
(* the following type was added in version 1.4 *)
BYTEARRAYVALUE :
begin
cnt := 1;
while TRUE do
begin
if byteArrayValue1[0] < cnt then
begin
if byteArrayValue2[0] < cnt then
begin
CompareValues := EQUALTO;
end
else
begin
CompareValues := LESSTHAN;
end;
Exit;
end;
if byteArrayValue2[0] < cnt then
begin
CompareValues := GREATERTHAN;
Exit;
end;
if byteArrayValue1[cnt] < byteArrayValue2[cnt] then
begin
CompareValues := LESSTHAN;
Exit;
end;
if byteArrayValue1[cnt] > byteArrayvalue2[cnt] then
begin
CompareValues := GREATERTHAN;
Exit;
end;
if cnt = MAXBYTE then
begin
CompareValues := EQUALTO;
Exit;
end;
Inc(cnt);
end;
end;
end; (* end of case statement *)
end; (* end of CompareValues routine *)
(*\*)
(* This routine will compare two values of type STRINGVALUE and look for a
partial match. The first parameter (paramValue1) contains a substring which
will be searched for in paramValue2. The search is only to see if
paramValue2 starts with substring paramValue1. If paramValue2 starts with
paramValue1 then EQUALTO will be returned. Otherwise if paramValue1 is
less that paramValue2 then LESSTHAN will be returned. If paramValue1 is
greater that paramValue2 then GREATERTHAN will be returned. *)
function SubstringCompare(var paramValue1;
var paramValue2) : Comparison;
var
stringValue1 : String absolute paramValue1;
stringValue2 : String absolute paramValue2;
begin
if Pos(stringValue2,stringValue1) = 1 then
begin
SubstringCompare := EQUALTO;
end
else
begin
if stringValue1 < stringValue2 then
begin
SubstringCompare := LESSTHAN;
end
else
begin
SubstringCompare := GREATERTHAN;
end;
end;
end; (* end of SubstringCompare routine *)
(*\*)
(* This routine will check to see if the substring passed in as paramValue1
is contained in the string passed in as paramValue2. It will return TRUE
if paramValue1 is contained in paramValue2 and FALSE otherwise. *)
function ContainsSubstring(var paramValue1;
var paramValue2) : Boolean;
var
stringValue1 : String absolute paramValue1;
stringValue2 : String absolute paramValue2;
begin
if Pos(stringValue1,stringValue2) > 0 then
begin
ContainsSubstring := TRUE;
end
else
begin
ContainsSubstring := FALSE;
end;
end; (* end of ContainsSubstring routine *)
(* This routine will check to see if the substring passed in as paramValue1
is contained in the string passed in as paramValue2 at the location in
paramValue2 specified by position. In other words, it looks for a partial
string match at one particular location within the target string. It will
return TRUE if paramValue1 is contained in paramValue2 at the specified
position and FALSE otherwise. *)
function ContainsSubstringAtPosition(var paramValue1;
var paramValue2;
position : Byte) : Boolean;
var
stringValue1 : String absolute paramValue1;
stringValue2 : String absolute paramValue2;
tempString : String;
begin
tempString := Copy(stringValue2,position,Length(stringValue1));
if stringValue1 = tempString then
begin
ContainsSubstringAtPosition := TRUE;
end
else
begin
ContainsSubstringAtPosition := FALSE;
end;
end; (* end of ContainsSubstringAtPosition routine *)
(*\*)
(* This routine will check to see if the substring passed in as paramValue1
starts the string passed in as paramValue2. It will return TRUE if
paramValue1 starts paramValue2 and FALSE otherwise. *)
function StartsWithSubstring(var paramValue1;
var paramValue2) : Boolean;
var
stringValue1 : String absolute paramValue1;
stringValue2 : String absolute paramValue2;
begin
if Pos(stringValue1,stringValue2) = 1 then
begin
StartsWithSubstring := TRUE;
end
else
begin
StartsWithSubstring := FALSE;
end;
end; (* end of StartsWithSubstring routine *)
(* This routine will check to see if the substring passed in as paramValue1
ends the string passed in as paramValue2. It will return TRUE if
paramValue1 ends paramValue2 and FALSE otherwise. *)
function EndsWithSubstring(var paramValue1;
var paramValue2) : Boolean;
var
stringValue1 : String absolute paramValue1;
stringValue2 : String absolute paramValue2;
tempString : String;
begin
tempString := Copy(stringValue2,
(Length(stringValue2) - Length(stringValue1)) + 1,
Length(stringValue1));
if stringValue1 = tempString then
begin
EndsWithSubstring := TRUE;
end
else
begin
EndsWithSubstring := FALSE;
end;
end; (* end of EndsWithSubstring routine *)
end. (* end of Compare unit *)
