标题: 按键精灵8脚本(1.1)：宠物连连看2.5版
作者: dnawo
日期: 2010-09-25 07:55 PM
分类: Win编程
内容: 复制内容到剪贴板 程序代码//按键精灵8.10.7234测试版 测试通过
//用户定义变量
UserVar LLKWIDTH=14 "水平方块数"
UserVar LLKHEIGHT=10 "垂直方块数"
UserVar LLKBORDER=DropList{"True":True|"False":False}=0 "外层是否可连"
UserVar LLKDELAY=200 "间隔时间(毫秒)"
//普通变量
Dim block()
Dim intX, intY
Dim bw, bh
Dim lw, lh
Dim DEFAULTVALUE,ISREADY
//入口函数
Sub Main()
Dim bmpfile, typecount
Dim bx, by
Dim i, j, m, n
//初始化二维数组
If CBool(LLKBORDER) Then
ReDim block(LLKWIDTH+1, LLKHEIGHT+1)
Else
ReDim block(LLKWIDTH-1, LLKHEIGHT-1)
End If
//初始化相关变量
bw=43
bh=39
lw=1
lh=1
DEFAULTVALUE=0
bmpfile = Plugin.Sys.GetDir(3) & "llk.bmp"
typecount=0
//初始化原点坐标
ISREADY=False
FindPic 0,0,Plugin.Sys.GetScRX,Plugin.Sys.GetScRY,"Attachment:\f5.bmp",0.9,intX,intY
If intX>0 And intY>0 Then
intX=intX-180
intY=intY+47
//让界面获取焦点
MoveTo intX-20, intY-20
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
typecount=typecount+1
block(i,j)=typecount
Plugin.Pic.PrintScreen GetBlockX(i,j)+3,GetBlockY(i,j)+3,GetBlockX2(i,j)-3,GetBlockY2(i,j)-3,bmpfile //缩进3像素截图
For m=1 To UBound(block,1)-1
For n=1 To UBound(block,2)-1
If block(m,n)="" Then
FindPic GetBlockX(m,n),GetBlockY(m,n),GetBlockX2(m,n),GetBlockY2(m,n),bmpfile,0.9,bx,by
If bx>0 And by>0 Then
block(m,n)=typecount
End If
End If
Next
Next
End If
Else
block(i,j)=DEFAULTVALUE
End If
//外层不可用
Else
If block(i,j)="" Then
typecount=typecount+1
block(i,j)=typecount
Plugin.Pic.PrintScreen GetBlockX(i+1,j+1)+3,GetBlockY(i+1,j+1)+3,GetBlockX2(i+1,j+1)-3,GetBlockY2(i+1,j+1)-3,bmpfile //缩进3像素截图
For m=LBound(block,1) To UBound(block,1)
For n=LBound(block,2) To UBound(block,2)
If block(m,n)="" Then
FindPic GetBlockX(m+1,n+1),GetBlockY(m+1,n+1),GetBlockX2(m+1,n+1),GetBlockY2(m+1,n+1),bmpfile,0.9,bx,by
If bx>0 And by>0 Then
block(m,n)=typecount
End If
End If
Next
Next
End If
End If
Next
Next
ISREADY=True
End If
Call Connect()
End Sub
//连连看
Sub Connect()
Dim blockcount,connected
If ISREADY Then
blockcount = LLKWIDTH*LLKHEIGHT
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 Line2(i,j,m,n) Then
If CBool(LLKBORDER) Then
MoveTo GetBlockX2(i,j)-20,GetBlockY2(i,j)-20
LeftClick 1
MoveTo GetBlockX2(m,n)-20,GetBlockY2(m,n)-20
LeftClick 1
Else
MoveTo GetBlockX2(i+1,j+1)-20,GetBlockY2(i+1,j+1)-20
LeftClick 1
MoveTo GetBlockX2(m+1,n+1)-20,GetBlockY2(m+1,n+1)-20
LeftClick 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 "无方块可消除！"
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 Line2(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)
Line2 = 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
Line2=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
Line2=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
//打印数组信息
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
原理
将界面上的方块编号并转存到二维数组中，从头开始依次定位每个方块，查找与之相同的方块并检测是否可以连通，直至消除了所有方块为止。
缺点
·当无牌可消除或消牌导致所有方块位置重排时无法继续使用；
宠物连连看2.5版(下载至本地)：http://www.4399.com/flash/1382_2.htm?1024
+ 查看当前日志评论 (0)
────────────
PJBlog3 v3.2.9.518 Inside.
Processed In 0.141 ms
你没有权限发表评论
────────────
PJBlog3 v3.2.9.518 Inside.
Processed In 0.141 ms
暂无评论
────────────
PJBlog3 v3.2.9.518 Inside.
Processed In 0.141 ms