Windows 10 OCR and Face detection

Share your advanced PureBasic knowledge/code with the community.
XCoder
User
User
Posts: 68
Joined: Tue Dec 31, 2013 9:18 pm

Re: Windows 10 OCR and Face detection

Post by XCoder »

The OCR code by fryquez has been useful for OCRing documents that have been scanned into a PDF file.

The program below uses this code to OCR text on the screen, enabling the user to draw a border around the text to be OCR'd using a mouse. It puts the scanned text into a rtf control where the text can be tidied up, saved as a .rtf file or copied [Using CTRL-C] for pasting into a word processor eg LibreWrite for advanced formatting.

Code: Select all


EnableExplicit

XIncludeFile "OCRModule2.pbi"
UseModule WinOCR
XIncludeFile "GetScreenRegion.pbi"
UseModule ModuleGetScreenRegion

Enumeration
  #MainWindow = 10
  #Editor
  #MainMenu
  #mnuSave
  #mnuClear
  #mnuCopy
  #HK_1 ;Constant For hot key
  #IDSysTray
  #TrayIcon
  #PopUpTrayMenu
  #mnuTrayIconShow
  #mnuExit
  #mnuCHMHelp
EndEnumeration

#ST_SELECTION	= 2 ;Required by RTFEditor_InsertRTFText()

Global Quit=#False, MenuID, hEdit
Global strucOCR.STRUC_OCR ; Declare OCR Structure
Global bIsIconised

Macro LOWORD(value)
  (value & $FFFF)
EndMacro

Macro HIWORD(value)
  ((value >> 16) & $FFFF)
EndMacro

