屏幕取词 dlephi10.3 可用

cjajax

unit UnitMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs,StdCtrls, Vcl.ExtCtrls
  ,unitHookType;

type
   TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
     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] of String =
     ('来自TextOutA',
      '来自TextOutW',
      '来自ExtTextOutA',
      '来自ExtTextOutW',
      '来自DrawTextA',
      '来自菜单(来自DrawTextW)'
      );

procedure TForm1.getMouseInfo(var theMess : TMessage);
begin
  try
   if fWndClosed then
     Exit;

    //if theMess.Msg=WM_MOUSEPT then   showmessage('fff');

   if theMess.LParam = 1 then{显示鼠标位置}
     {edit1.Text := 'X:' + IntToStr(pShMem^.pMouse.x) + ' ' +
                         'Y:' + IntToStr(pShMem^.pMouse.y) + ' ' +
                         'HWND:0x' + IntToHex(pShMem^.hHookWnd, 8) + ' ' +
                         pShMem^.fStrMouseQueue ;}
     Edit1.Text :=  format('X:%d Y:%d HWND:%X %s', [pShMem^.pMouse.x, pShMem^.pMouse.y, pShMem^.hHookWnd,
      string(@pShMem^.fStrMouseQueue)])

   else if theMess.LParam = 2 then
   begin
     edit2.Text := pShMem^.Text;
     if (theMess.WParam>=4)and(theMess.WParam<=9) then
         edit3.Text :=StrProcNames[theMess.Wparam-4];
     Edit2.Text :=format('X:%d Y:%d HWND:%X ', [pShMem^.pMouse.x, pShMem^.pMouse.y, pShMem^.hHookWnd]);
    Label2.caption := string(pShMem^.Text);
   end;
  except

  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;

end.