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

//按键精灵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

更新

·连连看窗口定位方式更新,改用Plugin.Window.Find;
·使用LeftDown和LeftUp代替LeftClick,单位时间内点击频率大大提高;
·使用找色法代替找图法进行方块编号,速度提升一倍;

评论: 5 | 引用: 0 | 查看次数: 19535
dnawo[2010-10-13 10:03 AM | | | 120.36.4.53 | del | 回复回复]
5#
可以的,http://www.mzwu.com/default.asp?id=2614这篇文章中使用的就是自己找图,可以参考下,但上边说了,找图法当硬件配置不高时非常慢。
onepee[2010-10-12 06:07 PM | | | 118.232.64.200 | del | 回复回复]
4#
按鍵精靈可以自己找圖嘛?

我在玩的連連看每回合圖不一樣

如果我用範圍找圖

就要把每個圖案都存在它的資料夾裡

請問版主有沒有比較簡單的方法
onepee[2010-10-12 10:55 AM | | | 118.232.64.200 | del | 回复回复]
地板
感謝

我再找找看
dnawo[2010-10-12 00:55 AM | | | 120.92.57.177 | del | 回复回复]
板凳
本博客中有个1.0版的,使用的就是找图法,可以搜索看下,但其缺点是分析的速度很慢,本文使用的找色法,速度加快了很多,还有更快的,说是可以在内存中查找,还在研究中。
onepee[2010-10-11 08:42 PM | | | 118.232.64.200 | del | 回复回复]
沙发
我想請問版主

按鍵精靈是如何設計連連看的

我用區域找圖效果非常有限

而且常常找不到

不知版主是用什麼指令
发表评论
登录后再发表评论!