' COMPRES$(0.0)  Compress Character String             12/22/1988-05/30/1997
' --------------------------------------------------------------------------
' Copyright (C) 1988-1997 by Vladimir Veytsel                  www.davar.net

' Type ---------------------------------------------------------------------

'    Function

' Description --------------------------------------------------------------

'    COMPRES$ function returns its first parameter with all successive
'    occurrences of characters specified by the second parameter being
'    compressed to the single occurrence.

' Declaration --------------------------------------------------------------

'    DECLARE FUNCTION COMPRES$(Strng$,Chars$)

' Parameters ---------------------------------------------------------------

'    Strng$  - Character string to be compressed
'    Chars$  - Characters, all successive occurrences of which
'              should to be compressed to single occurrence

' Value --------------------------------------------------------------------

'    Character string compressed as specified by Chars$ parameter

' Note ---------------------------------------------------------------------

'    Empty Chars$ parameter specifies compression of ALL successive
'    duplicate characters of the string.

' Examples -----------------------------------------------------------------

'    COMPRES$(""      ,""   )=""
'    COMPRES$("ABBCCC",""   )="ABC"
'    COMPRES$("ABBCCC","A"  )="ABBCCC"
'    COMPRES$("ABBCCC","B"  )="ABCCC"
'    COMPRES$("ABBCCC","C"  )="ABBC"
'    COMPRES$("ABBCCC","ABC")="ABC"

' Start Function -----------------------------------------------------------

     DEFINT A-Z  ' All defaulted variables are integer

     FUNCTION COMPRES$(Strng$,Chars$) PUBLIC

' Check Special Case (Compression Is Impossible) ---------------------------

     IF (LEN(Strng$)<2) THEN
        COMPRES$=Strng$
        EXIT FUNCTION
     END IF

' Form Compressed String (with the Exception of Last Symbol) ---------------

     Chars.Lngth=LEN(Chars$)
     FOR I=1 TO LEN(Strng$)-1
         Curr.Str.Symb$=MID$(Strng$,I  ,1)
         Next.Str.Symb$=MID$(Strng$,I+1,1)
         IF (( Curr.Str.Symb$<>Next.Str.Symb$)OR  _
             ((Curr.Str.Symb$= Next.Str.Symb$)AND _
              (Chars.Lngth>0)                 AND _
              (INSTR(Chars$,Curr.Str.Symb$)=0))) THEN
            Work.Str$=Work.Str$+Curr.Str.Symb$
         END IF
     NEXT I

' Return Function Value to the Point of Invocation -------------------------

     COMPRES$=Work.Str$+RIGHT$(Strng$,1)

' Finish Function ----------------------------------------------------------

     END FUNCTION