Link to home
Start Free TrialLog in
Avatar of MysticalNeopian
MysticalNeopian

asked on

Speeding up my OCR

Hello everyone I'm using the GetPixelAPI to scan an image... can anyone help me make it vastly faster?


In a module

Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
                                                                                    ByVal szURL As String, _
                                                                                    ByVal szFileName As String, _
                                                                                    ByVal dwReserved As Long, _
                                                                                    ByVal lpfnCB As Long) As Long
Public Function ColorDiff(myColor1 As Long, _
                          myColor2 As Long) As Long
    ColorDiff = Abs((myColor1 Mod 256) - (myColor2 Mod 256))
    ColorDiff = ColorDiff + Abs(((myColor1 \ 256) And 255) - ((myColor2 \ 256) And 255))
    ColorDiff = ColorDiff + Abs(((myColor1 \ 65536) And 255) - ((myColor2 \ 65536) And 255))
End Function
Public Function DownloadFile(URL As String, _
                             LocalFilename As String) As Boolean
    Dim lngRetVal As Long
    lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
    If lngRetVal = 0 Then
        DownloadFile = True
    End If
End Function


--------------------------
the program
--------
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, _
                                               ByVal X As Long, _
                                               ByVal Y As Long) As Long
Public Sub FindPet()
    Dim CurrDiff As Long
    Dim DoubleCheck As Long
   
    Dim highScore As Integer
    Dim TempScore As Integer
   
    Dim picKey As Object
    Dim mMaster As Object
   
    Dim TotDiff As Integer
    Dim NumDiff As Integer
    Dim Threshold As Integer
   
    'Select which background image for code
    For img = 1 To 14
        Select Case img
            Case 1:
                Set picKey = picDesert
            Case 2:
                Set picKey = picMain
            Case 3:
                Set picKey = picPlateau
            Case 4:
                Set picKey = picKiko
            Case 5:
                Set picKey = picFarm
            Case 6:
                Set picKey = picMeri
            Case 7:
                Set picKey = picCave
            Case 8:
                Set picKey = picDesert2
            Case 9:
                Set picKey = picMain2
            Case 10:
                Set picKey = picPlateau2
            Case 11:
                Set picKey = picKiko2
            Case 12:
                Set picKey = picFarm2
            Case 13:
                Set picKey = picMeri2
            Case 14:
                Set picKey = picCave2
        End Select
       
        TempScore = 0
        TotDiff = 0
        NumDiff = 0
       
        For X% = 10 To picKey.ScaleWidth Step 30
            For Y% = 10 To picKey.ScaleHeight Step 30
                CurrDiff = ColorDiff(GetPixel(picView.hDC, X%, Y%), GetPixel(picKey.hDC, X%, Y%))
                If CurrDiff < 600 Then
                    TotDiff = TotDiff + CurrDiff
                    NumDiff = NumDiff + 1
                End If
                If CurrDiff < 50 Then
                    TempScore = TempScore + 1
                End If
            Next Y%
        Next X%
        If TempScore > highScore Then
            Set mMaster = picKey
            highScore = TempScore
            Threshold = TotDiff / NumDiff + 20
        End If
    Next img
   
    'Find the pet in the image
    highScore = 0
    For X% = 10 To mMaster.ScaleWidth - 11 Step 10
        For Y% = 15 To mMaster.ScaleHeight - 16 Step 15
            TempScore = 0
            For X1% = X% - 10 To X% + 10 Step 5
                For Y1% = Y% - 15 To Y% + 15 Step 5

                    CurrDiff = ColorDiff(GetPixel(picView.hDC, X1%, Y1%), GetPixel(mMaster.hDC, X1%, Y1%)) + Modifier
                   
                    If CurrDiff > Threshold Then
                        TempScore = TempScore + CurrDiff / 10
                    End If
                Next Y1%
            Next X1%
            If TempScore > highScore Then
                highScore = TempScore
                CodeX = X%
                CodeY = Y%
            End If
        Next Y%
    Next X%
   
    picView.PSet (CodeX, CodeY), vbRed
    picView.Circle (CodeX, CodeY), 20, vbBlue
End Sub
Avatar of MysticalNeopian
MysticalNeopian

ASKER

the picture is a gif, and i'm getting it off a website.
I know someone can help me out!
Try NOT to scan every pixel...
ASKER CERTIFIED SOLUTION
Avatar of 2Angel
2Angel

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial