form1.frm

finger print compare software for free to use

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "comctl32.ocx"
Begin VB.Form Form1 
   Caption         =   "Fingerprints"
   ClientHeight    =   4170
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5040
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   278
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   336
   StartUpPosition =   3  'Windows Default
   Begin ComctlLib.StatusBar SB1 
      Align           =   2  'Align Bottom
      Height          =   255
      Left            =   0
      TabIndex        =   6
      Top             =   3915
      Width           =   5040
      _ExtentX        =   8890
      _ExtentY        =   450
      SimpleText      =   ""
      _Version        =   327682
      BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7} 
         NumPanels       =   2
         BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7} 
            Object.Width           =   3334
            MinWidth        =   3334
            Key             =   ""
            Object.Tag             =   ""
         EndProperty
         BeginProperty Panel2 {0713E89F-850A-101B-AFC0-4210102A8DA7} 
            Key             =   ""
            Object.Tag             =   ""
         EndProperty
      EndProperty
   End
   Begin VB.CommandButton cmdLoad2 
      Caption         =   "Load"
      Height          =   255
      Left            =   2520
      TabIndex        =   5
      Top             =   3120
      Width           =   2415
   End
   Begin VB.PictureBox pic2 
      AutoRedraw      =   -1  'True
      Height          =   3015
      Left            =   2520
      ScaleHeight     =   197
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   157
      TabIndex        =   4
      Top             =   120
      Width           =   2415
   End
   Begin VB.CommandButton cmdFind 
      Caption         =   "Find && Compare Prints"
      Height          =   375
      Left            =   960
      TabIndex        =   3
      Top             =   3480
      Width           =   2895
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   4200
      Top             =   3840
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.TextBox Text1 
      Height          =   285
      Left            =   4440
      TabIndex        =   2
      Top             =   4440
      Width           =   1335
   End
   Begin VB.CommandButton cmdLoad 
      Caption         =   "Load"
      Height          =   255
      Left            =   120
      TabIndex        =   1
      Top             =   3120
      Width           =   2415
   End
   Begin VB.PictureBox pic1 
      AutoRedraw      =   -1  'True
      Height          =   3015
      Left            =   120
      ScaleHeight     =   197
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   157
      TabIndex        =   0
      Top             =   120
      Width           =   2415
   End
   Begin VB.Image imgHidden 
      Height          =   615
      Left            =   1920
      Top             =   6360
      Visible         =   0   'False
      Width           =   735
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'IMPORTANT:
'This is a pathetic attempt of mapping and comparing fingerprints . It's
'full of bugs, the most of them due to the not-black fingerprints. It would
'work much better if the fingerprints were covered with black ink or something
'(like they should be), but I didn't want to go and clean my fingers (and my scanner)
'every 15 minutes :D.
'Thus, I had to extract only the pixels with the "lighter colour" (the one between
'the lines of a finger). This is hard to do, without extracting also unneeded pixels.
'So, as I said before, it would work better with black fingerprints.
'
'If you have some ideas about how this can be done better, please let me know.
'It is basically a challenge to the PSC community to create an actual application
'on fingerprints.

Option Explicit

Private Declare Function GetPixel Lib "gdi32" (ByVal HDC As Long, ByVal X As Long, ByVal Y As Long) As Long
 
Private Type Pixel
    X As Double     'Position
    Y As Double
    Col As Long     'Colour in dec and rgb
    R As Integer
    G As Integer
    B As Integer
End Type

Private Type PrintsPixel
    X As Double
    Y As Double
End Type

Dim P1() As Pixel, P2() As Pixel
Dim PP1() As PrintsPixel, PP2() As PrintsPixel
Dim Path1 As String, Path2 As String

