连连看，源代码(VB版)
下载地址: 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 Function
Public 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
帮顶 --------------------编程问答-------------------- up..... --------------------编程问答-------------------- 飘过 --------------------编程问答-------------------- UP --------------------编程问答-------------------- 噢。 --------------------编程问答-------------------- up --------------------编程问答-------------------- 太长的代码看着头晕，呵呵 --------------------编程问答-------------------- 路过... --------------------编程问答-------------------- --------------------编程问答-------------------- 有创意
--------------------编程问答-------------------- 学习中。。。。 --------------------编程问答-------------------- 顶 --------------------编程问答-------------------- Mark
--------------------编程问答-------------------- 有程序吗？效果我看看 --------------------编程问答-------------------- 我也有一个这样的代码不知各位要不要 --------------------编程问答-------------------- 拿回去学习下 --------------------编程问答-------------------- 纯接分可以吗？ --------------------编程问答-------------------- 有点意思。看一下。 --------------------编程问答-------------------- 代码风格很好 --------------------编程问答-------------------- 谢谢支持一下 --------------------编程问答--------------------
--------------------编程问答--------------------
up up up
--------------------编程问答--------------------
lu guo --------------------编程问答--------------------
--------------------编程问答--------------------
ｕｐ～
--------------------编程问答--------------------
up～
--------------------编程问答--------------------
..........
--------------------编程问答--------------------
谢谢分享.
--------------------编程问答--------------------
--------------------编程问答--------------------
学习了
--------------------编程问答--------------------
学习学习啊补充：VB , 非技术类
