按键精灵8脚本(1.0):QQ连连看

//按键精灵8.10.7234测试版 测试通过

//用户定义变量
UserVar LLKWIDTH=19 "水平方块数"
UserVar LLKHEIGHT=11 "垂直方块数"
UserVar LLKBORDER=DropList{"True":True|"False":False}=1 "外层是否可连"
UserVar LLKDELAY=400 "间隔时间(毫秒)"

//普通变量
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=25
    bh=29
    lw=6
    lh=6
    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:\djs.bmp",0.9,intX,intY
    If intX>0 And intY>0 Then
        intX=intX-9
        intY=intY-396
        //让界面获取焦点
        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
                                Plugin.Pic.PrintScreen GetBlockX(i,j),GetBlockY(i,j),GetBlockX2(i,j),GetBlockY2(i,j),bmpfile
                                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)+3,GetBlockY(i+1,j+1)+3,"704C30",0) Then
                            typecount=typecount+1
                            block(i,j)=typecount
                            blockcount=blockcount+1
                            Plugin.Pic.PrintScreen GetBlockX(i+1,j+1),GetBlockY(i+1,j+1),GetBlockX2(i+1,j+1),GetBlockY2(i+1,j+1),bmpfile
                            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 ToString()
    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),GetBlockY2(i,j)
                                            LeftClick 1
                                            MoveTo GetBlockX2(m,n),GetBlockY2(m,n)
                                            LeftClick 1
                                        Else
                                            MoveTo GetBlockX2(i+1,j+1),GetBlockY2(i+1,j+1)
                                            LeftClick 1
                                            MoveTo GetBlockX2(m+1,n+1),GetBlockY2(m+1,n+1)
                                            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=False
    Else
        IsColor=True
    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


评论: 0 | 引用: 0 | 查看次数: 9337
发表评论
登录后再发表评论!