连连看，源代码(VB版)

[mhm0517]

下载地址: 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

[superleo_007]

学习中。。。。

[qiangshou2301]

顶

[leftxp]

Mark

[peter0317]

有程序吗？效果我看看

[hongfei_2007]

我也有一个这样的代码不知各位要不要

[wang5214520]

拿回去学习下

[悟迟]

纯接分可以吗？

[ionlylove57]

有点意思。看一下。

[RobinTang]

代码风格很好

[superyangb]

谢谢支持一下

[lyb61917929]

up up up

[readfuture]

[gooore]

[Quote=引用 10 楼 myjian 的回复:]
引用 9 楼 yimain 的回复:路过...
[/Quote]

lu guo

[morris88]

[chinaboyzyq]

ｕｐ～

[chinaboyzyq]

up～

[wuxiaol3]

..........

[Roock]

谢谢分享.

[tongfeng1981]

学习了

[leeclimb]

学习学习啊