Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TBTREE.ZIP/COMPARE.PAS

Pascal/Delphi Source File | 1988-07-25 | 13.5 KB | 347 lines

(* TBTree13             Copyright (c)  1988            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 LESTHAN, EQUALTO, or GREATERTHAN the
   second value.  The following defined Turbo Pascal types are supported:

                   Byte
                   ShortInt
                   Integer
                   LongInt
                   Word
                   String (any sizes)
                   Real
                   Single
                   Double
                   Extended
                   Comp

   Note - To use the last four above (8087 types) you must remove the brackets
   found below in the code.  I commented these out to allow compilation on a
   non 8087 machine.  After removing the brackets recompile!!

   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                                                  *)


(*\*)
(*////////////////////////// I N T E R F A C E //////////////////////////////*)

interface

type
    Comparison = (LESSTHAN,EQUALTO,GREATERTHAN);

    ValueType = (INVALIDVALUE,
                 BYTEVALUE,
                 SHORTINTVALUE,
                 INTEGERVALUE,
                 LONGINTVALUE,
                 WORDVALUE,
                 STRINGVALUE,
                 REALVALUE,
                 SINGLEVALUE,
                 DOUBLEVALUE,
                 EXTENDEDVALUE,
                 COMPVALUE);

(*\*)
(* 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
  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;

    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 presently commented out
    To use -- remove brackets and recompile --

        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;
}
      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
  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;

    begin
    if Pos(stringValue1,stringValue2) =
       (Length(stringValue2) - Length(stringValue1)) + 1 then
        begin
        EndsWithSubstring := TRUE;
        end
    else
        begin
        EndsWithSubstring := FALSE;
        end;
    end;                                 (* end of EndsWithSubstring routine *)

end.                                                  (* end of Compare unit *)