获取其它程序的鼠标坐标。(200分)

dcs_dcs要我多看参考资料,能帮我推荐一些吗?

smallstomach你在哪里,我在苦苦等待你.

代码如下（右键打点计标，END键退出，本想ctrl+end提前的，但setforegroundwindow好像又不行，周未要回家了，你自已把这个弄一下，要不星期一我再看。你还可以通过屏幕取色识别线条以辅助定位（getpixel(getWindowDC(getDesktopWindow),），如果有必要的话。）

unit mainWnd;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,shellapi, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormShow(Sender: TObject);
public
procedure wndProc(var mess:TMessage);override;
private

end;
type TCommonData=record
mainWnd:Hwnd;
pt:Tpoint;
end;


Tpro=procedure;stdcall;
const SXW_CLICKED=1;
SXW_END=2;
var
Form1: TForm1;
myMessage:UINT;
hMapFile:Thandle;
hm:Hmodule;
implementation
{$R *.dfm}
procedure TForm1.wndProc(var mess:TMessage);
begin
if (mess.msg=myMessage) then
begin
if (mess.wParam=SXW_CLICKED) then
begin
memo1.lines.add('X'+inttostr(TCommonData(mapViewOfFile(HMapFile,file_map_write,0,0,0)^).pt.x)+' Y'+inttostr(TCommonData(mapViewOfFile(HMapFile,file_map_write,0,0,0)^).pt.y));

end;
if(mess.wParam=SXW_END) then
begin
self.button2Click(self);
postQuitMessage(0);
end;
Tmessage(mess).result:=1;
end;
inherited;
end;

procedure TForm1.Button1Click(Sender: TObject);
var install:Tpro;
begin
hm:=LoadLibrary('./hookdll.dll');
@install:=getProcAddress(hm,'installHook');
install;
end;

procedure TForm1.Button2Click(Sender: TObject);
var unHook:Tpro;
begin
@unHook:=getProcAddress(hm,'unHook');
unHook;
freeLibrary(hm);
closeHandle(hMapFile);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
hMapFile:=createFileMapping($FFFFFFFF,nil,page_readWrite,0,sizeOf(TCommonData),'sxw');
TCommonData(mapViewOfFile(HMapFile,file_map_write,0,0,0)^).mainWnd:=handle;
end;
begin
myMessage:=registerWindowMessage(pchar('smallstomach'));
end.


library hookdll;
uses
Windows,
Classes,
Controls,
Dialogs,
SysUtils,
shellapi,
Qt;
{$R *.res}
type TCommonData=record
mainWnd:Hwnd;
pt:Tpoint;
end;

const SXW_CLICKED=1;
SXW_END=2;
var mouseHook,keyboardHook:HHook;
p:^MOUSEHOOKSTRUCT;
myMessage:UINT;
mainWnd:Hwnd;
hmapFile:Thandle;
function keyboardProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
if nCode>=0 then
begin
if (wParam=VK_END) and (BOOL(lParam shr 31)) then
result:=1
else
if (wParam=VK_END) then
begin
HMapFile:=openFileMapping(file_map_write,false,'sxw');
sendMessage((TCommonData(mapViewOfFile(HMapFile,file_map_write,0,0,0)^)).mainWnd,myMessage,SXW_END,0);
closeHandle(hMapfile);
result:=1;
end else
result:=0;
end else
result:=callNextHookEx(keyboardHook,nCode,wParam,lParam);
end;

function mouseProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
p:=ptr(lParam);
if nCode>=0 then
begin
if (wParam=517) then
begin
HMapFile:=openFileMapping(file_map_write,false,'sxw');
TCommonData(mapViewOfFile(HMapFile,file_map_write,0,0,0)^).pt:=p^.pt;
sendMessage((TCommonData(mapViewOfFile(HMapFile,file_map_write,0,0,0)^)).mainWnd,myMessage,SXW_CLICKED,0);
closeHandle(hMapfile);
result:=1;
end else
if (wParam=516) then
result:=1
else
result:=0;
end
else
result:=callNextHookEx(mouseHook,nCode,wParam,lParam)
end;
procedure installHook;stdcall;
begin
mousehook:=setWindowsHookEx(WH_MOUSE,@MouseProc,Hinstance,0);
keyboardHook:=setWindowsHookEx(WH_KEYBOARD,@keyboardProc,Hinstance,0);
end;
procedure unHook;stdcall;
begin
if mouseHook<>0 then
begin
unHookWindowsHookEx(mouseHook);
unHookWindowsHookEx(keyboardHook);
mouseHook:=0;
end;
end;

exports
unHook,
installHook;
begin
myMessage:=registerWindowMessage('smallstomach');
end.

smallstomach:你好.
在等你的日子里,我找了关于WINDOWS钩子的资料来看,有点吃力.
我主要是想获取指定的CAD程序内客户区的鼠标坐标.
您是不是把鼠标右键的其它消息过滤了,在CAD程序内右键的点点之间是以弧线连接的.安装
钩子后,右键功能没有了.还有按&quot;
end&quot;脱钩，并回到我的主程序，不是退出程序。
不过你的回答我已很满意了.
还有一点恐怕比较难,CAD状态栏上有显示X,Y坐标,和鼠标钩子截获的坐标相去甚远.能否
直接获得CAD状态栏的X,Y值呢?如果你能解决的话,我把它加入我的程序那就完美了,并且
我将把剩下40分连同这200分一并奉上。
我星期一再来看，但愿能有一个惊喜。并且给你结帐。

我会给你一个惊喜的，呵呵！
程序代码做了些修改。
”您是不是把鼠标右键的其它消息过滤了,在CAD程序内右键的点点之间是以弧线连接的.安装钩子后,右键功能没有了“
解决办法：（1），DLL中第二行我加注的地方你可通过注解来选择用右键还是左键。（2）这次你可以通过CAPS LOCK键来决定开启和关闭，不影响你的正常操作。
“还有按&quot;
end&quot;脱钩，并回到我的主程序，不是退出程序。”
解决办法：脱钩与按CAPS LOCK键等价，改后已能回到主程序了。ctrl+end退出。
“还有一点恐怕比较难,CAD状态栏上有显示X,Y坐标,和鼠标钩子截获的坐标相去甚远.能否
直接获得CAD状态栏的X,Y值呢?如果你能解决的话,我把它加入我的程序那就完美了”
解决办法：在主程序中我注解的地方酌情加减。有问题的话可QQ联系。
unit mainWnd;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,shellapi, StdCtrls, ExtCtrls, ComCtrls;
type
TForm1 = class(TForm)
Button2: TButton;
Memo1: TMemo;
procedure Button2Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
public
procedure wndProc(var mess:TMessage);override;
private

end;
type TCommonData=record
mainWnd:Hwnd;
pt:Tpoint;
end;


Tpro=procedure;stdcall;
const SXW_CLICKED=1;
SXW_END=2;
SXW_CTRLEND=3;
var
Form1: TForm1;
myMessage:UINT;
hMapFile:Thandle;
hm:Hmodule;
implementation
{$R *.dfm}
function ForceForeGroundWindow(hwnd: THandle): boolean;
const
SPI_GETFOREGROUNDLOCKTIMEOUT = $2000;
SPI_SETFOREGROUNDLOCKTIMEOUT = $2001;
var
ForegroundThreadID: DWORD;
ThisThreadID : DWORD;
timeout : DWORD;
begin
if IsIconic(hwnd) then
ShowWindow(hwnd, SW_RESTORE);
if GetForegroundWindow = hwnd then
Result := true
else
begin
if ((Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion > 4))
or((Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and
((Win32MajorVersion > 4) or ((Win32MajorVersion = 4) and
(Win32MinorVersion > 0)))) then
begin
Result := false;
ForegroundThreadID :=GetWindowThreadProcessID(GetForegroundWindow,nil);
ThisThreadID := GetWindowThreadPRocessId(hwnd,nil);
if AttachThreadInput(ThisThreadID, ForegroundThreadID, true) then
begin
BringWindowToTop(hwnd);
SetForegroundWindow(hwnd);
AttachThreadInput(ThisThreadID, ForegroundThreadID, false);
Result := (GetForegroundWindow = hwnd);
end;
if not Result then
begin
SystemParametersInfo(SPI_GETFOREGROUNDLOCKTIMEOUT, 0, @timeout, 0);
SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, TObject(0),SPIF_SENDCHANGE);
BringWindowToTop(hwnd);
SetForegroundWindow(hWnd);
SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0,TObject(timeout), SPIF_SENDCHANGE);
end;
end
else
begin
BringWindowToTop(hwnd);
SetForegroundWindow(hwnd);
end;
Result := (GetForegroundWindow = hwnd);
end;
end;


