getword.pas

类似金山词霸的屏幕取词示例代码.rar

unit GetWord;

interface

uses
  SysUtils,
  windows,
  messages;

const NHD_GETWORD_TIMER = 2;
const NHD_MAX_TEXTLEN = 1024;
const NHD_WIN_INITPOSX = -1;
const NHD_WIN_INITPOSY = -1;
const NHD_FLYWIN_WIDTH = 1;
const NHD_FLYWIN_HEIGHT = 1;
const NHD_CLASSNAME_LEN	= 256;
const NHD_GW_WAITING_TIME = 200;   //get word waiting time;

  (*设置屏幕抓取函数*)
 type TBL_SetFlag32 = function (nFlag : word;    //设置是否取词
                             hNotifyWnd : HWND;    //当取词后得窗口句柄
                             MouseX : integer;    //X坐标
                             MouseY : integer): DWORD;stdcall;    //Y坐标
(*   功能:
	启动或停止取词。
   参数:
       nFlag
              [输入] 指定下列值之一：
              GETWORD_ENABLE: 开始取词。在重画被取单词区域前设置此标志。nhw32.dll是通过
                              重画单词区域，截取TextOutA, TextOutW, ExtTextOutA,
                              ExtTextOutW等Windows API函数的参数来取词的。
              GETWORD_DISABLE: 停止取词。
       hNotifyWnd
              [输入] 通知窗口句柄。当取到此时，向该通知窗口发送一登记消息：GWMSG_GETWORDOK。
       MouseX
		[输入] 指定取词点的X坐标。
       MouseY
              [输入] 指定取词点的Y坐标。
    返回值：
       可忽略。
*)
type TLPRECT = ^TRECT;  (*定义指针先*)
 type TBL_GetText32 = function(lpszCurWord : pchar;
                             nBufferSize : integer;
                             lpWordRect : TLPRECT ): DWORD;stdcall;
    (*功能:
      从内部缓冲区取出单词文本串。对英语文本，该函数最长取出一行内以空格为界的三个英文单词串，
      遇空格，非英文字母及除'-'外的标点符号，则终止取词。对汉字文本，该函数最长取出一行汉字串，
      遇英语字母，标点符号等非汉语字符，则终止取词。该函数不能同时取出英语和汉语字符。
    参数:
       lpszCurWord
              [输入] 目的缓冲区指针。
       nBufferSize
              [输入] 目的缓冲区大小。
       lpWordRect
              [输出] 指向 RECT 结构的指针。该结构定义了被取单词所在矩形区域。
    返回值：
        当前光标在全部词中的位置。*)

 type   TSetNHW32 = function(): boolean; stdcall;
 (*
     功能:
        Win NT/2000 环境下的初始化函数。一般在程序开始时，调用一次。
    参数:
        无。
    返回值：
        如果成功 TRUE ，失败 FALSE 。
 *)

 type  TResetNHW32= function():boolean; stdcall;
(*    功能:
        Win NT/2000 环境下的去初始化函数。一般在程序结束时调用。
    参数:
        无。
    返回值：
        如果成功 TRUE ，失败 FALSE 。*)



function NHD_FlyWndProc(hWnd, Msg,wParam,lParam: Integer): Integer; stdcall;
function NHD_CreateWindow(hInst: Integer): HWND;
procedure NHD_BeginGetWord(ptMousePos: TPOINT);

function NHD_ExitGetWords(): boolean;
function NHD_DestroyWindow(): boolean;
procedure NHD_FreeLoadedLib();
function NHD_InitGetWords(hInst: THANDLE; hwnd: HWND): HWND;
function NHD_LoadGetWordLib(): boolean;

var
  WinClass: TWndClassA;
  Inst: Integer;
  Msg: TMsg;

  g_TextBuffer : array[0..1024] of char;

  g_hFlyWin : HWND;
  g_nGWTimerID : word;
  
  g_hGetWordInst : Integer;
  BL_SetFlag32 : TBL_SetFlag32;
  BL_GetText32 : TBL_GetText32;
  SetNHW32 : TSetNHW32;
  ResetNHW32 : TResetNHW32;
  g_hNHMainWin : HWND;
  
  g_WM_GetWordOk:WORD;
  g_bInGetWord : boolean;
  currpoint:Tpoint;
  G_Rect : TRECT;
implementation

uses unit1;

function NHD_CreateWindow(hInst: Integer): HWND;
var
   hwnd : LongWord;
   wc : TWndClassA;
