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
Here is the demo project: TwinBasicOCR.zip