Hit-Parade .VB Research Center . Compteur
Accueil ~  Code ~  Programmes ~  Api ~  Forum ~  Cours ~  Livres ~  Quiz ~  Annuaire
~ Edito ~
12/03/2006 @ 13:39
Depuis la dernière mise à jour (qui remonte à... oulala plusieurs mois), un petit ménage de printemps s'impose. Ca tombe bien, c'est presque la période.
Au menu, et progressivement sur les jours à venir, rafraîchissement de plusieurs fonctions et procédures, nouvelles APIs et nouveaux programmes.

~ Rechercher ~

  

~ Annuaire VB ~
 Rechercher un site :
  

~ Partenaires ~

Classe : SString
Classe qui étend les caractéristiques du type standard String par l'ajout de nouvelles méthodes.
(Consulté 24624 fois.)

Voici une petite classe dont je suis assez content. Dans le cadre de mon travail, je manipule beaucoup toutes sortes de chaînes. J'ai donc voulu rassembler toutes les fonctions qui tournaient autour de ce thème. J'ai obtenu ainsi un petit module, et j'en ai fait une classe que j'ai appellé SString.
Elle n'a bien sûr d'intérêt, que si comme moi vous travaillez beaucoup avec le type String. Mais, elle peut être utilisée dans n'importe quel projet.
Voici ce qu'elle permet de faire :
- Donner le nombre de mot d'une chaîne,
- Trier les mots à l'intérieur d'une chaîne,
- Remplacer des caractères,
- Supprimer un mot,
- Donner le n-ième mot d'une chaîne,
- Remplacer le n-ième mot d'une chaîne,
- Filtrer des caractères,
- Insérer des mots,
- Mettre en majuscule/minuscule,
- Renvoyer la longueur de la chaine.

Elle est complétement utilisable avec le type String. Toutes les fonctions qui s'applique à String peuvent être utilisées avec SString (et l'inverse aussi, il suffit d'affecter votre String à une variable SString).

Avec l'apparition de la version 6 de Visual Basic, certaines de ces propriétés deviennent moins évidentes à utiliser. En effet, Microsoft a enfin eu la bonne idée (...) d'ajouter certaines fonctions qui permettent de travailler convenablement avec les String. Je pense, entre autres, aux fonctions Split ou StrReverse.

Voici quelques exemples de manipulation des méthodes disponibles.

' Déclaration de la variable.
Dim sTest as New SString

' Affectation d'une valeur. sTest = "Ceci est un test."
' Calcul du nombre de mot. Debug.Print sTest.NbMot ( " " ) ' Résultat : 4 Debug.Print sTest.NbMot ( "est" ) ' Résultat : 3
' Tri de la chaîne. Debug.Print sTest.TriMot ( " " , ssTri_A_Z ) ' Résultat : "Ceci est test. un" Debug.Print sTest.TriMot ( "e" , ssTri_Z_A ) ' Résultat : "st.est un teci eC"
' Remplacement. Debug.Print sTest.Remplace ( "e" , "a" ) ' Résultat : "Caci ast un tast." Debug.Print sTest.Remplace ( "un" , "" ) ' Résultat : "Ceci est test." Debug.Print sTest.Remplace ( "s" , "sss" ) ' Résultat : "Ceci essst un tessst."
' Suppression de mot. Debug.Print sTest.EnleveMot ( " " , 2 ) ' Résultat : "Ceci un test." Debug.Print sTest.EnleveMot ( "e" , 2 ) ' Résultat : "Cest un test."
' Lecture d'un mot. Debug.Print sTest.Mot ( 2 , "e" ) ' Résultat : "ci " Debug.Print sTest.Mot ( 4 , " " ) ' Résultat : "test."
' Affectation d'un mot. sTest.Mot ( 4 , " " ) = "essai!" Debug.Print sTest ' Résultat : "Ceci est un essai!" sTest.Mot ( 2 , "e" ) = "la " Debug.Print sTest ' Résultat : "Cela est un essai!"
' Filtrage de caractère. Debug.Print sTest.Filtre ( "est" ) ' Résultat : "eesttest" Debug.Print sTest.Filtre ( " cis" ) ' Résultat : "ci s s"
' Insertion de mot. Debug.Print sTest.Insere ( 4 , " " , "petit" ) ' Résultat : "Ceci est un petit test."

