//
// ПОЛУЧЕНИЕ СЛОВА ПОД КУРСОРОМ МЫШИ
// ---------------------------------------
// Copyright(C) by Alex International 2006
//
unit uGetWord;
interface

uses Windows, Classes, Messages;

function GetWordFromMouseCursor(FullLineEnable:boolean) : String; stdcall; export;

implementation

uses SysUtils, RichEdit, ActiveX, Accessibility_TLB, MSHTML_TLB;

function ExtractWordFromIE(hIE: HWND; Pt: TPoint): string; forward;
function GetWordFromPointIEInternal(hIE: HWND; HE: IHTMLElement; Pt: TPoint): string; forward;

type
{Переопределяем неправильное объявление TTextRange в RichEdit.pas}
  {$WARNINGS OFF}
  TTextRange = record
    chrg: TCharRange;
    lpstrText: PAnsiChar;
  end;
  PTextRange = ^TTextRange;
  {$WARNINGS ON}

type
   TKnownWndClass = (
        kwcUnknown                ,
        kwcRichEdit               ,
        kwcMultiLineEdit          ,
        kwcSingleLineEdit         ,
        kwcInternetExplorer_Server,
        kwcConsole
   );

const
  CHILDID_SELF = 0;

  const
  UNIT_WORD = 'word';
  UNIT_CHAR = 'character';
  UNIT_SENTENCE = 'sentence';
  UNIT_ENTIRE_RANGE  = 'textedit';


//----------------------------------------------------------------- 08.28.06
function GetWindowType(WND: HWND; const WNDClass: String): TKnownWndClass;
const
  StrKnownClasses: array[0..7] of string =
    ('RICHEDIT20A',
     'RICHEDIT20W',
     'RICHEDIT',
     'EDIT',
     'INTERNET EXPLORER_SERVER',
     'CONSOLEWINDOWCLASS',  // NT
     'TTYGRAB',             // 9x
     'TRICHEDIT'
    );

   //            ClassName
   // WinHelp  - MS_WINTOPIC
   // CHM Help - Internet Explorer_Server
   // Explorer - Internet Explorer_Server
   // MS Word  - _WwG
   // Calc     - SciCalc
   // FAR      - ConsoleWindowsNamw

  KnownClasses : array[0..High(StrKnownClasses)] of TKnownWndClass = (
    kwcRichEdit,
    kwcRichEdit,
    kwcRichEdit,
    kwcMultiLineEdit,
    kwcInternetExplorer_Server,
    kwcConsole,
    kwcConsole,
    kwcRichEdit
   );
var
  N, i: ShortInt;
begin
  Result := kwcUnknown;

  N := -1;
  for i:=0 to High(StrKnownClasses) do begin
     if UpperCase(WNDClass) = StrKnownClasses[i] then begin
        N := i;
        break;
     end;
  end;
  if N >= 0 then
  begin
    Result := KnownClasses[N];
    if Result = kwcMultiLineEdit then
      if (GetWindowLong(WND, GWL_STYLE) and ES_MULTILINE) = 0 then
        Result := kwcSingleLineEdit;
  end;
end;

//----------------------------------------------------------------- 08.28.06
function GetClassNameStr(hWnd:THandle):String;
var CName : array [byte] of char;
    L:integer;
begin
   Result := '';
   L := GetClassName(hWnd, CName, sizeOf(CNamE));
   if L = 0 then exit;
   Result := CName;
end;

//----------------------------------------------------------------- 08.28.06
function ExtractWordFromIE(hIE: HWND; Pt: TPoint): string;
var A: IAccessible;
    SP: IServiceProvider;
    HE: IHTMLElement;
    V: Variant;
begin
  Result := '';
  {$WARNINGS OFF}
  //if not Assigned(AccessibleObjectFromPoint)            then Result := 'notAssigned';
  //if not Succeeded(AccessibleObjectFromPoint(Pt, A, V)) then Result := '2';
  //if not ((VarType(V) = VT_I4) and (TVarData(V).VInteger <> 0)) then Result := '3';

  if Assigned(AccessibleObjectFromPoint) and
     Succeeded(AccessibleObjectFromPoint(Pt, A, V)) and
     ((VarType(V) = VT_I4) and (TVarData(V).VInteger <> 0))
  then begin
    if Succeeded(A.QueryInterface(IServiceProvider, SP)) then
      SP.QueryService(IHTMLElement, IHTMLElement, HE);
    Result := GetWordFromPointIEInternal(hIE, HE, Pt);
  end;
  {$WARNINGS ON}
