This project is a complete rewrite of its VB6 counterpart using the new tB features like type casting and interface definitions (also showcasing WinRT vector parsing, async operations and no more "DispCallFunc" atrocities).

The code is now much shorter and easy to read:

Code:
Class cOCR

Implements IAsyncOperationCompletedHandlerOcrResult

Private OcrEngineStatics As IOcrEngineStatics, OcrEngine As IOcrEngine, SoftwareBitmapFactory As ISoftwareBitmapFactory, SoftwareBitmap As ISoftwareBitmap, _
        dblTextAngle As Double, dblTextAngleRadians As Double, m_lWidth As Long, m_lHeight As Long, m_bIsAsyncOperationRunning As Boolean

Public Event GetText(sText As String)
Public Event GetTextLines(OcrLines As IVectorView_IOcrLine)

Friend Property Get BitmapWidth() As Long
    BitmapWidth = m_lWidth
End Property

Friend Property Get BitmapHeight() As Long
    BitmapHeight = m_lHeight
End Property

Friend Property Get IsAsyncOperationRunning() As Boolean
    IsAsyncOperationRunning = m_bIsAsyncOperationRunning
End Property

Friend Sub RecognizeAsync(lWidth As Long, lHeight As Long, Buffer As IBuffer)
Dim BitmapBuffer As IBitmapBuffer, MemoryReference As IMemoryBufferReference, lCapacity As Long, lpBuffer As LongPtr
    If lWidth > 0 AndAlso lHeight > 0 AndAlso lWidth * lHeight * 4 = Buffer.Capacity Then
        If SoftwareBitmap IsNot Nothing Then Dispose SoftwareBitmap
        Set SoftwareBitmap = SoftwareBitmapFactory.Create(BitmapPixelFormat_Bgra8, lWidth, lHeight)
        Set BitmapBuffer = SoftwareBitmap.LockBuffer(BitmapBufferAccessMode_Write)
        Set MemoryReference = CType(Of IMemoryBuffer)(BitmapBuffer).CreateReference
        If CType(Of IMemoryBufferByteAccess)(MemoryReference).GetBuffer(lpBuffer, lCapacity) = S_OK Then
            If lCapacity = Buffer.Capacity Then
                CopyMemory ByVal lpBuffer, ByVal CType(Of IBufferByteAccess)(Buffer).Buffer, lCapacity: Dispose MemoryReference: Dispose BitmapBuffer
                m_lWidth = lWidth: m_lHeight = lHeight: m_bIsAsyncOperationRunning = True: Set OcrEngine.RecognizeAsync(SoftwareBitmap).Completed = Me
            End If
        End If
    End If
End Sub

Friend Property Get TextAngle(Optional bRadians As Boolean = True) As Double
    If bRadians Then TextAngle = dblTextAngleRadians Else TextAngle = dblTextAngle
End Property

Private Sub IAsyncOperationCompletedHandlerOcrResult_Invoke(ByVal AsyncOperation As IAsyncOperationOcrResult, ByVal AsyncStatus As AsyncStatus)
Dim hString As LongPtr
    If AsyncStatus = AsyncStatus_Completed Then
        With AsyncOperation.GetResults
            dblTextAngle =.TextAngle.Value: dblTextAngleRadians = dblTextAngle * Atn(1) / 45
            hString =.Text
            RaiseEvent GetText(WindowsGetString(hString))
            hString = WindowsDeleteString(hString)
            RaiseEvent GetTextLines(.Lines)
        End With
    End If
    CloseAsyncOperation AsyncOperation: Dispose SoftwareBitmap: Set SoftwareBitmap = Nothing: m_bIsAsyncOperationRunning = False
End Sub

Private Sub Class_Initialize()
Dim Language As ILanguage, hString As LongPtr
    If GetActivationFactory(WindowsMediaOcrOcrEngine, pIID(eIOcrEngineStatics), VarPtr(OcrEngineStatics)) Then
        If GetActivationFactory(WindowsGraphicsImagingSoftwareBitmap, pIID(eISoftwareBitmapFactory), VarPtr(SoftwareBitmapFactory)) Then
            Set OcrEngine = OcrEngineStatics.TryCreateFromUserProfileLanguages
            #If bInIDE Then
                Set Language = OcrEngine.RecognizerLanguage: hString = Language.DisplayName
                Debug.Print "OCR Engine Ready, language:", WindowsGetString(hString)
                hString = WindowsDeleteString(hString)
            #End If
        End If
    End If
End Sub

Private Sub Class_Terminate()
    Dispose SoftwareBitmap
End Sub

End Class
Name:  TwinBasicOCR.png
Views: 149
Size:  74.4 KB

Here is the demo project: TwinBasicOCR.zip