LIBRAIRIE DE FONCTIONS DE GESTION DE SOUS-CHAINES.

{ SUBSTRING DEFINITION FOR DEVELOPPERS:
  Admettons une chaine de caractères de plusieurs éléments (subStrings) séparés par n' importe quel caractère comme par exemple ';

  !!! TRÈS IMPORTANT !!!
  On ne peut distinguer une chaine à 1 élément vide d' une chaine sans élément.
  Donc, si Chaine = '', on admet toujours qu' il existe 1 élément dans la chaine.
  Pour initialiser une chaine avec son 1er élément, on fait Chaine := 'mon 1er élément';

  Le 1er élément est sur l' Index 1.
  Pour récupérer le 3ème élément on fait:
  MonElement := SUBSTRING_GET('aaa;bb;ccccc;ddd;e;;g', ';', 3);
  !!! FIM TRÈS IMPORTANT !!!

  Exemple: Str = ''                 1 élément vide
  Exemple: Str = 'xxx'              1 élément rempli ...
  Exemple: Str = ';'                2 éléments (vides) ...
  Exemple: Str = 'xxx;'             2 éléments (dont 1 vide) ...
  Exemple: Str = ';xxx'             2 éléments (dont 1 vide) ...
  Exemple: Str = 'xxx;yyy'          2 éléments ...
}

     function SUBSTRING_START(Str: String; Separateur: Char; SubStringIndex: Word): Integer;
     function SUBSTRING_GET(Str: String; Separateur: Char; SubStringIndex: Word): ShortString;
     procedure SUBSTRING_EDIT(Var Str: String; Separateur: Char; SubStringIndex: Word; Novovaleur: String);
     function SUBSTRING_COUNT(Str: String; Separateur: Char): Integer;
     procedure SUBSTRING_ADD(var Str: String; Separateur: Char; valeur: String);
     function SUBSTRING_LENGTH(Str: String; Separateur: Char; SubStringIndex: Word): Integer;
     procedure SUBSTRING_INSERT(var Str: String; Separateur: Char; SubStringIndex: Word; valeur: String);
     function SUBSTRING_DELETE(var Str: string; Separateur: Char; SubStringIndex: Word): Boolean;
     function SUBSTRING_LOCATE(Str: string; Separateur: Char; SubString: String; Options: TLocateOptions): Integer;
     function SUBSTRING_RIBBON(Str: string; Separateur: Char; Current: Word; MoveBy: Integer): Integer; overload;
     function SUBSTRING_RIBBON(Str: string; Separateur: Char; Current: String; MoveBy: Integer): String; overload;


// Nombre d' éléments :
function SUBSTRING_COUNT(Str: String; Separateur: Char): Integer;
var i, nbCars: Integer;
begin
  RESULT := 1;
  nbCars := length(Str);

  for i := 1 to nbCars do
    if Str[i] = Separateur
    then RESULT := RESULT + 1;
end;

// Position dans Str du 1er caractère d' un élément : 
function SUBSTRING_START(Str: String; Separateur: Char; SubStringIndex: Word): Integer;
var nbCars, curSubStringIndex, i: Integer;
begin
  RESULT := 0;
  if SubStringIndex = 0 then raise ERangeError.Create('SubStringIndex = 0!');
  
  nbCars := length(Str);
  curSubStringIndex := 1;
  i := 0;

  while (curSubStringIndex <> SubStringIndex) and (i < nbCars) do
  begin
    i := i + 1;

    if Str[i] = Separateur
    then curSubStringIndex := curSubStringIndex + 1;   // On va passer à l' élément suivant : 
  end;

  if curSubStringIndex = SubStringIndex
  then RESULT := i + 1;    // 'Sauter' le separateur ou i = 0...
end;

// Ajouter un élément à la fin (Très con, je sais): 
procedure SUBSTRING_ADD(var Str: String; Separateur: Char; valeur: String);
begin                  
  // On considère donc que Str possède déjà un élément même si Str = '',
  // Pour insérer le 1er élément faites dans votre programme Str := 'c est mon 1er élément';
  Str := Str + Separateur + valeur;
end;

// Récupérer un élément : 
function SUBSTRING_GET(Str: String; Separateur: Char; SubStringIndex: Word): ShortString;
var nbCars, i: Integer;
begin
  RESULT := '';
  i := SUBSTRING_START(Str, Separateur, SubStringIndex);
  nbCars := length(Str);

  while i <= nbCars do
  begin
    if Str[i] <> Separateur
    then RESULT := RESULT + Str[i]
    else i := nbCars;

    i := i + 1;
  end;
end;

// Nombre de caractères d' un élément :
function SUBSTRING_LENGTH(Str: String; Separateur: Char; SubStringIndex: Word): Integer;
var i, nbCars: Integer;
begin
  RESULT := Length(SUBSTRING_GET(Str, Separateur, SubStringIndex));
end;

