下载地址: http://download.csdn.net/source/1556589
'连连看,主要是判断二点是否是有效连通.以下是算法思路及算法的实现.
'另此程序中所用的图象资源是从网络上下载. '************************************
' | Y
' |
' |
' |(dx,dy)
'----0---------|-------------- X
' | (i,dy) |
' 0---------|--------0(nx,ny)
' (i,ny) |
'
'***************************************
'如图所示:先判断 i,dy 是否与 dx, dy 连通.如果连通,再判断 i=nx ,dy=ny
'再判断 i,dy 与 i,ny 是否连通, 如果连通,再判断 i=nx
'再判断 i,ny 与 nx,ny 是否连通.
'不停的变换 i 的值,最后得到是否连通,及连通的拐点 |dx,dy| i,dy | i,ny | nx,ny|
'同理,再以Y坐标为不变进行计算.Public Function GetLink(ByVal dx As Long, ByVal dy As Long, ByVal nx As Long, ByVal ny As Long) As Boolean '判断一条直线上的二点是否连通.(横线或竖线)
Dim bX As Long
Dim eX As Long
Dim bY As Long
Dim eY As Long
Dim i
If dx < nx Then
bX = dx + 1
eX = nx - 1
Else
bX = nx + 1
eX = dx - 1
End If
If dy < ny Then
bY = dy + 1
eY = ny - 1
Else
bY = ny + 1
eY = dy - 1
End If
GetLink = True
If dx = nx Then
For i = bY To eY
If jl(dx + 16 * i - 16).Flag <> 0 Then GetLink = False: Exit Function
Next
Else
If dy = ny Then
For i = bX To eX
If jl(i + dy * 16 - 16).Flag <> 0 Then GetLink = False: Exit Function
Next
Else
GetLink = False
Exit Function
End If
End If
End FunctionPublic Function GetLink2(ByVal dx As Long, ByVal dy As Long, ByVal nx As Long, ByVal ny As Long) As Boolean
GetLink2 = False
Dim A() As New LinkInfo
If dx = nx And GetLink(dx, dy, nx, ny) Then
'MsgBox dx & ":" & dy & "/" & nx & ":" & ny
mStackxy.x1 = dx
mStackxy.x2 = nx
mStackxy.y1 = dy
mStackxy.y2 = ny
mStackxy.Flag = 2
'*********
'二点在同一列上,且连通
'*********
GetLink2 = True
Exit Function
End If
If dy = ny And GetLink(dx, dy, nx, ny) Then
' MsgBox dx & ":" & dy & "/" & nx & ":" & ny
mStackxy.x1 = dx
mStackxy.x2 = nx
mStackxy.y1 = dy
mStackxy.y2 = ny
mStackxy.Flag = 2
'*********
'二点在同一行上,且连通
'*********
GetLink2 = True
Exit Function
End If
Dim i As Long
For i = 1 To 16
If GetLink(i, dy, dx, dy) And jl(i + dy * 16 - 16).Flag = 0 Then
If GetLink(i, dy, i, ny) Then
If jl(i + ny * 16 - 16).Flag = 0 Then
If GetLink(i, ny, nx, ny) Then
' MsgBox dx & ":" & dy & "/" & i & ":" & dy & "/" & i & ":" & ny & "/" & nx & ":" & ny
mStackxy.x1 = dx
mStackxy.x2 = i
mStackxy.x3 = i
mStackxy.x4 = nx
mStackxy.y1 = dy
mStackxy.y2 = dy
mStackxy.y3 = ny
mStackxy.y4 = ny
mStackxy.Flag = 4
GetLink2 = True
Exit Function
End If
Else
If i = nx Then
' MsgBox dx & ":" & dy & "/" & i & ":" & dy & "/" & nx & ":" & ny
mStackxy.x1 = dx
mStackxy.x2 = i
mStackxy.x3 = nx
mStackxy.y1 = dy
mStackxy.y2 = dy
mStackxy.y3 = ny
mStackxy.Flag = 3
GetLink2 = True
Exit Function
End If
End If
End If
End If
Next
For i = 1 To 12
If GetLink(dx, i, dx, dy) And jl(dx + i * 16 - 16).Flag = 0 Then
If GetLink(dx, i, nx, i) Then
If jl(nx + i * 16 - 16).Flag = 0 Then
If GetLink(nx, i, nx, ny) Then
' MsgBox dx & ":" & dy & "/" & dx & ":" & i & "/" & nx & ":" & i & "/" & nx & ":" & ny
mStackxy.x1 = dx
mStackxy.x2 = dx
mStackxy.x3 = nx
mStackxy.x4 = nx
mStackxy.y1 = dy
mStackxy.y2 = i
mStackxy.y3 = i
mStackxy.y4 = ny
mStackxy.Flag = 4
GetLink2 = True
Exit Function
End If
Else
If i = ny Then
' MsgBox dx & ":" & dy & "/" & dx & ":" & i & "/" & nx & ":" & ny
mStackxy.x1 = dx
mStackxy.x2 = dx
mStackxy.x3 = nx
mStackxy.y1 = dy
mStackxy.y2 = i
mStackxy.y3 = ny
mStackxy.Flag = 3
GetLink2 = True
Exit Function
End If
End If
End If
End If
Next
End Function
'连连看,主要是判断二点是否是有效连通.以下是算法思路及算法的实现.
'另此程序中所用的图象资源是从网络上下载. '************************************
' | Y
' |
' |
' |(dx,dy)
'----0---------|-------------- X
' | (i,dy) |
' 0---------|--------0(nx,ny)
' (i,ny) |
'
'***************************************
'如图所示:先判断 i,dy 是否与 dx, dy 连通.如果连通,再判断 i=nx ,dy=ny
'再判断 i,dy 与 i,ny 是否连通, 如果连通,再判断 i=nx
'再判断 i,ny 与 nx,ny 是否连通.
'不停的变换 i 的值,最后得到是否连通,及连通的拐点 |dx,dy| i,dy | i,ny | nx,ny|
'同理,再以Y坐标为不变进行计算.Public Function GetLink(ByVal dx As Long, ByVal dy As Long, ByVal nx As Long, ByVal ny As Long) As Boolean '判断一条直线上的二点是否连通.(横线或竖线)
Dim bX As Long
Dim eX As Long
Dim bY As Long
Dim eY As Long
Dim i
If dx < nx Then
bX = dx + 1
eX = nx - 1
Else
bX = nx + 1
eX = dx - 1
End If
If dy < ny Then
bY = dy + 1
eY = ny - 1
Else
bY = ny + 1
eY = dy - 1
End If
GetLink = True
If dx = nx Then
For i = bY To eY
If jl(dx + 16 * i - 16).Flag <> 0 Then GetLink = False: Exit Function
Next
Else
If dy = ny Then
For i = bX To eX
If jl(i + dy * 16 - 16).Flag <> 0 Then GetLink = False: Exit Function
Next
Else
GetLink = False
Exit Function
End If
End If
End FunctionPublic Function GetLink2(ByVal dx As Long, ByVal dy As Long, ByVal nx As Long, ByVal ny As Long) As Boolean
GetLink2 = False
Dim A() As New LinkInfo
If dx = nx And GetLink(dx, dy, nx, ny) Then
'MsgBox dx & ":" & dy & "/" & nx & ":" & ny
mStackxy.x1 = dx
mStackxy.x2 = nx
mStackxy.y1 = dy
mStackxy.y2 = ny
mStackxy.Flag = 2
'*********
'二点在同一列上,且连通
'*********
GetLink2 = True
Exit Function
End If
If dy = ny And GetLink(dx, dy, nx, ny) Then
' MsgBox dx & ":" & dy & "/" & nx & ":" & ny
mStackxy.x1 = dx
mStackxy.x2 = nx
mStackxy.y1 = dy
mStackxy.y2 = ny
mStackxy.Flag = 2
'*********
'二点在同一行上,且连通
'*********
GetLink2 = True
Exit Function
End If
Dim i As Long
For i = 1 To 16
If GetLink(i, dy, dx, dy) And jl(i + dy * 16 - 16).Flag = 0 Then
If GetLink(i, dy, i, ny) Then
If jl(i + ny * 16 - 16).Flag = 0 Then
If GetLink(i, ny, nx, ny) Then
' MsgBox dx & ":" & dy & "/" & i & ":" & dy & "/" & i & ":" & ny & "/" & nx & ":" & ny
mStackxy.x1 = dx
mStackxy.x2 = i
mStackxy.x3 = i
mStackxy.x4 = nx
mStackxy.y1 = dy
mStackxy.y2 = dy
mStackxy.y3 = ny
mStackxy.y4 = ny
mStackxy.Flag = 4
GetLink2 = True
Exit Function
End If
Else
If i = nx Then
' MsgBox dx & ":" & dy & "/" & i & ":" & dy & "/" & nx & ":" & ny
mStackxy.x1 = dx
mStackxy.x2 = i
mStackxy.x3 = nx
mStackxy.y1 = dy
mStackxy.y2 = dy
mStackxy.y3 = ny
mStackxy.Flag = 3
GetLink2 = True
Exit Function
End If
End If
End If
End If
Next
For i = 1 To 12
If GetLink(dx, i, dx, dy) And jl(dx + i * 16 - 16).Flag = 0 Then
If GetLink(dx, i, nx, i) Then
If jl(nx + i * 16 - 16).Flag = 0 Then
If GetLink(nx, i, nx, ny) Then
' MsgBox dx & ":" & dy & "/" & dx & ":" & i & "/" & nx & ":" & i & "/" & nx & ":" & ny
mStackxy.x1 = dx
mStackxy.x2 = dx
mStackxy.x3 = nx
mStackxy.x4 = nx
mStackxy.y1 = dy
mStackxy.y2 = i
mStackxy.y3 = i
mStackxy.y4 = ny
mStackxy.Flag = 4
GetLink2 = True
Exit Function
End If
Else
If i = ny Then
' MsgBox dx & ":" & dy & "/" & dx & ":" & i & "/" & nx & ":" & ny
mStackxy.x1 = dx
mStackxy.x2 = dx
mStackxy.x3 = nx
mStackxy.y1 = dy
mStackxy.y2 = i
mStackxy.y3 = ny
mStackxy.Flag = 3
GetLink2 = True
Exit Function
End If
End If
End If
End If
Next
End Function
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货