Module de remise en forme Nom et Prénom

[GallyHC]

Bonjour,

Petit module permettant de filtré et de remettre en forme les Nom et Prénom, avant leur utilisation ou/ou enregistrement. pour les Prénoms: supprime les espaces et tirets inutiles, ajoute une majuscule à chaque Prénom si composé.

Code : Tout sélectionner

DisableASM
EnableExplicit

; ****************************************************************************
; ****************************************************************************

DeclareModule toString
  
  Declare.s toFullTrim            (text.s, value.s = " ")
  
  Declare.s toProperLastName      (name.s)
  Declare.s toProperFirstName     (name.s)

EndDeclareModule
;
;
;
Module toString
  ;
  ;
  ;
  DisableASM
  EnableExplicit
  
  ; ****************************************************************************
  ; ****************************************************************************
  
  Procedure.s toFullTrim(text.s, value.s = " ")
    
    If text <> #Null$
      text = Trim(text)
      While CountString(text, value + value) > 0
        text = ReplaceString(text, value + value, value)
      Wend
      If value = " "
        text = ReplaceString(text, " .", ".")
        text = ReplaceString(text, " '", "'")
        text = ReplaceString(text, "' ", "'")
        text = ReplaceString(text, " -", "-")
        text = ReplaceString(text, "- ", "-")
      EndIf
    EndIf
    ProcedureReturn text

  EndProcedure
  
  ; ****************************************************************************
  ; ****************************************************************************

  Procedure.s toProperLastName(lastname.s)
    
    ProcedureReturn UCase(toFullTrim(lastname))
    
  EndProcedure
  
  Procedure.s toProperFirstName(firstName.s)
    
    Define.l i, j
    Define.s result
    Dim separator.s(2)
    separator(0)  = " "
    separator(1)  = "-"
    ;
    If firstName <> #Null$
      firstName = ReplaceString(firstName, "_", " ")
      For i=0 To ArraySize(separator())
        firstName = toFullTrim(firstName, separator(i))
      Next i
      If Mid(firstName, 1, 1) = separator(1) : firstName = Mid(firstName, 2) : EndIf
      If Mid(firstName, Len(firstName)) = separator(1) : firstName = Mid(firstName, 1, Len(firstName) - 1) : EndIf
      For i=0 To ArraySize(separator()) - 1
        result = #Null$
        For j=0 To CountString(firstName, separator(i))
          If j > 0 And j <  CountString(firstName, separator(i)) + 1
            result + separator(i)
          EndIf
          result + UCase(Mid(StringField(firstName, j + 1, separator(i)), 1, 1))
          If Len(firstName) > 1
            result + LCase(Mid(StringField(firstName, j + 1, separator(i)), 2))
          EndIf
        Next j
        firstName = result
      Next i
    EndIf
    ProcedureReturn firstName

  EndProcedure
  
EndModule

; ****************************************************************************
; ****************************************************************************

Debug toString::toFullTrim        ("        test ttttt          tt           ttt         t                ")
Debug toString::toProperLastName  (" DE LA       MACHIN       ")
Debug toString::toProperFirstName ("     __________     -Jean -------------        YVES    -------      ")

Cordialement,
GallyHC

PS: on peut aussi ajouter une routine de filtrage de caractères interdit etc.... A vous de voir ^^.

[Ar-S]

Sympathique mise en forme Merci

[MLD]

@Gally
super

[MLD]

@Gally
J'adore triturer les phrases ou les noms.
Ton code m'a inspiré. J'ai refait les procédures comme ceci.
J'espère que cela te donneras des idées

Code : Tout sélectionner

;MLD
Procedure.s toFullTrim(text.s)
  If text <> ""
   text = Trim(text)
   While CountString(text," " + " ") > 0
    text = ReplaceString(text," " + " " , " ")
   Wend
   text = ReplaceString(text, " .", ".")
   text = ReplaceString(text, " '", "'")
   text = ReplaceString(text, "' ", "'")
   text = ReplaceString(text, " -", "-")
   text = ReplaceString(text, "- ", "-")  
  EndIf
  ProcedureReturn text
EndProcedure

Procedure.s toProperLastName(lastname.s)
   
    ProcedureReturn UCase(toFullTrim(lastname))
   
EndProcedure


Procedure.s toProperFirstName(firstName.s)
   If firstName <> ""
     firstName = ReplaceString(firstName, "_", " ")
     firstName = ReplaceString(firstName, "-", " ") 
     firstName = Trim(firstName)
     While CountString(firstName," " + " ") > 0
      firstName = ReplaceString(firstName," " + " " , " ")
     Wend
     l = Len(firstName)
     a$ = UCase(Left(firstName,1))
     firstName = a$ + Right(firstName,l-1)
     P  = FindString(firstName," ") 
     If P > 0
       firstName = ReplaceString(firstName, " ", "-") 
       b$ = UCase(Mid(firstName,P +1,1))
       firstName = Left(firstName,P) + b$ + Right(firstName,l - (P+1)) 
       ProcedureReturn firstName
     Else
       ProcedureReturn firstName
     EndIf  
   EndIf
EndProcedure
  
Debug toFullTrim ("        test    ttttt          tt           ttt         t                ")
Debug toProperLastName  (" DE LA       MACHIN       ")
Debug toProperFirstName ("     __________    ----- _____  marcel   -------      ")
Debug toProperFirstName ("     __________     claude -------------        YVES    -------      ")
Debug toProperFirstName ("     __________     claude -------------   henri        -------      ")

Si cela s'avère moins fiable que ton code dis le moi
a+

[GallyHC]

Bonjour,

Pas mal bon après faut prendre le temps de comparer pour savoir lequel est le plus fiable, dans tout les cas je le met de coté.

Cordialement,
GallyHC