TUTORIEL OPTIMISATIONS AVANCÉES

'OptCode

'tuto pour les fous

'Ces optimisations sont sensible lorsque le code est compilé.
'Il est probable qu'en mode interprété, les "Après" soit plus lent que "Avant"

'Pas de copyright (et puis quoi encore ! :p )



' ====== DEFS ======

DefLng A-Z
    'DefType : Au lieu de faire Dim i As Long, j As Long, ...
    '... il suffra de faire Dim i, j

Option Base 1
    'ReDim MonTablo(1 to MaVal) pourra être écrit ...
    'ReDim MonTablo(MaVal)
    
Option Explicit
    'Obligation de faire des "Dim" pour chaque variable ...
    'Evitant ainsi d'utiliser le type Variant, très lent!

Option Compare Binary
    'La Comparaison binaire est la plus rapide.
    'S'utilise avec InStr(), InStrRev(), Replace() ...

Option Private Module
    'Tout les subs, functions et declares sont sous-entendu "Private"





' ====== TESTS ======

'Avant
If b = 27 Then
    a = True
Else
    a = False
End If

'Après
Dim a As Boolean
a = (b = 27)




'Avant
If b = 27 And g < 50 Or (c * b > 250) Then
    a = True
Else
    a = False
End If

'Après
Dim a As Boolean
a = (b = 27 And g < 50 Or (c * b > 250))




'Avant
If b >= 0 And b < 255 Then
    a = 32767
End If

'Après (à utilisé avec précaution)
If (b And 255) = b Then
    a = 32767
End If



'Avant
For i = 1 To 5000
    If i > 4000 Then
        a = a + 2
    Else
        a = a + 1
    End If
Next i

'Après (le test qui sera "True" le plus souvent dois être le premier, si possible)
For i = 1 To 5000
    If i <= 4000 Then
        a = a + 1
    Else
        a = a + 2
    End If
Next i


'RAPPEL :
' - au niveau assembleur, les opérations booléennes se font en 1 instruction
'   c'est donc très rapide, plus rapide que les tests.
'   Mais pour profiter de cette rapidité, il faut compiler le programme!
' - l'instruction GOTO est très performante, converti en assembleur!





' ====== TEXTES ======

'Avant
g$ = Left(Trim(Str$))

'Après
Dim g As String
g = Left$(Trim$(Str$))



'Avant
For i = 1 To 100
    txt$ = txt$ & "toto"
Next i

'Après (si on connais la longeur finale de txt$)
txt$ = Space$(Len("toto") * 100)
For i = 1 To 400 Step 4
    Mid$(txt$, i, 4) = "toto"
Next i



'Avant
t = InStr(1, g$, "toto", vbTextCompare)

'Après
t = InStr(1, g$, "toto", vbBinaryCompare)

'Encore Après
Option Compare Binary
Dim t As Long
t = InStr(1, g$, "toto", -1) 'vbUseCompareOption


'RAPPEL :
' - certaines fonctions de manipulation de chaine existe en mode binaire.
'   LeftB(), RightB(), MidB(), InStrB()
'   Sachant que les chaines String$ sont sur 2 octets (unicode), cela peut
'   être utile lorsque on manipule la mémoire via pointeur plutôt que la
'   valeur... (comprenne qui pourra!)
' - Avant de coder une fonction de manipulation de chaine, vérifiez qu'elle
'   n'existe pas déjà!
'   Space$(),String$(),Trim$(),LTrim$(),RTrim$(),LSet,Rset
'   StrComp(),InStrRev(),Replace(),Split(),Filter(),StrConv(),StrReverse()





' ====== OBJETS ======

'Avant
Dim Bvv As New MaClasseQueJaiFait
Bvv.Init
Bvv.Param1 = 254
Bvv.Param2 = "toto"

'Après
Dim Bvv As New MaClasseQueJaiFait
With Bvv
    .Init
    .Param1 = 254
    .Param2 = "toto"
End With



'Avant
For i = 1 To Len(Text1.Text)
    g$ = g$ & Mid$(Text1.Text, i, Len(Text1.Text) - i + 1)
Next i

'Après (version 1)
Dim i As Long, l As Long, tx1 As String
tx1 = Text1.Text
l = Len(tx1)
For i = 1 To l
    g$ = g$ & Mid$(tx1, i, l - i + 1)
Next i

'Après (version 2)
Dim i As Long
With Text1
    For i = 1 To Len(.Text)
        g$ = g$ & Mid$(.Text, i, Len(.Text) - i + 1)
    Next i
End With



'Avant
Dim MaCollection() As MaClasseTruc
'[...]
For i = 1 To UBound(MaCollection())
    MaCollection(i).Truc = Machin
    MaCollection(i).FonctionBidule Param1
    If MaCollection(i).Tata = True Or MaCollection(i).Titi = True Then
        MaCollection(i).VazyGo
    End If
Next i

'Après
Dim MaCollection() As MaClasseTruc
'[...]
For i = 1 To UBound(MaCollection())
    With MaCollection(i)
    .Truc = Machin
    .FonctionBidule Param1
    If .Tata = True Or .Titi = True Then
        .VazyGo
    End If
    End With
Next i



'Avant
Dim Momo As MaClasseIci
Dim Mimi As MaClasseParam
'[...]
If Momo.Totoz(Mimi.Valeur(Index1)) = 1 Then
    Call FonctionQuiGere(Momo.Totoz(Mimi.Valeur(Index1)))
End If

'Après
Dim Momo As MaClasseIci
Dim Mimi As MaClasseParam
'[...]
Dim MaVal As Long
MaVal = Momo.Totoz(Mimi.Valeur(Index1))
If MaVal = 1 Then
    Call FonctionQuiGere(MaVal)
End If


