用vb編了個數獨計算器

平時很喜歡玩數獨遊戲，每天只要信報上有數獨遊戲，那就不看別的了，專心致志玩一路。

昨天突然想自己編一個軟件來算吧，於是就有了這篇文章和一個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 If
Next 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 i
Tcheck = True

End Function

 

Private Function checkexistNum()
'檢查現有的數據是否存在問題
Dim i As Integer
Dim j As Integer
Dim 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 j
Next i
checkexistNum = True
End Function

 

下面這個程序就是最重要的遞歸函數了：

Function CalcArray(arrayn() As Integer)
Dim k As Integer
Dim i As Integer
Dim 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 = 0
t = Timer
transfer '這個就是將text1轉到Mtx()中去
If SodoError = 1 Then
    Exit Sub
End If

If checkexistNum = False Then
 MsgBox "現有數據存在問題:" & errorstr
 Exit Sub
End 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

完