百度贴吧打豆豆问题……

UserVar yanshi=100 "速度，两次点击间隔的时间"
x=91
i=0
y=25
j=0
//找第一个子的颜色和哪个子相同

Rem 一
i=i+1
GetColor1=GetPixelColor(x+j,276)
GetColor2=GetPixelColor(x+y*i,276)
If GetColor1="EDEDED" Then
Goto 五
Else
Goto 六
End If
Rem 六
If GetColor1="FAFAFA" Then
Goto 五
Else
Goto 七
End If
Rem 七
If i=23 Then
Goto 三
Else
Goto 四
End If
Rem 四
If GetColor1=GetColor2 Then
Goto 二
Else
Delay yanshi
Goto 一
End If

Rem 二
MessageBox i+1
EndScript
Rem 三
MessageBox "没找到"
EndScript

Rem 五
MessageBox "第一个不是子"
EndScript

网上有现成的哦

s=0
x=0
y=0
While s=0
FindColor 0,y+1,1000,500,"E1E1E1",x,y
If GetPixelColor(x+1,y)="E1E1E1" and GetPixelColor(x,y+1)="E1E1E1" and GetPixelColor(x+1,y+1)="FEFAF9" Then
s=1
//MessageBox "a"&x&" "&y
End If
Wend

Dim a(15,23)
Dim b(10)
dim c(4)
dim d(4)
Dim e(4)
b(1)="03CC03"
b(2)="0367CC"
b(3)="CCCC67"
b(4)="9A9A9A"
b(5)="67CCCC"
b(6)="6666FF"
b(7)="039AFF"
b(8)="FF6703"
b(9)="FEABFD"
b(10)="CC67CC"
x=x-1
y=y+34
For i=1 to 15
For j=1 to 23
a(i,j)=GetPixelColor(x+25*j,y+25*i)
Select Case a(i,j)
Case b(1)
a(i,j)=1
Case b(2)
a(i,j)=2
Case b(3)
a(i,j)=3
Case b(4)
a(i,j)=4
Case b(5)
a(i,j)=5
Case b(6)
a(i,j)=6
Case b(7)
a(i,j)=7
Case b(8)
a(i,j)=8
Case b(9)
a(i,j)=9
Case b(10)
a(i,j)=10
Case else
a(i,j)=0
End Select
//MessageBox "a("&i&","&j&")="&a(i,j)
Next
Next
//MessageBox "p1e"
For i=2 to 14
For j=2 to 22
If a(i,j)=0 then
Delay 200
For k=1 to 4
e(k)=1
Next
d(1)=0
For c(1)=i-1 to 1 step -1
If a(c(1),j)>0 then
d(1)=a(c(1),j)
Exit For
End If
next
d(2)=0
For c(2)=i+1 to 15
If a(c(2),j)>0 then
d(2)=a(c(2),j)
Exit For
End If
next
d(3)=0
For c(3)=j-1 to 1 step -1
If a(i,c(3))>0 then
d(3)=a(i,c(3))
Exit For
End If
next
d(4)=0
For c(4)=j+1 to 23
If a(i,c(4))>0 then
d(4)=a(i,c(4))
Exit For
End If
Next
s=0
For k=1 to 3
For l=k+1 to 4
If d(k)=d(l) and d(k)>0 then
s=1
e(k)=0
e(l)=0
End if
Next
Next
If e(1)=0
a(c(1),j)=0
end if
If e(2)=0
a(c(2),j)=0
end if
If e(3)=0
a(i,c(3))=0
end if
If e(4)=0
a(i,c(4))=0
end if
If s=1
MoveTo x+25*j,y+25*i
//MessageBox i&j&" "&c(1)&c(2)&c(3)&c(4)&" "&d(1)&d(2)&d(3)&d(4)
LeftClick 1
end if
End if
Next
Next

