main.pas

delphi 读取屏幕的源码

unit main;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);

  private
    { Private declarations }
    hMapObj: THandle;
    pShMem: PShareMem;
    fWndClosed: boolean;
    procedure getMouseInfo(var theMess: TMessage); message WM_MOUSEPT;
  public
    { Public declarations }

  end;
var
  Form1: TForm1;

implementation

{$R *.DFM}

{调用32位的DLL进行取词}

function OpenGetKeyHook(sender: HWND; MessageID: WORD): BOOLean; stdcall; external 'GetWord32.DLL';
{取消取词}

function CloseGetKeyHook: BOOLean; stdcall; external 'GetWord32.DLL';
{鼠标处理过程}

procedure TForm1.Button1Click(Sender: TObject);
begin
  if button1.caption = '取词' then
  begin
    OpenGetKeyHook(Form1.Handle, WM_MOUSEPT);
    button1.caption := '取消';
  end
  else begin
    CloseGetKeyHook;
    button1.caption := '取词';
  end;
end;

procedure TForm1.getMouseInfo(var theMess: TMessage);
begin
  if fWndClosed then
    Exit;
  if theMess.LParam = 1 then
  begin {获取鼠标信息}
    Label1.caption := format('X:%d Y:%d HWND:%X %s', [pShMem^.pMouse.x, pShMem^.pMouse.y, pShMem^.hHookWnd,
      string(@pShMem^.fStrMouseQueue)]);
    Label2.caption := '';
  end
  else if theMess.LParam = 2 then
  begin
    {进行取词，获取缓冲区数据}
    Label1.caption := format('X:%d Y:%d HWND:%X ', [pShMem^.pMouse.x, pShMem^.pMouse.y, pShMem^.hHookWnd]);
    Label2.caption := string(pShMem^.Text);
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if button1.caption <> '取词' then
    Button1Click(Sender);
end;

procedure TForm1.FormCreate(Sender: TObject);
//var
//  wc: TWndClass;
begin
  SetForegroundWindow(self.Handle);
  hMapObj := OpenFileMapping(FILE_MAP_WRITE, {获得完全访问权}
    False,
    LPCTSTR(MappingFileName)); {内存映射文件的名字}
  if hMapObj = 0 then
  begin
    ShowMessage('Cannot locate the Share Memory Block!');
    Halt;
  end;
  {pShMem指向内存映象文件}
  pShMem := PShareMem(MapViewOfFile(hMapObj,
    FILE_MAP_WRITE,
    0,
    0,
    0));
  if pShMem = nil then
  begin
    ShowMessage('Map File Mapping Failed! Error ' + IntToStr(GetLastError));
    CloseHandle(hMapObj);
    Halt;
  end;

  FillChar(pShMem^, SizeOf(TShareMem), 0);
  pShMem^.hMainWnd := Self.Handle;
//  pShMem^.MainHinst := hInstance;
  fWndClosed := false;

{  wc.style := 0;
  wc.lpfnWndProc := TFNWndProc(@MouseWndProc);
  wc.cbClsExtra := 0;
  wc.cbWndExtra := 0;
  wc.hInstance := HInstance;
  wc.hIcon := 0;
  wc.hCursor := 0;
  wc.hbrBackground := 0;
  wc.lpszMenuName := nil;
  wc.lpszClassName := 'ZL_MOUSE_WND_PSEUDO';
  Windows.RegisterClass(wc); }
end;

end.