end;

//----------------------------------------------------------------- 08.28.06
function GetWordFromPointIEInternal(hIE: HWND; HE: IHTMLElement; Pt: TPoint): string;
var
  TR: IHTMLTxtRange;
  HD: IHTMLDocument2;
  NW3: IHTMLWindow3;
  NW2: IHTMLWindow2;
  childWND: HWND;
  lrHD: DWORD;
  
const
  IID_IHTMLDocument2: TGUID = '{332C4425-26CB-11D0-B483-00C04FD90119}';

begin
  Result := '';
  if HE <> nil then
    HD := HE.document as IHTMLDocument2
  else begin
    lrHD := 0;
    {$WARNINGS OFF}
    if not ((SendMessageTimeout(hIE, WM_HTML_GETOBJECT, 0, 0, SMTO_ABORTIFHUNG, 1000, lrHD) <> 0)
      and (lrHD <> 0)
      and (ObjectFromLResult(lrHD, @IID_IHTMLDocument2, 0, IDispatch(HD)) = S_OK)) then
        Exit;
    {$WARNINGS ON}
  end;
  TR := (HD.body as IHTMLBodyElement).createTextRange;
  childWND := ChildWindowFromPoint(hIE, Pt);
  NW2 := HD.parentWindow;
  if (NW2 <> nil) and Succeeded(NW2.QueryInterface(IHTMLWindow3, NW3)) then
  begin
    Pt.X := Pt.X  - NW3.screenLeft;
    Pt.Y := Pt.Y  - NW3.screenTop;
  end else begin
    if (childWND <> 0)
      and (UpperCase(GetClassNameStr(childWND)) = 'INTERNET EXPLORER_SERVER') then
      hIE := childWND;
    ScreenToClient(hIE, Pt);
  end;
  TR.moveToPoint(Pt.X, Pt.Y);
  TR.Expand(UNIT_WORD);
  Result := Trim(TR.Text);
  //if (Length(Result) > 0) and not IsCharAlpha(Result[1]) then
  //  Result := '';
end;

//----------------------------------------------------------------- 08.30.06
// Возвращает слово (или всю строку) под курсором мыши
function ExtractFromOtherApplication(hWND:HWND; P:TPoint):String;
var A:IAccessible;
    V:Variant;
begin
   Result := '';
   A := nil;
   if Assigned(AccessibleObjectFromPoint) and
      SUCCEEDED(AccessibleObjectFromPoint(P, A, V))
   then begin
      if assigned(A) and (V <> 0) then begin
         try
            Result := A.accName[V];
         except
         end;
      end;
   end;
end;

//----------------------------------------------------------------- 08.28.06
// Получение слова под курсором мыши
function GetWordFromMouseCursor(FullLineEnable:boolean) : String; stdcall; export;
var MPos : TPoint;
    hWnd : THandle;
    CName : array [byte] of char;
    L:integer;
    T:TKnownWndClass;
    //ProcessId : DWORD;
begin
   Result := '';
   // Определение окна под курсором мыши
   GetCursorPos(MPos);                   // глобальные координаты
   hWnd := WindowFromPoint( MPos );
   if hWnd = 0 then exit;
   L := GetClassName(hWnd, CName, sizeOf(CName));
   if L = 0 then exit;

   //{$WARNINGS OFF}
   //GetWindowThreadProcessId(hWnd, @ProcessId);
   //{$WARNINGS ON}

   T := GetWindowType(hWnd, CName);
   case T of
      kwcInternetExplorer_Server : Result := ExtractWordFromIE(hWnd, MPos);
      // Остальные методы используют RemoteExecute или TextHook, что не реализовано
      //kwcUnknown                 : {ExtractFromEverething};
      //kwcRichEdit                : {Result := REExtractWordFromPos(hWnd, ProcessId, MPos)};
      //kwcSingleLineEdit          : {ExtractWordFromEditPos};
      //kwcMultiLineEdit           : {ExtractWordFromEditPos};
      //kwcConsole                 : {GetWordFromConsole};
   else
       if FullLineEnable
       then Result := ExtractFromOtherApplication(hWnd, MPos);
   end;
end;

end.