第一个不能用，第二个缺少附件
Dim s(15,23)
Dim c(345)
Dim d(345)
a=1
b=1
e=1
f=1
g=0
h=0
i=0
j=0
FindPic 0,0,1024,768,"Attachment:\QQ截图未命名 - 副本.bmp",0.9,intX,intY
If intX > 0 And intY > 0 Then
x=intX
y=intY+35
Delay 1000
End If
For 15
For 23
FindColor x,y,x+25,y+25,"FEABFD",intX,intY
If intX > 0 And intY > 0 Then
s(b,a)=10
Goto 中转
End If
FindColor x,y,x+25,y+25,"CCC67",intX,intY
If intX > 0 And intY > 0 Then
s(b,a)=10
Goto 中转
End If
FindColor x,y,x+25,y+25,"72D0D0",intX,intY
If intX > 0 And intY > 0 Then
s(b,a)=10
Goto 中转
End If
FindColor x,y,x+25,y+25,"9A9A9A",intX,intY
If intX > 0 And intY > 0 Then
s(b,a)=10
Goto 中转
End If
FindColor x,y,x+25,y+25,"9797FF",intX,intY
If intX > 0 And intY > 0 Then
s(b,a)=10
Goto 中转
End If
FindColor x,y,x+25,y+25,"03CC03",intX,intY
If intX > 0 And intY > 0 Then
s(b,a)=10
Goto 中转
End If
FindColor x,y,x+25,y+25,"099CFF",intX,intY
If intX > 0 And intY > 0 Then
s(b,a)=10
Goto 中转
End If
FindColor x,y,x+25,y+25,"096BCD",intX,intY
If intX > 0 And intY > 0 Then
s(b,a)=10
Goto 中转
End If
FindColor x,y,x+25,y+25,"FF6703",intX,intY
If intX > 0 And intY > 0 Then
s(b,a)=10
Goto 中转
End If
FindColor x,y,x+25,y+25,"D072D0",intX,intY
If intX > 0 And intY > 0 Then
s(b,a)=10
Goto 中转
End If
s(b,a)=0
c(e)=a
d(e)=b
e=e+1
Rem 中转
x=x+25
a=a+1
Next
a=1
y=y+25
b=b+1
Next
For e
a=c(f)
b=d(f)
While s(b,a)=0 And a<23
a=a+1
Wend
If a<23 Then
g=s(b,a)
Else
g=0
End If
a=c(f)
While s(b,a)=0 And a>1
a=a-1
Wend
If a>1 Then
h=s(b,a)
Else
h=0
End If
a=c(f)
While s(b,a)=0 And b<15
b=b+1
Wend
If b<15 Then
i=s(b,a)
Else
i=11
Endif
b=d(f)
While s(b,a)=0 And b>0
b=b-1
Wend
If b>0 Then
j=s(b,a)
Else
j=11
End If
b=d(f)
x=intX-10+(25*a)
y=intY+25+(25*b)
If g=h Or g=i Or g=j Or i=j Or i=h Or j=h Then
MoveTo x, y
LeftClick 1
End If
f=f+1
Next
能找的就这些了，不过还有一个VB版打豆豆
Option Explicit

Private Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long

Dim PRows As Long, PCols As Long '棋盘总行数 总列数
Dim PWidth As Long, PHeight As Long '棋盘总宽 总高
Dim BoxW As Long '棋盘格子的边长
Dim Table() As Long '逻辑棋盘 2维数组(行,列) 0-9=豆豆 10-背景
Dim TCor(0 To 11) As Long '豆豆的颜色 0-9=豆豆 10-暗背景 11-亮背景

Private Sub Command1_Click()
Call InitGame '重新玩
End Sub

Private Sub Command2_Click()
Dim x As Long, y As Long '作弊 可连续点击
For y = 0 To PRows - 1: For x = 0 To PCols - 1
If Table(y, x) = 10 Then Call SearchRoute(y, x)
Next: Next
End Sub

Private Sub Form_Initialize()
Set Me.Icon = Nothing
End Sub

Private Sub Form_Load()
Me.BorderStyle = vbFixedDialog: Me.Caption = App.Title
Me.Width = Me.Width - Me.ScaleWidth + 800 * Screen.TwipsPerPixelX
Me.Height = Me.Height - Me.ScaleHeight + 600 * Screen.TwipsPerPixelY
Me.ScaleMode = vbPixels: Me.AutoRedraw = True: Me.BackColor = &HFFFFFF: Me.Show
PRows = 15: PCols = 23: BoxW = 30
TCor(0) = &HFF7113: TCor(1) = &H7CD07: TCor(2) = &HFEB2FD: TCor(3) = &H7474FF
TCor(4) = &HCFCF6F: TCor(5) = &HE6ECE: TCor(6) = &HCF70CF: TCor(7) = &H71CFCF
TCor(8) = &H9E9E9E: TCor(9) = &H79BFF: TCor(10) = &HEDEDED: TCor(11) = &HFFFFFF
Call InitGame
End Sub

Public Sub InitGame()
Dim x1 As Long, y1 As Long, x2 As Long, y2 As Long
PWidth = PCols * BoxW: PHeight = PRows * BoxW
x1 = (Me.ScaleWidth - PWidth) / 2: y1 = (Me.ScaleHeight - PHeight) / 2
x2 = Me.ScaleWidth - x1: y2 = Me.ScaleHeight - y1
Me.Scale (-x1, -y1)-(x2, y2): Me.Cls
ReDim Table(PRows - 1, PCols - 1) As Long
For y1 = 0 To PRows - 1: For x1 = 0 To PCols - 1
Randomize: Table(y1, x1) = Int(20 * Rnd) '随机布置豆豆
If Table(y1, x1) > 10 Then Table(y1, x1) = 10
Call DrawItem(y1, x1)
Next: Next
End Sub

