百度贴吧里面的打豆豆游戏的打200分辅助程序-更新了程序，源码不贴了

 

 

 

写的比较烂

有兴趣的可以去改一下，做不到太好的算法

不过速度也算还可以

//定义常用变量
vx = File.ReadINI("\DouDou.ini","DD","XPOS")    //读配置文件，参数含义：文件名，节名，段名
vy = File.ReadINI("\DouDou.ini","DD","YPOS")

//第一个豆豆位置的x y坐标，可以变化
//XPos = 160
//YPos = 321
//定义可以不找的点   
XPos = CInt(vx)
YPos = CInt(vy)
DPrint XPos
sTopx="abcde"
sBottomx ="abcde"
sLeftx = "abcde"
sRightx = "abcde"
ClickTimer = 0
Dim point(22,14)
Dim data(22,14) 
colorString = "" 
dotString = ""
//调用初始化函数 取得矩阵数组
Call init()  

m = 0
n = 0
//Call getData() 
//DPrint   dotString
Call slider()
If ClickTimer = 100
MsgBox "全部消除，恭喜上榜了。。。"
Else
MsgBox "能找到的就这些了。。无法全解"
EndIf
EndScript
//VBS自定义函数必须放在整个代码最后
VBSBegin
	//开始消除了
	Sub fPath(byval x,byval y)
		Dim cTop,cBottom,cLeft,cRight
		cTop = 0
		cBottom = 0 
		cLeft =0
		cRight = 0
		
		Dim posColor
		posColor = ""
		// 上方查找
		Dim i,j
		Dim numbers
		numbers = 0
		For i = y-1 To 0 Step -1
			If data(x,i) = "FFFFFF" Then 
			cTop = cTop + 1  
			Else  
			If numbers = 0 Then
			posColor = posColor + CStr(x)+","+CStr(i)
			Else
			 posColor = posColor + "|" +CStr(x)+","+CStr(i)
			End If
			numbers = numbers + 1
			 Exit For 
			 End If
		Next
		// 下方查找
		Dim aaa
		aaa = y + 1
		 
		
		For aaa=y+1 To 14  Step 1
			//MsgBox CStr(ii)
			If data(x,aaa) = "FFFFFF" Then 
			cBottom = cBottom + 1  
			Else
			If numbers = 0 Then 
			posColor = posColor + CStr(x)+","+CStr(aaa)
			Else                                      
			posColor = posColor +"|" +CStr(x)+","+CStr(aaa)
			End If 
			numbers = numbers + 1
			Exit For
			 End If 
			
		Next
		
		// 左方查找 
		Dim iii
		For iii = x-1 To 0 Step -1
			If data(iii,y) = "FFFFFF" Then 
			cBottom = cBottom + 1  
			Else 
			If numbers=0 Then
			posColor = posColor  +CStr(iii)+","+CStr(y)
			Else
			posColor = posColor + "|" +CStr(iii)+","+CStr(y)
			End If  
			numbers = numbers + 1
			Exit For
			End If
		Next 
		
		// 右方查找
		Dim iiii
		For iiii = x+1 To 22 
			If data(iiii,y) = "FFFFFF" Then 
			cBottom = cBottom + 1  
			Else
			If numbers=0 Then
			posColor = posColor + CStr(iiii)+","+CStr(y)
			Else 
			posColor = posColor + "|" +CStr(iiii)+","+CStr(y)
			End If  
			numbers = numbers + 1
			Exit For
			End If
		Next
		// If cTop = y Then  End If
		//color     
		
		If not(posColor = "") Then
			 Dim apearNum
			 apearNum = ""
			 //MsgBox posColor
			 // 判断每个坐标点的颜色值出现的次数
			 
		     splitColor = Split(posColor,"|")  

		     For i = 0 to UBound(splitColor)
		     	displayCount = 0
		     	For j = 0 to UBound(splitColor)
		     		
		     		ixypos = Split(splitColor(i),",")
		     		jxypos = Split(splitColor(j),",")
		     		If data(ixypos(0),ixypos(1)) = data(jxypos(0),jxypos(1)) Then
		     		     displayCount = displayCount + 1
		     		Else
		     		End If
		     	Next
		     	If i =0 Then 
		     	apearNum  = apearNum + CStr(displayCount)
		     	Else
		     	apearNum  = apearNum + "|" + CStr(displayCount)
		     	End If
		     Next
		     
		  	 //MsgBox apearNum 
		  	 ONum = Split(apearNum,"|")
		  	 bBoolean = 0
		  	 fourSame = 0
		  	 For i = 0 to UBound(ONum)
		  	 	If oNum(i) = 2 Then
		  	 	bBoolean = bBoolean + 1
		  	 	ElseIf oNum(i) = 4 Then
		  	 	fourSame = fourSame + 1
		  	 	
		  	 	End If
		  	 Next 
		  	 If bBoolean = 4 Or fourSame = 4 Then    
		  	 //For i = 0 to UBound(splitColor)
		  	 //	 abcpos = Split(splitColor(i),",") 
		  	 //	 data(abcpos(0),abcpos(1)) = "FFFFFF"
		  	 //Next
		  	 //Call clickHere(x,y)
		  	 
		  	 //MsgBox "可以点击"
		  	 ElseIf bBoolean = 2 Then
		  	 For i = 0 to UBound(ONum)
		  	 	If oNum(i) = 2 Then
		  	 	     abcpos = Split(splitColor(i),",") 
		  	 	 	 data(abcpos(0),abcpos(1)) = "FFFFFF"
		  	 	End If
		  	 Next
		  	 Call clickHere(x,y) 
		  	 
		  	 End If
		End If
		
		
	End Sub
	// 点击
	Sub clickHere(byval x,byval y)
		MoveTo XPos + 25*x,YPos + 25*y
		Delay 100
		LeftClick 1 
		Delay 150
		ClickTimer = ClickTimer + 1              
		Call slider()
	End Sub
	Sub slider()
	Dim i , j 
	
       For j = 0 To 14
           For i = 0 To 22
           	   // 获取指定点的颜色值
           	   If data(i,j) = "FFFFFF"  Then Call fPath(i,j) End If
               
               
           Next 
            outstring = outstring + Chr(10)
       Next
	End Sub
	//获取颜色点阵
	Sub msgAll() 
	Dim i , j 
	Dim outstring
	outstring = "点阵为:"  + Chr(10)
       For j = 0 To 14
           For i = 0 To 22
           	   // 获取指定点的颜色值
               outstring = outstring+" " + point(i,j) 
               
           Next
           outstring = outstring + Chr(10)
       Next
       colorString = outstring 
	End Sub 
	//获取1,0点阵
	Sub getData() 
	Dim i , j 
	Dim outstring
	outstring = "点阵为:" + Chr(10)
       For j = 0 To 14
           For i = 0 To 22
           	   // 获取指定点的颜色值
               outstring = outstring + " " + CStr(data(i,j) )
               
           Next 
            outstring = outstring + Chr(10)
       Next
       dotString = outstring 
	End Sub 
	
	//初始化数组
    Sub init()
       Dim i , j
       For j = 0 To 14
           For i = 0 To 22
           	   // 获取指定点的颜色值
               
               currentColor =  GetPixel(XPos + 25*i,YPos + 25*j)
               point(i,j) =currentColor
If currentColor = "EDEDED" or currentColor="FFFFFF"  Then    data(i,j) = "FFFFFF"  Else data(i,j) = currentColor End If

               
              // End If 
              
           Next
       Next
        
    End Sub
VBSEnd

 

 

附近上传有点慢，直接贴源码得了

使用的是按键精灵

感觉各种写法思路都差不多

我的思路有点低级

大神们别喷

 

评论

3 楼 【●】景天 2010-11-03  

用了一下发现两个问题:
1.会经常点错，消耗时间
2.最后无解的问题无法避免。。。

2 楼 xdd_987 2010-11-02  

下来看看
不错，辛苦啦。。

1 楼 xuxiangpan888 2010-11-02  

vb的？？