procedure TForm1.wndProc(var mess:TMessage);
var posDcOrg,pos:Tpoint;
begin
if (mess.msg=myMessage) then
begin
if (mess.wParam=SXW_CLICKED) then
begin
getCursorPos(pos);
getDcOrgEx(getWindowDc(windowFromPoint(pos)),posDcorg);
memo1.lines.add('X:'+inttostr(TCommonData(mapViewOfFile(HMapFile,file_map_write,0,0,0)^).pt.x-posDcOrg.x)+' Y'+inttostr(TCommonData(mapViewOfFile(HMapFile,file_map_write,0,0,0)^).pt.y-posDcOrg.y));
//你可同CAD状态栏的XY值比较，如果有一定的差值，可以对上句酌情加减一定的值，总会和CAD上值一样的。
end else
if mess.wParam=SXW_END then
begin
self.button2Click(self);
postQuitMessage(0);
end else
if mess.wParam=SXW_CTRLEND then
begin
ForceForeGroundWindow(handle);
end;
Tmessage(mess).result:=1;
end;
inherited;
end;
procedure TForm1.Button2Click(Sender: TObject);
var unHook:Tpro;
begin
@unHook:=getProcAddress(hm,'unHook');
unHook;
freeLibrary(hm);
closeHandle(hMapFile);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
hMapFile:=createFileMapping($FFFFFFFF,nil,page_readWrite,0,sizeOf(TCommonData),'sxw');
TCommonData(mapViewOfFile(HMapFile,file_map_write,0,0,0)^).mainWnd:=handle;
end;
procedure TForm1.FormCreate(Sender: TObject);
var install:Tpro;
begin
hm:=LoadLibrary('./hookdll.dll');
@install:=getProcAddress(hm,'installHook');
install;
end;

