im englischen Forum hat fryquez einen interessanten Code veröffentlicht, mit dem man OCR und Gesichtserkennung mitttels Windows API realisieren kann. Während die OCR Texterkennung recht überzeugend gut funktioniert, ist die Gesichtserkennung allerdings eher mäßig..
Code: Alles auswählen
; Autor: fryquez
; Englisches Forum: https://www.purebasic.fr/english/viewtopic.php?f=12&t=77835
EnableExplicit
DeclareModule WinOCR
Declare.s get_Languages()
Declare.s get_TextFromFile(sFile.s, sLanguage.s = "")
Declare.s get_TextFromImageID(ImageID, sLanguage.s = "")
Declare.s get_TextFromHWND(ImageID, sLanguage.s = "")
;
Declare get_FacesFromFile(sFile.s, List rcList.rect())
Declare get_FacesFromImageID(ImageID, List rcList.rect())
Declare get_FacesFromHWND(hWNd, List rcList.rect())
EndDeclareModule
Module WinOCR
;Credits - Malcev @autohotkey.com
;https://www.autohotkey.com/boards/viewtopic.php?t=72674
;https://www.autohotkey.com/boards/viewtopic.php?t=72797
EnableExplicit
#MyRoDebug = 0
;- Interfaces
Interface IInspectable Extends IUnknown
GetIids(*iidCount, *iids)
GetRuntimeClassName(*className)
GetTrustLevel(*trustLevel)
EndInterface
Interface IClosable Extends IInspectable
Close()
EndInterface
Interface ILanguageFactory Extends IInspectable
createLanguage(*string, *out)
EndInterface
Interface ILanguage Extends IInspectable
get_LanguageTag(*value)
get_DisplayName(*value)
get_NativeName(*value)
get_Script(*value)
EndInterface
Interface IBitmapDecoderStatics Extends IInspectable
BmpDecoderId(*value.guid)
JpegDecoderId(*value.guid)
PngDecoderId(*value.guid)
TiffDecoderId(*value.guid)
GifDecoderId(*value.guid)
JpegXRDecoderId(*value.guid)
IcoDecoderId(*value.guid)
GetDecoderInformationEnumerator(*out)
CreateAsync(*in, *out)
CreateWithIdAsync(*decoderId.guid, *in, *out)
EndInterface
Interface IBitmapDecoder Extends IInspectable
BitmapContainerProperties(*value)
DecoderInformation(*value)
FrameCount(*value)
GetPreviewAsync(*value)
GetFrameAsync(frameIndex, *value)
EndInterface
Interface IBitmapFrameWithSoftwareBitmap Extends IInspectable
GetSoftwareBitmapAsync(*value)
GetSoftwareBitmapConvertedAsync(pixelFormat, alphaMode, *value)
GetSoftwareBitmapTransformedAsync(pixelFormat, alphaMode, transform, exifOrientationMode, colorManagementMode, *value)
EndInterface
Interface IBitmapFrame Extends IInspectable
GetThumbnailAsync(*asyncInfo)
BitmapProperties(*value)
BitmapPixelFormat(*value)
BitmapAlphaMode(*value)
DpiX(*value)
DpiY(*value)
PixelWidth(*value)
PixelHeight(*value)
OrientedPixelWidth(*value)
OrientedPixelHeight(*value)
GetPixelDataAsync(*asyncInfo)
GetPixelDataTransformedAsync(pixelFormat, alphaMode, transform, exifOrientationMode, colorManagementMode, *asyncInfo)
EndInterface
Interface ISoftwareBitmap Extends IInspectable
get_BitmapPixelFormat(*value)
get_BitmapAlphaMode(*value)
get_PixelWidth(*value)
get_PixelHeight(*value)
get_IsReadOnly(*value)
put_DpiX(*value)
get_DpiX(*value)
put_DpiY(*value)
get_DpiY(*value)
LockBuffer(mode, *value)
CopyTo(*bitmap)
CopyFromBuffer(*buffer)
GetReadOnlyView(*value)
EndInterface
Interface IOcrEngineStatics Extends IInspectable
MaxDimensions(*value)
AvailableRecognizerLanguages(*value)
IsLanguageSupported(*Language,*Result)
TryCreateFromLanguage(*Language,*Result)
TryCreateFromUserProfileLanguages(*Result)
EndInterface
Interface IOcrEngine Extends IInspectable
RecognizeAsync(*bitmap, *result)
RecognizerLanguage(*value)
EndInterface
Interface IOcrResult Extends IInspectable
Lines(*value)
TextAngle(*value)
Text(*value)
EndInterface
Interface IRandomAccessStream Extends IInspectable
get_Size(*value)
put_Size(*value)
GetInputStreamAt(position.q, *stream)
GetOutputStreamAt(position.q, *stream)
get_Position(*value)
Seek(position.q)
CloneStream(*stream)
get_CanRead(*value)
get_CanWrite(*value)
EndInterface
Interface IAsyncInfo Extends IInspectable
Id(*id)
Status(*status)
ErrorCode(*errorCode)
Cancel()
Close()
EndInterface
Interface IAsyncOperationWithProgress Extends IInspectable
Completed(asyncInfo, asyncStatus)
Progress(asyncInfo, progressInfo)
GetResults(*Object)
EndInterface
Interface IGlobalizationPreferencesStatics Extends IInspectable
get_Calendars(*value)
get_Clocks(*value)
get_Currencies(*value)
get_Languages(*value)
get_HomeGeographicRegion(*value)
get_WeekStartsOn(*value)
EndInterface
Interface IReadOnlyList Extends IInspectable
get_Item(index, *hString)
count(*value)
EndInterface
Interface IFaceDetectorStatics Extends IInspectable
CreateAsync(*returnValue)
GetSupportedBitmapPixelFormats(*result)
IsBitmapPixelFormatSupported(bitmapPixelFormat, *result)
IsSupported(*returnValue)
EndInterface
Interface IFaceDetector Extends IInspectable
DetectFacesAsync(image, *returnValue)
DetectFacesWithSearchAreaAsync(image, searchArea, *returnValue)
MinDetectableFaceSize(*value)
MaxDetectableFaceSize(*value)
EndInterface
Interface IBitmapEncoderStatics Extends IInspectable
get_BmpEncoderId(*value)
get_JpegEncoderId(*value)
get_PngEncoderId(*value)
get_TiffEncoderId(*value)
get_GifEncoderId(*value)
get_JpegXREncoderId(*value)
GetEncoderInformationEnumerator(*encoderInformationEnumerator)
CreateAsync(encoderId, *stream, *asyncInfo)
CreateWithEncodingOptionsAsync(encoderId, stream, *encodingOptions, *asyncInfo)
CreateForTranscodingAsync(stream, bitmapDecoder, *asyncInfo)
CreateForInPlacePropertyEncodingAsync(stream, bitmapDecoder, *asyncInfo)
EndInterface
Interface ISoftwareBitmapStatics Extends IInspectable
Copy(*source, *value)
Convert(*source, format, *value)
ConvertWithAlpha(*source, format, alpha, *value)
CreateCopyFromBuffer(*source, format, width, height, *value)
CreateCopyWithAlphaFromBuffer(*source, format, width, height, alpha, *value)
CreateCopyFromSurfaceAsync(surface, *value)
CreateCopyWithAlphaFromSurfaceAsync(surface, alpha, *value)
EndInterface
Interface IBitmapEncoder Extends IInspectable
EncoderInformation(*value)
BitmapProperties(*value)
BitmapContainerProperties(*value)
IsThumbnailGenerated(*value)
GeneratedThumbnailWidth(*value)
GeneratedThumbnailHeight(*value)
BitmapTransform(*value)
SetPixelData(pixelFormat, alphaMode, width, height, dpiX.d, dpiY.d, __pixelsSize, *pixels)
GoToNextFrameAsync(*asyncInfo)
GoToNextFrameWithEncodingOptionsAsync(encodingOptions, *asyncInfo)
FlushAsync(*asyncInfo)
EndInterface
Interface IBitmapTransform Extends IInspectable
ScaledWidth(*value)
ScaledHeight(*value)
InterpolationMode(*value)
Flip(*value)
Rotation(*value)
Bounds(*value)
EndInterface
Interface IDetectedFace Extends IInspectable
FaceBox(*returnValue)
EndInterface
;-
;- DataSection
DataSection
IID_IBitmapFrame:
Data.l $72A49A1C
Data.w $8081, $438D
Data.b $91, $BC, $94, $EC, $FC, $81, $85, $C6
IID_IRandomAccessStream:
Data.l $905A0FE1
Data.w $BC53, $11DF
Data.b $8C, $49, $0, $1E, $4F, $C6, $86, $DA
IID_IClosable:
Data.l $30D5A829
Data.w $7FA4, $4026
Data.b $83, $BB, $D7, $5B, $AE, $4E, $A9, $9E
IID_IBitmapFrameWithSoftwareBitmap:
Data.l $FE287C9A
Data.w $420C, $4963
Data.b $87, $AD, $69, $14, $36, $E0, $83, $83
IID_IAsyncInfo:
Data.l $00000036
Data.w $00, $00
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
IID_IPicture:
Data.l $7BF80980
Data.w $BF32, $101A
Data.b $8B, $BB, $00, $AA, $0, $30, $0C, $AB
IID_ILanguageFactory:
Data.l $9B0252AC
Data.w $C27, $44F8
Data.b $B7, $92, $97, $93, $FB, $66, $C6, $3E
IID_IBitmapDecoderStatics:
Data.l $438CCB26
Data.w $BCEF, $4E95
Data.b $BA, $D6, $23, $A8, $22, $E5, $8D, $01
IID_IOcrEngineStatics:
Data.l $5BFFA85A
Data.w $3384, $3540
Data.b $99, $40, $69, $91, $20, $D4, $28, $A8
IID_IGlobalizationPreferencesStatics:
Data.l $1BF4326
Data.w $ED37, $4E96
Data.b $B0, $E9, $C1, $34, $0D, $1E, $A1, $58
EndDataSection
Prototype pRoInitialize(initType)
Prototype pWindowsCreateString(a, b, c)
Prototype pRoGetActivationFactory(a, b, c)
Prototype pWindowsDeleteString(a)
Prototype pWindowsGetStringRawBuffer(a, length)
Prototype pCreateRandomAccessStreamOnFile(file, iRead, *GUID, *out)
Prototype pCreateRandomAccessStreamOverStream(*stream, options, *riid, *ppv)
Structure DynamicRuntimeFuncs
WindowsCreateString.pWindowsCreateString
WindowsDeleteString.pWindowsDeleteString
RoGetActivationFactory.pRoGetActivationFactory
WindowsGetStringRawBuffer.pWindowsGetStringRawBuffer
CreateRandomAccessStreamOnFile.pCreateRandomAccessStreamOnFile
CreateRandomAccessStreamOverStream.pCreateRandomAccessStreamOverStream
RoInitialize.pRoInitialize
EndStructure
Global RT_Funcs.DynamicRuntimeFuncs
Global RT_INIT_DONE
Structure MyRTIntArray
i.i[0]
EndStructure
;-
;- HelperFuncs
;-
Procedure RT_Init()
Protected hr.l
#RO_INIT_SINGLETHREADED = 0
#RO_INIT_MULTITHREADED = 1
Protected hCombase = OpenLibrary(#PB_Any, "combase.dll")
If Not hCombase
ProcedureReturn 0
EndIf
RT_Funcs\WindowsCreateString = GetFunction(hCombase, "WindowsCreateString")
RT_Funcs\WindowsDeleteString = GetFunction(hCombase, "WindowsDeleteString")
RT_Funcs\RoGetActivationFactory = GetFunction(hCombase, "RoGetActivationFactory")
RT_Funcs\WindowsGetStringRawBuffer = GetFunction(hCombase, "WindowsGetStringRawBuffer")
RT_Funcs\RoInitialize = GetFunction(hCombase, "RoInitialize")
hCombase = OpenLibrary(#PB_Any, "SHCore.dll")
If Not hCombase
ProcedureReturn 0
EndIf
RT_Funcs\CreateRandomAccessStreamOnFile = GetFunction(hCombase, "CreateRandomAccessStreamOnFile")
RT_Funcs\CreateRandomAccessStreamOverStream = GetFunction(hCombase, "CreateRandomAccessStreamOverStream")
RT_INIT_DONE = 1
Protected *i.MyRTIntArray = @RT_Funcs, i
For i = 0 To (SizeOf(RT_Funcs) / SizeOf(Integer)) - 1
If Not *i\i[i]
RT_INIT_DONE = 0
Break
EndIf
Next
If RT_INIT_DONE
hr = RT_Funcs\RoInitialize(#RO_INIT_MULTITHREADED)
CompilerIf #MyRoDebug : Debug "RoInitialize = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
;RPC_E_CHANGED_MODE = $80010106
EndIf
ProcedureReturn RT_INIT_DONE
EndProcedure
Procedure CreateHString(sString.s, *hString)
ProcedureReturn RT_Funcs\WindowsCreateString(@sString, Len(sString), *hString)
EndProcedure
Procedure DeleteHString(*hString)
ProcedureReturn RT_Funcs\WindowsDeleteString(*hString)
EndProcedure
Procedure CreateClass(sString.s, sGUID.s, *OutClass)
Protected hString, GUID.GUID, iReturn
CreateHString(sString, @hString)
CLSIDFromString_(@sGUID, @GUID)
iReturn = RT_Funcs\RoGetActivationFactory(hString, @GUID, *OutClass)
RT_Funcs\WindowsDeleteString(hString)
ProcedureReturn iReturn
EndProcedure
Procedure WaitForAsync(*InOut.Integer)
Protected *Object.IAsyncOperationWithProgress = *InOut\i
Protected IAsyncInfo.IAsyncInfo, status.l, ErrorCode.l, hr.l
hr = *Object\QueryInterface(?IID_IAsyncInfo, @IAsyncInfo)
;Debug "WaitForAsync QueryInterface = 0x" + Hex(hr)
If Not IAsyncInfo
Debug "ER QueryInterface IID_IAsyncInfo failed!"
ProcedureReturn 0
EndIf
While 1
hr = IAsyncInfo\Status(@status)
; Debug "IAsyncInfo::Status = 0x" + Hex(hr) + " - " + Hex(status)
If (status <> 0)
If (status <> 1)
IAsyncInfo\ErrorCode(@ErrorCode)
Debug "ER IAsyncInfo status error 0x" + Hex(ErrorCode, #PB_Long)
End
EndIf
IAsyncInfo\Release()
Break
EndIf
Sleep_(10)
Wend
Protected ObjectResult
*Object\GetResults(@ObjectResult)
If ObjectResult
*Object\Release()
*InOut\i = ObjectResult
EndIf
ProcedureReturn ObjectResult
EndProcedure
Procedure FileToRandomAccessStream(sFile.s)
If Not RT_INIT_DONE
RT_Init()
If Not RT_INIT_DONE
ProcedureReturn 0
EndIf
EndIf
Protected IRandomAccessStream.IRandomAccessStream
Protected hr.l = RT_Funcs\CreateRandomAccessStreamOnFile(@sFile, 0, ?IID_IRandomAccessStream, @IRandomAccessStream)
CompilerIf #MyRoDebug : Debug "CreateRandomAccessStreamOnFile = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
ProcedureReturn IRandomAccessStream
EndProcedure
Structure PICTDESC_bmp
hbitmap.i
hpal.i
EndStructure
Structure PICTDESC_wmf
hmete.i
xExt.l
yExt.l
EndStructure
Structure PICTDESC_icon
hicon.i
EndStructure
Structure PICTDESC_emf
hemf.i
EndStructure
Structure PICTDESC
cbSizeofstruct.l
picType.l
StructureUnion
bmp.PICTDESC_bmp
wmf.PICTDESC_wmf
icon.PICTDESC_icon
emf.PICTDESC_emf
EndStructureUnion
EndStructure
Procedure HBitmapToRandomAccessStream(hBitmap)
If Not RT_INIT_DONE
RT_Init()
If Not RT_INIT_DONE
ProcedureReturn 0
EndIf
EndIf
Protected pIStream.IStream, pIPicture.IPicture, hr.l
hr = CreateStreamOnHGlobal_(0, #True, @pIStream)
If pIStream
#PICTYPE_BITMAP = 1
Protected PD.PICTDESC
PD\cbSizeofstruct = SizeOf(PICTDESC)
PD\picType = #PICTYPE_BITMAP
PD\bmp\hbitmap = hBitmap
hr = OleCreatePictureIndirect_(@PD, ?IID_IPicture, #False, @pIPicture)
If pIPicture
Protected cbSize
hr = pIPicture\SaveAsFile(pIStream, #True, 0)
Protected pIRandomAccessStream.IRandomAccessStream
#BSOS_DEFAULT = 0
hr = RT_Funcs\CreateRandomAccessStreamOverStream(pIStream, #BSOS_DEFAULT, ?IID_IRandomAccessStream, @pIRandomAccessStream)
pIPicture\Release()
EndIf
pIStream\Release()
EndIf
ProcedureReturn pIRandomAccessStream
EndProcedure
Procedure HBitmapFromHWND(hWnd, x = 0, y = 0, w = 0, h = 0)
Protected HDC, rc.rect, HBM, PDC
HDC = GetDC_(hWnd)
If HDC
GetWindowRect_(hWnd, @rc)
If w = 0 : w = rc\right - rc\left : EndIf
If h = 0 : h = rc\bottom - rc\top : EndIf
HBM = CreateCompatibleBitmap_(HDC, W, H)
If HBM
PDC = CreateCompatibleDC_(HDC)
If PDC
SelectObject_(PDC, HBM)
BitBlt_(PDC, 0, 0, W, H, HDC, X, Y, #SRCCOPY)
DeleteDC_(PDC)
EndIf
EndIf
ReleaseDC_(hWnd, HDC)
EndIf
ProcedureReturn HBM
EndProcedure
;-
;- WorkerFuncs
;-
Procedure.s GetOCRFromImage(IRandomAccessStream.IRandomAccessStream, sLanguage.s = "", bReturnLanguages = 0)
If Not RT_INIT_DONE
RT_Init()
If Not RT_INIT_DONE
ProcedureReturn ""
EndIf
EndIf
Static ILanguageFactory.ILanguageFactory
Static IBitmapDecoderStatics.IBitmapDecoderStatics
Static IOcrEngineStatics.IOcrEngineStatics
Static IGlobalizationPreferencesStatics.IGlobalizationPreferencesStatics
Static MaxDimension
Protected hString, hr.l, bSupported, i, sOCRText.s
Protected hText, length, *p, count, hLanguage, iFrames, width, height, iUsedLanguage
Protected IOcrEngine.IOcrEngine
Protected ILanguageList.IReadOnlyList
Protected ILanguageTest.ILanguage
Protected IBitmapDecoder.IBitmapDecoder
Protected IBitmapFrame.IBitmapFrame
Protected IClosable.IClosable
Protected IOcrResult.IOcrResult
Protected ILinesList.IReadOnlyList
Protected IBitmapFrameWithSoftwareBitmap.IBitmapFrameWithSoftwareBitmap
Protected ISoftwareBitmap.ISoftwareBitmap
Protected IOCRLine.ILanguage
If ILanguageFactory = 0 Or
IBitmapDecoderStatics = 0 Or
IOcrEngineStatics = 0 Or
IGlobalizationPreferencesStatics = 0
hr = CreateClass("Windows.Globalization.Language", "{9B0252AC-0C27-44F8-B792-9793FB66C63E}", @ILanguageFactory)
CompilerIf #MyRoDebug : Debug "CreateClass Windows.Globalization.Language = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = CreateClass("Windows.Graphics.Imaging.BitmapDecoder", "{438CCB26-BCEF-4E95-BAD6-23A822E58D01}", @IBitmapDecoderStatics)
CompilerIf #MyRoDebug : Debug "CreateClass Windows.Graphics.Imaging.BitmapDecoder = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = CreateClass("Windows.Media.Ocr.OcrEngine", "{5BFFA85A-3384-3540-9940-699120D428A8}", @IOcrEngineStatics)
CompilerIf #MyRoDebug : Debug "CreateClass Windows.Media.Ocr.OcrEngine = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = CreateClass("Windows.System.UserProfile.GlobalizationPreferences", "{01BF4326-ED37-4E96-B0E9-C1340D1EA158}", @IGlobalizationPreferencesStatics)
CompilerIf #MyRoDebug : Debug "CreateClass Windows.System.UserProfile.GlobalizationPreferences = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
EndIf
If ILanguageFactory = 0 Or
IBitmapDecoderStatics = 0 Or
IOcrEngineStatics = 0 Or
IGlobalizationPreferencesStatics = 0
Goto Release
EndIf
If Not MaxDimension
IOcrEngineStatics\MaxDimensions(@MaxDimension)
EndIf
If sLanguage = ""
hr = IGlobalizationPreferencesStatics\get_Languages(@ILanguageList)
CompilerIf #MyRoDebug : Debug "IGlobalizationPreferencesStatics::get_Languages = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If ILanguageList
hr = ILanguageList\count(@count)
CompilerIf #MyRoDebug : Debug "ILanguageList::count = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
For i = 0 To count -1
hr = ILanguageList\get_Item(0, @hString)
CompilerIf #MyRoDebug : Debug "ILanguageList::get_Item = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = ILanguageFactory\createLanguage(hString, @ILanguageTest)
CompilerIf #MyRoDebug : Debug "ILanguageFactory::createLanguage = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If ILanguageTest
hr = IOcrEngineStatics\IsLanguageSupported(ILanguageTest, @bSupported)
CompilerIf #MyRoDebug : Debug "IOcrEngineStatics::IsLanguageSupported = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If bSupported
hText = 0
ILanguageTest\get_LanguageTag(@hText)
CompilerIf #MyRoDebug : Debug "ILanguageTest::get_LanguageTag = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If hText
*p = RT_Funcs\WindowsGetStringRawBuffer(hText, @length)
If *p
sLanguage = PeekS(*p)
If bReturnLanguages
sOCRText + sLanguage + #CRLF$
EndIf
;Debug sLanguage
EndIf
EndIf
EndIf
ILanguageTest\Release()
EndIf
Next
ILanguageList\Release()
EndIf
EndIf
If bReturnLanguages
Goto Release
EndIf
hString = 0
CreateHString(sLanguage, @hString)
If hString
hr = ILanguageFactory\createLanguage(hString, @iUsedLanguage)
CompilerIf #MyRoDebug : Debug "ILanguageFactory::createLanguage = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = RT_Funcs\WindowsDeleteString(hString)
CompilerIf #MyRoDebug : Debug "WindowsDeleteString = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = IOcrEngineStatics\TryCreateFromLanguage(iUsedLanguage, @IOcrEngine)
CompilerIf #MyRoDebug : Debug "IOcrEngineStatics::TryCreateFromLanguage = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IOcrEngine
If IRandomAccessStream
hr = IBitmapDecoderStatics\CreateAsync(IRandomAccessStream, @IBitmapDecoder)
CompilerIf #MyRoDebug : Debug "IBitmapDecoderStatics::CreateAsync = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IBitmapDecoder
WaitForAsync(@IBitmapDecoder)
hr = IBitmapDecoder\FrameCount(@iFrames)
CompilerIf #MyRoDebug : Debug "IBitmapDecoder::FrameCount = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = IBitmapDecoder\QueryInterface(?IID_IBitmapFrame, @IBitmapFrame)
CompilerIf #MyRoDebug : Debug "IBitmapDecoder::QueryInterface = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IBitmapFrame
hr = IBitmapFrame\PixelWidth(@width)
CompilerIf #MyRoDebug : Debug "IBitmapFrame::PixelWidth = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = IBitmapFrame\PixelHeight(@height)
CompilerIf #MyRoDebug : Debug "IBitmapFrame::PixelHeight = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If width > MaxDimension Or height > MaxDimension
Debug "ER: Image is to big"
Else
hr = IBitmapDecoder\QueryInterface(?IID_IBitmapFrameWithSoftwareBitmap, @IBitmapFrameWithSoftwareBitmap)
CompilerIf #MyRoDebug : Debug "IBitmapDecoder::QueryInterface = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IBitmapFrameWithSoftwareBitmap
hr = IBitmapFrameWithSoftwareBitmap\GetSoftwareBitmapAsync(@ISoftwareBitmap)
CompilerIf #MyRoDebug : Debug "IBitmapFrameWithSoftwareBitmap::GetSoftwareBitmapAsync = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If ISoftwareBitmap
WaitForAsync(@ISoftwareBitmap)
IOcrEngine\RecognizeAsync(ISoftwareBitmap, @IOcrResult)
CompilerIf #MyRoDebug : Debug "IOcrEngine::RecognizeAsync = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IOcrResult
WaitForAsync(@IOcrResult)
hr = IOcrResult\Lines(@ILinesList)
CompilerIf #MyRoDebug : Debug "IOcrResult::Lines = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If ILinesList
count = 0
hr = ILinesList\count(@count)
CompilerIf #MyRoDebug : Debug "ILinesList::count = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
For i = 0 To count -1
hText = 0
hr = ILinesList\get_Item(i, @IOCRLine)
CompilerIf #MyRoDebug : Debug "ILinesList::get_Item = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = IOCRLine\get_DisplayName(@hText)
CompilerIf #MyRoDebug : Debug "IOCRLine::get_DisplayName = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If hText
*p = RT_Funcs\WindowsGetStringRawBuffer(hText, 0)
If *p
sOCRText + PeekS(*p) + #CRLF$
EndIf
EndIf
IOCRLine\Release()
Next
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
If ISoftwareBitmap
hr = ISoftwareBitmap\QueryInterface(?IID_IClosable, @IClosable)
CompilerIf #MyRoDebug : Debug "ISoftwareBitmap::QueryInterface = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IClosable
IClosable\Close()
IClosable\Release()
IClosable = 0
EndIf
EndIf
EndIf
IOcrEngine\Release()
EndIf
EndIf
Release:
If IBitmapDecoder : IBitmapDecoder\Release() : EndIf
If IBitmapFrame : IBitmapFrame\Release() : EndIf
If IBitmapFrameWithSoftwareBitmap : IBitmapFrameWithSoftwareBitmap\Release() : EndIf
If ISoftwareBitmap : ISoftwareBitmap\Release() : EndIf
If IOcrResult : IOcrResult\Release() : EndIf
If ILinesList : ILinesList\Release() : EndIf
CompilerIf #MyRoDebug : Debug "### Func End ###" + #CRLF$ : CompilerEndIf
ProcedureReturn sOCRText
EndProcedure
Procedure FaceDetect(IRandomAccessStream, List rcList.rect(), maxheight = 2000)
Static IBitmapDecoderStatics.IBitmapDecoderStatics
Static IBitmapEncoderStatics.IBitmapEncoderStatics
Static ISoftwareBitmapStatics.ISoftwareBitmapStatics
Static IFaceDetectorStatics.IFaceDetectorStatics
Protected IFaceDetector.IFaceDetector
Protected IReadOnlyList.IReadOnlyList
Protected IBitmapDecoder.IBitmapDecoder
Protected IBitmapEncoder.IBitmapEncoder
Protected IBitmapFrame.IBitmapFrame
Protected IBitmapFrameWithSoftwareBitmap.IBitmapFrameWithSoftwareBitmap
Protected IBitmapTransform.IBitmapTransform
Protected ISoftwareBitmap.ISoftwareBitmap, ISoftwareBitmapTemp.ISoftwareBitmap
Protected IClosable.IClosable
Protected IDetectedFaceList.IReadOnlyList
Protected IDetectedFace.IDetectedFace
Protected hr.l, iCount, i, hString, *p
Protected BitmapPixelFormat
Protected sSupportedBitmapPixelFormats.s
Protected width, height, rc.rect
If Not RT_INIT_DONE
RT_Init()
If Not RT_INIT_DONE
ProcedureReturn 0
EndIf
EndIf
If IBitmapDecoderStatics = 0 Or
IBitmapEncoderStatics = 0 Or
ISoftwareBitmapStatics = 0 Or
IFaceDetectorStatics = 0
hr = CreateClass("Windows.Graphics.Imaging.BitmapDecoder", "{438CCB26-BCEF-4E95-BAD6-23A822E58D01}", @IBitmapDecoderStatics)
CompilerIf #MyRoDebug : Debug "CreateClass Windows.Graphics.Imaging.BitmapDecoder = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = CreateClass("Windows.Graphics.Imaging.BitmapEncoder", "{A74356A7-A4E4-4EB9-8E40-564DE7E1CCB2}", @IBitmapEncoderStatics)
CompilerIf #MyRoDebug : Debug "CreateClass Windows.Graphics.Imaging.BitmapEncoder = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = CreateClass("Windows.Graphics.Imaging.SoftwareBitmap", "{DF0385DB-672F-4A9D-806E-C2442F343E86}", @ISoftwareBitmapStatics)
CompilerIf #MyRoDebug : Debug "CreateClass Windows.Graphics.Imaging.SoftwareBitmap = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = CreateClass("Windows.Media.FaceAnalysis.FaceDetector", "{BC042D67-9047-33F6-881B-6746C1B218B8}", @IFaceDetectorStatics)
CompilerIf #MyRoDebug : Debug "CreateClass Windows.Media.FaceAnalysis.FaceDetector = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
EndIf
If IBitmapDecoderStatics = 0 Or
IBitmapEncoderStatics = 0 Or
ISoftwareBitmapStatics = 0 Or
IFaceDetectorStatics = 0
Goto Release
EndIf
hr = IFaceDetectorStatics\CreateAsync(@IFaceDetector)
CompilerIf #MyRoDebug : Debug "IFaceDetectorStatics::CreateAsync = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IFaceDetector
WaitForAsync(@IFaceDetector)
hr = IFaceDetectorStatics\GetSupportedBitmapPixelFormats(@IReadOnlyList)
CompilerIf #MyRoDebug : Debug "IFaceDetectorStatics::GetSupportedBitmapPixelFormats = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IReadOnlyList
hr = IReadOnlyList\count(@iCount)
CompilerIf #MyRoDebug : Debug "IReadOnlyList::count = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
For i = 0 To iCount -1
hr = IReadOnlyList\get_Item(i, @BitmapPixelFormat)
CompilerIf #MyRoDebug : Debug "ILanguageList::get_Item = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
sSupportedBitmapPixelFormats + "|" + Str(BitmapPixelFormat) + "|"
Next
IReadOnlyList\Release()
EndIf
IFaceDetectorStatics\Release()
EndIf
hr = IBitmapDecoderStatics\CreateAsync(IRandomAccessStream, @IBitmapDecoder)
CompilerIf #MyRoDebug : Debug "IBitmapDecoderStatics::CreateAsync = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IBitmapDecoder
WaitForAsync(@IBitmapDecoder)
hr = IBitmapDecoder\QueryInterface(?IID_IBitmapFrame, @IBitmapFrame)
CompilerIf #MyRoDebug : Debug "IBitmapDecoder::QueryInterface = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IBitmapFrame
hr = IBitmapFrame\PixelWidth(@width)
CompilerIf #MyRoDebug : Debug "IBitmapFrame::PixelWidth = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = IBitmapFrame\PixelHeight(@height)
CompilerIf #MyRoDebug : Debug "IBitmapFrame::PixelHeight = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = IBitmapFrame\BitmapPixelFormat(@BitmapPixelFormat)
CompilerIf #MyRoDebug : Debug "IBitmapFrame::BitmapPixelFormat = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = IBitmapDecoder\QueryInterface(?IID_IBitmapFrameWithSoftwareBitmap, @IBitmapFrameWithSoftwareBitmap)
CompilerIf #MyRoDebug : Debug "IBitmapDecoder::QueryInterface = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IBitmapFrameWithSoftwareBitmap
If (height > maxheight)
hr = IBitmapEncoderStatics\CreateForTranscodingAsync(IRandomAccessStream, IBitmapDecoder, @IBitmapEncoder)
CompilerIf #MyRoDebug : Debug "IBitmapEncoderStatics::CreateForTranscodingAsync = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IBitmapEncoder
WaitForAsync(@IBitmapEncoder)
hr = IBitmapEncoder\BitmapTransform(@IBitmapTransform)
CompilerIf #MyRoDebug : Debug "IBitmapEncoder::BitmapTransform = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IBitmapTransform
hr = IBitmapTransform\ScaledWidth((maxheight/height*width))
CompilerIf #MyRoDebug : Debug "IBitmapTransform::ScaledWidth = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = IBitmapTransform\ScaledHeight(maxheight)
CompilerIf #MyRoDebug : Debug "IBitmapTransform::ScaledHeight = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = IBitmapFrameWithSoftwareBitmap\GetSoftwareBitmapTransformedAsync(BitmapPixelFormat, 0, IBitmapTransform, 0, 0, @ISoftwareBitmap)
CompilerIf #MyRoDebug : Debug "IBitmapFrameWithSoftwareBitmap::GetSoftwareBitmapTransformedAsync = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
EndIf
EndIf
Else
hr = IBitmapFrameWithSoftwareBitmap\GetSoftwareBitmapAsync(@ISoftwareBitmap)
CompilerIf #MyRoDebug : Debug "IBitmapFrameWithSoftwareBitmap::GetSoftwareBitmapTransformedAsync = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
EndIf
If ISoftwareBitmap
WaitForAsync(@ISoftwareBitmap)
If Not FindString(sSupportedBitmapPixelFormats, "|" + BitmapPixelFormat + "|")
hr = ISoftwareBitmapStatics\Convert(ISoftwareBitmap, 62, @ISoftwareBitmapTemp)
CompilerIf #MyRoDebug : Debug "ISoftwareBitmapStatics::Convert = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
hr = ISoftwareBitmap\QueryInterface(?IID_IClosable, @IClosable)
If IClosable
IClosable\Close()
IClosable\Release()
EndIf
ISoftwareBitmap\Release()
ISoftwareBitmap = ISoftwareBitmapTemp
EndIf
hr = IFaceDetector\DetectFacesAsync(ISoftwareBitmap, @IDetectedFaceList)
CompilerIf #MyRoDebug : Debug "IFaceDetector\DetectFacesAsync = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IDetectedFaceList
WaitForAsync(@IDetectedFaceList)
hr = IDetectedFaceList\count(@iCount)
CompilerIf #MyRoDebug : Debug "IDetectedFaceList::count = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
For i = 0 To iCount -1
hr = IDetectedFaceList\get_Item(i, @IDetectedFace)
CompilerIf #MyRoDebug : Debug "IDetectedFaceList::get_Item = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IDetectedFace
AddElement(rcList())
hr = IDetectedFace\FaceBox(@rcList())
CompilerIf #MyRoDebug : Debug "IDetectedFace::FaceBox = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
IDetectedFace\Release()
IDetectedFace = 0
EndIf
Next
EndIf
hr = ISoftwareBitmap\QueryInterface(?IID_IClosable, @IClosable)
CompilerIf #MyRoDebug : Debug "ISoftwareBitmap::QueryInterface = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IClosable
IClosable\Close()
IClosable\Release()
IClosable = 0
EndIf
EndIf
EndIf
EndIf
EndIf
Release:
If IBitmapDecoder : IBitmapDecoder\Release() : EndIf
If IBitmapFrame : IBitmapFrame\Release() : EndIf
If (height > maxheight)
If IBitmapEncoder : IBitmapEncoder\Release() : EndIf
If IBitmapTransform : IBitmapTransform\Release() : EndIf
EndIf
If IBitmapFrameWithSoftwareBitmap : IBitmapFrameWithSoftwareBitmap\Release() : EndIf
If IDetectedFaceList : IDetectedFaceList\Release() : EndIf
If IFaceDetector : IFaceDetector\Release() : EndIf
EndProcedure
;-
;- Module Exports
;-
Procedure.s get_Languages()
ProcedureReturn GetOCRFromImage(0, "", 1)
EndProcedure
Procedure.s get_TextFromFile(sFile.s, sLanguage.s = "")
Protected sOutPut.s
Protected IRandomAccessStream.IRandomAccessStream = FileToRandomAccessStream(sFile)
If IRandomAccessStream
sOutPut = GetOCRFromImage(IRandomAccessStream, sLanguage, 0)
Protected IClosable.IClosable
Protected hr.l = IRandomAccessStream\QueryInterface(?IID_IClosable, @IClosable)
CompilerIf #MyRoDebug : Debug "IRandomAccessStream::QueryInterface = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IClosable
IClosable\Close()
IClosable\Release()
IClosable = 0
EndIf
IRandomAccessStream\Release()
EndIf
ProcedureReturn sOutPut
EndProcedure
Procedure.s get_TextFromImageID(ImageID, sLanguage.s = "")
Protected sOutPut.s
Protected IRandomAccessStream.IRandomAccessStream = HBitmapToRandomAccessStream(ImageID)
If IRandomAccessStream
sOutPut = GetOCRFromImage(IRandomAccessStream, sLanguage, 0)
Protected IClosable.IClosable
Protected hr.l = IRandomAccessStream\QueryInterface(?IID_IClosable, @IClosable)
CompilerIf #MyRoDebug : Debug "IRandomAccessStream::QueryInterface = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IClosable
IClosable\Close()
IClosable\Release()
IClosable = 0
EndIf
IRandomAccessStream\Release()
EndIf
ProcedureReturn sOutPut
EndProcedure
Procedure.s get_TextFromHWND(hWND, sLanguage.s = "")
Protected sOutPut.s
Protected ImageID = HBitmapFromHWND(hWND)
If ImageID
Protected IRandomAccessStream.IRandomAccessStream = HBitmapToRandomAccessStream(ImageID)
If IRandomAccessStream
sOutPut = GetOCRFromImage(IRandomAccessStream, sLanguage, 0)
Protected IClosable.IClosable
Protected hr.l = IRandomAccessStream\QueryInterface(?IID_IClosable, @IClosable)
CompilerIf #MyRoDebug : Debug "IRandomAccessStream::QueryInterface = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IClosable
IClosable\Close()
IClosable\Release()
IClosable = 0
EndIf
IRandomAccessStream\Release()
EndIf
DeleteObject_(ImageID)
EndIf
ProcedureReturn sOutPut
EndProcedure
;-
Procedure get_FacesFromFile(sFile.s, List rcList.rect())
Protected iCount
Protected IRandomAccessStream.IRandomAccessStream = FileToRandomAccessStream(sFile)
If IRandomAccessStream
iCount = facedetect(IRandomAccessStream, rcList())
Protected IClosable.IClosable
Protected hr = IRandomAccessStream\QueryInterface(?IID_IClosable, @IClosable)
CompilerIf #MyRoDebug : Debug "IRandomAccessStream::QueryInterface = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IClosable
IClosable\Close()
IClosable\Release()
IClosable = 0
EndIf
IRandomAccessStream\Release()
EndIf
ProcedureReturn iCount
EndProcedure
Procedure get_FacesFromImageID(ImageID, List rcList.rect())
Protected iCount
Protected IRandomAccessStream.IRandomAccessStream = HBitmapToRandomAccessStream(ImageID)
If IRandomAccessStream
iCount = facedetect(IRandomAccessStream, rcList())
Protected IClosable.IClosable
Protected hr = IRandomAccessStream\QueryInterface(?IID_IClosable, @IClosable)
CompilerIf #MyRoDebug : Debug "IRandomAccessStream::QueryInterface = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IClosable
IClosable\Close()
IClosable\Release()
IClosable = 0
EndIf
IRandomAccessStream\Release()
EndIf
ProcedureReturn iCount
EndProcedure
Procedure get_FacesFromHWND(hWND, List rcList.rect())
Protected iCount
Protected ImageID = HBitmapFromHWND(hWND)
If ImageID
Protected IRandomAccessStream.IRandomAccessStream = HBitmapToRandomAccessStream(ImageID)
If IRandomAccessStream
iCount = facedetect(IRandomAccessStream, rcList())
Protected IClosable.IClosable
Protected hr = IRandomAccessStream\QueryInterface(?IID_IClosable, @IClosable)
CompilerIf #MyRoDebug : Debug "IRandomAccessStream::QueryInterface = 0x" + Hex(hr, #PB_Long) : CompilerEndIf
If IClosable
IClosable\Close()
IClosable\Release()
IClosable = 0
EndIf
IRandomAccessStream\Release()
EndIf
DeleteObject_(ImageID)
EndIf
ProcedureReturn iCount
EndProcedure
EndModule
CompilerIf #PB_Compiler_IsMainFile
Structure tOCR_DEMO
sFile.s
ImageID.i
;
sLanguages.s
sFromFile.s
sFromImage.s
List rcFaces.Rect()
EndStructure
;-
Procedure OCR_DEMO(*OCR_DEMO.tOCR_DEMO)
*OCR_DEMO\sLanguages = WinOCR::get_Languages()
If *OCR_DEMO\sFile <> ""
*OCR_DEMO\sFromFile = WinOCR::get_TextFromFile(*OCR_DEMO\sFile)
EndIf
If *OCR_DEMO\ImageID
*OCR_DEMO\sFromImage = WinOCR::get_TextFromImageID(*OCR_DEMO\ImageID)
EndIf
WinOCR::get_FacesFromFile(*OCR_DEMO\sFile, *OCR_DEMO\rcFaces())
EndProcedure
Procedure HBitmapFromScreen(X, Y, W, H)
Protected HDC = GetDC_(0)
Protected HBM = CreateCompatibleBitmap_(HDC, W, H)
Protected PDC = CreateCompatibleDC_(HDC)
SelectObject_(PDC, HBM)
BitBlt_(PDC, 0, 0, W, H, HDC, X, Y, #SRCCOPY)
DeleteDC_(PDC)
ReleaseDC_(0, HDC)
ProcedureReturn HBM
EndProcedure
Define tOCR_DEMO.tOCR_DEMO
tOCR_DEMO\sFile = OpenFileRequester("Choose Image File", "Image.png", "ImageFiles (*.png;jpg;gif;bmp;tif;tiff)|*.png;*.jpg;*.gif;*.bmp;*.tif;*.tiff", 0)
If tOCR_DEMO\sFile
;UsePNGImageDecoder()
;UseJPEGImageDecoder()
;UseTIFFImageDecoder()
;LoadImage(0, tOCR_DEMO\sFile)
;tOCR_DEMO\ImageID = ImageID(0)
tOCR_DEMO\ImageID = HBitmapFromScreen(0, 0, 800, 600)
Define thread = CreateThread(@OCR_DEMO(), @tOCR_DEMO)
If thread
WaitThread(thread)
Define sFaces.s = "Detected Faces = " + Str(ListSize(tOCR_DEMO\rcFaces())) + #CRLF$
ForEach tOCR_DEMO\rcFaces()
sFaces + #CRLF$ + Str(tOCR_DEMO\rcFaces()\left) + ", " + Str(tOCR_DEMO\rcFaces()\top) + ", " + Str(tOCR_DEMO\rcFaces()\right) + ", " + Str(tOCR_DEMO\rcFaces()\bottom)
Next
MessageRequester("Available Languages", tOCR_DEMO\sLanguages)
MessageRequester("TextFromFile", tOCR_DEMO\sFromFile)
MessageRequester("TextFromImageID", tOCR_DEMO\sFromImage)
MessageRequester("Faces", sFaces)
EndIf
EndIf
CompilerEndIf