按键精灵8脚本(1.1):宠物连连看2.5版

//按键精灵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 | 引用: 0 | 查看次数: 19201
发表评论
登录后再发表评论!