Page 1 sur 1

Module de remise en forme Nom et Prénom

Publié : sam. 23/mai/2020 10:18
par 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 ^^.

Re: Module de remise en forme Nom et Prénom

Publié : sam. 23/mai/2020 12:38
par Ar-S
Sympathique mise en forme :wink: Merci

Re: Module de remise en forme Nom et Prénom

Publié : dim. 24/mai/2020 8:43
par MLD
@Gally
super :wink:

Re: Module de remise en forme Nom et Prénom

Publié : dim. 24/mai/2020 15:30
par 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 :?: :lol:

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+

Re: Module de remise en forme Nom et Prénom

Publié : dim. 24/mai/2020 19:46
par 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