Private Sub cmdFind_Click()
Dim i As Double, j As Double, j2 As Double, c As Double, pPic As StdPicture
ReDim P1(0): ReDim P2(0)

    Me.MousePointer = 11
    SB1.Panels(1).Text = "Loading fingerpints..."
    'Get all pixels from both pics and store them in arrays
    For i = 0 To pic1.Height - 1
        For j = 0 To pic1.Width - 1
            c = c + 1: ReDim Preserve P1(c): ReDim Preserve P2(c)
            
            With P1(c)
            .Col = GetPixel(pic1.HDC, j, i)
            .X = j: .Y = i
            DecTORGB .Col, .R, .G, .B
            End With
            
            With P2(c)
            .Col = GetPixel(pic2.HDC, j, i)
            .X = j: .Y = i
            DecTORGB .Col, .R, .G, .B
            End With

        Next j
    Next i

    DoEvents
    pic1.Cls: pic2.Cls
    j = 0
    
    SB1.Panels(1).Text = "Mapping fingerprints..."
    'Find the prints and draw them
    
    'It extracts the pixels within a certain range of RGB.
    'These parameters may be varied, perhaps obtaining a bette result.
    '169, 113, 96; 180, 124, 107
    For i = 0 To c
        With P1(i)
            If (.R > 175 And .R < 190) And (.G > 120 And .G < 130) And (.B > 102 And .B < 120) Then
                pic1.PSet (.X, .Y), .Col
                j = j + 1: ReDim Preserve PP1(j)
                PP1(j).X = .X: PP1(j).Y = .Y
                DoEvents
            End If
        End With
        
        With P2(i)
            If (.R > 175 And .R < 190) And (.G > 120 And .G < 130) And (.B > 102 And .B < 120) Then
                pic2.PSet (.X, .Y), .Col
                j2 = j2 + 1: ReDim Preserve PP2(j2)
                PP2(j2).X = .X: PP2(j2).Y = .Y
                'DoEvents
            End If
        End With
    Next i
    
    Me.MousePointer = 0
    SB1.Panels(1).Text = "Fingerprints mapped"
    SB1.Panels(2).Text = AccessGranted & "%"
End Sub

Function AccessGranted() As Double
Dim Same As Long, i As Long
    On Error Resume Next
    
    For i = 0 To UBound(PP1)
        If i > UBound(PP2) Then Exit For
        If Abs(PP1(i).X - PP2(i).X) < 25 And Abs(PP1(i).Y - PP2(i).Y) < 25 Then Same = Same + 1
    Next i
AccessGranted = Format(Same * 100 / (UBound(PP1) + 1), "#.##")
End Function

Private Sub cmdLoad_Click()
With CommonDialog1
    .Filter = "Images |*.jpg;*.gif"
    .ShowOpen
    Path1 = .FileName
End With
ShowImage pic1, Path1, False
ShowImage pic2, Path2, False
End Sub

Private Sub cmdLoad2_Click()
With CommonDialog1
    .Filter = "Images |*.jpg;*.gif"
    .ShowOpen
    Path2 = .FileName
End With
ShowImage pic2, Path2, False
ShowImage pic1, Path1, False
End Sub

Private Sub Form_Load()
    Path1 = App.Path & "\print1a.jpg"
    Path2 = App.Path & "\print1b.jpg"
    ShowImage pic1, Path1, False
    ShowImage pic2, Path2, False
End Sub

Private Sub pic1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Rr As Integer, Gg As Integer, Bb As Integer
DecTORGB GetPixel(pic1.HDC, X, Y), Rr, Gg, Bb
Text1 = Rr & ", " & Gg & ", " & Bb
End Sub

'Input: Col = colour in dec; output: R, G, B.
Sub DecTORGB(ByVal Col As Long, R As Integer, G As Integer, B As Integer)
    R = Col Mod 256
    G = ((Col - R) Mod 65536) / 256
    B = (Col - R - G) / 65536
End Sub

Sub ShowImage(pic As PictureBox, img As String, Optional Stretch As Boolean = True)
On Error Resume Next
    
    imgHidden.Picture = LoadPicture(img)
    
    If Stretch = True Then
        pic.PaintPicture imgHidden.Picture, 0, 0, pic.ScaleWidth, pic.ScaleHeight
    Else    'Center
        pic.PaintPicture imgHidden.Picture, (pic1.ScaleWidth - imgHidden.Width) / 2, (pic1.ScaleHeight - imgHidden.Height) / 2
    End If
    
End Sub

Function ArithmeticMean(vals() As Double, ByVal StartPoint As Long, ByVal EndPoint As Long) As Single
Dim i As Long, result As Single
On Error Resume Next
    For i = StartPoint To EndPoint
        result = result + vals(i)
    Next i
ArithmeticMean = result / (EndPoint - StartPoint)
End Function

Function StandardDeviation(vals() As Double, ByVal StartPoint As Long, ByVal EndPoint As Long) As Double
Dim i As Long, Am As Single, result As Double
On Error Resume Next
Am = ArithmeticMean(vals(), StartPoint, EndPoint)
    For i = StartPoint To EndPoint
        result = result + ((vals(i) - Am) ^ 2)
    Next i
StandardDeviation = Format(Sqr(result / (EndPoint - StartPoint)), "#.##")
End Function