Je passe sur les fonctions Maj, Min et Length qui sont évidentes.

Et voilà, vous obtenez donc une petite classe bien pratique. Je suis comme d'habitude à l'écoute de toute suggestion qui pourrait améliorer ces lignes de codes (ou de tout bug qui m'aurait échappé).

Vous pouvez récupérer le code (format zip), où bien le consulter directement ci-dessous :

Option Explicit

' Définition de la variable contenant la chaîne manipulée.
Private mstString As String
Public Enum
ssSort
    ssTri_A_Z = 1
    ssTri_Z_A = -1
End Enum

Private Sub
Class_Initialize()
' Initialisation de la chaîne.
mstString = vbNullString
End Sub

Public Property Let
Str(ByVal vData As String)
' Affectation de la valeur de la chaîne.
mstString = vData
End Property

Public Property Get
Str() As String
' Récupération de la valeur de la chaîne.
Str = mstString
End Property

Public Function
Length() As Long
' Retourne la longueur de la chaîne.
Length = Len(mstString)
End Function

Public Function
Maj() As String
' Passe la chaîne en majuscule.
Maj = UCase$(mstString)
End Function

Public Function
Min() As String
' Passe la chaîne en minuscule.
Min = LCase$(mstString)
End Function

Public Function
NbMot(stSeparateur As String) As Long
' Retourne le nombre de mots de la chaîne. Le séparateur
' utilisé doit être donné en paramêtre.
Dim lgNBMot As Long, lgPos As Long
If
stSeparateur <> vbNullString Then
   
lgNBMot = 0
    lgPos = 0
   
Do
     
  lgPos = InStr(lgPos + 1, mstString, stSeparateur)
        lgNBMot = lgNBMot + 1
   
Loop Until lgPos = 0
   
If mstString = vbNullString Then NbMot = 0 Else NbMot = lgNBMot
Else
 
  NbMot = 0
End If
End Function

Public Property Get
TriMot(stCarSep As String, ssTri As ssSort) As SString
' Cette fonction a pour but de trier tous les mots de la chaînes.
' Le caractère de séparation des mots est donné en paramêtre,
' l'ordre du tri également.
Dim lgLen As Long
Dim
ssTMP As New SString
lgLen = Me.NbMot(stCarSep)
If lgLen = 0 Then
 
  ssTMP = vbNullString
Else
 
  ReDim stTMP(lgLen) As String
 
  Dim i As Long, j As Long
' On stocke tous les mots dans un tableau.
  For i = 1 To lgLen
  stTMP(i) = Me.Mot(i, stCarSep)
 
Next i
' On tri le tableau.
  For i = 1 To lgLen - 1
 
For j = 1 To lgLen - 1
 
If ((ssTri = ssTri_A_Z) And (stTMP(j) > stTMP(j + 1))) Or _
  ((ssTri = ssTri_Z_A)
And (stTMP(j) < stTMP(j + 1))) Then
  stTMP(0) = stTMP(j)
  stTMP(j) = stTMP(j + 1)
  stTMP(j + 1) = stTMP(0)
 
End If
  Next j
 
Next i
' On remet le tableau trié dans une chaîne.
  ssTMP = stTMP(1)
 
For i = 2 To lgLen
  ssTMP = ssTMP & stCarSep & stTMP(i)
 
Next i
End If
Set
TriMot = ssTMP
End Property

Public Function
Remplace(stAvant As String, stApres As String) As SString
' Cette fonction remplace toutes les occurences de la chaîne stAvant
' par la chaîne stApres.
Dim lgPos As Long, lgRes As Long
Dim
ssTMP As New SString
Dim stTMP As String
Dim
stRes() As String
If
stAvant <> vbNullString Then
  stTMP = mstString
  lgPos = InStr(stTMP, stAvant)
  lgRes = 0
 
Do While lgPos > 0
 
ReDim Preserve stRes(lgRes) As String
  stRes(lgRes) = Left$(stTMP, lgPos - 1)
  lgRes = lgRes + 1
  stTMP = Right$(stTMP, Len(stTMP) - lgPos + 1 - Len(stAvant))
  lgPos = InStr(stTMP, stAvant)
 
Loop
  ssTMP = vbNullString
 
For lgPos = 0 To lgRes - 1
  ssTMP = ssTMP & stRes(lgPos) & stApres
 
Next lgPos
  ssTMP = ssTMP & stTMP
Else
  ssTMP = mstString
End If
Set
Remplace = ssTMP
End Function

Public Function
EnleveMot(stSeparateur As String, lgPosition As Long) As SString
' Cette fonction permet d'enlever un mot de la chaîne. La particularité
' par rapport à une affectation de chaîne nulle en utilisant
' la méthode Mot, est ici, que le séparateur est également supprimé.
Dim lgOld As Long, lgPos As Long, lgNb As Long
Dim
ssTMP As New SString
' Si on sort des limites de la chaîne, on retourne une chaîne vide.
If (lgPosition < 1) Or (Me.NbMot(stSeparateur) < lgPosition) Then
  ssTMP = vbNullString
Else
  lgOld = 0
  lgPos = 0
  lgNb = 0
 
Do
' Parcours de tous les mots délimités par le séparateur.
  If lgOld = 0 Then lgOld = 1 Else lgOld = lgPos + Len(stSeparateur)
  lgPos = InStr(lgOld, mstString, stSeparateur)
  lgNb = lgNb + 1
 
Loop Until (lgNb >= lgPosition)
 
If lgPos = 0 Then
  lgPos = Len(mstString)
' On diminue lgOld pour supprimer le séparateur de fin de ligne.
  lgOld = lgOld - 1
 
End If
' Suppression du mot. On prend le début et la fin de la chaîne sans le mot à enlever.
  ssTMP = Left$(mstString, lgOld - 1) & Right$(mstString, Len(mstString) - lgPos)
End If
Set
EnleveMot = ssTMP
End Function

Public Property Get
Mot(lgPosition As Long, stSeparateur As String) As SString
' Permet de récupérer un mot de la chaîne suivant un séparateur défini.
' Retourne un objet SString. Si le mot demandé n'existe pas,
' retourne une chaîne vide.
Dim lgOld As Long, lgPos As Long, lgNb As Long
Dim
ssTMP As New SString
If (lgPosition < 1) Or (Me.NbMot(stSeparateur) < lgPosition) Then
' Si on sort des limites de la chaîne, on retourne une chaîne vide.
  ssTMP = vbNullString
Else
  lgOld = 0
  lgPos = 0
  lgNb = 0
 
Do
' Parcours de tous les mots délimités par le séparateur.
  If lgOld = 0 Then lgOld = 1 Else lgOld = lgPos + Len(stSeparateur)
  lgPos = InStr(lgOld, mstString, stSeparateur)
  lgNb = lgNb + 1
 
Loop Until (lgNb >= lgPosition)
 
If lgPos = 0 Then lgPos = Len(mstString) + 1
  ssTMP = Mid$(mstString, lgOld, lgPos - lgOld)
End If
Set
Mot = ssTMP
End Property

Public Property Let
Mot(lgPosition As Long, stSeparateur As String, ByVal vData As Variant)
' Permet d'affecter un nouveau mot à la place d'un ancien.
' Il suffit d'indiquer la position dans la chaîne,
' le séparateur à utiliser et le nouveau mot à mettre en place.
Dim lgOld As Long, lgPos As Long, lgNb As Long
' Si le vData n'est pas une chaîne, on sort.
If Not (VarType(vData) <> vbString) Then
' Si on sort des limites de la chaîne, on retourne une chaîne vide.
  If Not ((lgPosition < 1) Or (Me.NbMot(stSeparateur) < lgPosition)) Then
  lgOld = 0
  lgPos = 0
  lgNb = 0
 
Do
' Parcours de tous les mots délimités par le séparateur.
  If lgOld = 0 Then lgOld = 1 Else lgOld = lgPos + Len(stSeparateur)
  lgPos = InStr(lgOld, mstString, stSeparateur)
  lgNb = lgNb + 1
 
Loop Until (lgNb >= lgPosition)
 
If lgPos = 0 Then lgPos = Len(mstString) + 1
' Insertion du nouveau mot à la place de l'ancien.
  mstString = Left$(mstString, lgOld - 1) & vData & Right$(mstString, Len(mstString) - lgPos + 1)
 
End If
End If
End Property

Public Function
Filtre(stFiltre As String) As SString
' Cette fonction filtre la chaîne. Tous les caractères
' qui ne sont pas présents dans stFiltre sont enlevés.
Dim lgPos As Long, lgLen As Long
Dim
ssTMP As New SString
If stFiltre <> vbNullString Then
  lgLen = Len(mstString)
  lgPos = 1
  ssTMP = mstString
 
Do While lgPos <= lgLen
' Teste si le caractère courant fait partie du filtre.
  If InStr(stFiltre, Mid$(ssTMP, lgPos, 1)) <> 0 Then
  lgPos = lgPos + 1
 
Else
' Réduction de la chaîne.
  ssTMP = Left$(ssTMP, lgPos - 1) & Right$(ssTMP, lgLen - lgPos)
' La longueur est diminuée.
  lgLen = lgLen - 1
 
End If
  Loop
Else
  ssTMP = vbNullString
End If
Set
Filtre = ssTMP
End Function

Public Function
Insere(lgPosition As Long, stSeparateur As String, _
                       stMot
As String) As SString
' Insère un nouveau dans la chaîne, à la position indiquée.
' Si la position indiquée est plus grande que le nombre de mot,
' le mot à insérer est mis à la fin.
' Cette fonction n'est réellement qu'à utilisé dans le cadre d'une
' insertion à l'intérieure de la chaîne, pour l'ajout au début ou à la
' fin, il est plus rapide de le faire soi-même.
Dim lgOld As Long, lgPos As Long, lgNb As Long
Dim
ssTMP As New SString
If (lgPosition < 1) Then
  ssTMP = vbNullString
ElseIf lgPosition < 2 Then
  ssTMP = stMot & stSeparateur & mstString
ElseIf lgPosition > Me.NbMot(stSeparateur) Then
  ssTMP = mstString & stSeparateur & stMot
Else
  lgOld = 0
  lgPos = 0
  lgNb = 0
 
Do
' Parcours de tous les mots délimités par le séparateur.
  If lgOld = 0 Then lgOld = 1 Else lgOld = lgPos + Len(stSeparateur)
  lgPos = InStr(lgOld, mstString, stSeparateur)
  lgNb = lgNb + 1
 
Loop Until (lgNb >= lgPosition)
 
If lgPos = 0 Then lgPos = Len(mstString) + 1
' Insertion du nouveau mot à la place de l'ancien.
  ssTMP = Left$(mstString, lgOld - 1) & stMot & stSeparateur & _
                Mid$(mstString, lgOld, Len(mstString) - lgOld + 1)
End If
Set
Insere = ssTMP
End Function
Visual Basic Research Center - (c) 2000/2002 -  Webmaster : docvb (chez) free (point) fr