begin
  if hInst = 0 then begin
    result :=0;
    exit;
  end;

  with wc do
  begin
    style              := WS_EX_TOPMOST;
    lpfnWndProc        := @NHD_FlyWndProc;  (*消息处理函数*)
    hInstance          := hInst;
    hbrBackground      := color_btnface + 1;
    lpszClassname      := 'NHD_FLYWIN_DEMO';
    hicon              := 0;
    hCursor            := 0;
    cbClsExtra         := 0;
    cbWndExtra         := 0;
  end;
  RegisterClass(wc);

  hwnd := CreateWindowEx (WS_EX_TOPMOST or WS_EX_TOOLWINDOW,
                           'NHD_FLYWIN_DEMO',
                           'NHD_FlyWindow_Demo',
                           WS_POPUP or WS_VISIBLE,
                           NHD_WIN_INITPOSX,
                           NHD_WIN_INITPOSY,
                           NHD_FLYWIN_WIDTH,
                           NHD_FLYWIN_HEIGHT,
                           0,  
                           0,
                           hInst,
                           nil);
    
  result := hwnd;
end;

function NHD_FlyWndProc(hWnd, Msg,wParam,lParam: Integer): Integer; stdcall;
begin
  //Unhook textout when reveived msg from getword;
  if msg = g_WM_GetWordOk then begin
    if g_bInGetWord then begin
      g_bInGetWord := FALSE;
      KillTimer(g_hFlyWin, NHD_GETWORD_TIMER);
      g_nGWTimerID := 0;
      BL_SetFlag32(GETWORD_DISABLE, 0, 0, 0);

      if wParam = 0 then begin
        BL_GetText32(@g_TextBuffer, sizeof(g_TextBuffer), @G_Rect);
      end;

      PostMessage(g_hNHMainWin, NHD_WM_GETWORD_OK, 0, 0);
      result := 0;
      exit;
    end;
  end;

  result := DefWindowProc(hWnd, msg, wParam, lParam);
end;

procedure NHD_GetWordTimerProc(hwnd: HWND; msg: word; idTimer: word; dwTime: DWORD);stdcall;
begin
	//may be proior finished by Getword message;
  if g_bInGetWord then begin
    g_bInGetWord := FALSE;
    //UnHook TextOut;
    BL_SetFlag32(GETWORD_DISABLE, 0, 0, 0);
    BL_GetText32(g_TextBuffer, NHD_MAX_TEXTLEN, @G_Rect);
  end;

  KillTimer(g_hFlyWin, NHD_GETWORD_TIMER);
  g_nGWTimerID := 0;

  PostMessage(g_hNHMainWin, NHD_WM_GETWORD_OK, 0, 0);
end;

procedure NHD_BeginGetWord(ptMousePos: TPOINT);
var
  szAppClassName : array [0..NHD_CLASSNAME_LEN] of char;
  hAppWin : LongWord;
  nFlyWinLeft : integer;
  nFlyWinWidth : integer;
  rcAppWin : TRECT ;
  cmpstr : string;
begin

	//get window from mouse point;
	hAppWin := WindowFromPoint(ptMousePos);

	//check if the app window is EDIT, if it is, redraw whole line;
	GetClassName(hAppWin, szAppClassName, NHD_CLASSNAME_LEN);

	(*DbgPrintf("hAppWin: %x\n", hAppWin);
	DbgPrintf("ClassName: %s\n", szAppClassName);*)
	cmpstr := trim(strpas(szAppClassName));
        Frm_main.Edit2.text := cmpstr;

	if ((cmpstr = 'Edit') or						//NotePad
	   (cmpstr = 'Internet Explorer_Server') or //IE4.0
	   (cmpstr = 'RichEdit') or					//
	   (cmpstr = 'RichEdit20A') or				//WordPad
	   (cmpstr = 'RichEdit20W')	 or				//WordPad
	   (cmpstr = 'HTML_Internet Explorer')	 or	//IE3.0
	   (cmpstr = 'ThunderTextBox')	 or			//VB Edit
	   (cmpstr = 'ThunderRT5TextBox') or		//VB Edit
	   (cmpstr = 'ThunderRT6TextBox') or		//VB Edit
	   (cmpstr = 'EXCEL<')	or		//Excel 2000
	   (cmpstr = 'EXCEL7')  or		//Excel 2000
	   (cmpstr = 'EXCEL6') or					//Excel 2000
	   (cmpstr = 'ConsoleWindowClass') or		//NT V86
	   (cmpstr = 'Edit') or
	   (cmpstr = 'tty')  or
	   (cmpstr = 'ttyGrab'))						//Word97
	then begin
		GetWindowRect(hAppWin, rcAppWin);
		nFlyWinLeft := rcAppWin.left - 4;
		nFlyWinWidth := rcAppWin.right - rcAppWin.left - 8;

		//don't not repaint whole line if too long;
		if (ptMousePos.x - nFlyWinLeft) > 200 then begin
			nFlyWinLeft := ptMousePos.x - 200;
		end;

		//DbgPrintf("!!!!tty window");
	end else begin
		nFlyWinLeft := ptMousePos.x;
		nFlyWinWidth := NHD_FLYWIN_WIDTH;
	end;

	//note: move the flywin to cursor pos "x - 1" to aviod mouse shape changing between ARROW and EDIT in edit area;
	//use SetWindowPos instead of MoveWindow, for MoveWindow can not make menu item redraw.
	SetWindowPos(g_hFlyWin, HWND_TOPMOST, 
			     nFlyWinLeft, 
				 ptMousePos.y - 1 ,
				 nFlyWinWidth,
				 NHD_FLYWIN_HEIGHT,
				 SWP_NOACTIVATE or SWP_NOREDRAW);
	
	//set flag to avoid re-entry;
	g_bInGetWord := TRUE;

	//hook TextOut;
	BL_SetFlag32(GETWORD_ENABLE, g_hFlyWin, ptMousePos.x, ptMousePos.y);

	MoveWindow(g_hFlyWin, -1, -1, NHD_FLYWIN_WIDTH, NHD_FLYWIN_HEIGHT, TRUE);

	g_nGWTimerID := SetTimer(g_hFlyWin, NHD_GETWORD_TIMER, NHD_GW_WAITING_TIME, @NHD_GetWordTimerProc);
