Reconnaissance de caractères à partir d'un tracé souris

Télécharger le projet
Commenter

Description

Ce petit exemple montre comment on peut se lancer de facon simple dans la
reconnaissance de forme : il s'agit ici de tracer une forme ou une lettre à la souris puis de la sauver en tant que modèle.
Ensuite, on essaie de la reproduire avec la souris et la touche "GO" vous calcul la marge d'erreur avec l'original.

Une des applications directes pourrait etre de remplacer le senpiternel mot de passe par une signature souris !

Ci-joint une capture d'écran avec un exemple sur la lettre e + les sources.

email : joshrbz@yahoo.fr

Source / Exemple : 


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
Télécharger le projet

Codes Sources

A voir également

Du même auteur (joshrbz)