标题: 按键精灵8脚本(1.2)：宠物连连看2.5版
作者: dnawo
日期: 2010-09-26 09:20 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 blockcount
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
blockcount=0
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
If IsColor(GetBlockX(i,j),GetBlockY(i,j)+3,"FEF0EF",0) Then
typecount=typecount+1
block(i,j)=typecount
blockcount=blockcount+1
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
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),GetBlockY(i+1,j+1)+3,"FEF0EF",0) Then
typecount=typecount+1
block(i,j)=typecount
blockcount=blockcount+1
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
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 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 "无方块可消除！重排后继续："
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 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
//颜色判断
Function IsColor(x, y, color1, offset)
IfColor x,y,color1,offset Then
IsColor=True
Else
IsColor=False
End If
End Function
//打印数组信息
Function 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
ToString=str
End Function
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.188 ms
你没有权限发表评论
────────────
PJBlog3 v3.2.9.518 Inside.
Processed In 0.188 ms
暂无评论
────────────
PJBlog3 v3.2.9.518 Inside.
Processed In 0.188 ms