平时很喜欢玩数独游戏，每天只要信报上有数独游戏，那就不看别的了，专心致志玩一路。

昨天突然想自己编一个软件来算吧，于是就有了这篇文章和一个vb的数独计算器。

下载地址：

http://download.csdn.net/source/1381913

谈思想吧，思想最重要：我用了最最笨的方法，就是每个空位都从1～9挨个填，出了问题再折回来重新填。

所以这样的想法一定要用到递归了，就是不断调用自身来达到目的。

东西简单，所以代码也简单：

我用了81个text来填数：text1（0）～text1(80),存到一个 Mtx(81)的数组中。

而且先写了一个填写检查程序：（目的是检查是否可以在x,y这个位置填入此Num。）

Function Tcheck(arrayc() As Integer, x As Integer, y As Integer,num As Integer)For i = 0 To 8    If Mtx(i, y) = num Then        Tcheck = False        Exit Function    End If    If Mtx(x, i) = num Then        Tcheck = False        Exit Function    End IfNext i

            For i = 0 To 2                For j = 0 To 2                        If (arrayc((x/3)*3 + i, (y/3)*3 + j) = num) Then                            Tcheck = False                            Exit Function                        End If                Next j            Next iTcheck = True

End Function

Private Function checkexistNum()'检查现有的数据是否存在问题Dim i As IntegerDim j As IntegerDim temp As Integer

For i = 0 To 8    For j = 0 To 8        If (Mtx(i, j) 0) Then            temp = Mtx(i, j)            Mtx(i, j) = 0            If Tcheck(Mtx, i, j, temp) = False Then                checkexistNum = False                errorstr = temp                Text1(i * 9 + j).SetFocus                Exit Function            End If            Mtx(i, j) = temp        End If    Next jNext icheckexistNum = TrueEnd Function

下面这个程序就是最重要的递归函数了：

Function CalcArray(arrayn() As Integer)Dim k As IntegerDim i As IntegerDim j As Integer

 For i = 0 To 8    For j = 0 To 8        If arrayn(i * 9 + j) = 0 Then '原来的值为０才能进行赋值试验            Dim flag As Boolean            flag = False                        For k = 1 To 9 '准备填数                flag = Tcheck(arrayn(), i, j, k)                If flag = True Then                    arrayn(i * 9 + j) = k                    If CalcArray(arrayn) = False Then                        arrayn(i * 9 + j) = 0                        flag = False                    Else                        CalcArray= True                        Exit Function                    End If                End If            Next k                        If flag = False Then                CalcArray = False                Exit Function            End If                    End If    Next j Next i CalcArray = True End Function

ok，最后一步就是主函数了：

Private Sub CalculatorCT_Click()

Dim i, j As Integer

SodoError = 0t = Timertransfer '这个就是将text1转到Mtx()中去If SodoError = 1 Then    Exit SubEnd If

If checkexistNum = False Then MsgBox "现有数据存在问题:" & errorstr Exit SubEnd If

If CalcArray(Mtx) = False Then    MsgBox "无法解出", , "龙卷风数独"Else        '将资料填回Text1中        For i = 0 To 8           For j = 0 To 8                Text1(j + (i * 9)) = Mtx(i, j)           Next j        Next i        MsgBox "计算完成", , "龙卷风数独"End If

End Sub

呵呵，简单吧！

发个我做的软件链接：

 http://download.csdn.net/source/1381913

完