' RAPPEL :
' - appeler une variable ou une fonction d'un objet oblige a appelé
'   un gestionnaire d'objets (c'est lent)
' - mieux vaux utiliser un maximum de modules / un minimum d'objets
'   ou encore un objet avec beaucoup de fonctions Private, le rendant autonome
' - les OCX sont des objets encore plus lent que des classes, car externe au projet.
' - DirectX et ses affiliés sont des objets, et s'optimise très bien avec ces astuces.





' ====== ALGOS DIVERS ======


Sub DecomposeRGB(Couleur As Long)
    'Avant (maths)
    cb = Int(Couleur / 65536)
    cg = Int((Couleur - cb * 65536) / 256)
    cr = Couleur - cg * 256 - cb * 65536

    'Après (bitmask)
    cb = Couleur And 255&
    cg = (Couleur And &HFF00&) / 256&
    cr = (Couleur And &HFF0000) / &H10000
End Sub



'Avant
For i = 1 To 150000

Next i

'Après (vitesse a vérifier en benchmark post-compilatoire : varie selon l'algo)
Dim i As Long
i = 1
Do While i <= 150000

i = i + 1
Loop
' nota : très utile lorsque vous devez imbriquer des boucles.


'Avant
Sub Wait(Duree As Single)
    t1 = Timer + Duree
    Do While Timer < t1
    Loop
End Sub

'Après (selon besoins de préçision)
Declare Sub Sleep Lib "kernel32" (ByVal DureeMS As Long)
Sub Wait2(Duree As Single)
Dim t1 As Single
    t1 = Timer + Duree
    Do While Timer < t1
        DoEvents  '<= evite de bloquer le système
        Sleep 1&  '<= libère le CPU pendant 1 milliseconde (évite de chauffer)
    Loop
End Sub



'Avant
For i = 1 To 10000
    t = t + i * Sqr(5)
Next i

'Après (précalcul)
sq = Sqr(5)
For i = 1 To 10000
    t = t + i * sq
Next i



'Avant (on peut remplacé lbound() par 1 si on connais le plus petit index de la liste)
Dim MaListe() As Long
Dim MaCopie() As Long
'[...]
ReDim MaCopie(LBound(MaListe()) To UBound(MaListe()))
For i = LBound(MaListe()) To UBound(MaListe())
    MaCopie(i) = MaListe(i)
Next i

'Après (on est pas limité par le type de la destination)
Declare Sub RtlMoveMemory Lib "kernel32" (ByRef Destination As Any, ByRef Origine As Any, ByVal Longueur As Long)
Dim MaListe() As Long
Dim MaCopie() As Long
'[...]
Dim l As Long
l = UBound(MaListe()) - LBound(MaListe()) + 1
ReDim MaCopie(1 To l)
RtlMoveMemory MaCopie(1), MaListe(LBound(MaListe())), l * 4  '4 octets par entrée


'RAPPEL :
' - Précalculez les valeurs avant les boucles si c'est possible
' - L'utilisation du masque de bits fait parti des astuces de
'   programmation impossible a réaliser avec des mathématiques
' - l'API RtlMoveMemorty permet de faire des manipulations de
'   données en mémoire, c'est un outil puissant qui fait défaut
'   à VB alors qu'il existe dans les autres langages (memcpy en C)
' - la fonction vb VarPtr() couplé à l'API su-cité permet de
'   compensé l'absence de pointeur (comme en C)!






' ====== FONCTIONS VB6 PEU UTILISEES ======

'Pour récupérer le dossier temporaire de windows, le dossier système, ...
'peut varié selon l'OS utilisé (win98, win2k, ...)
DossierTemp$ = Environ("TMP")
DossierTemp$ = Environ("TEMP")
ExePathDefault$ = Environ("PATH")
DossierWin$ = Environ("WINDIR")



'Connaitre le type d'une variable (débogage)
MonType$ = TypeName(MaVar)



'Arrondi au nombre de décimal souhaité
MaValInt2 = Round(MaValPrecise, 2)



'Gestion d'erreur
'Classique :
Sub MaFunc()
On Error Resume Next 'ignore l'erreur
End Sub

Sub MaFunc2()
'Approfondi :
On Error GoTo Gere
'[...]
Exit Sub
Gere:
    'gestion
Resume 'retourne a la ligne source d'erreur
End Sub

'RAPPEL : il vaux mieux faire des tests pour éviter les erreurs plutôt que de laissé On Error gérer l'erreur



'Fonction dans une fonction
'L'interêt est qu'appelé (Call) une fonction est plus lent que faire un GOTO
Sub Truc()
'[...]
GoSub algotemp
'[...]
Exit Sub
algotemp:
    '[...]
Return
End Sub



'E/S Fichier
'vous connaissiez :
Close
'pour fermer tout les fichiers ouvert ?
'il existe également :
Reset
'Qui... fait pareil :)



'Utiliser un masque pour comparer des chaines de caractères
b = (MaChaine Like MonMasque)
'autre écriture autorisé :
If MaChaine Like MonMasque Then
'démo :
MaChaine$ = "pomme": Masque$ = "p?m*"
'alors b = True ...







' ====== ASTUCE ======

'Affichage de l'état / progression d'une fonction
'Avant
For i = 1 To 10000
    Label1.Caption = Format$(i / 100, "#0") & "%"
    DoEvents
    Call SubMachin(UnTruc(i))
Next i

'Après
For i = 1 To 10000
    If i Mod 100 = 0 Then
        Label1.Caption = Format$(i / 100, "#0") & "%"
        DoEvents
    End If
    Call SubMachin(UnTruc(i))
Next i
'nota : on évite de rafraichir en permanence l'affichage, ce qui gaspille BEAUCOUP de temps-machine
'dans l'exemple "après", on le rafraichit toutes les 100 itérations