PROGRAM   ChSptS52 ;
{$IFDEF VER60}                 USES   Objects ;   {$ENDIF}
{$IFDEF VER70}{$IFDEF MSDOS}   USES   Objects ;   {$ENDIF}{$ENDIF}
{$IFDEF VER70}{$IFDEF DPMI}    USES   Objects ;   {$ENDIF}{$ENDIF}
{$IFDEF VER70}{$IFDEF WINDOWS}   USES   WinCRT , Objects ;   {$ENDIF}{$ENDIF}
{$IFDEF VER80}                   USES   WinCRT , Objects ;   {$ENDIF}      {--- Delphi1 }

{
!------------------------------------------------------------------------------
! Small toolbox
!------------------------------------------------------------------------------
}
{
!---------------
! TCollection (of String) routines
!---------------
! TCollectionOfString_FreeItems
!---------------
}
{===== TCollectionOfString_FreeItems }

PROCEDURE   TCollectionOfString_FreeItems   ( Var Self : TCollection );
VAR
   L_i : Longint ;
BEGIN
   {----- LOOP , Free all String items }
   FOR L_i := 0 TO Self.Count -1 DO BEGIN
      DisposeStr ( Self.At(L_i) );
   END;

   Self.DeleteAll ;
END;

{
!------------------------------------------------------------------------------
! This program toolbox
!------------------------------------------------------------------------------
}
{
!---------------
! TCollection (of String) routines
!---------------
! TCollectionOfString_ChSplitString
!---------------
}
{===== TCollectionOfString_ChSplitString }

PROCEDURE   TCollectionOfString_ChSplitString   ( Var Self : TCollection
                                                ; {$IFDEF VER70}Const{$ENDIF} I_String : String
                                                ; I_ChSeparator : Char );
VAR
   L_Len      : Longint ;
   L_FldBegin : Longint ;
   L_FldAEnd  : Longint ;
BEGIN
   TCollectionOfString_FreeItems ( Self );

   L_Len      := Length(I_String);
   L_FldBegin := 1 ;
   L_FldAEnd  := 1 ;

   {----- LOOP 1 , Search each field }
   WHILE L_Len <> 0 DO BEGIN

      {----- LOOP 2 , Search separator }
      WHILE (L_Len <> 0) and (I_String[L_FldAEnd] <> I_ChSeparator)
      DO BEGIN  Dec ( L_Len );  Inc(L_FldAEnd);  END;

      {----- Add field }
      Self.AtInsert ( Self.Count , NewStr(Copy(I_String,L_FldBegin,L_FldAEnd-L_FldBegin)) );

      {----- If inside the string (separator found),... }
      IF L_Len <> 0
      THEN BEGIN
         {----- Prepare next search }
         Dec ( L_Len );
         Inc ( L_FldAEnd );
         L_FldBegin := L_FldAEnd ;
      END;
   END;{while}

   {----- One more at the end... }
   IF (I_String <> '') and (I_String[Length(I_String)] = I_ChSeparator)
   THEN Self.AtInsert ( Self.Count , NewStr('') );
END;


{===============}


FUNCTION   TCollectionOfString_Join   ( Var Self : TCollection
                                      ; I_Separator : String ) : String ;
VAR
   L_Result : String ;
   L_i       : Integer ;
   L_PString : PString ;
BEGIN
   L_Result := '' ;

   {----- LOOP , Concat items }
   FOR L_i := 0 TO Self.Count -1 DO BEGIN
      L_PString := Self.At(L_i);

      IF L_i > 0 THEN L_Result := L_Result  +  I_Separator ;
      IF L_PString <> Nil
      THEN L_Result := L_Result  +  L_PString^ ;
   END;{for}

   TCollectionOfString_Join := L_Result ;
END;

{===== Test Speed variables }
LABEL
   G_TEST_SPEED ;
VAR
   G_SPEED_LoopMax  : Longint ;
   G_SPEED_i        : Longint ;
   G_SPEED_DummyStr : String ;

   GI_SPEED_TmpStr : String ;
   G_SPEED_ErrPos  : Integer ;

VAR
   G_MyStrings : TCollection ;

   G_i : Integer ;

BEGIN
   G_MyStrings.Init ( 0 , 4 );



   IF ParamStr(1) = 'TestSpeed' THEN GOTO G_TEST_SPEED ;      {--- Test speed ?  }



   TCollectionOfString_ChSplitString ( G_MyStrings , '' , ',' );
   FOR G_i := 0 TO G_MyStrings.Count -1 DO BEGIN
      IF G_i > 0 THEN Write (   ';'   );
      Write (   PString(G_MyStrings.At(G_i))^   );
   END;{i}
   WriteLn (   '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


   TCollectionOfString_ChSplitString ( G_MyStrings , ',' , ',' );
   WriteLn (   TCollectionOfString_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


   TCollectionOfString_ChSplitString ( G_MyStrings , ',,' , ',' );
   WriteLn (   TCollectionOfString_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


   TCollectionOfString_ChSplitString ( G_MyStrings , 'Red,Green,Blue' , ',' );
   WriteLn (   TCollectionOfString_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );
   WriteLn ;


   {---------------}


   TCollectionOfString_ChSplitString ( G_MyStrings , 'a' , ',' );
   WriteLn (   TCollectionOfString_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


   TCollectionOfString_ChSplitString ( G_MyStrings , 'a,b' , ',' );
   WriteLn (   TCollectionOfString_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


   TCollectionOfString_ChSplitString ( G_MyStrings , 'a,b,c' , ',' );
   WriteLn (   TCollectionOfString_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


   TCollectionOfString_ChSplitString ( G_MyStrings , ',b,c' , ',' );
   WriteLn (   TCollectionOfString_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


   TCollectionOfString_ChSplitString ( G_MyStrings , 'a,,c' , ',' );
   WriteLn (   TCollectionOfString_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


   TCollectionOfString_ChSplitString ( G_MyStrings , 'a,b,' , ',' );
   WriteLn (   TCollectionOfString_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );



   {***************  TEST SPEED  ***************}
  G_TEST_SPEED:

   {----- Get Parameter 2  ( optional ) : Loop max }
   G_SPEED_LoopMax := 10 ;      {--- Default value }
   GI_SPEED_TmpStr := ParamStr(2);
   IF GI_SPEED_TmpStr <> '' THEN BEGIN
      Val ( GI_SPEED_TmpStr , G_SPEED_LoopMax , G_SPEED_ErrPos );
      IF G_SPEED_ErrPos <> 0 THEN BEGIN
         WriteLn (   'ERROR: '  ,  'Number expected  ( Parameter 2 ).'   );
         HALT ( 1 );
      END;
   END;

   {----- LOOP , Call a split }
   FOR G_SPEED_i := 1 TO G_SPEED_LoopMax DO BEGIN
      TCollectionOfString_ChSplitString ( G_MyStrings ,
'Red,Green,Blue,Red,,..........,Green..........,Blue..........,,Red,Green,Blue,,,' , ',' );
{12345678901234567890123456789012345678901234567890123456789012345678901234567890}
   END;{i}



   TCollectionOfString_FreeItems ( G_MyStrings );
   G_MyStrings.Done ;
END.
