Module vb5 -> vb6

Description

Malgrès son titre (modVB6.bas), c'est au utilisateur de VB5 qu'il est adressé. Il ajoute quelques fonctions bien pratique à VB5 empreintées à VB6. Celle-ci sont :

- InstRev (de moi, déjà poster en fait, méthode bourrine et à la con [;p] )
- Round (de moi, tirer par les cheveux celle-la, nan ?)
- Replace (pas de moi)
- Split (pas de moi sur la base, mais maintenant, ouais [:)] )

Ce qui permet de faire facilement les opérations suivantes :

- Editer sans trop de difficultés le travail d'un autre travaillant sous VB6.
- Utiliser ses fonctions dans vos projets, même si je ne garantis pas l'optimisation de celle-ci.

Il manquerait FormatDateTime, mais elle est généralement peu usitée et il est quasiment plus comode d'utiliser Format("hh:nn:ss"). Je vous conseille par ailleurs de faire un tour dans l'aide sur cette fonction. C'est incroyable comme elle est puissante.

Rq qur l'utilisation de Split : Il n'y pas d'affectation directe au tableau (MArray = Split(ARG)). Je ne cois pas que ce soit possible en VB5 et pour tout vous dire, j'ai pas vraiment cherché. L'utilisation d'un array Public (Splt) me convient amplement.

Source / Exemple :


'> Split Function
Public SpltT() As String
Public Sub Splt(TMsg As String, TCar As String)

'----- Déclaration des variables locales
    Dim Ind As Long
    ReDim SpltT(0)
    
'----- Boucle de calcul
    If Right(TMsg, 1) = TCar Then TMsg = Left(TMsg, Len(TMsg) - 1)
    Do
        SpltT(UBound(SpltT)) = Mid(TMsg, Ind + 1, IIf(InStr(Ind + 1, TMsg, TCar) <> 0, _
        InStr(Ind + 1, TMsg, TCar) - Ind - 1, Len(TMsg)))
        Ind = InStr(Ind + 1, TMsg, TCar)
        ReDim Preserve SpltT(UBound(SpltT) + 1)
        DoEvents
    Loop While Ind <> 0

End Sub
'-----// Fin du code

Public Function Round#(Number#, NbreDec%)

Round = IIf(Number * 10 ^ NbreDec - Fix(Number * 10 ^ NbreDec) >= 0.5, _
Sgn(Number) * Abs(Int(-1 * Abs(Number * 10 ^ NbreDec))) / 10 ^ NbreDec, _
Sgn(Number) * Abs(Fix(-1 * Abs(Number * 10 ^ NbreDec))) / 10 ^ NbreDec)

End Function

Public Function InStrRev(MyStr As String, SearchStr As String, Optional MStart As Long, Optional Compare As VbCompareMethod) As Long
'Les p'tites variables
Dim RStr As String
Dim RSearchStr As String

'Inversion des chaînes, et oui, C kon, mé ca marche !
For I = Len(MyStr) - MStart To 1 Step -1
RStr = RStr + Mid(MyStr, I, 1)
Next
For I = Len(SearchStr) To 1 Step -1
RSearchStr = RSearchStr + Mid(SearchStr, I, 1)
Next

'Et un petit InStr classique pour finir
'--
'Le +2 est la pour paré les effets du Instr qui donne le N° caractère et non sa place
'Si vous faites InStr("TEST","TEST"), la valeur retournée sera 1...
'--
'Le reste, je pense, va de soi
'--
'pour tester le code, faites un TextBox et un CommandButton
'Dans l'Event Click du CommandButton, inscrivez
'Me.Caption = Mid(Text1.Text, InStrRev(Text1.Text, "TEST"), Len("TEST"))
'Vous verez, ca marche
InStrRev = Len(MyStr) - InStr(RStr, RSearchStr, Compare) + 2 - Len(SearchStr) - MStart
End Function

