本文作者：按键小小生  我正好在写大唐无双的漠北挂，用到了坐标识别，这个游戏的坐标实在是有问题，另外，还不能输入坐标来自动找路，用挂来自动找坐标非常困难，这是按键小小生的方法，但是我和他的不同，只是他的这张图给我了一些参考。这种程序代码根本不是问题，问题是数学运算能力，害的姥爷我研究了一个通宵+1个下午。

http://bbs.anjian.com/forum.php?mod=attachment&aid=NTM5NDV8ZDU1NDFjNWJ8MTM0MjY4MTYwNXw2MjYyNDV8MjE0MjA5&noupdate=yes 这两天和朋友一起玩大唐无双，发现他的地图坐标体系和一般的游戏不太一样，
具体的请看简图，红色部分是屏幕的坐标系，浅色部分是大唐的坐标系。

经过大量的数据采集 ，进行平均和归化计算，基本可以肯定，两轴间的夹角如
图所示。在此基础上，得出如下的计算公式。（解决问题为，已知大地图某点坐标和该点的实际坐
标，求出欲达到大地图的坐标的实际坐标。）


定义如下变量： 公式如下：

经过上述计算，得出的 目标_实际 就是地图上目标点的实际屏幕坐标。有这个公式，游戏地图基本上是任我行了，

如果考虑得到的实际距离超出地图边界的问题 ，还可以依据这个实现智能移动大地图，以达到去往地图上任意点的

功能。那么诸如采集之类的脚本就可以不局限于地图的一角，或者固定几点，实际上我自己正是这样做的，我只需

要给出资源点的坐标，人物就能自己去坐标进行采集工作。

 

以上是按键小小生的方法。

我自己的方法不多做解释，直接上代码，看不懂的不要骚扰本人，简单解释下，用了大漠插件写的，另外有点乱，还没来得及精简代码，交期紧张，先这样凑和着用吧。

 

Dim x1,y1,x2,y2

//PutAttachment "d:\sx","*.*"
set ws=createobject("Wscript.Shell")
ws.run "regsvr32 d:\sx\dm.dll /s"
set ws=nothing
Delay 1500

Set dm = CreateObject("dm.dmsoft")
ver = dm.Ver()
If len(ver) = 0 Then
    MessageBox "创建对象失败,检查系统是否禁用了vbs脚本权限,关闭脚本重新开始或者手动注册，再开始-运行里输入regsvr32 d:\sx\dm.dll回车即可"
    EndScript
End If
MessageBox "鼠标准备了"
Delay 2000
hwnd = dm.GetMousePointWindow()
//MessageBox "现在找父句柄"
//Delay 1000
//hf = dm.getmousepointwindow()
dm_ret = dm.BindWindow(hwnd,"dx2","windows","windows",0)
Delay 1000
dm.SetPath "d:\sx"
dm.SetDict 0, "dtws.txt"
dm.SetDict 1, "song9.txt"
dm.SetDict 2, "songpua13.txt"
dm.SetDict 3, "spuaul13.txt"
dm.SetDict 4, "dm_soft.txt"

//Call lib.xyb.gc()
Call main()
dm_ret = dm.UnBindwindow()

Sub main()
x1=446:y1=400
Call coordinate()
x1=501:y1=418
Call coordinate()
x1=510:y1=362
Call coordinate()
x1=454:y1=318
Call coordinate()
x1=506:y1=241
Call coordinate()
x1=454:y1=202
Call coordinate()
x1=425:y1=100
Call coordinate()
x1=415:y1=69
Call coordinate()
x1=319:y1=90
Call coordinate()
x1=312:y1=203
Call coordinate()
x1=301:y1=244
Call coordinate()

End Sub

Sub activeit()'打开地图激活鼠标
 dm.usedict 0
Rem openworldmap
dm_ret = dm.Findstr(0, 0, 2000, 2000, "世界地图", "f7d9a6-000000", 1.0, x, y)
If x > 0 Then
 dm.moveto x, y
 Delay 50
 dm.leftclick
 xp1 = x + 352 : yp1 = y + 27 : xp2 = x + 457 : yp2 = y + 48
 x = x + 28 : y = y + 317
 dm.moveto x, y
 Delay 50
 dm.mover - 10 , - 10
 Delay 50