end;

function NHD_CopyWordsTo(szBuffer: pchar; nBufferSize: Integer):Boolean;
var
 nLen : integer;
begin
  nLen := sizeof(g_TextBuffer);
  if(nLen + 1) > nBufferSize
  then begin
    result := false;
    exit;
  end;

  ZeroMemory(szBuffer,nBufferSize);
  CopyMemory(szBuffer, @g_TextBuffer, nLen);

  result := true;
 end;

function NHD_ExitGetWords(): boolean;
begin
  //free libarys:
  NHD_FreeLoadedLib();

  NHD_DestroyWindow();

  result := TRUE;
end;

function NHD_DestroyWindow(): boolean;
begin
  if g_hFlyWin<>0 then begin
          DestroyWindow(g_hFlyWin);
          g_hFlyWin := 0;
  end;

  result := TRUE;
end;

procedure NHD_FreeLoadedLib();
begin
  if g_hGetWordInst<>0 then begin
    //only valid in windows NT enviroment

    if @ResetNHW32<>nil then begin
            ResetNHW32();
    end;

    FreeLibrary(g_hGetWordInst);
    //g_hGetWordInst = 0;
  end;
end;

function NHD_InitGetWords(hInst: THANDLE;  hwnd: HWND): HWND;
begin
  //save NH main window to send run time error messages:
  g_hNHMainWin := hwnd;

  if NHD_LoadGetWordLib=false then begin
          NHD_FreeLoadedLib();
          result := 0;
          exit;
  end;

  //Create fly_window (cause paint) and show text window;
  g_hFlyWin := NHD_CreateWindow(hInst);
  if g_hFlyWin=0 then begin
          NHD_FreeLoadedLib();
          result := 0;
          exit;
  end;

  g_WM_GetWordOk := RegisterWindowMessage('BL_HASSTRING');
  if g_WM_GetWordOk=0 then begin
          NHD_FreeLoadedLib();
          result := 0;
          exit;
  end;

  result := g_hFlyWin;
end;

function NHD_LoadGetWordLib(): boolean;
begin
  g_hGetWordInst := LoadLibrary('nhw32.dll');
  if g_hGetWordInst=0 then begin
          messagebox(0,'装载动态链接库失败','警告',mb_ok or mb_iconwarning or mb_applmodal);
          result := FALSE;
          exit;
  end;

  @BL_SetFlag32 := GetProcAddress(g_hGetWordInst,'BL_SetFlag32');
  if @BL_SetFlag32=nil then begin
   messagebox(0,'装载屏幕取词动态链接库函数: BL_SetFlag32失败!','信息',MB_OK or MB_APPLMODAL or MB_ICONWARNING);
   result := false;
   exit;
  end;

  @BL_GetText32 := GetProcAddress(g_hGetWordInst,'BL_GetText32');
  if @BL_GetText32=nil then begin
   messagebox(0,'装载屏幕取词动态链接库函数: BL_GetText32失败!','信息',MB_OK or MB_APPLMODAL or MB_ICONWARNING);
   result := false;
   exit;
  end;

  @SetNHW32 := GetProcAddress(g_hGetWordInst,'SetNHW32');
  if @SetNHW32=nil then begin
   messagebox(0,'装载屏幕取词动态链接库函数: SetNHW32失败!','信息',MB_OK or MB_APPLMODAL or MB_ICONWARNING);
   result := false;
   exit;
  end;

  @ResetNHW32 := GetProcAddress(g_hGetWordInst,'ResetNHW32');
  if @ResetNHW32=nil then begin
   messagebox(0,'装载屏幕取词动态链接库函数: ResetNHW32失败!','信息',MB_OK or MB_APPLMODAL or MB_ICONWARNING);
   result := false;
   exit;
  end;

  if SetNHW32()=false then begin
   messagebox(0,'无法设置屏幕取词!','信息',MB_OK or MB_APPLMODAL or MB_ICONWARNING);
   result := false;
   exit;
  end;

 result := true;
end;

end.