Fonction "pluriel_de" qui renvoie le pluriel de la chaine de caractère passée en paramètre.

Commenter

Contenu du snippet

Fonction "PLURIEL_DE" qui renvoie le pluriel de la chaine de caractère passée en paramètre.
Quoi dire de plus ?
Je l'utilise énormément...
J'ai créé l'unité PLURIEL pour publier cette fonction. Celle-ci est dans une unité fourre-tout avec d'autres fonction.

Source / Exemple : 


//----------------------------------------------------------//
// Unité Pluriel.pas par Diégo DELPY - assemple@free.fr     //
//----------------------------------------------------------//
// La fonction Pluriel_de renvoie le pluriel du mot ou du   //
// groupe de mots passé en paramètre                        //
// Dans le cas d'un mot simple passé en paramètre, je pense //
// que la function est juste. Dans le cas contraire, envoyez//
// moi un mot à assemple@free.fr.                           //
// Dans le cas d'un groupe de mot je ne suis pas très sûr   //
// que la fonction soit juste. Faites-moi ici aussi des     //
// suggestions, ou reprennez ce source et améliorez le.     //
//----------------------------------------------------------//
unit Pluriel;

interface

Function Pluriel_de( S : ShortString ) : ShortString ;

implementation

Function Majuscule( S : String ) : String ; OverLoad ;
var I : Integer ;
Begin
  If S='' then
  Begin
    Result := '' ;
    EXIT ;
  End ;
  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 Majuscule( S : ShortString ) : ShortString ;OverLoad ;
var I : Byte ;
Begin
  If S='' then
  Begin
    Result := '' ;
    EXIT ;
  End ;
  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_de( S : ShortString ) : ShortString ;
var
    EnMajuscule : ShortString ;
    ToutEnMajuscule : Boolean ;
    S2 : ShortString ;
Begin
  If (Pos('(',S)>0) and (Pos(')',S)>Pos('(',S)+1) then
  Begin
    S2 := Copy(S,Pos('(',S)+1,Pos(')',S)-Pos('(',S)-1) ;
    Delete(S,Pos('(',S)+1,Length(S2) ) ;
    S := Pluriel_de(S) ;
    Insert(S2,S,Pos('()',S)+1) ;
  End ;
  If S='' then
  Begin
    Pluriel_de := '' ;
    EXIT ;
  End ;
  If Pos(' ',S)>0
  then Result := Pluriel_de(Copy(S,1,Pos(' ',S)-1))
  else If Pos('-',S)>0
  then Result := Pluriel_de(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_de(Copy(S,Pos(' ',S)+1,30))
  else If Pos('-',S)>0 then Result := Result+Copy(S,Pos('-',S),30) ;
End ;

end.

Conclusion :


Le zip joint contient l'unité et une application de démonstration (toute simple)
Je développe des applications de Gestion (Facturation - Comptabilité - Paye)
librement téléchargeable sur mon site http://assemple.free.fr

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (assemple)