Public Sub DrawItem(ByVal diRow As Long, ByVal diCol As Long)
'画某个格子 该格子的样式在 Table(diRow,diCol)里
Dim x As Long, y As Long, c As Long
x = diCol * BoxW: y = diRow * BoxW: c = Table(diRow, diCol)
Me.Line (x, y)-Step(BoxW, BoxW), TCor(10 + ((diRow + diCol) Mod 2)), BF
If c <= 9 Then
x = x + BoxW / 2: y = y + BoxW / 2: Me.FillStyle = 0: Me.FillColor = TCor(c)
Me.Circle (x, y), BoxW * 2 / 5, &HC0C0C0: Me.FillStyle = 1
End If
End Sub

Public Sub DrawBorder(ByVal dbRow As Long, ByVal dbCol As Long, Optional ByVal dbType As Boolean = True)
'为某个格子Table(diRow,diCol)绘制热点边框 缺省为有边框 否则为去除边框
Dim x As Long, y As Long, c As Long: x = dbCol * BoxW: y = dbRow * BoxW
If dbType Then c = &HFF00FF Else c = TCor(10 + ((dbRow + dbCol) Mod 2))
Me.Line (x, y)-Step(BoxW, BoxW), c, B '洋红色热点框 否则就是格子背景色
End Sub

Public Sub SearchRoute(ByVal srRow As Long, ByVal srCol As Long)
'删除当前格子的四个方向上 最先遇到的相同的豆豆（豆豆0-9 如果到边界为10）
Dim i As Long, j As Long, Tb(3) As Long, Ret(3) As Long, Del(3) As Boolean
For i = srRow To 0 Step -1 '向上方搜索 方向编号为0
Ret(0) = Table(i, srCol) '找到第一个遇到的豆豆 记录它的位置
If Ret(0) < 10 Then Tb(0) = i * PCols + srCol: Exit For
Next
For i = srRow To PRows - 1 '向下方搜索 方向编号为1
Ret(1) = Table(i, srCol) '找到第一个遇到的豆豆 记录它的位置
If Ret(1) < 10 Then Tb(1) = i * PCols + srCol: Exit For
Next
For i = srCol To 0 Step -1 '向左方搜索 方向编号为2
Ret(2) = Table(srRow, i) '找到第一个遇到的豆豆 记录它的位置
If Ret(2) < 10 Then Tb(2) = srRow * PCols + i: Exit For
Next
For i = srCol To PCols - 1 '向右方搜索 方向编号为3
Ret(3) = Table(srRow, i) '找到第一个遇到的豆豆 记录它的位置
If Ret(3) < 10 Then Tb(3) = srRow * PCols + i: Exit For
Next
For i = 0 To 2: For j = i + 1 To 3 '判断各个方向有没有相同的豆豆
If Ret(j) = Ret(i) Then Del(i) = True: Del(j) = True
Next: Next
For i = 0 To 3 '删除相同的豆豆
If Del(i) Then
Table(Tb(i) \ PCols, Tb(i) Mod PCols) = 10 '逻辑删除
Call DrawItem(Tb(i) \ PCols, Tb(i) Mod PCols) '物理删除
End If
Next
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
If x > 0 And x < PWidth And y > 0 And y < PHeight Then
SetCursor 65581
Dim ix As Long, iy As Long, ic As Long: ix = x \ BoxW: iy = y \ BoxW
If Table(iy, ix) = 10 Then '按在空格上 找可以连接到豆子
SearchRoute iy, ix
End If
End If
End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Static InPanel As Boolean, InItemX As Long, InItemY As Long
If x > 0 And x < PWidth And y > 0 And y < PHeight Then '在棋盘范围内
Dim ix As Long, iy As Long, ic As Long: ix = x \ BoxW: iy = y \ BoxW
If Not InPanel Then InPanel = True: InItemX = ix: InItemY = iy: Call DrawBorder(iy, ix) '热点框
SetCursor 65581 '手形
If InItemX <> ix Or InItemY <> iy Then '漫游到另一个格子了
Call DrawBorder(InItemY, InItemX, False) '去掉先前格子的热点框
Call DrawBorder(iy, ix): InItemX = ix: InItemY = iy '在新位置绘制热点框
End If
Else
If InPanel Then
Call DrawBorder(InItemY, InItemX, False) '去掉先前格子的热点框
InPanel = False: InItemX = -1: InItemY = -1
End If
End If
End Sub

百度一下你就知道