Voici quelques codes générique que j'utilise dans tous mes développements et qui me servent régulièrement dans du calcul mathématique ou de traitement de chaine de caractères :
'---------------------------------------------------------------------------
' Point en 3D
'---------------------------------------------------------------------------
Public Type Point3
X As Double
Y As Double
Z As Double
End Type
'Longueur de vecteur
Function Longueur(ByRef P1 As Point3) As Double
Longueur = Sqr((P1.X ^ 2) + (P1.Y ^ 2) + (P1.Z ^ 2))
End Function
'Distance entre 2 points
Function Distance(ByRef P1 As Point3, ByRef P2 As Point3) As Double
Distance = Sqr((P2.X - P1.X) ^ 2 + (P2.Y - P1.Y) ^ 2 + (P2.Z - P1.Z) ^ 2)
End Function
'Addition de vecteur
Function VecAdd(ByRef P1 As Point3, ByRef P2 As Point3, Optional F As Double = 1) As Point3
VecAdd.X = P1.X + F * P2.X
VecAdd.Y = P1.Y + F * P2.Y
VecAdd.Z = P1.Z + F * P2.Z
End Function
'Produit Scalaire
Function Dot(ByRef p As Point3, ByRef Q As Point3) As Double
Dot = p.X * Q.X + p.Y * Q.Y + p.Z * Q.Z
End Function
'Soustraction de point
Function SubVect(ByRef P1 As Point3, ByRef P2 As Point3, ByRef F As Double) As Point3
SubVect.X = P1.X - P2.X * F
SubVect.Y = P1.Y - P2.Y * F
SubVect.Z = P1.Z - P2.Z * F
End Function
'Produit vectoriel
Function VecProd(ByRef P1 As Point3, ByRef P2 As Point3) As Point3
Dim P4 As Point3
P4.X = (P1.Y * P2.Z) - (P1.Z * P2.Y)
P4.Y = (P1.Z * P2.X) - (P1.X * P2.Z)
P4.Z = (P1.X * P2.Y) - (P1.Y * P2.X)
VecProd = P4
End Function
' Soustraction de vecteur
Function VecSub(ByRef P1 As Point3, ByRef P2 As Point3, Optional t As Double = 1) As Point3
VecSub.X = P1.X - t * P2.X
VecSub.Y = P1.Y - t * P2.Y
VecSub.Z = P1.Z - t * P2.Z
End Function
'Récupération du vecteur normal de 3 points
Function NormVec(ByRef P1 As Point3, ByRef P2 As Point3, ByRef P3 As Point3) As Point3
NormVec = VecteurUnitaire(VecProd(VecSub(P1, P2), VecSub(P3, P2)))
End Function
' Transforme un vecteur en vecteur unitaire
Function VecteurUnitaire(ByRef P1 As Point3) As Point3
Dim Norm As Double
Norm = Sqr(P1.X * P1.X + P1.Y * P1.Y + P1.Z * P1.Z)
If Norm = 0 Then
Exit Function
End If
VecteurUnitaire.X = P1.X / Norm
VecteurUnitaire.Y = P1.Y / Norm
VecteurUnitaire.Z = P1.Z / Norm
End Function
' Coordonnées du point Milieu
Function PointMilieu(ByRef P1 As Point3, ByRef P2 As Point3) As Point3
PointMilieu.X = 0.5 * (P1.X + P2.X)
PointMilieu.Y = 0.5 * (P1.Y + P2.Y)
PointMilieu.Z = 0.5 * (P1.Z + P2.Z)
End Function
'****************************************************************
' Name: Round
'
' Inputs:DP is the decimal place to round to (0 to 14) e.g
' Round (3.56376, 3) will give the result 3.564
' Round (3.56376, 1) will give the result 3.6
' Round (3.56376, 0) will give the result 4
' Round (3.56376, 2) will give the result 3.56
' Round (1.4999, 3) will give the result 1.5
' Round (1.4899, 2) will give the result 1.49
' Returns:None
' Assumes:None
' Side Effects:None
'
'****************************************************************
Function Round(X1 As Double, DP As Integer) As Double
Round = Int((X1 * 10 ^ DP) + 0.5) / 10 ^ DP
End Function
'****************************************************************
' Name: A 'strtok' function for VB
' Description:I wrote four functions to tokenize strings. He
' re they are...
'The functions work like this TokLeftLeft finds the leftmost token and
'then returns the left part of the string (empty if not there). You
'can figure out the rest. Note that if the token is more than 1 character
'then the function will always return "".
'****************************************************************
Public Function TokLeftLeft(ByRef Source As String, ByRef token As String) As String
Dim I As Integer
TokLeftLeft = Source
For I = 1 To Len(Source)
If Mid(Source, I, 1) = token Then
TokLeftLeft = Left(Source, I - 1)
Exit Function
End If
Next I
End Function
Public Function TokLeftRight(ByRef Source As String, ByRef token As String) As String
Dim I As Integer
TokLeftRight = Source
For I = 1 To Len(Source)
If Mid(Source, I, 1) = token Then
TokLeftRight = Right(Source, Len(Source) - I)
Exit Function
End If
Next I
End Function
Public Function TokRightLeft(ByRef Source As String, ByRef token As String) As String
Dim I As Integer
TokRightLeft = ""
For I = Len(Source) To 1 Step -1
If Mid(Source, I, 1) = token Then
TokRightLeft = Left(Source, I - 1)
Exit Function
End If
Next I
End Function
Public Function TokRightRight(ByRef Source As String, ByRef token As String) As String
Dim I As Integer
TokRightRight = ""
For I = Len(Source) To 1 Step -1
If Mid(Source, I, 1) = token Then
TokRightRight = Right(Source, Len(Source) - I)
Exit Function
End If
Next I
End Function