Une "Function" qui retourne le pluriel d'une chaine de caractères

// - - - - - - - - - - - - -
// SOURCE DE LA FONCTION
// - - - - - - - - - - - - -
// NECESSITE LA FONCTION "MAJUSCULE" (qui est au STRING que UPCASE est aux CHAR ) :

Function Majuscule( S : ShortString ) : ShortString ;
var I : Byte ;
Begin
For I:= 1 to Length(S) do
Begin
Case S[I] Of
'à','â','ä' : S[I] := 'A' ;
'é','è','ê','ë' : S[I] := 'E' ;
'î','ï' : S[I] := 'I' ;
'ô','ö' : S[I] := 'O' ;
'ù','û','ü' : S[I] := 'U' ;
Else S[I] := UpCase(S[I]) ;
End ;
End ;
Majuscule := S ;
End ;

Function Pluriel( S : ShortString ) : ShortString ;
//---------------------------------------------------------------------------------------|
// Retourne le pluriel de la chaîne S - selon les règles orthographiques françaises |
// Exemple Pluriel('Bijou') retourne 'Bijoux' |
// accepte les nom composés : |
// Pluriel('Cheval de Bataille') retourne 'Chevaux de Bataille' |
// PS : J'ai utilisé le BLED - Merci à ses auteurs |
// Rq : le source est facilement transcriptible dans un autre language |
//_______________________________________________________________________________________|
var
EnMajuscule : ShortString ;
ToutEnMajuscule : Boolean ;
Const
Langue:integer=0;

Begin
Case Langue of
0 : Begin // FRANCAIS
If S='' then
Begin
Pluriel := '' ;
EXIT ;
End ;
If Pos(' ',S)>0
then Result := Pluriel(Copy(S,1,Pos(' ',S)-1))
else If Pos('-',S)>0
then Result := Pluriel(Copy(S,1,Pos('-',S)-1))
else Begin
Result := S ;
EnMajuscule := Majuscule(S) ;
ToutEnMajuscule := (EnMajuscule = Result) ;
If Pos(Result[Ord(Result[0])],'zZxsXS')>0 then Exit
else If (EnMajuscule='LANDAU')Or
(EnMajuscule='SARRAU')Or
(EnMajuscule='BLEU')Or
(EnMajuscule='PNEU')Or
(EnMajuscule='BAL')Or
(EnMajuscule='CARNAVAL')Or
(EnMajuscule='CHACAL')Or
(EnMajuscule='FESTIVAL')Or
(EnMajuscule='RECITAL')Or
(EnMajuscule='REGAL') then Result := Result + 's'
Else If (EnMajuscule='BIJOU')Or
(EnMajuscule='CAILLOU')Or
(EnMajuscule='CHOU')Or
(EnMajuscule='GENOU')Or
(EnMajuscule='HIBOU')Or
(EnMajuscule='JOUJOU')Or
(EnMajuscule='POU') Or
((EnMajuscule[0]>#2)AND(Copy(EnMajuscule,Ord(EnMajuscule[0])-1,2)='AU')) Or
((EnMajuscule[0]>#2)AND(Copy(EnMajuscule,Ord(EnMajuscule[0])-1,2)='EU'))
then Result := Result + 'x'
Else If (EnMajuscule='BAIL')Or
(EnMajuscule='CORAIL')Or
(EnMajuscule='EMAIL')Or
(EnMajuscule='SOUPIRAIL')Or
(EnMajuscule='TRAVAIL')Or
(EnMajuscule='VANTAIL')Or
(EnMajuscule='VITRAIL')
then Result := Copy(Result,1,Ord(Result[0])-3)+'aux'
Else If ((EnMajuscule[0]>#2)AND(Copy(EnMajuscule,Ord(EnMajuscule[0])-1,2)='AL'))
then Result := Copy(Result,1,Ord(Result[0])-1)+'ux'
Else Result := Result + 's' ;
If ToutEnMajuscule Then Result := Majuscule(Result) ;
End ;
If Pos(' ',S)>0 then If (Pos(' DE ',Majuscule(S))>0) or (Pos(' D''',Majuscule(S))>0) then Result := Result+Copy(S,Pos(' ',S),30)
else Result := Result+' '+Pluriel(Copy(S,Pos(' ',S)+1,30))
else If Pos('-',S)>0 then Result := Result+Copy(S,Pos('-',S),30) ;
End ;
1 : Begin // Español En cours ........
// SI DES SPANISHOPHILES VEULENT LE FAIRE QU'ILS ME L'ENVOIE par email à assemple@free.fr
// L'ANGLAIS, L'ITALIEN, ET L'ALLEMEND M'INTERRESSERAIT AUSSI
// MERCI D'AVANCE
If S='' then
Begin
Pluriel := '' ;
EXIT ;
End ; // où est le ENDCASE ??????
If Pos(' ',S)>0
then Result := Pluriel(Copy(S,1,Pos(' ',S)-1))
else If Pos('-',S)>0
then Result := Pluriel(Copy(S,1,Pos('-',S)-1))
else Begin
Result := S ;
EnMajuscule := Majuscule(S) ;
ToutEnMajuscule := (EnMajuscule = Result) ;
If Pos(EnMajuscule[Ord(EnMajuscule[0])],'AeEiIoOuU')>0 then Result := Result+ 's' else Result := Result + 'es' ;
If ToutEnMajuscule Then Result := Majuscule(Result) ;
End ;
End ;
End ; { Case Langue }
End ;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage('le pluriel de travail est ' + Pluriel('travail'));
ShowMessage('le pluriel de truc est ' + Pluriel('truc'));
end;

// S'il manquait une fonction pour faire fonctionner "Pluriel", e mail à assemple@free.fr
// je n'ai pas eu le temps de vér if ier ... Je vient d'improviser cette e-publication