Текст под курсором (через (UI Automation)

[Filyus]

Охота сделать определение слова под курсором в других приложениях. Следующий код возвращает абзац (в Firefox работает правильно). А как сделать, чтобы слово находил... Есть догадки?

Код: Выделить всё

Private Type POINT
  x As Long
  y As Long
End Type
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINT) As Long
Private Sub Timer1_Timer()
  Dim pt As POINT, UI As CUIAutomation, El As IUIAutomationElement
  Dim Value As IUIAutomationValuePattern
  GetCursorPos pt
  Set UI = New CUIAutomation
  Set El = UI.ElementFromPoint(pt.x, pt.y)
  If ObjPtr(El) <> 0 Then
    Debug.Print El.CurrentClassName; " "; El.CurrentName
      Set Value = El.GetCurrentPattern(UIA_ValuePatternId)
      If ObjPtr(Value) <> 0 Then
        Debug.Print "value="; Value.CurrentValue 'Link URL in the Firefox
      End If
  End If
End Sub