Code - Visual Basic Research Center

~ 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 ~

~ Partenaires ~

Retour à la liste des fonctions

Classe : SString
Classe qui étend les caractéristiques du type standard String par l'ajout de nouvelles méthodes.
(Consulté 25739 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

Retour à la liste des fonctions