Speeding up my OCR

Posted on 2004-11-26
Last Modified: 2012-06-27
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
Question by:MysticalNeopian

    Author Comment

    the picture is a gif, and i'm getting it off a website.

    Author Comment

    I know someone can help me out!
    LVL 2

    Expert Comment

    Try NOT to scan every pixel...
    LVL 2

    Accepted Solution


    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    IT, Stop Being Called Into Every Meeting

    Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

    Suggested Solutions

    Title # Comments Views Activity
    word-wrap:break-word CSS is not working on IE11 With Compatibility Mode 1 366
    Port V2 16 35 2008 2 39
    VBA error replacing data 6 29
    Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
    You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
    Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
    This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

    760 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    10 Experts available now in Live!

    Get 1:1 Help Now