• Home
 · 
• Math/Dates
 · 
• PATTERN SEARCHER 1.0 This utility can searching pattern inside image according to pearson correlati

PATTERN SEARCHER 1.0 This utility can searching pattern inside image according to pearson correlati

PATTERN SEARCHER 1.0 This utility can searching pattern inside image according to pearson correlation values. This software include functions

API Declarations


(ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Option Base 1 'set array base to 1
Private resmat(150, 150) As Variant
Private patmat(150, 150) As Variant
Private hesmat As Long
Private hesap As Long
Private Phesa As Long
Private Reis As String
Private seyis As String
Private n As Integer
Private f As Integer
Private m As Integer
Private k As Integer
Private ad As Integer
Private cont As Integer
Private t As Double
'korelayon için değiskenler
Private toplam1 As Long
Private toplam2 As Long
Private fark1 As Long
Private fark2 As Long
Private korel As Double
Private hh As Integer
Private ww As Integer
Private verti As Integer
Private horis As Integer




Rate PATTERN SEARCHER 1.0 This utility can searching pattern inside image according to pearson correlati

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

On Error Resume Next
MkDir App.Path & "\" & Text5.Text & Date
ad = Val(Text7)
t = Val(Text6) / 100
f = Picture1.Width - Picture2.Width
k = Picture1.Height - Picture2.Height
Timer1.Enabled = True
hh = Picture2.Height - 4
ww = Picture2.Width - 6
End Sub
Private Sub Dur_Click()
End Sub
Private Sub donust_Click()
verti = Picture1.Height
horis = Picture1.Width
If Option1.Value = True Then
Call d1

End If
If Option2.Value = True Then
Call d2

End If
If Option3.Value = True Then
Call d3

End If
If Option4.Value = True Then
Call d4

End If
If Option5.Value = True Then
Call d5

End If
End Sub

Private Sub Form_Load()
cont = 0
pixel = 3
    Form1.ScaleMode = pixel
    Picture1.ScaleMode = pixel
    Picture2.ScaleMode = pixel
    Picture3.ScaleMode = pixel
n = 0
m = 0
hesmat = 0

End Sub

Private Sub infos_Click()
MsgBox "Serdar Yüksel, e mail: [email protected]"
End Sub

Private Sub nesneac_Click()
On Error GoTo error:

   
        cmd1.DialogTitle = "Open Picture"
        cmd1.Filter = "Pictures (*.Bmp *.Jpg *.Gif)|*.bmp; *.jpg; *.gif"
        cmd1.ShowOpen
       Picture2.Picture = LoadPicture(cmd1.FileName)
      
   
error:
    Err.Clear

vert = Picture2.Width
hor = Picture2.Height
Text3.Text = vert
Text4.Text = hor
End Sub

Private Sub resac_Click()
Dim vert, hor As Integer
On Error GoTo error:
 
        cmd1.DialogTitle = "Open Picture"
        cmd1.Filter = "Pictures (*.Bmp *.Jpg *.Gif)|*.bmp; *.jpg; *.gif"
        cmd1.ShowOpen
       Picture1.Picture = LoadPicture(cmd1.FileName)
      Picture3.Picture = LoadPicture(cmd1.FileName)
   
error:
    Err.Clear
vert = Picture1.Width
hor = Picture1.Height
Text1.Text = vert
Text2.Text = hor
Picture3.Width = Picture1.Width
Picture3.Height = Picture1.Height
End Sub
Private Sub reset_Click()
Unload Me
Form1.Show
End Sub

Private Sub stop_Click()
Timer1.Enabled = False
End Sub

Private Sub Timer1_Timer()
If n > f Then
n = 0
m = m + ad

Rtb.Text = Rtb.Text & vbCrLf & "*******"

End If
If m > k Then


Timer1.Enabled = False

End If
Call patern

Call matris



End Sub


Private Function matris()
On Error GoTo hata


For i% = 1 To ww
For j% = 1 To hh

       resmat(i%, j%) = Round(GetPixel(Picture3.hDC, i% + n, j% + m) / 100000)
       hesmat = hesmat + Round(Abs(resmat(i%, j%) - patmat(i%, j%)) / 100000)
       hesap = resmat(i%, j%)
       Phesa = patmat(i%, j%)
       Reis = Reis & hesap & ";"
       seyis = seyis & Phesa & ";"
       If j% = ww Then
       Reis = Reis & vbCrLf & ";"
       seyis = seyis & vbCrLf & ";"
       End If
       Next j%
    Next i%
    Call korelasyon
    
       If korel > t Then
       Rtb.Text = Rtb.Text & i% + n & ";" & j% + m & vbCrLf & ";"
        Picture1.DrawWidth = 5
        Picture1.DrawMode = 13
        Picture1.Line (i% + n, j% + m)-(i% + n, j% + m), vbYellow
        pt.Text = pt.Text & Reis
        pt.SaveFile App.Path & "\" & Text5.Text & Date & "\" & Text5.Text & i% + n & "-" & j% + m & ".csv", Text
        pt.Text = ""
        st.Text = pt.Text & seyis
        st.SaveFile App.Path & "\" & Text5.Text & Date & "\" & Text5.Text & "-" & "NESNE" & ".csv", Text
        st.Text = ""
          cont = cont + 1
          Label3.Caption = cont
          
hata:
       End If
       
korel = "0"
    hesmat = 0
    Reis = ""
    seyis = ""
    
    n = n + ad

    
End Function
Private Function patern()
For i% = 1 To ww
For j% = 1 To hh


        patmat(i%, j%) = Round(GetPixel(Picture2.hDC, i%, j%) / 100000)
    
     
    Next j%
    Next i%
    
End Function

Private Function korelasyon()
On Error Resume Next

uz% = hh * ww
For i% = 1 To ww
For j% = 1 To hh
       t1& = t1& + resmat(i%, j%)
       t2& = t2& + patmat(i%, j%)
Next j%
Next i%
ort1& = Round(t1& / uz%, 2)
ort2& = Round(t2& / uz%, 2)

For i% = 1 To ww
For j% = 1 To hh
       xy# = Round(xy# + ((resmat(i%, j%) - ort1&) * (patmat(i%, j%) - ort2&)), 2)
       xm# = Round(xm# + (resmat(i%, j%) - ort1&) ^ 2, 2)
       
       ym# = Round(ym# + (patmat(i%, j%) - ort2&) ^ 2, 2)
       
Next j%
Next i%

korel = xy# / Sqr(xm# * ym#)

t1& = "0"
t2& = "0"
ort1& = "0"
ort2& = "0"
xy# = "0"
xm# = "0"
ym# = "0"
End Function
Private Function d1()
Picture3.DrawWidth = 3
        Picture3.DrawMode = 13
        

For i% = 1 To horis
For j% = 1 To verti
Picture3.Line (i%, j%)-(i%, j%), GetPixel(Picture1.hDC, i%, j%) + 5000

Next j%
Next i%

End Function
Private Function d2()
Picture3.DrawWidth = 3
        Picture3.DrawMode = 13
        

For i% = 1 To horis
For j% = 1 To verti
ks# = GetPixel(Picture1.hDC, i%, j%)
If ks# > 2000000 And ks# < 10000000 Then

Picture3.Line (i%, j%)-(i%, j%), GetPixel(Picture1.hDC, i%, j%)
Else
Picture3.Line (i%, j%)-(i%, j%), vbBlack
End If


Next j%
Next i%

End Function
Private Function d3()
Picture3.DrawWidth = 3
        Picture3.DrawMode = 13
        

For i% = 1 To horis
For j% = 1 To verti
Picture3.Line (i%, j%)-(i%, j%), Sqr(Abs(GetPixel(Picture1.hDC, i%, j%)))


Next j%
Next i%

End Function
Private Function d4()
Picture3.DrawWidth = 3
        Picture3.DrawMode = 13
        

For i% = 1 To horis
For j% = 1 To verti
Picture3.Line (i%, j%)-(i%, j%), (GetPixel(Picture1.hDC, i%, j%) + GetPixel(Picture1.hDC, i% + 1, j% + 1) / 2)


Next j%
Next i%

End Function
Private Function d5()
Picture3.DrawWidth = 3
        Picture3.DrawMode = 13
        

For i% = 1 To horis
For j% = 1 To verti
If (GetPixel(Picture1.hDC, i% - 1, j%) / 1000000) * (GetPixel(Picture1.hDC, i%, j + 1) / 1000000) * (GetPixel(Picture1.hDC, i%, j% - 1) / 1000000) * (GetPixel(Picture1.hDC, i%, j%) / 1000000) * (GetPixel(Picture1.hDC, i% + 1, j%) / 1000000) < 10000 Then
Picture3.Line (i%, j%)-(i%, j%), vbWhite
Else
Picture3.Line (i%, j%)-(i%, j%), GetPixel(Picture1.hDC, i%, j%)
End If


Next j%
Next i%

End Function