Procedure CreateTrayMenu()
CreatePopupMenu(#PopUpTrayMenu)
MenuItem(#mnuTrayIconShow,"Show OCR window")
MenuItem(#mnuExit,"Exit OCR reader")
MenuItem(#mnuCHMHelp, "Help")
EndProcedure

Procedure HideOCRWindow()
  If bIsIconised = #False ;Must not call AddSysTrayIcon() if icon is already shown
    bIsIconised = #True
    HideWindow(#MainWindow, #True)
    AddSysTrayIcon(#IDSysTray, WindowID(#MainWindow), ImageID(#TrayIcon))
    SysTrayIconToolTip(#IDSysTray, "OCR Screen reader")
    EndIf
  EndProcedure

Procedure ShowOCRWindow()
  If bIsIconised = #True ; ;Must not call RemoveSysTrayIcon() if icon is not shown
    bIsIconised = #False
    RemoveSysTrayIcon(#IDSysTray) ;Need to do this only if window is iconised
    HideWindow(#MainWindow, #False)
    SetActiveWindow(#MainWindow)
    SetWindowState(#MainWindow, #PB_Window_Normal)
  EndIf
EndProcedure

Procedure CreateMainMenu()
  CreateImageMenu(#MainMenu, WindowID(#MainWindow))    ; menu creation starts....
  MenuTitle("&Actions")
  MenuItem(#mnuSave, "Save")
  MenuItem(#mnuCopy, "Copy Ctrl-C")
  MenuItem(#mnuClear, "Clear")
  MenuTitle("&Help")
  MenuItem(#mnuCHMHelp, "Help")
EndProcedure

Procedure Editor_GetExtentOfFile(Filename$)
  Protected ext$, FileType
  ext$=Right(Filename$, 3)
  If ext$="txt"
    FileType=#SF_TEXT
  Else
    FileType=#SF_RTF
  EndIf
  ProcedureReturn FileType
EndProcedure

Procedure StreamSaveFileCallback(hFile, pbBuff, cb, pcb) 
  ProcedureReturn WriteFile_(hFile, pbBuff, cb, pcb, 0)!1 
EndProcedure 

Procedure GetExtentOfFile(Filename$)
  Protected ext$, FileType
  ext$=Right(Filename$, 3)
  If ext$="txt"
    FileType=#SF_TEXT
  Else
    FileType=#SF_RTF
  EndIf
  ProcedureReturn FileType
EndProcedure

Procedure.s Editor_SaveFile(hRichEd)
  ;This procedure requests the name of the file to which the current document is to be saved
  ;It will create a file with this name or, if the file exists, overwrite the existing file
  ;It returns the name of the file used to store the document or an empty string if the file could not be created/overwritten
  Protected StreamData.EDITSTREAM, Filename$="", FileType
  Protected FileID = 0; ;This can be any number to ID the file
                      ;Filename$ = SaveFileRequester("Save file", "", "RTF (.rtf)|*.rtf", 0) ;set name of file to save
                      ;Filename$ = SaveFileRequester("Save file", "", "RTF (.rtf)|*.rtf", 0) ;set name of file to save
  Filename$ = SaveFileRequester("Save file", "", "RTF (*.rtf)|*.rtf|Text (.txt)|*.txt",0) ;set name of file to save
  
  If Filename$=""
    MessageRequester("File not saved", "A correct filename was not supplied:"+Chr(13)+Filename$, #PB_MessageRequester_Warning)
    
  Else
    
    FileType= GetExtentOfFile(Filename$)
    If FileType=#SF_RTF And GetExtensionPart(Filename$) <> "rtf" ;[UPDATED 22 July 2021]
      Filename$=Filename$+".rtf"
    EndIf
    
    If CreateFile(FileID, Filename$) 
      StreamData\dwCookie = FileID(FileID) ;Get window handle for the file
      StreamData\dwError = #Null 
      StreamData\pfnCallback = @StreamSaveFileCallback() ; set the address of the callback procedure
      SendMessage_(hRichEd, #EM_STREAMOUT, FileType, @StreamData)
      CloseFile(FileID) 
    EndIf   
    
  EndIf
  
  ProcedureReturn Filename$
EndProcedure

Procedure Editor_SetFontSize(hRichEd, Fontsize.l)
  Protected format.CHARFORMAT 
  format\cbSize = SizeOf(CHARFORMAT) 
  format\dwMask = #CFM_SIZE 
  format\yHeight = FontSize *20
  SendMessage_(hRichEd, #EM_SETCHARFORMAT, #SCF_SELECTION, @format) 
EndProcedure 

Procedure Editor_ClearText(hRichEd)
  Protected blankText$="", st.SETTEXTEX
  SendMessage_(hRichEd,  #EM_SETSEL, 0, -1) ; Select all text
  st\flags = #ST_SELECTION
  st\codepage = #CP_ACP ;#CP_UTF8 ;
  SendMessage_(hRichEd, #EM_SETTEXTEX, @st, @blankText$)
  SendMessage_(hRichEd, #EM_SETMODIFY, #False, 0) ;Clear the modified flag for the RTE
EndProcedure

Procedure RTFEditor_InsertRTFText(hRichEd, rtfText$)
  ;This procedure inserts text with rtf format into the rtf control at the current insertion point
  ;If text in the rich text editor is selected then it will be replaced by the contents of rtfText$
  ;hRichEd - The window handle for the rtf control
  ;rtfText$ - the rtf text; this must start with {\rtf
  Protected RTFbuffer, st.SETTEXTEX
  RTFbuffer = AllocateMemory(Len(rtfText$)+1)
  If RTFbuffer
    PokeS(RTFbuffer, rtfText$, #PB_Any, #PB_Ascii)
    st\flags = #ST_SELECTION
    st\codepage = #CP_ACP ;#CP_UTF8 ;
    SendMessage_(hRichEd, #EM_SETTEXTEX, @st, RTFbuffer)
    FreeMemory(RTFbuffer)
  EndIf
EndProcedure

Procedure RunOCR(*strucOCR.STRUC_OCR)
  ;This is a thread created by OCRText()
  ;It OCRs the text in the selected region of the screen
  *strucOCR\sLanguages = WinOCR::get_Languages()
;   If *strucOCR\sFile <> ""
;     *strucOCR\sFromFile = WinOCR::get_TextFromFile(*strucOCR\sFile)
;   EndIf
  If *strucOCR\ImageID
    *strucOCR\sFromImage = WinOCR::get_TextFromImageID(*strucOCR\ImageID)
  EndIf  
EndProcedure

Procedure HBitmapFromScreen(X, Y, W, H)
  ;This creates a bitmap for the OCR to process, based on the selected region of the screen
  ;X, Y, W, H represents the region of the screen to process
  ;X and Y are the top x- and y- coordinates of the selected region
  ;W - the width of the selected region
  ;H - the height of the selected region.
  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

Procedure OCRText(*strucOCR.STRUC_OCR)
  Define thread = CreateThread(@RunOCR(), *strucOCR)
  If thread
    WaitThread(thread)
  EndIf
EndProcedure

Procedure DoOCR()
  strucOCR\ImageID = HBitmapFromScreen(ScreenRegion\X, ScreenRegion\Y, ScreenRegion\width, ScreenRegion\height)
  OCRText(@strucOCR)
EndProcedure

Procedure MainWinCallback(WindowID, uMsg, WParam, LParam)
  Protected MainWidth, MainHeight, Result
    Result = #PB_ProcessPureBasicEvents
    Select uMsg
    Case #WM_HOTKEY 
      Select WParam 
        Case #HK_1  ;Hotkey with ref #HK_1 was pressed
          HideOCRWindow() ;Needed as if window is restored under the window with text to OCR then only part of the screen is read - don't know why this is?
          GetScreenRegion()
          DoOCR()
          ;ShowWindow_(WindowID(#MainWindow),#SW_RESTORE)
          ShowOCRWindow()
    
  Editor_SetFontSize(hEdit, 12) 
    RTFEditor_InsertRTFText(hEdit, strucOCR\sFromImage)
      EndSelect
      
    Case #WM_SIZE ;Main window has been resized. Resize editor gadget
      MainWidth = LOWORD(lParam); // width of client area of resized window
      MainHeight = HIWORD(lParam); // height of client area of resized window
      MoveWindow_(hEdit, #PB_Any, #PB_Any, MainWidth, MainHeight, #False)
    EndSelect
    ProcedureReturn Result
EndProcedure


CatchImage(#TrayIcon, ?TrayIcon)
InitDesktop()

OpenWindow(#MainWindow, #PB_Any, #PB_Any, 550, 470, "OCR screen reader", #PB_Window_Invisible | #PB_Window_SizeGadget|#PB_Window_ScreenCentered | #PB_Window_SystemMenu  | #PB_Window_MinimizeGadget)
HideOCRWindow()
CreateMainMenu()
CreateTrayMenu()
hEdit = EditorGadget(#Editor, 10, 10, 500, 330)
Editor_SetFontSize(hEdit, 12) 

SetWindowCallback(@MainWinCallback(),#MainWindow) 
RegisterHotKey_(WindowID(#MainWindow), #HK_1, #MOD_SHIFT|#MOD_CONTROL|#MOD_ALT,#VK_B)

Repeat
  Select WaitWindowEvent()
      
    Case #PB_Event_Menu
      MenuID=EventMenu()
      Select MenuID
        Case  #mnuClear
          Editor_ClearText(hEdit)
        Case #mnuSave
          Editor_SaveFile(hEdit)
        Case #mnuCopy
          SendMessage_(hEdit, #WM_COPY, 0, 0)
        Case #mnuTrayIconShow
          ShowOCRWindow()
        Case #mnuExit
          UnregisterHotKey_(WindowID(#MainWindow), #HK_1)
          Quit = #True
        Case #mnuCHMHelp
          OpenHelp("OCR Screen Reader.chm", "ConvertPDFPageToText.html")
      EndSelect
      
    Case #PB_Event_MinimizeWindow: 
        HideOCRWindow()
      
    Case #PB_Event_SysTray
      Select EventType()
        Case #PB_EventType_RightClick
          DisplayPopupMenu(#PopUpTrayMenu,WindowID(#MainWindow))
        Case #PB_EventType_LeftClick
          ShowOCRWindow()
      EndSelect
      
    Case #PB_Event_CloseWindow
      Quit=#True
      UnregisterHotKey_(WindowID(#MainWindow), #HK_1)
      CloseWindow(#MainWindow)
  EndSelect
Until  Quit=#True
End

DataSection
 TrayIcon:
    IncludeBinary "OCRScreenReader.ico"  
EndDataSection
OCRModule2.pbi

Code: Select all

;This module is taken from the code at https://www.purebasic.fr/english/viewtopic.php?f=12&t=77835
; - Thanks to fryquez

;To use this module in another module, use:
;XIncludeFile "OCRModule.pbi"
;UseModule WinOCR

EnableExplicit

DeclareModule WinOCR
  
  Structure STRUC_OCR ;{
    sFile.s
    ImageID.i
    ;
     sLanguages.s  
    sFromFile.s
    sFromImage.s
  EndStructure ;}

  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
GetScreenRegion.pbi

Code: Select all

; This module enables the user to use a mouse to select a region of the screen.

; The module must be initialised by calling InitDesktop() once. Then a region of the screen can be selected by calling GetScreenRegion()
; After  calling GetScreenRegion(), a crosswire cursor is placed in the top-left corner of the screen. Use the mouse to
; move this cursor to the top-left corner of the region of the screen to be selected, then click the left mouse button and 
; hold it down while dragging the mouse to select the required region of the screen. This will draw a border to show the
; selected region. When the mouse is released, details of the selected region is stored in the structure SCREEN_REGION
; that is declared in the global ScreenRegion.SCREEN_REGION.


; This module was derived from the code at https://www.purebasic.fr/german/viewtopic.php?f=8&t=3949&start=10
; - Thanks to DarkDragon and mk-soft

;To use this module in another module, use:
;XIncludeFile "GetScreenRegion.pbi"
;UseModule ModuleGetScreenRegion

DeclareModule ModuleGetScreenRegion
  
  Structure SCREEN_REGION
    X.l ; Left co-ordinate of the selected region
    Y.l ; Top co-ordinate of the selected region
    Width.l ; width of the selected region
    Height.l ; height of the selected region
  EndStructure
  
  Global ScreenRegion.SCREEN_REGION
  
  Declare GetScreenRegion()
  Declare InitDesktop()
  
EndDeclareModule

Module ModuleGetScreenRegion
	
Procedure GetCurrentCursor(*pt.Point)
  ;Returns the handle of the current cursor
  Protected hWindow
  Protected dwThreadID
  Protected dwCurrentThreadID
  Protected hCursor, nil
  
  If GetCursorPos_(*pt)
    hWindow = WindowFromPoint_(*pt\x << 32 + *pt\y)
    If IsWindow_(hWindow)
      dwThreadID = GetWindowThreadProcessId_(hWindow, @nil)
      dwCurrentThreadID = GetCurrentThreadId_()
      
      If (dwCurrentThreadID <> dwThreadID)
        If AttachThreadInput_(dwCurrentThreadID, dwThreadID, 1)
          hCursor = GetCursor_()  ; gets handle of current cursor
          AttachThreadInput_(dwCurrentThreadID, dwThreadID, 0)
        EndIf
      Else
        hCursor = GetCursor_() ; gets handle of current cursor
      EndIf
    EndIf
  EndIf
  ProcedureReturn hCursor
EndProcedure

Procedure MakeDesktopScreenshot(ImageNr,x, y, Width, Height)
  
  Protected hImage, hDC, DeskDC, hCursor
  Protected pt.point
  
  hImage = CreateImage(ImageNr,Width,Height)
  If hImage
    hDC = StartDrawing(ImageOutput(ImageNr))
    If hDC
      DeskDC = GetDC_(GetDesktopWindow_())
      If DeskDC
        BitBlt_(hDC,0,0,Width,Height,DeskDC,x,y,#SRCCOPY)
      EndIf
      ReleaseDC_(GetDesktopWindow_(),DeskDC)
    EndIf

    hCursor = GetCurrentCursor(@pt.Point)
    DrawImage(hCursor, pt\x, pt\y)

    StopDrawing()
  EndIf
  
  ProcedureReturn hImage
EndProcedure

Procedure GetScreenRegion()
  Protected Mousex, MouseY, capMouse=0, oMouseX, oMouseY
  Protected v, Q
  Protected img

  MakeDesktopScreenshot(Img,0,0,DesktopWidth(0),DesktopHeight(0))
  OpenScreen(DesktopWidth(0), DesktopHeight(0), 32, "Capture")
  
  Repeat
    If IsScreenActive()
      ExamineMouse()
      
      MouseX = MouseX()
      MouseY = MouseY()
      If MouseButton(#PB_MouseButton_Left)
        If capMouse = 0
          oMouseX = MouseX
          oMouseY = MouseY
          capMouse = 1
        EndIf
      Else
        If capMouse = 1
          If MouseX < oMouseX : v = oMouseX : oMouseX = MouseX : MouseX = v : EndIf
          If MouseY < oMouseY : v = oMouseY : oMouseY = MouseY : MouseY = v : EndIf
          ScreenRegion\X = oMouseX
          ScreenRegion\Y = oMouseY
          ScreenRegion\Width = MouseX-oMouseX
          ScreenRegion\Height = MouseY-oMouseY
          Q = 1
        EndIf
      EndIf
      
      ClearScreen(0)
      StartDrawing(ScreenOutput())
      DrawImage(ImageID(0), 0, 0)
      DrawingMode(#PB_2DDrawing_Outlined | #PB_2DDrawing_XOr)
      If capMouse <> 0
        Box(oMouseX, oMouseY, MouseX-oMouseX, MouseY-oMouseY)
      EndIf
      DrawingMode(#PB_2DDrawing_XOr)
      Box(MouseX-1 , MouseY-10, 2 , 20)
      Box(MouseX-10, MouseY-1 , 20, 2 )
      StopDrawing()
      FlipBuffers()
    EndIf
    
    Delay(10)
  Until Q = 1
  CloseScreen()
  FreeImage(Img)
EndProcedure

Procedure InitDesktop()
  ExamineDesktops()
  InitSprite()
  InitMouse()
EndProcedure

  
EndModule
Some code has been adapted from other programmers in the PureBasic Forum (see credits in each part of the program).

When the program runs, an icon appears in the icon tray. After displaying the PDF page on screen using an appropriate Reader (I use SumatraPDF), press CTRL-ALT-SHIFT-B [you can change this hotkey if required]. This places a cross-hair cursor in the top left corner of the screen. Use the mouse to move this cursor to the top-left corner of the text to be OCR'd, then click the left mouse button and while holding it down, drag the mouse to select the required text. This will draw a border around the selected text. When the mouse button is released, the text in the selected region is OCR'd and the results appended to the RTF control of the OCR window.

The tray icon has a menu with three options:
(1) Show OCR window - this opens the main OCR window containing the OCR'd text (clicking the tray icon will also open the main OCR window)
(2) Exit.
(3) Help - this shows a help file

The main OCR window includes a simple menu named Actions with three options:
(1) Save - this opens a file dialog box enabling the OCR'd text to be saved to a rtf file
(2) Copy - this copies selected text from the main OCR window to the clipboard
(3) Clear - this clears the text in the rtf editor. If text is not cleared then when another page is OCR'd then the result of the new OCR is appended to the previous one in the rtf control.

The tray image icon and help file for this program may be downloaded from:
https://www.mediafire.com/file/tswk927z ... r.ico/file
https://www.mediafire.com/file/wcz68oij ... r.chm/file

No OCR engine is perfect and - as with commercially available OCR programs - the text will need checking after it has been OCR'd [I've noticed that it sometimes omits words from the OCR process]. The more complex program at the following link includes a spelling checker. After OCRing a page any mispelt words are underlined with a red wavy line in the RTF control and these can be corrected manually or, if the mispelt word is selected, right-clicking it will bring up suggested spellings. Words can be added to the spell-checking dictionary.

https://www.mediafire.com/file/ruq0nt37 ... 2.zip/file
Last edited by XCoder on Tue Apr 05, 2022 10:28 am, edited 1 time in total.
dige
Addict
Addict
Posts: 1247
Joined: Wed Apr 30, 2003 8:15 am
Location: Germany
Contact:

Re: Windows 10 OCR and Face detection

Post by dige »

Big thx XCoder! This is great!! :D
"Daddy, I'll run faster, then it is not so far..."
dige
Addict
Addict
Posts: 1247
Joined: Wed Apr 30, 2003 8:15 am
Location: Germany
Contact:

Re: Windows 10 OCR and Face detection

Post by dige »

@fryquez: If you install the windows HEIF extension (https://www.microsoft.com/en-us/p/heif- ... verviewtab or https://www.copytrans.de/copytransheic/), your tool is also able to load .heif, .heic images in the High Efficiency Image File format.

Is it possible to convert an image opened by IRandomAccessStream to a Purebasic image or to Windows Bitmap?
Basically the reverse of Procedure HBitmapToRandomAccessStream (hBitmap) like

hBitmap = RandomAccessStreamtoHBitmap (IRandomAccessStream)?
"Daddy, I'll run faster, then it is not so far..."
fryquez
Enthusiast
Enthusiast
Posts: 362
Joined: Mon Dec 21, 2015 8:12 pm

Re: Windows 10 OCR and Face detection

Post by fryquez »

@dige: Yes, it's possible to use Windows RunTime to convert images to a HBITMAP.
But I would recommend to use WIC, which is much much easier.
dige
Addict
Addict
Posts: 1247
Joined: Wed Apr 30, 2003 8:15 am
Location: Germany
Contact:

Re: Windows 10 OCR and Face detection

Post by dige »

Thank you for your reply fryquez. But unfortunately that doesn't help me yet. My skills are limited. Do you have a link or a code example on how to work with "WIC"?

Kind regards

Dige
"Daddy, I'll run faster, then it is not so far..."
fryquez
Enthusiast
Enthusiast
Posts: 362
Joined: Mon Dec 21, 2015 8:12 pm

Re: Windows 10 OCR and Face detection

Post by fryquez »

Code: Select all

EnableExplicit

Macro WIC_SUCCEEDED(HRESULT)
  (HRESULT & $80000000 = 0)
EndMacro

#WICBitmapInterpolationModeNearestNeighbor	= 0
#WICBitmapInterpolationModeLinear	= 1
#WICBitmapInterpolationModeCubic	= 2
#WICBitmapInterpolationModeFant	= 3
#WICBitmapInterpolationModeHighQualityCubic	= 4
#WICBITMAPINTERPOLATIONMODE_FORCE_DWORD	= $7fffffff

#WICBitmapTransformRotate0	= 0
#WICBitmapTransformRotate90	= 1
#WICBitmapTransformRotate180	= 2
#WICBitmapTransformRotate270	= 3
#WICBitmapTransformFlipHorizontal	= 8
#WICBitmapTransformFlipVertical	= $10
#WICBITMAPTRANSFORMOPTIONS_FORCE_DWORD	= $7fffffff

Interface IWICMetadataQueryReader Extends IUnknown
  GetContainerFormat(*pguidContainerFormat)
  GetLocation(cchMaxLength, *wzNamespace, *pcchActualLength)
  GetMetadataByName(wzName, *pvarValue)
  GetEnumerator(*ppIEnumString)
EndInterface

Interface IWICComponentInfo Extends IUnknown
  GetComponentType(*pType)
  GetCLSID(*pclsid.CLSID)
  GetSigningStatus(*pStatus)
  GetAuthor(cchAuthor, *wzAuthor, *pcchActual)
  GetVendorGUID(*pguidVendor.GUID)
  GetVersion(cchVersion, *wzVersion, *pcchActual)
  GetSpecVersion(cchSpecVersion, *wzSpecVersion, *pcchActual)
  GetFriendlyName(cchFriendlyName, *wzFriendlyName, *pcchActual)
EndInterface

Interface IWICBitmapCodecInfo Extends IWICComponentInfo
  GetContainerFormat(*pguidContainerFormat.GUID)
  GetPixelFormats(cFormats, *pguidPixelFormats.GUID, *pcActual.l)
  GetColorManagementVersion(cchColorManagementVersion, *wzColorManagementVersion, *pcchActual.l)
  GetDeviceManufacturer(cchDeviceManufacturer, *wzDeviceManufacturer, *pcchActual.l)
  GetDeviceModels(cchDeviceModels, *wzDeviceModels, *pcchActual.l)  
  GetMimeTypes(cchMimeTypes, *wzMimeTypes, *pcchActual.l)
  GetFileExtensions(cchFileExtensions, *wzFileExtensions, *pcchActual.l)  
  DoesSupportAnimation(*pfSupportAnimation.l)
  DoesSupportChromakey(*pfSupportChromakey.l)
  DoesSupportLossless(*pfSupportLossless.l)
  DoesSupportMultiframe(*pfSupportMultiframe.l)  
  MatchesMimeType(wzMimeType, *pfMatches)  
EndInterface

Interface IWICImagingFactory Extends IUnknown
  CreateDecoderFromFilename(wzFilename.p-unicode, *pguidVendor, dwDesiredAccess,  metadataOptions, *ppIDecoder)
  CreateDecoderFromStream(*pIStream, *pguidVendor, metadataOptions, *ppIDecoder)
  CreateDecoderFromFileHandle(hFile, *pguidVendor, metadataOptions, *ppIDecoder)
  CreateComponentInfo(clsidComponent, *ppIInfo)
  CreateDecoder(guidContainerFormat, *pguidVendor, *ppIDecoder)
  CreateEncoder(guidContainerFormat, *pguidVendor, *ppIEncoder)
  CreatePalette(*ppIPalette)
  CreateFormatConverter(*ppIFormatConverter)
  CreateBitmapScaler(*ppIBitmapScaler)
  CreateBitmapClipper(*ppIBitmapClipper)
  CreateBitmapFlipRotator(*ppIBitmapFlipRotator)
  CreateStream(*ppIWICStream)
  CreateColorContext(*ppIWICColorContext)
  CreateColorTransformer(*ppIWICColorTransform)
  CreateBitmap(uiWidth, uiHeight, pixelFormat, option, *ppIBitmap)
  CreateBitmapFromSource(*piBitmapSource, option, *ppIBitmap)
  CreateBitmapFromSourceRect(*piBitmapSource, x, y, width, height, *ppIBitmap)
  CreateBitmapFromMemory(uiWidth, uiHeight, pixelFormat, cbStride, cbBufferSize, *pbBuffer, *ppIBitmap)
  CreateBitmapFromHBITMAP(hBitmap, hPalette, options, *ppIBitmap)
  CreateBitmapFromHICON(hIcon, *ppIBitmap)
  CreateComponentEnumerator(componentTypes, options, *ppIEnumUnknown)
  CreateFastMetadataEncoderFromDecoder(*pIDecoder, *ppIFastEncoder)
  CreateFastMetadataEncoderFromFrameDecode(*pIFrameDecoder, *ppIFastEncoder)
  CreateQueryWriter(guidMetadataFormat, *pguidVendor, *ppIQueryWriter)
  CreateQueryWriterFromReader(*pIQueryReader, *pguidVendor, *ppIQueryWriter)
EndInterface

Interface IWICStream Extends IStream
  InitializeFromIStream(Stream.IStream)
  InitializeFromFilename(*sFilename, AccessMode.l)
  InitializeFromMemory(*Buffer, BufferSize.l)
  InitializeFromIStreamRegion(Stream.IStream, Offset.q, MaxSize.q)
EndInterface

Interface IWICBitmapSource Extends IUnknown
  GetSize(*puiWidth, *puiHeight)
  GetPixelFormat(*pPixelFormat)
  GetResolution(*pDpiX, *pDpiY)
  CopyPalette(*pIPalette)
  CopyPixels(*prc, cbStride, cbBufferSize, *pbBuffer)
EndInterface

Interface IWICBitmapFlipRotator Extends IWICBitmapSource
  Initialize(*pISource, options)
EndInterface

Interface IWICBitmap Extends IWICBitmapSource
  Lock(*prcLock, flags, *ppILock)
  SetPalette(*pIPalette)
  SetResolution(dpiX.d, dpiY.d)
EndInterface

Interface IWICFormatConverter Extends IWICBitmapSource
  Initialize(*pISource, dstFormat, dither, *pIPalette, alphaThresholdPercent.d, paletteTranslate)
  CanConvert(srcPixelFormat, dstPixelFormat, *pfCanConvert)
EndInterface

Interface IWICBitmapDecoder Extends IUnknown
  QueryCapability(*pIStream, *pdwCapability)
  Initialize(*pIStream, cacheOptions)
  GetContainerFormat(*pguidContainerFormat)
  GetDecoderInfo(*ppIDecoderInfo)
  CopyPalette(*pIPalette)
  GetMetadataQueryReader(*ppIMetadataQueryReader)
  GetPreview(*ppIBitmapSource)
  GetColorContexts(cCount, *ppIColorContexts, *pcActualCount)
  GetThumbnail(*ppIThumbnail)
  GetFrameCount(*pCount)
  GetFrame(index, *ppIBitmapFrame)
EndInterface

Interface IWICBitmapFrameDecode Extends IWICBitmapSource
  GetMetadataQueryReader(*ppIMetadataQueryReader)
  GetColorContexts(cCount, *ppIColorContexts, *pcActualCount)
  GetThumbnail(*ppIThumbnail)
EndInterface

Interface IWICBitmapScaler Extends IWICBitmapSource
  Initialize(*pISource, uiWidth, uiHeight, mode)
EndInterface


Macro WIC_DEFINE_GUID(label,l1,w1,w2,b1,b2,b3,b4,b5,b6,b7,b8)
  label:
  Data.l l1
  Data.w w1,w2
  Data.b b1,b2,b3,b4,b5,b6,b7,b8
EndMacro


DataSection
  WIC_DEFINE_GUID(CLSID_WICImagingFactory        , $cacaf262,$9370,$4615,$a1,$3b,$9f,$55,$39,$da,$4c,$0a)
  WIC_DEFINE_GUID(IID_IWICImagingFactory         , $ec5ec8a9,$c395,$4314,$9c,$77,$54,$d7,$a9,$35,$ff,$70)
  WIC_DEFINE_GUID(CLSID_WICImagingFactory2       , $317d06e8,$5f24,$433d,$bd,$f7,$79,$ce,$68,$d8,$ab,$c2)
  WIC_DEFINE_GUID(IID_IWICImagingFactory2        , $7B816B45,$1996,$4476,$B1,$32,$DE,$9E,$24,$7C,$8A,$F0)
  WIC_DEFINE_GUID(GUID_ContainerFormatBmp        , $0af1d87e,$fcfe,$4188,$bd,$eb,$a7,$90,$64,$71,$cb,$e3)
  WIC_DEFINE_GUID(GUID_ContainerFormatPng        , $1b7cfaf4,$713f,$473c,$bb,$cd,$61,$37,$42,$5f,$ae,$af)
  WIC_DEFINE_GUID(GUID_ContainerFormatJpeg       , $19e4a5aa,$5662,$4fc5,$a0,$c0,$17,$58,$02,$8e,$10,$57)
  WIC_DEFINE_GUID(GUID_ContainerFormatTiff       , $163bcc30,$e2e9,$4f0b,$96,$1d,$a3,$e9,$fd,$b7,$88,$a3)
  WIC_DEFINE_GUID(GUID_ContainerFormatGif        , $1f8a5601,$7d4d,$4cbd,$9c,$82,$1b,$c8,$d4,$ee,$b9,$a5)
  WIC_DEFINE_GUID(GUID_WICPixelFormat32bppBGR    , $6fddc324,$4e03,$4bfe,$b1,$85,$3d,$77,$76,$8d,$c9,$0e)
  WIC_DEFINE_GUID(GUID_WICPixelFormat32bppPBGRA  , $6fddc324,$4e03,$4bfe,$b1,$85,$3d,$77,$76,$8d,$c9,$10)
  WIC_DEFINE_GUID(IID_IWICPixelFormatInfo        , $E8EDA601,$3D48,$431a,$AB,$44,$69,$05,$9B,$E8,$8B,$BE)
  WIC_DEFINE_GUID(IID_IWICComponentInfo          , $23BC3F0A,$698B,$4357,$88,$6B,$F2,$4D,$50,$67,$13,$34)
  WIC_DEFINE_GUID(IID_IWICBitmapSource           , $00000120,$a8f2,$4877,$ba,$0a,$fd,$2b,$66,$45,$fb,$94)
  
  WIC_DEFINE_GUID(IID_IWICBitmapCodecInfo        , $E87A44C4,$B76E,$4C47,$8B,  9,$29,$8E,$B1,$2A,$27,$14)
  
EndDataSection




Global g__pIWICFactory.IWICImagingFactory

Procedure WIC_Initialize_Factory()
  ProcedureReturn CoCreateInstance_(?CLSID_WICImagingFactory, 0, #CLSCTX_INPROC_SERVER, ?IID_IWICImagingFactory, @g__pIWICFactory)  
EndProcedure



Procedure WIC_CreateDIBSectionFromBitmapSource(*pToRenderBitmapSource.IWICBitmapSource, *hDIBBitmap.Integer, iOriantation = 0)
  
  Protected bminfo.BITMAPINFO
  Protected width, height, cbStride, cbImage, hdcScreen, *pvImageBits
  Protected hr.l = *pToRenderBitmapSource\GetSize(@width, @height)
  
  If (iOriantation & #WICBitmapTransformRotate90) Or (iOriantation & #WICBitmapTransformRotate270)
    cbStride = height
    height = width
    width = cbStride
  EndIf
  
  ZeroMemory_(@bminfo, SizeOf(bminfo))
  bminfo\bmiHeader\biSize         = SizeOf(BITMAPINFOHEADER)
  bminfo\bmiHeader\biWidth        = width                   
  bminfo\bmiHeader\biHeight       = 0 - height
  bminfo\bmiHeader\biPlanes       = 1                       
  bminfo\bmiHeader\biBitCount     = 32                      
  bminfo\bmiHeader\biCompression  = #BI_RGB                  
  
  hdcScreen = GetDC_(0)
  *hDIBBitmap\i = CreateDIBSection_(hdcScreen, @bminfo, #DIB_RGB_COLORS, @*pvImageBits, #Null, 0)
  ReleaseDC_(0, hdcScreen)
  
  cbStride = width * 4
  cbImage = cbStride * height
  
  If iOriantation = 0
    hr = *pToRenderBitmapSource\CopyPixels(#Null, cbStride, cbImage, *pvImageBits)
    If Not WIC_SUCCEEDED(hr)
      DeleteObject_(*hDIBBitmap\i)
      *hDIBBitmap\i = 0
    EndIf
    
    ProcedureReturn hr
  EndIf
  
  Protected *pIFlipRotator.IWICBitmapFlipRotator
  hr = g__pIWICFactory\CreateBitmapFlipRotator(@*pIFlipRotator)            
  If WIC_SUCCEEDED(hr)
    hr = *pIFlipRotator\Initialize(*pToRenderBitmapSource, iOriantation)
    hr = *pIFlipRotator\CopyPixels(#Null, cbStride, cbImage, *pvImageBits)
    If Not WIC_SUCCEEDED(hr)
      DeleteObject_(*hDIBBitmap\i)
      *hDIBBitmap\i = 0
    EndIf
    *pIFlipRotator\Release()
    ProcedureReturn hr
  EndIf
    
EndProcedure



Procedure WIC_CatchImage(*Memory, iSize, *cx.Integer = 0, *cy.Integer = 0, *iFrame.Integer = 0)
  
  Protected *pDecoder.IWICBitmapDecoder
  Protected *pFrame.IWICBitmapFrameDecode
  Protected *pToRenderBitmapSource.IWICBitmapSource
  Protected *pScaler.IWICBitmapScaler
  Protected *pConverter.IWICFormatConverter
  Protected *WICBitmapSrc.IWICBitmapSource
  Protected *IWICStream.IWICStream
  Protected hBitmap, width, height, hr.l, bDoReSize, index
  
  
  If Not g__pIWICFactory Or g__pIWICFactory\CreateStream(@*IWICStream)
    Debug "g__pIWICFactory !"
    ProcedureReturn 0
  EndIf
    
  hr = *IWICStream\InitializeFromMemory(*Memory, iSize)  
  If WIC_SUCCEEDED(hr)
    hr = g__pIWICFactory\CreateDecoderFromStream(*IWICStream, 0, 0, @*pDecoder)    
    If WIC_SUCCEEDED(hr)
      
      If *iFrame
        index = *iFrame\i
      EndIf
      
      hr = *pDecoder\GetFrame(index, @*pFrame)
      If WIC_SUCCEEDED(hr)
        
        If *iFrame And *iFrame\i = 0
          *pDecoder\GetFrameCount(@*iFrame\i)
        EndIf
        
        Protected *pQueryReader.IWICMetadataQueryReader
        hr = *pFrame\GetMetadataQueryReader(@*pQueryReader)
        If WIC_SUCCEEDED(hr)          
          Protected bitmapTransformationOptions, VariantMetaData.VARIANT
          hr = *pQueryReader\GetMetadataByName(@"/app1/{ushort=0}/{ushort=274}", @VariantMetaData)
          If WIC_SUCCEEDED(hr)
            Select VariantMetaData\iVal
              Case 2
                bitmapTransformationOptions = #WICBitmapTransformRotate0 | #WICBitmapTransformFlipHorizontal
              Case 3
                bitmapTransformationOptions = #WICBitmapTransformRotate180
              Case 4
                bitmapTransformationOptions = #WICBitmapTransformRotate180 | #WICBitmapTransformFlipHorizontal
              Case 5
                bitmapTransformationOptions = #WICBitmapTransformRotate270 | #WICBitmapTransformFlipHorizontal
              Case 6
                bitmapTransformationOptions = #WICBitmapTransformRotate90
              Case 7
                bitmapTransformationOptions = #WICBitmapTransformRotate90 | #WICBitmapTransformFlipHorizontal
              Case 8
                bitmapTransformationOptions = #WICBitmapTransformRotate270
            EndSelect            
          EndIf          
          *pQueryReader\Release()
        EndIf
        
        hr = *pFrame\QueryInterface(?IID_IWICBitmapSource, @*WICBitmapSrc)
        If WIC_SUCCEEDED(hr)
          
          hr = *WICBitmapSrc\GetSize(@width, @height)
          hr = g__pIWICFactory\CreateBitmapScaler(@*pScaler)
          
          If WIC_SUCCEEDED(hr)
            
            If *cx And *cx\i
              width = *cx\i
              bDoReSize = #True
            EndIf
            
            If *cy And *cy\i
              height = *cy\i
              bDoReSize = #True
            EndIf
            
            If (bitmapTransformationOptions & #WICBitmapTransformRotate90) Or (bitmapTransformationOptions & #WICBitmapTransformRotate270)
              hr = height
              height = width
              width = hr
            EndIf
            
            
            
            hr = *pScaler\Initialize(*WICBitmapSrc, width, height, #WICBitmapInterpolationModeFant)
            If WIC_SUCCEEDED(hr)
              g__pIWICFactory\CreateFormatConverter(@*pConverter);
              If WIC_SUCCEEDED(hr)
                hr = *pConverter\Initialize(*pScaler, ?GUID_WICPixelFormat32bppBGR, 0, #Null, 0.0, 0)
                If WIC_SUCCEEDED(hr)
                  hr = *pConverter\QueryInterface(?IID_IWICBitmapSource, @*pToRenderBitmapSource)        
                  If WIC_SUCCEEDED(hr)
                    
                    hr = WIC_CreateDIBSectionFromBitmapSource(*pToRenderBitmapSource, @hBitmap, bitmapTransformationOptions)
                    If WIC_SUCCEEDED(hr)
                      If *cx Or *cy
                        *pToRenderBitmapSource\GetSize(@width, @height)
                        
                        If *cx And *cx\i = 0
                          *cx\i = width
                        EndIf
                        
                        If *cy And *cy\i = 0
                          *cy\i = height
                        EndIf
                      EndIf
                    EndIf
                    
                    *pToRenderBitmapSource\Release()
                  EndIf   
                  
                EndIf
                *pConverter\Release()
              EndIf
            EndIf
            *pScaler\Release()
          EndIf
          
          *WICBitmapSrc\Release()
          
        EndIf
        *pFrame\Release()
      EndIf
      
      *pDecoder\Release()
    EndIf
    
    *IWICStream\Release()
  EndIf
  
  ProcedureReturn hBitmap
  
  
EndProcedure



Procedure WIC_LoadImage(sFile.s, *cx.Integer = 0, *cy.Integer = 0, *iFrame.Integer = 0)
  
  Protected hFile, buffer, cbSize, hBitmap
  
  hFile = ReadFile(#PB_Any, sFile)
  If hFile
    cbSize = Lof(hFile)
    If cbSize
      buffer = AllocateMemory(cbSize)
      If buffer
        If ReadData(hFile, buffer, cbSize)
          hBitmap = WIC_CatchImage(buffer, cbSize, *cx, *cy, *iFrame)
        EndIf
        FreeMemory(buffer)
      EndIf
    EndIf
    CloseFile(hFile)
  EndIf
  
  ProcedureReturn hBitmap
  
EndProcedure




Procedure WIC_Enum_Decoders()
  
  Protected hr.l, spEnum.IEnumUnknown, spEnumElement.IWICComponentInfo, cbActual
  Protected sName.s{261}, sExtentions.s{261}
  Protected IWICBitmapCodecInfo.IWICBitmapCodecInfo
  
  If Not g__pIWICFactory
    Debug "g__pIWICFactory !"
    ProcedureReturn 0
  EndIf
  
  hr = g__pIWICFactory\CreateComponentEnumerator(1, 0, @spEnum)
  If SUCCEEDED_(hr)
    
    While (#S_OK = spEnum\Next(1, @spEnumElement, @cbActual))
      
      hr = spEnumElement\QueryInterface(?IID_IWICBitmapCodecInfo, @IWICBitmapCodecInfo)
      If SUCCEEDED_(hr)
        IWICBitmapCodecInfo\GetFriendlyName(260, @sName, @cbActual)
        Debug sName
        IWICBitmapCodecInfo\GetFileExtensions(260, @sExtentions, @cbActual)
        Debug #TAB$ + sExtentions + #CRLF$        
        IWICBitmapCodecInfo\Release()
      EndIf
      
      spEnumElement\Release()
    Wend
    
    spEnum\Release()
  EndIf
  
EndProcedure



;- example

CompilerIf #PB_Compiler_IsMainFile
  
  
  CoInitialize_(0)
  WIC_Initialize_Factory()
  ;WIC_Enum_Decoders()
  
  
  Define cx = 800, cy = 600, iFrame, sFile.s, hBitmap
  
  sFile = OpenFileRequester("Images files", "", "All files (*.*)|*.*", 0)
  If sFile <> ""
    hBitmap = WIC_LoadImage(sFile, @cx, @cy, @iFrame)
    If Not hBitmap
      Debug "Error loading " + sFile
    Else
      If OpenWindow(0, 0, 0, 800, 600, "WIC Image", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
        ImageGadget(0,  0, 0, 800, 600, hBitmap)
        Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
      EndIf
    EndIf
    
  EndIf
  
CompilerEndIf
Last edited by fryquez on Tue May 30, 2023 6:17 pm, edited 2 times in total.
dige
Addict
Addict
Posts: 1247
Joined: Wed Apr 30, 2003 8:15 am
Location: Germany
Contact:

Re: Windows 10 OCR and Face detection

Post by dige »

@fryquez: great :D 👍🏼👏🏼 Thank you!!
"Daddy, I'll run faster, then it is not so far..."
acreis
Enthusiast
Enthusiast
Posts: 182
Joined: Fri Jun 01, 2012 12:20 am

Re: Windows 10 OCR and Face detection

Post by acreis »

Great code for loading HEIC. Works with any format windows support.
dige
Addict
Addict
Posts: 1247
Joined: Wed Apr 30, 2003 8:15 am
Location: Germany
Contact:

Re: Windows 10 OCR and Face detection

Post by dige »

..and its incredible fast! :D
"Daddy, I'll run faster, then it is not so far..."
fryquez
Enthusiast
Enthusiast
Posts: 362
Joined: Mon Dec 21, 2015 8:12 pm

Re: Windows 10 OCR and Face detection

Post by fryquez »

Decoder enumeration:

Code: Select all

Interface IWICComponentInfo Extends IUnknown
  GetComponentType(*pType)
  GetCLSID(*pclsid.CLSID)
  GetSigningStatus(*pStatus)
  GetAuthor(cchAuthor, *wzAuthor, *pcchActual)
  GetVendorGUID(*pguidVendor.GUID)
  GetVersion(cchVersion, *wzVersion, *pcchActual)
  GetSpecVersion(cchSpecVersion, *wzSpecVersion, *pcchActual)
  GetFriendlyName(cchFriendlyName, *wzFriendlyName, *pcchActual)
EndInterface

Interface IWICBitmapCodecInfo Extends IWICComponentInfo
  GetContainerFormat(*pguidContainerFormat.GUID)
  GetPixelFormats(cFormats, *pguidPixelFormats.GUID, *pcActual)
  GetColorManagementVersion(cchColorManagementVersion, *wzColorManagementVersion, *pcchActual)
  GetDeviceManufacturer(cchDeviceManufacturer, *wzDeviceManufacturer, *pcchActual)
  GetDeviceModels(cchDeviceModels, *wzDeviceModels, *pcchActual)  
  GetMimeTypes(cchMimeTypes, *wzMimeTypes, *pcchActual)
  GetFileExtensions(cchFileExtensions, *wzFileExtensions, *pcchActual)
  DoesSupportAnimation(*pfSupportAnimation)
  DoesSupportChromakey(*pfSupportChromakey)
  DoesSupportLossless(*pfSupportLossless)
  DoesSupportMultiframe(*pfSupportMultiframe)
  MatchesMimeType(wzMimeType, *pfMatches)  
EndInterface

DataSection  
  IID_IWICBitmapCodecInfo:
  Data.l $E87A44C4
  Data.w $B76E, $4C47
  Data.b $8B, 9, $29, $8E, $B1, $2A, $27, $14
EndDataSection



Procedure WIC_Enum_Decoders()
  
  Protected hr.l, spEnum.IEnumUnknown, spEnumElement.IUnknown, cbActual
  Protected sName.s{261}, sExtentions.s{261}
  Protected IWICBitmapCodecInfo.IWICBitmapCodecInfo
  
  If Not g__pIWICFactory
    Debug "g__pIWICFactory !"
    ProcedureReturn 0
  EndIf
  
  hr = g__pIWICFactory\CreateComponentEnumerator(1, 0, @spEnum)
  If WIC_SUCCEEDED(hr)
    
    While (#S_OK = spEnum\Next(1, @spEnumElement, @cbActual))
      
      hr = spEnumElement\QueryInterface(?IID_IWICBitmapCodecInfo, @IWICBitmapCodecInfo)
      If WIC_SUCCEEDED(hr)
        IWICBitmapCodecInfo\GetFriendlyName(260, @sName, @cbActual)
        Debug sName
        IWICBitmapCodecInfo\GetFileExtensions(260, @sExtentions, @cbActual)
        Debug #TAB$ + sExtentions + #CRLF$        
        IWICBitmapCodecInfo\Release()
      EndIf
      
      spEnumElement\Release()
    Wend
    
    spEnum\Release()
  EndIf
  
EndProcedure
dige
Addict
Addict
Posts: 1247
Joined: Wed Apr 30, 2003 8:15 am
Location: Germany
Contact:

Re: Windows 10 OCR and Face detection

Post by dige »

@fryquez: Thanks for the decoder listing.

I use the FreeImage.dll so far. But this lib has not been further developed since 2018 and has a bug when loading tiff images.

I going to like WIC more and more. Could be a gamechanger.

What also would important for me: how to load an image automatically rotated (according to the orientation according to Exif)? Is it possible with WIC?

Kind regards

Dige
"Daddy, I'll run faster, then it is not so far..."
fryquez
Enthusiast
Enthusiast
Posts: 362
Joined: Mon Dec 21, 2015 8:12 pm

Re: Windows 10 OCR and Face detection

Post by fryquez »

Updated previous post, should now flip the image according to EXIF setting.
dige
Addict
Addict
Posts: 1247
Joined: Wed Apr 30, 2003 8:15 am
Location: Germany
Contact:

Re: Windows 10 OCR and Face detection

Post by dige »

Great! Thank you very much! :D
"Daddy, I'll run faster, then it is not so far..."
deviousduck
New User
New User
Posts: 2
Joined: Sat Sep 02, 2006 12:13 pm
Location: Nottingham, UK

Re: Windows 10 OCR and Face detection

Post by deviousduck »

Nice!.

Does anyone know if the windows 10 OCR function to get the position of the lines and text in the OCR image, could be added to this.

for example, to find the place of some text on the screen, or for formatting purposes

I know the functions exist, but not how to implement it here.
fryquez
Enthusiast
Enthusiast
Posts: 362
Joined: Mon Dec 21, 2015 8:12 pm

Re: Windows 10 OCR and Face detection

Post by fryquez »

Seems you can get the coordinates of every word with Windows 10 OCR engine.
I can't edit the first post because it exceeds of the forum limitation.

https://pastebin.com/iCL8pW4e
Post Reply