VB6 - Simple OCR Text Recognition from a PictureBox Image

[VanGoghGaming]

This project is a simple example of using the "WinRT OCR Engine" to recognize the text from a PictureBox image pulled from the Clipboard. Just copy any image containing some text in the Clipboard and click on the PictureBox to display it. The recognized text will appear in the TextBox below.

The code is fairly simple, the biggest hurdle to overcome was that the OCR Engine doesn't work with regular GDI bitmaps but uses "SoftwareBitmap" objects instead. So all we had to do was create such an object and then go through a bunch of interfaces just to expose the underlying byte buffer. Once we got that, it all came down to calling "GetDIBits" on the PictureBox picture handle to pull the bitmap bytes into the "SoftwareBitmap" object and let the OCR Engine do its magic. That meant calling the "RecognizeAsync" method and raising an event when the asynchronous operation was completed (which is pretty much instant).

frmOCR.frm

Option Explicit

Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type

Private Type BITMAPINFOHEADER
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type

Private Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type

Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors As RGBQUAD
End Type

Private Const DIB_RGB_COLORS As Long = 0

Private Declare Function GetDIBits Lib "gdi32" (ByVal hDC As Long, ByVal hBitmap As Long, ByVal lStart As Long, ByVal cLines As Long, ByVal lpvBits As Long, ByVal lpBMI As Long, ByVal lUsage As Long) As Long
Private Declare Function GetObjectW Lib "gdi32" (ByVal hGDIObj As Long, ByVal cbBuffer As Long, ByVal lpvObject As Long) As Long

Private WithEvents OcrEngine As cOCR, SoftwareBitmap As cSoftwareBitmap, bmiBitmapInfo As BITMAPINFO

Private Sub Form_Load()
    With bmiBitmapInfo.bmiHeader: .biSize = LenB(bmiBitmapInfo.bmiHeader): .biPlanes = 1: .biBitCount = 32: End With
    Set SoftwareBitmap = New cSoftwareBitmap: Set OcrEngine = New cOCR
End Sub

Private Sub OcrEngine_GetText(sText As String)
    txtOCR = sText
End Sub

Private Sub OcrEngine_GetTextLines(colOcrLines As Collection)
Dim OcrLine As cOcrLine, OcrWord As cOcrWord
    If Not colOcrLines Is Nothing Then
        #If bInIDE Then
            Debug.Print "Rotation Angle:", OcrEngine.TextAngle(False)
        #End If
        For Each OcrLine In colOcrLines
            For Each OcrWord In OcrLine.WordsCollection
                #If bInIDE Then
                    Debug.Print OcrWord.WordIndex, OcrWord.WordText
                #End If
                With OcrWord.RotatedBoundingRect
                    .X11 = ScaleX(.X11, vbPixels, ScaleMode): .Y11 = ScaleY(.Y11, vbPixels, ScaleMode)
                    .X12 = ScaleX(.X12, vbPixels, ScaleMode): .Y12 = ScaleY(.Y12, vbPixels, ScaleMode)
                    .X22 = ScaleX(.X22, vbPixels, ScaleMode): .Y22 = ScaleY(.Y22, vbPixels, ScaleMode)
                    .X21 = ScaleX(.X21, vbPixels, ScaleMode): .Y21 = ScaleY(.Y21, vbPixels, ScaleMode)
                    picOCR.Line (.X11, .Y11)-(.X12, .Y12), vbRed
                    picOCR.Line (.X12, .Y12)-(.X22, .Y22), vbRed
                    picOCR.Line (.X22, .Y22)-(.X21, .Y21), vbRed
                    picOCR.Line (.X21, .Y21)-(.X11, .Y11), vbRed
                End With
            Next OcrWord
        Next OcrLine
    End If
End Sub

Private Sub picOCR_Click()
Dim bmBitmap As BITMAP, hDC As Long, hOldBitmap As Long
    If Clipboard.GetFormat(vbCFBitmap) Then
        With picOCR
            Set .Picture = Clipboard.GetData
            GetObjectW .Picture.Handle, LenB(bmBitmap), VarPtr(bmBitmap)
            .Width = .ScaleX(bmBitmap.bmWidth, vbPixels, .ScaleMode): .Height = .ScaleY(bmBitmap.bmHeight, vbPixels, .ScaleMode)
            txtOCR.Move .Left, .Top + .Height, .Width: Width = Width - ScaleWidth + .Left * 2 + .Width: Height = Height - ScaleHeight + .Height + txtOCR.Height + .Top * 2
            With bmiBitmapInfo.bmiHeader: .biWidth = bmBitmap.bmWidth: .biHeight = -bmBitmap.bmHeight: End With
            If SoftwareBitmap.CreateSoftwareBitmap(bmBitmap.bmWidth, bmBitmap.bmHeight) Then
                If GetDIBits(.hDC, .Picture.Handle, 0, bmBitmap.bmHeight, SoftwareBitmap.GetBitmapBuffer, VarPtr(bmiBitmapInfo), DIB_RGB_COLORS) Then
                    SoftwareBitmap.UnlockBitmapBuffer: OcrEngine.RecognizeAsync SoftwareBitmap
                End If
            End If
        End With
    Else
        MsgBox "Clipboard does not contain a picture!", vbExclamation, App.Title: Exit Sub
    End If
End Sub

It seems the more you crank up the picture contrast the better results you get on the text recognition. Best results would be from an image containing black text over a white background.

Here is the demo project: OCR.ZIP (Updated)