按键精灵8脚本(1.1):QQ连连看
编辑:dnawo 日期:2010-09-28
复制内容到剪贴板
程序代码

//按键精灵8.10.7234测试版 测试通过
//用户定义变量
UserVar LLKWIDTH=19 "水平方块数"
UserVar LLKHEIGHT=11 "垂直方块数"
UserVar LLKBORDER=DropList{"True":True|"False":False}=1 "外层是否可连"
UserVar LLKDELAY=400 "间隔时间(毫秒)"
//普通变量
Dim block()
Dim colors()
Dim intX, intY
Dim bw, bh
Dim lw, lh
Dim blockcount
Dim DEFAULTVALUE,ISREADY
//入口函数
Sub Main()
Dim typecount
Dim i, j, m, n
Dim winhwnd, winrect
//初始化二维数组
If CBool(LLKBORDER) Then
ReDim block(LLKWIDTH+1, LLKHEIGHT+1)
Else
ReDim block(LLKWIDTH-1, LLKHEIGHT-1)
End If
//初始化相关变量
bw=25
bh=29
lw=6
lh=6
blockcount=0
DEFAULTVALUE=0
ReDim colors(bw-1)
typecount=0
//初始化原点坐标
ISREADY=False
winhwnd=Plugin.Window.Find(0,"QQ游戏 - 连连看角色版")
If winhwnd>0 Then
winrect=Plugin.Window.GetWindowRect(winhwnd)
xys=Split(winrect,"|")
intX=xys(0)+11
intY=xys(1)+178
//让界面获取焦点
MoveTo intX, intY
LeftClick 1
//填充二维数组
For i=LBound(block,1) To UBound(block,1)
For j=LBound(block,2) To UBound(block,2)
//外层可用
If CBool(LLKBORDER) Then
If i>0 And i<UBound(block,1) And j>0 And j<UBound(block,2) Then
If block(i,j)="" Then
If IsColor(GetBlockX(i,j)+3,GetBlockY(i,j)+3,"704C30",0) Then
typecount=typecount+1
block(i,j)=typecount
blockcount=blockcount+1
Colors_Add i,j,CInt(bh/2)
For m=1 To UBound(block,1)-1
For n=1 To UBound(block,2)-1
If block(m,n)="" Then
If Colors_Equal(m,n,CInt(bh/2)) Then
block(m,n)=typecount
blockcount=blockcount+1
End If
End If
Next
Next
Else
block(i,j)=DEFAULTVALUE
End If
End If
Else
block(i,j)=DEFAULTVALUE
End If
//外层不可用
Else
If block(i,j)="" Then
If IsColor(GetBlockX(i+1,j+1)+3,GetBlockY(i+1,j+1)+3,"704C30",0) Then
typecount=typecount+1
block(i,j)=typecount
blockcount=blockcount+1
Colors_Add i+1,j+1,CInt(bh/2)
For m=LBound(block,1) To UBound(block,1)
For n=LBound(block,2) To UBound(block,2)
If block(m,n)="" Then
If Colors_Equal(m+1,n+1,CInt(bh/2)) Then
block(m,n)=typecount
blockcount=blockcount+1
End If
End If
Next
Next
Else
block(i,j)=DEFAULTVALUE
End If
End If
End If
Next
Next
ISREADY=True
End If
Call Connect()
End Sub
//连连看
Sub Connect()
Dim connected
If ISREADY Then
Do While blockcount>0
connected=False
For i=LBound(block,1) To UBound(block,1)
For j=LBound(block,2) To UBound(block,2)
If block(i,j)<>DEFAULTVALUE Then
For m=LBound(block,1) To UBound(block,1)
For n=LBound(block,2) To UBound(block,2)
If block(m,n)=block(i,j) And Not (i=m And j=n) Then
If LineEx(i,j,m,n) Then
If CBool(LLKBORDER) Then
LeftClickEx GetBlockX2(i,j),GetBlockY2(i,j),1
LeftClickEx GetBlockX2(m,n),GetBlockY2(m,n),1
Else
LeftClickEx GetBlockX2(i+1,j+1),GetBlockY2(i+1,j+1),1
LeftClickEx GetBlockX2(m+1,n+1),GetBlockY2(m+1,n+1),1
End If
block(i,j)=DEFAULTVALUE
block(m,n)=DEFAULTVALUE
blockcount=blockcount-2
connected=True
Delay LLKDELAY
Goto NextBlock
End If
End If
Next
Next
End If
Rem NextBlock
Next
Next
If Not connected Then
//MessageBox "无方块可消除!重排后继续:"
Call Main()
Goto Quit
End If
Loop
MessageBox "方块全部消除完毕!"
Else
MessageBox "精灵初始化失败!"
End If
End Sub
//直线相连
Function Line(x1, y1, x2, y2)
Dim result
Dim num1,num2,i
result=True
//竖直
If x1=x2 Then
If y1>=y2 Then
num1=y2
num2=y1
Else
num1=y1
num2=y2
End If
num1=num1+1
num2=num2-1
For i=num1 To num2
If block(x1,i)<>DEFAULTVALUE Then
result=False
Exit For
End If
Next
//水平
ElseIf y1=y2 Then
If x1>=x2 Then
num1=x2
num2=x1
Else
num1=x1
num2=x2
End If
num1=num1+1
num2=num2-1
For i=num1 To num2
If block(i,y1)<>DEFAULTVALUE Then
result=False
Exit For
End If
Next
Else
result=False
End If
Line=result
End Function
//折线相连
Function LineEx(x1, y1, x2, y2)
Dim num1,num2,i
Dim x3 : x3 = GetMinX(x1,y1)
Dim x4 : x4 = GetMaxX(x1,y1)
Dim x5 : x5 = GetMinX(x2,y2)
Dim x6 : x6 = GetMaxX(x2,y2)
Dim y3 : y3 = GetMinY(x1,y1)
Dim y4 : y4 = GetMaxY(x1,y1)
Dim y5 : y5 = GetMinY(x2,y2)
Dim y6 : y6 = GetMaxY(x2,y2)
LineEx = False
//水平
num1=IIF(x3>=x5,x3,x5)
num2=IIF(x4>=x6,x6,x4)
For i=num1 To num2
If Line(i,y1,i,y2) Then
LineEx=True
Exit For
End If
Next
//竖直
num1=IIF(y3>=y5,y3,y5)
num2=IIF(y4>=y6,y6,y4)
For i=num1 To num2
If Line(x1,i,x2,i) Then
LineEx=True
Exit For
End If
Next
End Function
//方块左上角x坐标
Function GetBlockX(x, y)
GetBlockX = intX+(x-1)*bw+(x*lw)
End Function
//方块左上角y坐标
Function GetBlockY(x, y)
GetBlockY = intY+(y-1)*bh+(y*lh)
End Function
//方块右上角x坐标
Function GetBlockX2(x, y)
GetBlockX2 = intX+x*bw+(x*lw)
End Function
//方块右上角y坐标
Function GetBlockY2(x, y)
GetBlockY2 = intY+y*bh+(y*lh)
End Function
//获取最小x坐标
Function GetMinX(x, y)
Dim i : GetMinX = x
For i=x-1 To LBound(block,1) step -1
If block(i,y)=DEFAULTVALUE Then
GetMinX = i
Else
Exit Function
End If
Next
End Function
//获取最大x坐标
Function GetMaxX(x, y)
Dim i : GetMaxX = x
For i=x+1 To UBound(block,1)
If block(i,y)=DEFAULTVALUE Then
GetMaxX = i
Else
Exit Function
End If
Next
End Function
//获取最小y坐标
Function GetMinY(x, y)
Dim i : GetMinY = y
For i=y-1 To LBound(block,2) step -1
If block(x,i)=DEFAULTVALUE Then
GetMinY = i
Else
Exit Function
End If
Next
End Function
//获取最大y坐标
Function GetMaxY(x, y)
Dim i : GetMaxY = y
For i=y+1 To UBound(block,2)
If block(x,i)=DEFAULTVALUE Then
GetMaxY = i
Else
Exit Function
End If
Next
End Function
//根据条件获取返回值
Function IIF(exp, value1, value2)
If exp Then
IIF=value1
Else
IIF=value2
End If
End Function
//颜色判断
Function IsColor(x, y, color1, offset)
IfColor x,y,color1,offset Then
IsColor=False
Else
IsColor=True
End If
End Function
//鼠标单击
Sub LeftClickEx(x, y, n)
Dim i
MoveTo x,y
For i=1 To n
LeftDown 1
LeftUp 1
Next
End Sub
//添加颜色到数组
Sub Colors_Add(x, y, offset)
Dim i
If CBool(LLKBORDER) Then
x=intX+x*bw+(x+1)*lw
y=intY+y*bh+(y+1)*lh+offset
Else
x=intX+(x-1)*bw+(x*lw)
y=intY+(y-1)*bh+(y*lh)+offset
End If
For i=LBound(colors) To UBound(colors)
colors(i)=GetPixelColor(x,y)
x=x+1
Next
End Sub
//判断颜色是否相等
Function Colors_Equal(x, y, offset)
Dim i
Colors_Equal=True
If CBool(LLKBORDER) Then
x=intX+x*bw+(x+1)*lw
y=intY+y*bh+(y+1)*lh+offset
Else
x=intX+(x-1)*bw+(x*lw)
y=intY+(y-1)*bh+(y*lh)+offset
End If
For i=LBound(colors) To UBound(colors)
If colors(i)<>GetPixelColor(x,y) Then
Colors_Equal=False
Exit For
End If
x=x+1
Next
End Function
//打印数组信息
Sub ToString()
Dim str
For i=0 To UBound(block,2)
For j=0 To UBound(block,1)
str = str & block(j,i) & vbTab
Next
str = str & vbCrLf
Next
MessageBox str
End Sub
Call Main()
Rem Quit
EndScript
//用户定义变量
UserVar LLKWIDTH=19 "水平方块数"
UserVar LLKHEIGHT=11 "垂直方块数"
UserVar LLKBORDER=DropList{"True":True|"False":False}=1 "外层是否可连"
UserVar LLKDELAY=400 "间隔时间(毫秒)"
//普通变量
Dim block()
Dim colors()
Dim intX, intY
Dim bw, bh
Dim lw, lh
Dim blockcount
Dim DEFAULTVALUE,ISREADY
//入口函数
Sub Main()
Dim typecount
Dim i, j, m, n
Dim winhwnd, winrect
//初始化二维数组
If CBool(LLKBORDER) Then
ReDim block(LLKWIDTH+1, LLKHEIGHT+1)
Else
ReDim block(LLKWIDTH-1, LLKHEIGHT-1)
End If
//初始化相关变量
bw=25
bh=29
lw=6
lh=6
blockcount=0
DEFAULTVALUE=0
ReDim colors(bw-1)
typecount=0
//初始化原点坐标
ISREADY=False
winhwnd=Plugin.Window.Find(0,"QQ游戏 - 连连看角色版")
If winhwnd>0 Then
winrect=Plugin.Window.GetWindowRect(winhwnd)
xys=Split(winrect,"|")
intX=xys(0)+11
intY=xys(1)+178
//让界面获取焦点
MoveTo intX, intY
LeftClick 1
//填充二维数组
For i=LBound(block,1) To UBound(block,1)
For j=LBound(block,2) To UBound(block,2)
//外层可用
If CBool(LLKBORDER) Then
If i>0 And i<UBound(block,1) And j>0 And j<UBound(block,2) Then
If block(i,j)="" Then
If IsColor(GetBlockX(i,j)+3,GetBlockY(i,j)+3,"704C30",0) Then
typecount=typecount+1
block(i,j)=typecount
blockcount=blockcount+1
Colors_Add i,j,CInt(bh/2)
For m=1 To UBound(block,1)-1
For n=1 To UBound(block,2)-1
If block(m,n)="" Then
If Colors_Equal(m,n,CInt(bh/2)) Then
block(m,n)=typecount
blockcount=blockcount+1
End If
End If
Next
Next
Else
block(i,j)=DEFAULTVALUE
End If
End If
Else
block(i,j)=DEFAULTVALUE
End If
//外层不可用
Else
If block(i,j)="" Then
If IsColor(GetBlockX(i+1,j+1)+3,GetBlockY(i+1,j+1)+3,"704C30",0) Then
typecount=typecount+1
block(i,j)=typecount
blockcount=blockcount+1
Colors_Add i+1,j+1,CInt(bh/2)
For m=LBound(block,1) To UBound(block,1)
For n=LBound(block,2) To UBound(block,2)
If block(m,n)="" Then
If Colors_Equal(m+1,n+1,CInt(bh/2)) Then
block(m,n)=typecount
blockcount=blockcount+1
End If
End If
Next
Next
Else
block(i,j)=DEFAULTVALUE
End If
End If
End If
Next
Next
ISREADY=True
End If
Call Connect()
End Sub
//连连看
Sub Connect()
Dim connected
If ISREADY Then
Do While blockcount>0
connected=False
For i=LBound(block,1) To UBound(block,1)
For j=LBound(block,2) To UBound(block,2)
If block(i,j)<>DEFAULTVALUE Then
For m=LBound(block,1) To UBound(block,1)
For n=LBound(block,2) To UBound(block,2)
If block(m,n)=block(i,j) And Not (i=m And j=n) Then
If LineEx(i,j,m,n) Then
If CBool(LLKBORDER) Then
LeftClickEx GetBlockX2(i,j),GetBlockY2(i,j),1
LeftClickEx GetBlockX2(m,n),GetBlockY2(m,n),1
Else
LeftClickEx GetBlockX2(i+1,j+1),GetBlockY2(i+1,j+1),1
LeftClickEx GetBlockX2(m+1,n+1),GetBlockY2(m+1,n+1),1
End If
block(i,j)=DEFAULTVALUE
block(m,n)=DEFAULTVALUE
blockcount=blockcount-2
connected=True
Delay LLKDELAY
Goto NextBlock
End If
End If
Next
Next
End If
Rem NextBlock
Next
Next
If Not connected Then
//MessageBox "无方块可消除!重排后继续:"
Call Main()
Goto Quit
End If
Loop
MessageBox "方块全部消除完毕!"
Else
MessageBox "精灵初始化失败!"
End If
End Sub
//直线相连
Function Line(x1, y1, x2, y2)
Dim result
Dim num1,num2,i
result=True
//竖直
If x1=x2 Then
If y1>=y2 Then
num1=y2
num2=y1
Else
num1=y1
num2=y2
End If
num1=num1+1
num2=num2-1
For i=num1 To num2
If block(x1,i)<>DEFAULTVALUE Then
result=False
Exit For
End If
Next
//水平
ElseIf y1=y2 Then
If x1>=x2 Then
num1=x2
num2=x1
Else
num1=x1
num2=x2
End If
num1=num1+1
num2=num2-1
For i=num1 To num2
If block(i,y1)<>DEFAULTVALUE Then
result=False
Exit For
End If
Next
Else
result=False
End If
Line=result
End Function
//折线相连
Function LineEx(x1, y1, x2, y2)
Dim num1,num2,i
Dim x3 : x3 = GetMinX(x1,y1)
Dim x4 : x4 = GetMaxX(x1,y1)
Dim x5 : x5 = GetMinX(x2,y2)
Dim x6 : x6 = GetMaxX(x2,y2)
Dim y3 : y3 = GetMinY(x1,y1)
Dim y4 : y4 = GetMaxY(x1,y1)
Dim y5 : y5 = GetMinY(x2,y2)
Dim y6 : y6 = GetMaxY(x2,y2)
LineEx = False
//水平
num1=IIF(x3>=x5,x3,x5)
num2=IIF(x4>=x6,x6,x4)
For i=num1 To num2
If Line(i,y1,i,y2) Then
LineEx=True
Exit For
End If
Next
//竖直
num1=IIF(y3>=y5,y3,y5)
num2=IIF(y4>=y6,y6,y4)
For i=num1 To num2
If Line(x1,i,x2,i) Then
LineEx=True
Exit For
End If
Next
End Function
//方块左上角x坐标
Function GetBlockX(x, y)
GetBlockX = intX+(x-1)*bw+(x*lw)
End Function
//方块左上角y坐标
Function GetBlockY(x, y)
GetBlockY = intY+(y-1)*bh+(y*lh)
End Function
//方块右上角x坐标
Function GetBlockX2(x, y)
GetBlockX2 = intX+x*bw+(x*lw)
End Function
//方块右上角y坐标
Function GetBlockY2(x, y)
GetBlockY2 = intY+y*bh+(y*lh)
End Function
//获取最小x坐标
Function GetMinX(x, y)
Dim i : GetMinX = x
For i=x-1 To LBound(block,1) step -1
If block(i,y)=DEFAULTVALUE Then
GetMinX = i
Else
Exit Function
End If
Next
End Function
//获取最大x坐标
Function GetMaxX(x, y)
Dim i : GetMaxX = x
For i=x+1 To UBound(block,1)
If block(i,y)=DEFAULTVALUE Then
GetMaxX = i
Else
Exit Function
End If
Next
End Function
//获取最小y坐标
Function GetMinY(x, y)
Dim i : GetMinY = y
For i=y-1 To LBound(block,2) step -1
If block(x,i)=DEFAULTVALUE Then
GetMinY = i
Else
Exit Function
End If
Next
End Function
//获取最大y坐标
Function GetMaxY(x, y)
Dim i : GetMaxY = y
For i=y+1 To UBound(block,2)
If block(x,i)=DEFAULTVALUE Then
GetMaxY = i
Else
Exit Function
End If
Next
End Function
//根据条件获取返回值
Function IIF(exp, value1, value2)
If exp Then
IIF=value1
Else
IIF=value2
End If
End Function
//颜色判断
Function IsColor(x, y, color1, offset)
IfColor x,y,color1,offset Then
IsColor=False
Else
IsColor=True
End If
End Function
//鼠标单击
Sub LeftClickEx(x, y, n)
Dim i
MoveTo x,y
For i=1 To n
LeftDown 1
LeftUp 1
Next
End Sub
//添加颜色到数组
Sub Colors_Add(x, y, offset)
Dim i
If CBool(LLKBORDER) Then
x=intX+x*bw+(x+1)*lw
y=intY+y*bh+(y+1)*lh+offset
Else
x=intX+(x-1)*bw+(x*lw)
y=intY+(y-1)*bh+(y*lh)+offset
End If
For i=LBound(colors) To UBound(colors)
colors(i)=GetPixelColor(x,y)
x=x+1
Next
End Sub
//判断颜色是否相等
Function Colors_Equal(x, y, offset)
Dim i
Colors_Equal=True
If CBool(LLKBORDER) Then
x=intX+x*bw+(x+1)*lw
y=intY+y*bh+(y+1)*lh+offset
Else
x=intX+(x-1)*bw+(x*lw)
y=intY+(y-1)*bh+(y*lh)+offset
End If
For i=LBound(colors) To UBound(colors)
If colors(i)<>GetPixelColor(x,y) Then
Colors_Equal=False
Exit For
End If
x=x+1
Next
End Function
//打印数组信息
Sub ToString()
Dim str
For i=0 To UBound(block,2)
For j=0 To UBound(block,1)
str = str & block(j,i) & vbTab
Next
str = str & vbCrLf
Next
MessageBox str
End Sub
Call Main()
Rem Quit
EndScript
更新
·连连看窗口定位方式更新,改用Plugin.Window.Find;
·使用LeftDown和LeftUp代替LeftClick,单位时间内点击频率大大提高;
·使用找色法代替找图法进行方块编号,速度提升一倍;
评论: 5 | 引用: 0 | 查看次数: 19535





可以的,http://www.mzwu.com/default.asp?id=2614这篇文章中使用的就是自己找图,可以参考下,但上边说了,找图法当硬件配置不高时非常慢。
4#
按鍵精靈可以自己找圖嘛?
我在玩的連連看每回合圖不一樣
如果我用範圍找圖
就要把每個圖案都存在它的資料夾裡
請問版主有沒有比較簡單的方法
我在玩的連連看每回合圖不一樣
如果我用範圍找圖
就要把每個圖案都存在它的資料夾裡
請問版主有沒有比較簡單的方法
板凳
本博客中有个1.0版的,使用的就是找图法,可以搜索看下,但其缺点是分析的速度很慢,本文使用的找色法,速度加快了很多,还有更快的,说是可以在内存中查找,还在研究中。
沙发
我想請問版主
按鍵精靈是如何設計連連看的
我用區域找圖效果非常有限
而且常常找不到
不知版主是用什麼指令
按鍵精靈是如何設計連連看的
我用區域找圖效果非常有限
而且常常找不到
不知版主是用什麼指令
发表评论
请登录后再发表评论!