0/5 (6 avis)
Vue 7 084 fois - Téléchargée 995 fois
Option Explicit Dim tabX(0 To 1000) As Single Dim tabY(0 To 1000) As Single Dim modX(0 To 1000) As Single Dim modY(0 To 1000) As Single Dim n As Integer Dim maxN As Integer Dim modN As Integer Private Sub Compare() Dim i As Integer Dim j As Integer Dim lastJ As Integer Dim dX As Single Dim dY As Single Dim delta As Double Dim nb As Integer Me.Refresh Call DisplayAll dX = modX(0) - tabX(0) dY = modY(0) - tabY(0) delta = 0 lastJ = 0 nb = 0 For i = 1 To modN j = CInt(i / modN * maxN) delta = delta + Sqr((modX(i) - tabX(j) - dX) ^ 2 + (modY(i) - tabY(j) - dY) ^ 2) lastJ = j Next i lblinfo.Caption = "Erreur = " & Format(delta / modN, "#.0000") End Sub Private Sub DisplayAll() Dim i As Integer Dim dX As Single Dim dY As Single dX = modX(0) - tabX(0) dY = modY(0) - tabY(0) i = 1 While modX(i) > 0 Me.Line (modX(i - 1), modY(i - 1))-(modX(i), modY(i)), vbGreen i = i + 1 Wend i = 1 While tabX(i) > 0 Me.Line (tabX(i - 1) + dX, tabY(i - 1) + dY)-(tabX(i) + dX, tabY(i) + dY), vbGrayed i = i + 1 Wend End Sub Private Sub Display() Dim i As Integer i = 1 While tabX(i) > 0 Me.Line (tabX(i - 1), tabY(i - 1))-(tabX(i), tabY(i)), vbGrayed i = i + 1 Wend maxN = i lblinfo.Caption = maxN & " sur " & modN End Sub Private Sub SetAsModel() Dim i As Integer i = 0 modN = maxN For i = 0 To 1000 modX(i) = tabX(i) modY(i) = tabY(i) Next i lblinfo.Caption = "Modèle sauvé..." End Sub Private Sub Reset() Dim i As Integer For i = 0 To 1000 tabX(i) = 0 tabY(i) = 0 Next i Me.Refresh End Sub Private Sub Command1_Click() Call Reset End Sub Private Sub Command2_Click() Call SetAsModel End Sub Private Sub Command3_Click() Call Compare End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 1 Then If n < 1000 Then Call Me.PSet(0, X, Y, vbBlack) tabX(n) = X tabY(n) = Y n = n + 1 End If Else If n > 0 Then Call Display n = 0 End If End If End Sub
23 août 2003 à 10:19
20 août 2003 à 23:39
@+
20 août 2003 à 17:00
http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=42632&lngWId=1
19 août 2003 à 21:04
19 août 2003 à 19:22
Bref, cette méthode a ses limites...
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.