Public Function Replace(ByVal Expression As String, ByVal Trouver As String, ByVal Remplacement As String, Optional ByVal Start As Long = 1, Optional ByVal Count As Long = -1, Optional ByVal Compare As VbCompareMethod = vbBinaryCompare) As String
    '
    ' Tente de reproduire le plus fidèlement possible
    ' la fonction Replace de VB6
    '
    ' Expression     : La chaine à traiter
    ' Trouver            : L'expression ou caractère à remplacer
    ' Remplacement : L'expression ou caractère de remplacement, peux être vide
    ' Start                : Le caractère à partir duquel commencer le remplacement, défaut : 1, soit début de la chaine
    ' Count                : Le nombre de remplacement à effectuer, défaut : -1, soit illimité
    '
    Dim iPos1 As Integer            'Position où commence "Trouver"
    Dim iLngExp As Integer      'Longueur de "Expression"
    Dim iLngTrv As Integer      'Longueur de "Trouver"
    Dim iDnrPos1 As Integer  'Dernière position relevée

    'Préparations et vérifications de limites
    Replace = vbNullString
    If ((LenB(Expression) = 0) Or ((LenB(Expression) / 2) > 32767)) Then
            Err.Raise vbObjectError + 1, App.Title & ".Replace", "Le paramètre [Expression] est vide ou dépasse 32767 caractères."
            Exit Function
        Else
            iLngExp = Int(LenB(Expression) / 2)
    End If
    If ((LenB(Trouver) = 0) Or ((LenB(Trouver) / 2) > 32767)) Then
            Err.Raise vbObjectError + 2, "Replace", "Le paramètre [Trouver] est vide ou dépasse 32767 caractères."
            Exit Function
        Else
            iLngTrv = Int(LenB(Trouver) / 2)
    End If
    'If ((LenB(Remplacement) = 0) Or ((LenB(Remplacement) / 2) > 32767)) Then
    If ((LenB(Remplacement) / 2) > 32767) Then
            'On permet que "Remplacement" soit vide
            Err.Raise vbObjectError + 3, "Replace", "Le paramètre [Remplacement] est vide ou dépasse 32767 caractères."
            Exit Function
        'Else
    End If
    If ((Start < 1) Or (Start > (iLngExp - 1))) Then
            Err.Raise vbObjectError + 4, "Replace", "La valeur du paramètre [Start] est sous 0 ou dépasse la longueur de [Expression]."
            Exit Function
        'Else
    End If
    If (Count > (iLngExp - 1)) Then
            Err.Raise vbObjectError + 5, "Replace", "La valeur du paramètre [Count] dépasse la longueur de [Expression]."
        Else
            If (Count < 0) Then
                    Count = iLngExp + 1 'Illimité
                Else
                    If (Count = 0) Then Count = 1
            End If
    End If
    If (Compare = vbDatabaseCompare) Then
            Err.Raise vbObjectError + 6, "Replace", "Database Compare non supporté..."
            'Compare = vbBinaryCompare
            Exit Function
        'Else
    End If

    'Prendre le début si Start <> 1
    If (Start > 1) Then
            Replace = Left$(Expression, Start - 1)
        'Else
    End If

    'Remplacement...
    iDnrPos1 = Start
    Do
        iPos1 = InStr(iDnrPos1, Expression, Trouver, Compare)
        If (iPos1 > 0) Then
                Replace = Replace & Mid$(Expression, iDnrPos1, iPos1 - iDnrPos1)
                Replace = Replace & Remplacement
                iDnrPos1 = iPos1 + iLngTrv
                Count = Count - 1
            Else
                Replace = Replace & Mid$(Expression, iDnrPos1, iLngExp - iDnrPos1 + 1)
                iDnrPos1 = iLngExp + 1
        End If
    Loop Until ((iDnrPos1 > iLngExp) Or (Count <= 0))

    'Ramasser les miettes si Count <> -1
    If (iDnrPos1 <= iLngExp) Then
            Replace = Replace & Mid$(Expression, iDnrPos1, iLngExp - iDnrPos1 + 1)
        'Else
    End If
End Function

Conclusion :


Je n'est pas verifié autrement qu'avec ma compil' si il existe d'autres modules du genre. Je vous prie de m'excuser si tel est le cas.

A ce propos, Nix, je sait que tu es surbooké, mais si (on ne sait jamais) tu pouvais autorisés le téléchargement des Compil' par des programmes tel que FlashGet ou GetRight, ca serait sympa. (et ouais! on a pas tous l'adsl. Faudrait que je regarde, ya peut-être des fonctions d'anonymizing dessus...).

Si quelqu'un a de nouvelles fonctions ajouter, bheu... contactez-moi quoi...

Et puis une dernière chose, ce module est n'est pas 'fini' (et n'est pas destiné à l'être). Je ne sais trop comment le dire mais, il n'y a pas de gestion d'erreur, rien d'optimisé. Il me permet d'utiliser des fonctions bien utiles, je le mets à votre disposition pour VOUS, si ca peut vous etre utile et parce que ca serait bête de garder ca pour moi (je trouve qu'il a un intérêt quand même). Je vous demande juste de pas venir en râlant avec vos gros sabots en disant "Comment on peut ce dire programmeur en envoyant un module à moitié fini, en plus c'est meme pas comme ca qu'elle fonctionne Round." (je raconte pas un peu ma vie la nan ????). Cependant, j'accepte toutes les remarques constructives et les améliorations que vous pourriez apporter.
Si ca interesse vraiment du monde, alors je ferais les vraies fonctions (au maximum) de VB6, avec des gestions d'erreurs et tout...

Voila ! ca va ? ca vous a pas trop fait chié de lire tout le spitch que j'ai pondu ? (souriez quand même :D )

Codes Sources

A voir également

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.