unitmain.pas

windows win200 32位取词

unit UnitMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,UnitHookType, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    procedure getMouseInfo(var theMess:TMessage); message WM_MOUSEPT;{处理WM_MOUSEPT}
  private
    hMapObj : THandle;
    pShMem : PShareMem;
    fWndClosed:boolean;{是否正在退出主程序}
    { Private declarations }
  public
    { Public declarations }
  end;
//  {未公开的函数，实现隐浮窗口}
//  procedure SwitchToThisWindow(wnd:Hwnd;Switch:BOOL);stdcall;external 'user32.dll';
  procedure StartHook; stdcall; external 'GetWordDll.DLL';
  procedure StopHook; stdcall; external 'GetWordDll.DLL';

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
  if button1.caption='取词' then
  begin
     StartHook;
     button1.caption:='停止';
  end
  else begin
     StopHook;
     button1.caption:='取词';
  end;
end;

const
  StrProcNames : array[fTextOutA..fDrawTextW+1] of String =
    ('来自TextOutA',
     '来自TextOutW',
     '来自ExtTextOutA',
     '来自ExtTextOutW',
     '来自DrawTextA',
     '来自DrawTextW',
     '来自菜单');

procedure TForm1.getMouseInfo(var theMess : TMessage);
begin
  if fWndClosed then
    Exit;
  if theMess.LParam = 1 then{显示鼠标位置}
{    Label1.caption := 'X:' + IntToStr(pShMem^.pMouse.x) + ' ' +
                        'Y:' + IntToStr(pShMem^.pMouse.y) + ' ' +
                        'HWND:0x' + IntToHex(pShMem^.hHookWnd, 8) + ' ' +
                        pShMem^.fStrMouseQueue }
  else if theMess.LParam = 2 then
  begin
    Label2.caption := pShMem^.Text;
    if (theMess.WParam>=0)and(theMess.WParam<=5) then
//        Label3.Caption :=StrProcNames[theMess.Wparam];
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  fWndClosed := True;{正在退出主程序}
  if button1.caption<>'取词' then
    Button1Click(sender);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  SetForegroundWindow(self.Handle);{实现隐浮窗口}
  hMapObj := OpenFileMapping(FILE_MAP_WRITE,{获取完全访问映射文件}
                             False,{不可继承的}
                             LPCTSTR(MappingFileName));{映射文件名字}
  if hMapObj = 0 then
  begin
    ShowMessage('不能定位内存映射文件块!');
    Halt;
  end;

  pShMem := MapViewOfFile(hMapObj,FILE_MAP_WRITE,0,0,0);
  if pShMem = nil then
  begin
    ShowMessage('映射文件错误'+ IntToStr(GetLastError));
    CloseHandle(hMapObj);
    Halt;
  end;

  FillChar(pShMem^, SizeOf(TShareMem), 0);
  pShMem^.hProcWnd := Self.Handle;
  fWndClosed:=false;
end;

initialization
finalization

end.