Else
dm.keypress 77
Delay 200
Goto openworldmap
End If
Delay 50
nowps = dm.ocr(xp1, yp1, xp2, yp2, "ffffff-000000", 1.0)
Rem confirmstate
Delay 50
dm.mover 10, 10
Delay 100
nowps2 = dm.ocr(xp1, yp1, xp2, yp2, "ffffff-000000", 1.0)
Delay 50
If nowps2 = nowps Then
 Goto confirmstate
End If
End Sub

Sub coordinate()
Dim Myarray
Rem againboy
dm.usedict 0
Rem openworldmap
dm_ret = dm.Findstr(0, 0, 2000, 2000, "世界地图", "f7d9a6-000000", 1.0, x, y)
If x > 0 Then
 dm.moveto x, y
 Delay 50
 dm.leftclick
 xp1 = x + 352 : yp1 = y + 27 : xp2 = x + 457 : yp2 = y + 48
 x = x + 28 : y = y + 317
 dm.moveto x, y
 Delay 50
Else
dm.keypress 77
Delay 200
Goto openworldmap
End If
abc = 50
kax = 0.866*3 : kbx = 0.866*3 : kay=0.5*3 : kby=-0.5*3

Delay abc
nowps = dm.ocr(xp1, yp1, xp2, yp2, "ffffff-000000", 1.0)
Rem confirmstate
Delay 50
dm.mover 10, 10
Delay 100
nowps2 = dm.ocr(xp1, yp1, xp2, yp2, "ffffff-000000", 1.0)
Delay 50
If nowps2 = nowps Then
 Goto confirmstate
End If

For 10000
Delay abc
nowps = dm.ocr(xp1, yp1, xp2, yp2, "ffffff-000000", 1.0)
Myarray = Split(nowps, ",")
x0 = CInt(myarray(0)) : y0 = CInt(myarray(1))
//If abs(x0 - x1)<2 and abs(y0 - y1)<2 Then
If x0=x1 and y0=y1 then
Exit For
Else
If abs(x0 - x1) > 4 and abs(y0-y1)>4 Then
 x = x + (x1 - x0) * kax : y = y + (x1 - x0) * kay
 x = x + (y1 - y0) * kbx : y = y + (y1 - y0) * kby
 dm.moveto x, y
 Delay abc*3
Else
If abs(x0 - x1) > 4 Then
 x = x + (x1 - x0) * kax : y = y + (x1 - x0) * kay
 dm.moveto x, y
 Delay abc*3
 Else
 If abs(y0 - y1) > 4 Then
  x = x + (y1 - y0) * kbx : y = y + (y1 - y0) * kby 
        dm.moveto x, y
        Delay abc*3
        Else
//If abs(x0 - x1)<2 Then
If x0=x1 then
If y0 < y1 Then
 x = x + 1 : y = y - 1
 dm.moveto x, y
 Delay abc
 Else
 x = x - 1 : y = y + 1
 dm.moveto x, y
 Delay abc
End If
Else
If x0 < x1 Then
 x = x + 1 : y = y + 1
 dm.moveto x, y
 Delay abc
 Else
 x = x - 1 : y = y - 1
 dm.moveto x, y
 Delay abc
End If
End If
End If
End If
End If 
End If
Next
dm.rightclick
Delay 1000
dm.keypress 77
Delay 500
Call position()
If x2 = x1 and y2 = y1 Then
 Exit Sub
 Else
 Goto againboy
End If
End Sub

Sub position()
Dim myarray
dm.usedict 0
Rem startboy
newps = dm.ocr(888, 118, 973, 151, "dad487-000000", 1.0)
myarray = split(newps, ",")
x2 = CInt(myarray(0)) : y2 = CInt(myarray(1))
Delay 500
If x2 = x1 and y2 = y1 Then
 Else
 Goto startboy
End If
End Sub