' COMPRES$(0.0)  Compress Character String                 12/22/1988-02/01/2010
' ------------------------------------------------------------------------------
' Copyright (C) 1988-2010 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 a single occurrence.

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

'    Strng$  - Character string to be compressed.
'    Chars$  - Characters, all successive occurrences of which
'              should to be compressed to a 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$)

' 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