Salut les mecs !

Juste pour vous secouer un peu le cerveau, je vous envoi quelques fonctions de 
manipulation et tripatouillage de tableaux array (qui seront totalement 
inutiles pour les non utilisateurs du VB6), mais que j'ai pris beaucoup de 
plaisir à coder.

D'abord les prototypes:

function Explode(s, separator)
' décompose du texte dans un tableau
' suivant un séparateur.
' évite les erreurs de la fonctions split

Function SortArray(tbl, blAsc)
' Tri un tableau
' suivant un ordre croissant ou décroissant.

Function IsPresentInArray(tbl, search, blExactly)
' Détermine si un élément est présent dans un tableau
' et renvoi le nombre d'occurences trouvées.

function ConcatArrays(tbl1, tbl2)
' concatène deux tableaux

Function InsertInArray(tbl, s, index)
' Insère un élément dans un tableau
' à une position donnée.

function RemoveFromArray(tbl, index)
' retire un élément du tableau par son index.

Très intéressant n'est-ce pas ? Quoi que tout ce qui n'est pas du vb6 a déja 
des fonctions intégrées qui font plus ou moins ces travaux.
On va se dire que cette recréation de roue va nous servir à savoir comment ça 
marche.

Voici les fonctions en entier

Début du code vb


function Explode(s, separator)
' décompose du texte dans un tableau
' suivant un séparateur.
dim i: i = 0
dim tbl: tbl = array()
on error resume next
if InStr(s, separator) > 0 then
tbl = split(s, separator)
else ' séparateur non trouvé
redim tbl(0): tbl(0) = s
end if
Explode = tbl
end function

Function IsPresentInArray(tbl, search, blExactly)
' Détermine si un élément est présent dans un tableau
' et renvoi le nombre d'occurences trouvées.
dim i: i = 0
dim iNb: iNb = 0
on error resume next
for i = 0 to ubound(tbl)
if blExactly = true then ' recherche d'exactitude
if StrComp(tbl(i), search, vbTextCompare) = 0 then iNb = iNb+1
else ' recherche approximative
if InStr(1, tbl(i), search, vbTextCompare) > 0 then iNb = iNb+1
end if
next
IsPresentInArray = iNb
end function

Function SortArray(tbl, blAsc)
' Tri un tableau
' suivant un ordre croissant ou décroissant.
dim i: i = -1
dim flag: flag = true
dim tmp
on error resume next
' détermination si suffisamment d'éléments dans le tableau
i = ubound(tbl)
if i < 1 then
SortArray = tbl
exit function
end if
' parcours
while(flag = true)
flag = false
for i = 1 to ubound(tbl)
if (tbl(i) < tbl(i-1) and blAsc = true) _
or (tbl(i) > tbl(i-1) and blAsc = false) then
tmp = tbl(i)
tbl(i) = tbl(i-1)
tbl(i-1) = tmp
flag = true
end if
next
Wend
SortArray = tbl
end function

function ConcatArrays(tbl1, tbl2)
' concatène deux tableaux
dim i: i = 0
dim j: j = -1
dim i1: i1 = -1
dim i2: i2 = -1
dim tbl: tbl = array()
on error resume next
' dimensionnement du tableau de destination
i1 = ubound(tbl1)
i2 = ubound(tbl2)
j = i1+i2+1
redim tbl(j)
'
j = -1
' tableau 1
for i = 0 to ubound(tbl1)
j = j+1
tbl(j) = tbl1(i)
next
' tableau 2
for i = 0 to ubound(tbl2)
j = j+1
tbl(j) = tbl2(i)
next
ConcatArrays = tbl
end function

Function InsertInArray(tbl, s, index)
' Insère un élément dans un tableau
' à une position donnée.
dim i: i = -1
on error resume next
' on augmente la taille du tableau
i = ubound(tbl)
i = i+1
redim preserve tbl(i)
' si instruction d'insertion à la fin
if index <= -1 then
index = i
elseIf index > i then
index = i
end if
' déplacement progressif des éléments 
' à partir de la fin
' jusqu'à l'index.
for i = ubound(tbl) to index+1 step -1
tbl(i) = tbl(i-1)
next
' insertion à l'emplacement dégagé
tbl(index) = s
' renvoi
InsertInArray = tbl
end function

function RemoveFromArray(tbl, index)
' retire un élément du tableau par son index.
dim i: i = -1
dim iNb: iNb = -1
on error resume next
iNb = ubound(tbl)
if index <= -1 then index = iNb
if iNb >= 0 _
and index >= 0 _
and index <= iNB then
for i = index+1 to ubound(tbl)
tbl(i-1) = tbl(i)
next
' réduction de la taille du tableau
if iNb > 0 then
redim preserve tbl(iNb-1)
else
erase tbl
end if
end if ' fin si des éléments
RemoveFromArray = tbl
end function

Fin du code vb

Puisse cela intéresser quelqu'un !

Yannick Daniel Youalé
La programmation est une religion. Aimez-la, ou quittez-la.
Mon site: www.visuweb.net

Répondre à