// Insérer un élément : 
procedure SUBSTRING_INSERT(var Str: String; Separateur: Char; SubStringIndex: Word; valeur: String);
var i, SubStrCount: Integer;
begin
  SubStrCount := SUBSTRING_COUNT(Str, Separateur);

  if (SubStringIndex > 0) and (SubStringIndex <= SubStrCount)
  then begin
    i := SUBSTRING_START(Str, Separateur, SubStringIndex);
    Insert(valeur + Separateur, Str, i);  
  end
  else
    raise ERangeError.CreateFmt('%d is not within the valid range of %d..%d', [SubStringIndex, 1, SubStrCount]);
end;

// Modifier un élément même dans une position qui n' existe pas : 
procedure SUBSTRING_EDIT(var Str: string; Separateur: Char; SubStringIndex: Word; Novovaleur: string);
var i, SubStrCount, nbCars: Integer;
begin
  i := SUBSTRING_START(Str, Separateur, SubStringIndex);

  if i = 0          // L' élément n' existe pas ...
  then begin
    SubStrCount := SUBSTRING_COUNT(Str, Separateur);

    while SubStrCount < SubStringIndex do
    begin
      Str := Str + Separateur;          // Ajouter um élément vide ...
      SubStrCount := SubStrCount + 1;
    end;

    Str := Str + Novovaleur;
  end
  else begin        // L' élément existe à la position i ...
    nbCars := length(Str);
    // Retirer valeur actuelle :
    while i <= nbCars do
      if Str[i] <> Separateur
      then begin
        Delete(Str, i, 1);
        nbCars := nbCars - 1;
      end
      else
        nbCars := 0;   // fim do elemento ...

    // Insérer la nouvelle valeur de l' élément :
    Insert(Novovaleur, Str, i);
  end;
end;

// Récupérer l' indice d' un élément :
function SUBSTRING_LOCATE(Str: string; Separateur: Char; SubString: String; Options: TLocateOptions): Integer;
var
  SubStrCount, CurSubStrIndex: Integer;
  FindPartialKey, FindCaseInsensitive: Boolean;
begin
  RESULT := 0;
  CurSubStrIndex := 1;
  SubStrCount := SUBSTRING_COUNT(Str, Separateur);
  FindPartialKey := loPartialKey in Options;
  FindCaseInsensitive := loCaseInsensitive in Options;

  if FindCaseInsensitive
  then begin
    Str := STRING_MAIUSCULAS(Str, []);
    SubString := STRING_MAIUSCULAS(SubString, []);
  end;

  while (RESULT = 0) and (CurSubStrIndex <= SubStrCount) do
  begin
    if FindPartialKey
    then begin
      if Pos(SubString, SUBSTRING_GET(Str, Separateur, CurSubStrIndex)) = 1  
      then RESULT := CurSubStrIndex;
    end
    else
      if SubString = SUBSTRING_GET(Str, Separateur, CurSubStrIndex)
      then RESULT := CurSubStrIndex;

    inc(CurSubStrIndex, 1);
  end;
end;

// Permet, à la manière d' un DataSet, sauter de "MoveBy" éléments, avec la particularité de revenir au début lorsqu' on atteind le 

dernier élément (de même si on atteind le début quand MoveBy négatif, on revient au dernier) : 
function SUBSTRING_RIBBON(Str: string; Separateur: Char; Current: Word; MoveBy: Integer): Integer;
var Count: Integer;
begin
  Count := SUBSTRING_COUNT(Str, Separateur);

  RESULT := Current + MoveBy;

  if RESULT > 0
  then begin
    while RESULT > Count do
      RESULT := RESULT - Count;
  end
  else begin
    while RESULT <= 0 do
      RESULT := RESULT + Count;
  end;
end;

// La même mais sans l' indice (par la valeur de l' élément) : 
function SUBSTRING_RIBBON(Str: string; Separateur: Char; Current: String; MoveBy: Integer): String;
var SubStringIndex: Integer;
begin
  SubStringIndex := SUBSTRING_LOCATE(Str, Separateur, Current, []);

  if SubStringIndex = 0
  then SubStringIndex := 1
  else SubStringIndex := SUBSTRING_RIBBON(Str, Separateur, SubStringIndex, MoveBy);

  RESULT := SUBSTRING_GET(Str, Separateur, SubStringIndex);
end;

// Retirer un élément : 
function SUBSTRING_DELETE(var Str: string; Separateur: Char; SubStringIndex: Word): Boolean;
var nbCars: Integer;
begin
  RESULT := false;
  i := SUBSTRING_START(Str, Separateur, SubStringIndex);

  if i <> 0
  then begin
    RESULT := True;
    nbCars := length(Str);
    // Remover valeur actual :
    while i <= nbCars do
    begin
      if Str[i] = Separateur
      then nbCars := 0             // fim do elemento ...
      else nbCars := nbCars - 1;

      Delete(Str, i, 1);
    end;
  end;
end;