begin
myMessage:=registerWindowMessage(pchar('smallstomach'));
end.

library hookdll;
{$define RBUTTON}
//如果喜欢左键打点，注解上句后编译。
uses
Windows,
Classes,
Controls,
Dialogs,
SysUtils,
shellapi,
Qt;
{$R *.res}
type TCommonData=record
mainWnd:Hwnd;
pt:Tpoint;
end;

const SXW_CLICKED=1;
SXW_END=2;
SXW_CTRLEND=3;
var mouseHook,keyboardHook:HHook;
p:^MOUSEHOOKSTRUCT;
myMessage:UINT;
hmapFile:Thandle;
function keyboardProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
if nCode>=0 then
begin
if (wParam=VK_END) and (BOOL(lParam shr 31)) then
result:=1
else
if (wParam=VK_END) then
begin
HMapFile:=openFileMapping(file_map_write,false,'sxw');
if getKeyState(17)<0 then
sendMessage((TCommonData(mapViewOfFile(HMapFile,file_map_write,0,0,0)^)).mainWnd,myMessage,SXW_END,0)
else
sendMessage((TCommonData(mapViewOfFile(HMapFile,file_map_write,0,0,0)^)).mainWnd,myMessage,SXW_CTRLEND,0);
closeHandle(hMapfile);
result:=1;
end else
result:=0;
end else
result:=callNextHookEx(keyboardHook,nCode,wParam,lParam);
end;

function mouseProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
p:=ptr(lParam);
if nCode>=0 then
begin
{$ifndef RBUTTON}
if (getKeyState(VK_CAPITAL)=1)and(wParam=513) then
{$else
}
if (getKeyState(VK_CAPITAL)=1)and(wParam=516) then
{$endif}
begin
HMapFile:=openFileMapping(file_map_write,false,'sxw');
TCommonData(mapViewOfFile(HMapFile,file_map_write,0,0,0)^).pt:=p^.pt;
sendMessage((TCommonData(mapViewOfFile(HMapFile,file_map_write,0,0,0)^)).mainWnd,myMessage,SXW_CLICKED,0);
closeHandle(hMapfile);
result:=1;
{$ifndef RBUTTON}
end else
if (getKeyState(VK_CAPITAL)=1)AND(wParam=517) then
result:=1
{$else
}
end else
if (getKeyState(VK_CAPITAL)=1)AND(wParam=517) then
result:=1
{$endif}
else
result:=0;
end
else
result:=callNextHookEx(mouseHook,nCode,wParam,lParam)
end;
procedure installHook;stdcall;
begin
mousehook:=setWindowsHookEx(WH_MOUSE,@MouseProc,Hinstance,0);
keyboardHook:=setWindowsHookEx(WH_KEYBOARD,@keyboardProc,Hinstance,0);
end;
procedure unHook;stdcall;
begin
if mouseHook<>0 then
begin
unHookWindowsHookEx(mouseHook);
unHookWindowsHookEx(keyboardHook);
mouseHook:=0;
end;
end;

exports
unHook,
installHook;
begin
myMessage:=registerWindowMessage('smallstomach');
end.

我已给你加了200分,另外我说再给40分可怎么加呢?
我想拜你为师，你愿意吗？
有点美中不足是，我在CAD内点左键是加折线，点右键加曲线，安装钩子后啦要么选择左键要么选择右键，比如我要加一条曲线我就点右键，点完后在屏幕上就能出现曲线。能否只过滤右键的弹出式菜单呢？
QQ:361871402
email:jiangjianguo29@163.com

你把分都给了别人自已怎么生活啊？留着以后用吧，要不再碰到问题就没的赏钱了。
我也是菜鸟，我们可能编程都不是太懂，有问题就得互助帮助。
这论坛上高手倒有不少，高手为了生活都很忙碌，很少回复一般的贴子，要师就得找刘麻子那样的高人，我们只能互相帮助，共同进步。
能给200分已经很多了，提出问题就得遵循江湖道义，但如今好多人在接受了大家热心的帮助后，不结贴，不散一分，让人痛心。
你做得很好。
&quot;只过滤右键的弹出式菜单&quot;是不能实现的，要不就改用中键吧。