不多说了，增加了第三逻辑和对可能情况的遍历（也就是当不能用逻辑区分的时候的暴力破解）。
http://lostabaddon.spaces.live.com/cns!EB06676D0B60BFBD!1986.entry
FrmSudoku.FRM:
Option Explicit
Dim SUDOKU(9, 9, 9) As Integer
Dim SudokuSolution As New ClsSudoku
Private Sub CmdClear_Click()
Dim I As Integer, J As Integer, K As Integer
For I = 1 To 9
For J = 1 To 9
For K = 0 To 9
SUDOKU(I, J, K) = 0
Next K
Next J
Next I
ShowSUDOKU
End Sub
Private Sub Form_Load()
Dim I As Integer, J As Integer, X As Integer, Y As Integer
Dim T As Integer
Dim P As Single
P = (Me.ScaleWidth - 3700) / 2
TxtInput(0).Visible = False
For I = 1 To 3
For J = 1 To 3
For X = 1 To 3
For Y = 1 To 3
T = ((I - 1) * 3 + (J - 1)) * 9 + ((X - 1) * 3 + Y)
Load TxtInput(T)
TxtInput(T).Left = ((I - 1) * 3 + X - 1) * 400 + (I - 1) * 50 + P
TxtInput(T).Top = ((J - 1) * 3 + Y - 1) * 400 + (J - 1) * 50
TxtInput(T).Visible = True
TxtInput(T) = ""
Next Y
Next X
Next J
Next I
CmdStart.Top = Me.ScaleHeight - CmdStart.Height
CmdGenerate.Top = Me.ScaleHeight - CmdGenerate.Height
CmdStart.Left = (Me.ScaleWidth - CmdStart.Width - CmdGenerate.Width) / 2
CmdGenerate.Left = (Me.ScaleWidth - CmdStart.Width - CmdGenerate.Width) / 2 + CmdStart.Width
End Sub
Private Sub CmdStart_Click()
ReadSUDOKU
If SudokuSolution.Solution(SUDOKU) Then
ShowSUDOKU
End If
ShowSUDOKU
End Sub
Private Sub CmdGenerate_Click()
SudokuSolution.Build SUDOKU
ShowSUDOKU
Me.Caption = "Sudoku Solution"
End Sub
Private Sub TxtInput_DblClick(Index As Integer)
Dim A As Integer
A = Int((Index - 1) / 9) + 1
Dim X As Integer, Y As Integer
X = A - Int(A / 3) * 3
If X = 0 Then X = 3
Y = Int((A - 1) / 3 + 1)
A = Index - ((Y - 1) * 3 + X - 1) * 9
Dim I As Integer, J As Integer
I = A - Int(A / 3) * 3
If I = 0 Then I = 3
J = Int((A - 1) / 3 + 1)
MsgBox Str((X - 1) * 3 + I) & "," & Str((Y - 1) * 3 + J)
End Sub
'辅助区
Private Sub ReadSUDOKU()
Dim I As Integer, J As Integer, X As Integer, Y As Integer
Dim T As Integer, Q As Integer, K As Integer
For I = 1 To 3
For J = 1 To 3
For X = 1 To 3
For Y = 1 To 3
T = ((I - 1) * 3 + (J - 1)) * 9 + ((X - 1) * 3 + Y)
Q = Val(TxtInput(T))
If Q >= 0 Then
SUDOKU((I - 1) * 3 + X, (J - 1) * 3 + Y, 0) = Q
End If
For K = 1 To 9
SUDOKU((I - 1) * 3 + X, (J - 1) * 3 + Y, K) = 0
Next K
Next Y
Next X
Next J
Next I
End Sub
Private Sub ShowSUDOKU()
Dim I As Integer, J As Integer, X As Integer, Y As Integer
Dim T As Integer, Q As Integer
For I = 1 To 3
For J = 1 To 3
For X = 1 To 3
For Y = 1 To 3
T = ((I - 1) * 3 + (J - 1)) * 9 + ((X - 1) * 3 + Y)
Q = SUDOKU((I - 1) * 3 + X, (J - 1) * 3 + Y, 0)
If Q > 0 Then
TxtInput(T).Text = Q
Else
TxtInput(T).Text = ""
End If
Next Y
Next X
Next J
Next I
End Sub
'辅助区结束
ClsSudoku.CLS:
Option Explicit
Dim SUDOKU(9, 9, 9) As Integer
'功能区
Public Function Solution(ByRef S() As Integer) As Boolean
Dim I As Integer, J As Integer, T() As Integer, K As Integer
Dim IsOK As Boolean
ReDim T(0)
GetSUDOKU S
Solution = False
If Check Then
If Not CheckEmpty Then
Exit Function
End If
Else
Exit Function
End If
IsOK = True
Do While IsOK
IsOK = Deal Or ThirdLogic
Loop
Solution = IsFinished
If Solution Then
BackSUDOKU S
Else
Find I, J, T
If UBound(T) = 0 Then Solution = False: Exit Function
For K = 1 To UBound(T)
If Try(I, J, T(K)) Then BackSUDOKU S: Solution = True: Exit For
Next K
End If
End Function
Public Sub Build(ByRef S() As Integer)
'初始化最原始SUDOKU
Dim I As Integer
For I = 1 To 9
SUDOKU(I, 1, 0) = I
Next I
For I = 1 To 3
SUDOKU(6 + I, 2, 0) = I
SUDOKU(I, 3, 0) = 6 + I
Next I
For I = 1 To 6
SUDOKU(I, 2, 0) = 3 + I
SUDOKU(3 + I, 3, 0) = I
Next I
For I = 1 To 8
SUDOKU(I, 4, 0) = I + 1
SUDOKU(I + 1, 7, 0) = I
Next I
SUDOKU(3, 4, 0) = 1
SUDOKU(6, 4, 0) = 4
SUDOKU(9, 4, 0) = 7
SUDOKU(1, 7, 0) = 3
SUDOKU(4, 7, 0) = 6
SUDOKU(7, 7, 0) = 9
For I = 1 To 5
SUDOKU(I, 5, 0) = I + 4
SUDOKU(I + 1, 8, 0) = I + 3
Next I
SUDOKU(6, 5, 0) = 7
SUDOKU(7, 5, 0) = 2
SUDOKU(8, 5, 0) = 3
SUDOKU(9, 5, 0) = 1
SUDOKU(3, 5, 0) = 4
SUDOKU(1, 8, 0) = 6
SUDOKU(4, 8, 0) = 9
SUDOKU(7, 8, 0) = 3
SUDOKU(8, 8, 0) = 1
SUDOKU(9, 8, 0) = 2
For I = 1 To 5
SUDOKU(I + 3, 6, 0) = I + 1
SUDOKU(I + 4, 9, 0) = I
Next I
SUDOKU(1, 6, 0) = 8
SUDOKU(2, 6, 0) = 9
SUDOKU(3, 6, 0) = 7
SUDOKU(6, 6, 0) = 1
SUDOKU(9, 6, 0) = 4
SUDOKU(1, 9, 0) = 9
SUDOKU(2, 9, 0) = 7
SUDOKU(3, 9, 0) = 8
SUDOKU(4, 9, 0) = 3
SUDOKU(7, 9, 0) = 6
'SUDOKU混排
I = 5 + Int(Rnd() * 10)
Do While I > 0
If Rnd() > 0.5 Then
RowTrans 1 + Int(Rnd() * 3), 1 + Int(Rnd() * 3)
Else
ColTrans 1 + Int(Rnd() * 3), 1 + Int(Rnd() * 3)
End If
I = I - 1
Loop
For I = 1 To 6
RowTrans 1 + Int(Rnd() * 3), 1 + Int(Rnd() * 3)
ColTrans 1 + Int(Rnd() * 3), 1 + Int(Rnd() * 3)
Next I
Cycle
Cover
BackSUDOKU S
End Sub
'功能区结束
'辅助区
Private Function Try(ByVal I As Integer, ByVal J As Integer, ByVal T As Integer) As Boolean
Dim SS(9, 9, 9) As Integer
BackSUDOKU SS
SS(I, J, 0) = T
Dim SSS As New ClsSudoku
Try = SSS.Solution(SS)
If Try Then
GetSUDOKU SS
End If
End Function
Private Sub Find(ByRef I As Integer, ByRef J As Integer, ByRef T() As Integer)
Dim A As Integer, B As Integer, C As Integer
Dim D As Integer, E As Integer
E = 10
For A = 1 To 9
For B = 1 To 9
If SUDOKU(A, B, 0) = 0 Then
D = 0
For C = 1 To 9
If SUDOKU(A, B, C) = 1 Then D = D + 1
Next C
If D < E And D > 0 Then
ReDim T(0)
For C = 1 To 9
If SUDOKU(A, B, C) = 1 Then
ReDim Preserve T(UBound(T) + 1)
T(UBound(T)) = C
End If
Next C
I = A
J = B
End If
End If
Next B
Next A
End Sub
Private Function IsFinished() As Boolean
IsFinished = False
Dim I As Integer
Dim J As Integer
If Not Check Then Exit Function
For I = 1 To 9
For J = 1 To 9
If SUDOKU(I, J, 0) = 0 Then Exit Function
Next J
Next I
IsFinished = True
End Function
Private Function Check() As Boolean
Dim I As Integer, J As Integer, X As Integer, Y As Integer
Dim T As Integer, Q As Integer
Dim P1(9) As Integer, P2(9) As Integer, P3(9) As Integer
Check = True
For I = 1 To 3
For X = 1 To 3
For T = 1 To 9
P1(T) = T
P2(T) = T
P3(T) = T
Next
For J = 1 To 3
For Y = 1 To 3
Q = SUDOKU((I - 1) * 3 + X, (J - 1) * 3 + Y, 0)
If P1(Q) > 0 Or Q = 0 Then
P1(Q) = 0
Else
Check = False
Exit Function
End If
Q = SUDOKU((J - 1) * 3 + Y, (I - 1) * 3 + X, 0)
If P2(Q) > 0 Or Q = 0 Then
P2(Q) = 0
Else
Check = False
Exit Function
End If
Q = SUDOKU((I - 1) * 3 + J, (X - 1) * 3 + Y, 0)
If P3(Q) > 0 Or Q = 0 Then
P3(Q) = 0
Else
Check = False
Exit Function
End If
Next
Next
Next
Next
End Function
Private Function CheckEmpty() As Boolean
Dim I As Integer, J As Integer
Dim P As Integer
For I = 1 To 9
For J = 1 To 9
P = P + SUDOKU(I, J, 0)
Next J
Next I
If P = 0 Then
CheckEmpty = False
Else
CheckEmpty = True
End If
End Function
Private Sub GetSUDOKU(ByRef S() As Integer)
Dim I As Integer, J As Integer, K As Integer
For I = 1 To 9
For J = 1 To 9
SUDOKU(I, J, 0) = S(I, J, 0)
For K = 1 To 9
SUDOKU(I, J, K) = 0
Next K
Next J
Next I
End Sub
Private Sub BackSUDOKU(ByRef S() As Integer)
Dim I As Integer, J As Integer, K As Integer
For I = 1 To 9
For J = 1 To 9
S(I, J, 0) = SUDOKU(I, J, 0)
For K = 1 To 9
S(I, J, K) = SUDOKU(I, J, K)
Next K
Next J
Next I
End Sub
'辅助区结束
'SUDOKU生成区
Private Sub RowTrans(ByVal SupN As Integer, ByVal SubN As Integer)
Dim I As Integer
Dim J As Integer
Dim K As Integer
Dim R As Integer
Dim S As Integer
Dim A(9) As Integer, B(9) As Integer
I = (SupN - 1) * 3
J = I
Select Case SubN
Case 1
I = I + 2
J = J + 3
Case 2
I = I + 1
J = J + 3
Case 3
I = I + 1
J = J + 2
End Select
For K = 1 To 9
A(K) = SUDOKU(I, K, 0)
B(K) = SUDOKU(J, K, 0)
Next K
K = Int(Rnd() * 5) + 1
S = SUDOKU(J, K, 0)
R = SUDOKU(I, K, 0)
A(K) = S
B(K) = R
Do While S <> R
For K = 1 To 9
If SUDOKU(I, K, 0) = S Then Exit For
Next K
S = SUDOKU(J, K, 0)
A(K) = SUDOKU(J, K, 0)
B(K) = SUDOKU(I, K, 0)
Loop
For K = 1 To 9
SUDOKU(I, K, 0) = A(K)
SUDOKU(J, K, 0) = B(K)
Next K
End Sub
Private Sub ColTrans(ByVal SupN As Integer, ByVal SubN As Integer)
Dim I As Integer
Dim J As Integer
Dim K As Integer
Dim R As Integer
Dim S As Integer
Dim A(9) As Integer, B(9) As Integer
I = (SupN - 1) * 3
J = I
Select Case SubN
Case 1
I = I + 2
J = J + 3
Case 2
I = I + 1
J = J + 3
Case 3
I = I + 1
J = J + 2
End Select
For K = 1 To 9
A(K) = SUDOKU(K, I, 0)
B(K) = SUDOKU(K, J, 0)
Next K
K = Int(Rnd() * 5) + 1
S = SUDOKU(K, J, 0)
R = SUDOKU(K, I, 0)
A(K) = S
B(K) = R
Do While S <> R
For K = 1 To 9
If SUDOKU(K, I, 0) = S Then Exit For
Next K
S = SUDOKU(K, J, 0)
A(K) = SUDOKU(K, J, 0)
B(K) = SUDOKU(K, I, 0)
Loop
For K = 1 To 9
SUDOKU(K, I, 0) = A(K)
SUDOKU(K, J, 0) = B(K)
Next K
End Sub
Private Sub Cycle()
Dim T(9) As Integer
Dim I As Integer
Dim J As Integer
Dim K As Integer
Randomize
Do While I < 9
J = Int(Rnd() * 9) + 1
If J = 10 Then J = 1
K = K + J
If K > 9 Then K = K - 9
Do While T(K) > 0
K = K + 1
If K = 10 Then K = 1
Loop
I = I + 1
T(K) = I
Loop
For I = 1 To 9
For J = 1 To 9
SUDOKU(I, J, 0) = T(SUDOKU(I, J, 0))
Next J
Next I
End Sub
Private Sub Cover()
Dim Total As Integer
Total = 25 + Int((Rnd() + Rnd()) / 2 * 9)
Total = 81 - Total
Dim I As Integer
Dim J As Integer
Do While Total > 0
I = Int(Rnd() * 9) + 1
If I = 10 Then I = 1
J = Int(Rnd() * 9) + 1
If J = 10 Then J = 9
If SUDOKU(I, J, 0) > 0 Then
SUDOKU(I, J, 0) = 0
Total = Total - 1
End If
Loop
End Sub
'SUDOKU生成区结束
'排除法分析区
Private Function AnalyzeRestH(ByVal Index As Integer) As Integer()
Dim I As Integer
Dim J As Integer
Dim P() As Integer
ReDim P(0)
J = 1
For I = 1 To 9
If SUDOKU(Index, I, 0) > 0 Then
ReDim Preserve P(J)
P(J) = SUDOKU(Index, I, 0)
J = J + 1
End If
Next I
AnalyzeRestH = P
End Function
Private Function AnalyzeRestV(ByVal Index As Integer) As Integer()
Dim I As Integer
Dim J As Integer
Dim P() As Integer
ReDim P(0)
J = 1
For I = 1 To 9
If SUDOKU(I, Index, 0) > 0 Then
ReDim Preserve P(J)
P(J) = SUDOKU(I, Index, 0)
J = J + 1
End If
Next I
AnalyzeRestV = P
End Function
Private Function AnalyzeRestR(ByVal Index As Integer) As Integer()
Dim I As Integer
Dim J As Integer
Dim P() As Integer
ReDim P(0)
I = Int(Index / 3)
J = Index - I * 3
If J = 0 Then J = 3: I = I - 1
I = I + 1
Dim T As Integer
T = 1
Dim X As Integer, Y As Integer
For X = 1 To 3
For Y = 1 To 3
If SUDOKU((I - 1) * 3 + X, (J - 1) * 3 + Y, 0) > 0 Then
ReDim Preserve P(T)
P(T) = SUDOKU((I - 1) * 3 + X, (J - 1) * 3 + Y, 0)
T = T + 1
End If
Next
Next
AnalyzeRestR = P
End Function
Private Function Union(ByRef A() As Integer, B() As Integer, C() As Integer) As Integer()
Dim I As Integer
Dim P(9) As Integer
Dim Q() As Integer
ReDim Q(0)
For I = 1 To 9
P(I) = 1
Next
For I = 1 To UBound(A)
P(A(I)) = 0
Next
For I = 1 To UBound(B)
P(B(I)) = 0
Next
For I = 1 To UBound(C)
P(C(I)) = 0
Next
Dim J As Integer
J = 1
ReDim Union(0)
For I = 1 To 9
If P(I) = 1 Then
ReDim Preserve Q(J)
Q(J) = I
J = J + 1
End If
Next
Union = Q
End Function
'排除法分析区结束
'外推法分析区
Private Function Surround(ByVal Number As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal I As Integer, ByVal J As Integer) As Boolean
Dim A As Integer, B As Integer, C As Integer, D As Integer
Dim M As Integer, N As Integer, P As Integer, Q As Integer
GetBoundary X, M, N
GetBoundary Y, P, Q
GetBoundary I, A, B
GetBoundary J, C, D
Dim Ans As Integer, Res As Integer
Dim T As Integer, R As Integer
Dim Fin As Boolean
Dim TmpA As Integer, TmpB As Integer
Dim Tmp(4) As Integer
T = X * 3 - 3 + A
Fin = False
If SUDOKU(T, Y * 3 - 2, 0) > 0 And SUDOKU(T, Y * 3 - 1, 0) > 0 And SUDOKU(T, Y * 3, 0) > 0 Then
Ans = 1
Else
For R = P * 3 - 2 To P * 3
If SUDOKU(T, R, 0) = Number Then Ans = 1: Fin = True: Exit For
Next R
If Not Fin Then
For R = Q * 3 - 2 To Q * 3
If SUDOKU(T, R, 0) = Number Then Ans = 1: Fin = True: Exit For
Next R
End If
If Fin Then Tmp(1) = 1
End If
T = X * 3 - 3 + B
Fin = False
If SUDOKU(T, Y * 3 - 2, 0) > 0 And SUDOKU(T, Y * 3 - 1, 0) > 0 And SUDOKU(T, Y * 3, 0) > 0 Then
Ans = Ans + 1
Else
For R = P * 3 - 2 To P * 3
If SUDOKU(T, R, 0) = Number Then Ans = Ans + 1: Fin = True: Exit For
Next R
If Not Fin Then
For R = Q * 3 - 2 To Q * 3
If SUDOKU(T, R, 0) = Number Then Ans = Ans + 1: Fin = True: Exit For
Next R
End If
If Fin Then Tmp(2) = 1
End If
T = Y * 3 - 3 + C
Fin = False
If SUDOKU(X * 3 - 2, T, 0) > 0 And SUDOKU(X * 3 - 1, T, 0) > 0 And SUDOKU(X * 3, T, 0) > 0 Then
Res = 1
Else
For R = M * 3 - 2 To M * 3
If SUDOKU(R, T, 0) = Number Then Res = 1: Fin = True: Exit For
Next R
If Not Fin Then
For R = N * 3 - 2 To N * 3
If SUDOKU(R, T, 0) = Number Then Res = 1: Fin = True: Exit For
Next R
End If
If Fin Then Tmp(3) = 1
End If
T = Y * 3 - 3 + D
Fin = False
If SUDOKU(X * 3 - 2, T, 0) > 0 And SUDOKU(X * 3 - 1, T, 0) > 0 And SUDOKU(X * 3, T, 0) > 0 Then
Res = Res + 1
Else
For R = M * 3 - 2 To M * 3
If SUDOKU(R, T, 0) = Number Then Res = Res + 1: Fin = True: Exit For
Next R
If Not Fin Then
For R = N * 3 - 2 To N * 3
If SUDOKU(R, T, 0) = Number Then Res = Res + 1: Fin = True: Exit For
Next R
End If
If Fin Then Tmp(4) = 1
End If
If Ans = 2 And Res = 2 Then Surround = True: Exit Function
TmpA = SUDOKU(X * 3 - 3 + I, Y * 3 - 3 + C, 0)
TmpB = SUDOKU(X * 3 - 3 + I, Y * 3 - 3 + D, 0)
If Ans = 2 And ((TmpA > 0 And TmpB > 0) Or (Tmp(4) = 1 And TmpA > 0) Or (Tmp(3) = 1 And TmpB > 0)) Then Surround = True: Exit Function
TmpA = SUDOKU(X * 3 - 3 + A, Y * 3 - 3 + J, 0)
TmpB = SUDOKU(X * 3 - 3 + B, Y * 3 - 3 + J, 0)
If Res = 2 And ((TmpA > 0 And TmpB > 0) Or (Tmp(2) = 1 And TmpA > 0) Or (Tmp(1) = 1 And TmpB > 0)) Then Surround = True: Exit Function
End Function
Private Function Environment(ByVal Number As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal I As Integer, ByVal J As Integer) As Boolean
Dim A As Integer, B As Integer, C As Integer, D As Integer
Dim M As Integer, N As Integer, P As Integer, Q As Integer
GetBoundary X, M, N
GetBoundary Y, P, Q
GetBoundary I, A, B
GetBoundary J, C, D
Dim Tmp(1) As Boolean
Dim Found As Boolean
Dim T As Integer
Dim K As Integer
Dim Tmps As Integer
Environment = False
Found = True
K = X * 3 - 3 + I
For T = 1 To 3 '当所在列出现该数的存在概率时
If SUDOKU(K, P * 3 - 3 + T, Number) = 1 Or SUDOKU(K, Q * 3 - 3 + T, Number) = 1 Then Found = False: Exit For
Next T
If Found Then
K = X * 3 - 3 + A
If SUDOKU(K, Y * 3 - 3 + J, 0) > 0 Then
Found = True
Else
For T = 1 To 3
If SUDOKU(K, P * 3 - 3 + T, Number) = 1 Then Exit For
If SUDOKU(K, Q * 3 - 3 + T, Number) = 1 Then Exit For
If SUDOKU(K, P * 3 - 3 + T, 0) = Number Then Exit For
If SUDOKU(K, Q * 3 - 3 + T, 0) = Number Then Exit For
Next T
If T < 4 Then Found = True
End If
If Found Then
Found = False
K = X * 3 - 3 + B
If SUDOKU(K, Y * 3 - 3 + J, 0) > 0 Then
Found = True
Else
For T = 1 To 3
If SUDOKU(K, P * 3 - 3 + T, Number) = 1 Then Exit For
If SUDOKU(K, Q * 3 - 3 + T, Number) = 1 Then Exit For
If SUDOKU(K, P * 3 - 3 + T, 0) = Number Then Exit For
If SUDOKU(K, Q * 3 - 3 + T, 0) = Number Then Exit For
Next T
If T < 4 Then Found = True
End If
End If
End If
If Found Then Tmp(0) = True
Found = True
K = Y * 3 - 3 + J
For T = 1 To 3 '当所在列出现该数的存在概率时
If SUDOKU(M * 3 - 3 + T, K, Number) = 1 Or SUDOKU(N * 3 - 3 + T, K, Number) = 1 Then Found = False: Exit For
Next T
If Found Then
K = Y * 3 - 3 + C
If SUDOKU(X * 3 - 3 + I, K, 0) > 0 Then
Found = True
Else
For T = 1 To 3
If SUDOKU(M * 3 - 3 + T, K, Number) = 1 Then Exit For
If SUDOKU(N * 3 - 3 + T, K, Number) = 1 Then Exit For
If SUDOKU(M * 3 - 3 + T, K, 0) = Number Then Exit For
If SUDOKU(N * 3 - 3 + T, K, 0) = Number Then Exit For
Next T
If T < 4 Then Found = True
End If
If Found Then
Found = False
K = Y * 3 - 3 + D
If SUDOKU(X * 3 - 3 + I, K, 0) > 0 Then
Found = True
Else
For T = 1 To 3
If SUDOKU(M * 3 - 3 + T, K, Number) = 1 Then Exit For
If SUDOKU(N * 3 - 3 + T, K, Number) = 1 Then Exit For
If SUDOKU(M * 3 - 3 + T, K, 0) = Number Then Exit For
If SUDOKU(N * 3 - 3 + T, K, 0) = Number Then Exit For
Next T
If T < 4 Then Found = True
End If
End If
End If
If Found Then Tmp(1) = True
If Tmp(0) And Tmp(1) Then Environment = True: Exit Function
If Tmp(0) And SUDOKU(X * 3 - 3 + I, Y * 3 - 3 + C, 0) > 0 And SUDOKU(X * 3 - 3 + I, Y * 3 - 3 + D, 0) > 0 Then Environment = True: Exit Function
If Tmp(1) And SUDOKU(X * 3 - 3 + A, Y * 3 - 3 + J, 0) > 0 And SUDOKU(X * 3 - 3 + B, Y * 3 - 3 + J, 0) > 0 Then Environment = True
End Function
Private Sub GetBoundary(ByVal Index As Integer, ByRef Down As Integer, ByRef Up As Integer)
Select Case Index
Case 1
Down = 2: Up = 3
Case 2
Down = 1: Up = 3
Case 3
Down = 1: Up = 2
End Select
End Sub
'外推法分析区结束
Private Function Deal() As Boolean
Deal = False
Dim HasNew As Boolean
HasNew = True
Dim I As Integer, J As Integer, K As Integer
Dim P1() As Integer, P2() As Integer, P3() As Integer, P4() As Integer
Dim T As Integer
Do While HasNew = True
HasNew = False
For I = 1 To 9
P1 = AnalyzeRestH(I)
For J = 1 To 9
If SUDOKU(I, J, 0) = 0 Then
P2 = AnalyzeRestV(J)
P3 = AnalyzeRestR(Int((I - 1) / 3) * 3 + Int((J - 1) / 3) + 1)
P4 = Union(P1, P2, P3)
If UBound(P4) = 1 Then
SUDOKU(I, J, 0) = P4(1)
HasNew = True
Else
For T = 1 To UBound(P4)
If Surround(P4(T), Int((I - 1) / 3 + 1), Int((J - 1) / 3 + 1), I - Int((I - 1) / 3) * 3, J - Int((J - 1) / 3) * 3) Then
SUDOKU(I, J, 0) = P4(T)
HasNew = True
Exit For
End If
Next T
End If
End If
Next
Next
If HasNew Then Deal = True
Loop
End Function
Private Function ThirdLogic() As Boolean
ThirdLogic = False
Dim HasNew As Boolean
HasNew = True
Dim I As Integer, J As Integer
Dim T As Integer, K As Integer
Dim X As Integer, Y As Integer
Dim P1() As Integer, P2() As Integer, P3() As Integer, P4() As Integer
For I = 1 To 9
P1 = AnalyzeRestH(I)
For J = 1 To 9
For T = 1 To 9
SUDOKU(I, J, T) = 0
Next T
If SUDOKU(I, J, 0) = 0 Then
P2 = AnalyzeRestV(J)
P3 = AnalyzeRestR(Int((I - 1) / 3) * 3 + Int((J - 1) / 3) + 1)
P4 = Union(P1, P2, P3)
If UBound(P4) > 1 Then
For T = 1 To UBound(P4)
SUDOKU(I, J, P4(T)) = 1
Next
End If
End If
Next J
Next I
Do While HasNew = True
HasNew = False
For I = 1 To 9
For J = 1 To 9
For T = 1 To 9
If SUDOKU(I, J, T) = 1 Then
X = Int((I - 1) / 3 + 1)
Y = Int((J - 1) / 3 + 1)
If Environment(T, X, Y, I - Int((I - 1) / 3) * 3, J - Int((J - 1) / 3) * 3) Then
SUDOKU(I, J, 0) = T
For K = 1 To 9
SUDOKU(I, K, T) = 0
SUDOKU(K, J, T) = 0
Next K
For K = 1 To 3
SUDOKU(X * 3 - 2, Y * 3 - 3 + K, T) = 0
SUDOKU(X * 3 - 1, Y * 3 - 3 + K, T) = 0
SUDOKU(X * 3, Y * 3 - 3 + K, T) = 0
Next K
HasNew = True
Exit For
End If
End If
Next T
Next J
Next I
If HasNew Then ThirdLogic = True
Loop
End Function
博文
