解數獨程式：
下載程式表單檔
Dim orig(81) As String
Dim gameOver As Boolean, Repe As Boolean
Const g1 = "410709600286035097007000200000501040030007528900000100740203069168000050300008014"
Const g2 = "000500010008603000090070308000000200005016804034200001040008000000100795760952000"
Const g3 = "601580000000000020000030000400000900980400050305002014700000100000620049204070580"
Private Sub Command1_Click()
gameOver = False
For i = 1 To 81
a = Mid(g1, i, 1)
orig(i) = a
If a = 0 Then
T1(i).Text = ""
Else
T1(i).Text = a
T1(i).ForeColor = RGB(200, 0, 0)
End If
Next
End Sub
Private Sub Command2_Click()
For i = 1 To 81
If T1(i).Text = "" Then
All = "123456789"
a = (i - 1) \ 9 + 1
b = (i - 1) Mod 9 + 1
For x = 1 + (a - 1) * 9 To a * 9
'T1(i).BackColor = vbRed
If i <> x Then
All = Replace(All, T1(x), "")
End If
Next x
For x = b To 81 Step 9
If i <> x Then
All = Replace(All, T1(x), "")
End If
Next x
'九個小區的檢查是否重複(n,m)=(1,1)~(3,3) 共九區
'(1,1),(1,2),(1,3)
'(2,1),(2,2),(2,3)
'(3,1),(3,2),(3,3)
n = (a - 1) \ 3 + 1
m = (b - 1) \ 3 + 1
'Print "("; n; ","; m; ")"
For z = 1 + (n - 1) * 27 To 19 + (n - 1) * 27 Step 9
For x = z + (m - 1) * 3 To z + 2 + (m - 1) * 3
If i <> x Then
All = Replace(All, T1(x), "")
End If
Next x
Next z
'MsgBox All
If Len(All) = 1 Then T1(i).Text = All
End If
Next i
End Sub
Private Sub Command3_Click()
gameOver = False
For i = 1 To 81
a = Mid(g2, i, 1)
orig(i) = a
If a = 0 Then
T1(i).Text = ""
Else
T1(i).Text = a
T1(i).ForeColor = RGB(200, 0, 0)
End If
Next
End Sub
Private Sub Command4_Click()
gameOver = False
For i = 1 To 81
a = Mid(g3, i, 1)
orig(i) = a
If a = 0 Then
T1(i).Text = ""
Else
T1(i).Text = a
T1(i).ForeColor = RGB(200, 0, 0)
End If
Next
End Sub
Private Sub Command5_Click()
Dim kk(81) As Integer
Dim kkdata(81) As Integer
For i = 1 To 81
If T1(i).Text <> "" Then
kk(i) = 1
Else
kk(i) = 2 '等於2時，才是需要猜的格子
kkdata(i) = 0
End If
Next i
i = 1
Do
'If i Mod 20 = 0 Then MsgBox i
If kk(i) = 1 Then
i = i + 1
Else
Do
kkdata(i) = kkdata(i) + 1
T1(i).Text = kkdata(i)
'MsgBox i & "," & kkdata(i)
Loop Until Repe = False Or kkdata(i) >= 9
If Repe = False Then
i = i + 1
Else
Do
kkdata(i) = 0
i = i - 1
Loop Until kk(i) = 2
End If
End If
Loop Until gameOver = True
End Sub
Private Sub mygues()
ag:
achang = False
For i = 1 To 81
If T1(i).Text = "" Then
All = "123456789"
a = (i - 1) \ 9 + 1
b = (i - 1) Mod 9 + 1
For x = 1 + (a - 1) * 9 To a * 9
'T1(i).BackColor = vbRed
If i <> x Then
All = Replace(All, T1(x), "")
End If
Next x
For x = b To 81 Step 9
If i <> x Then
All = Replace(All, T1(x), "")
End If
Next x
'九個小區的檢查是否重複(n,m)=(1,1)~(3,3) 共九區
'(1,1),(1,2),(1,3)
'(2,1),(2,2),(2,3)
'(3,1),(3,2),(3,3)
n = (a - 1) \ 3 + 1
m = (b - 1) \ 3 + 1
'Print "("; n; ","; m; ")"
For z = 1 + (n - 1) * 27 To 19 + (n - 1) * 27 Step 9
For x = z + (m - 1) * 3 To z + 2 + (m - 1) * 3
If i <> x Then
All = Replace(All, T1(x), "")
End If
Next x
Next z
'MsgBox All
If Len(All) = 1 Then T1(i).Text = All: achang = True
If Len(All) = 2 Then
T1(i).Text = Mid(All, 2, 1)
achang = True
End If
End If
Next i
If achang Then GoTo ag
End Sub
Private Sub Command6_Click()
ag:
achang = False
For i = 1 To 81
If T1(i).Text = "" Then
All = "123456789"
a = (i - 1) \ 9 + 1
b = (i - 1) Mod 9 + 1
For x = 1 + (a - 1) * 9 To a * 9
'T1(i).BackColor = vbRed
If i <> x Then
All = Replace(All, T1(x), "")
End If
Next x
For x = b To 81 Step 9
If i <> x Then
All = Replace(All, T1(x), "")
End If
Next x
'九個小區的檢查是否重複(n,m)=(1,1)~(3,3) 共九區
'(1,1),(1,2),(1,3)
'(2,1),(2,2),(2,3)
'(3,1),(3,2),(3,3)
n = (a - 1) \ 3 + 1
m = (b - 1) \ 3 + 1
'Print "("; n; ","; m; ")"
For z = 1 + (n - 1) * 27 To 19 + (n - 1) * 27 Step 9
For x = z + (m - 1) * 3 To z + 2 + (m - 1) * 3
If i <> x Then
All = Replace(All, T1(x), "")
End If
Next x
Next z
'MsgBox All
If Len(All) = 1 Then T1(i).Text = All: achang = True
End If
Next i
If achang Then GoTo ag
End Sub
Private Sub Form_Load()
For i = 0 To 81: T1(i).Text = "": orig(i) = 0: Next
End Sub
Private Sub T1_Change(Index As Integer)
i = Index
Repe = False
If T1(i).Text >= "1" And T1(i).Text <= "9" _
And Len(T1(i).Text) = 1 And orig(i) = "0" Then
'第a橫排 第b直排
a = (i - 1) \ 9 + 1
b = (i - 1) Mod 9 + 1
For x = 1 + (a - 1) * 9 To a * 9
'T1(i).BackColor = vbRed
If i <> x And T1(i).Text = T1(x).Text Then
T1(i).Text = "": Beep: Repe = True
End If
Next x
For x = b To 81 Step 9
If i <> x And T1(i).Text = T1(x).Text Then
T1(i).Text = "": Beep: Repe = True
End If
Next x
'九個小區的檢查是否重複(n,m)=(1,1)~(3,3) 共九區
'(1,1),(1,2),(1,3)
'(2,1),(2,2),(2,3)
'(3,1),(3,2),(3,3)
n = (a - 1) \ 3 + 1
m = (b - 1) \ 3 + 1
'Print "("; n; ","; m; ")"
For z = 1 + (n - 1) * 27 To 19 + (n - 1) * 27 Step 9
For x = z + (m - 1) * 3 To z + 2 + (m - 1) * 3
If i <> x And T1(i).Text = T1(x).Text Then
T1(i).Text = "": Beep: Repe = True
End If
Next x
Next z
'判斷是否結束了
ok = True
For x = 1 To 81
If T1(x) = "" Then ok = False
Next x
If ok = True Then MsgBox "恭喜您完成了": gameOver = True
Else
If orig(i) = "0" Then T1(i).Text = "": Repe = True Else T1(i).Text = orig(i)
End If
End Sub
Private Sub T1_GotFocus(Index As Integer)
'輔助顯示相同數字
i = Index
If T1(i) <> "" Then
For x = 1 To 81
If T1(i).Text = T1(x).Text And T1(x).Text <> "" Then
T1(x).BackColor = vbYellow
Else
T1(x).BackColor = vbWhite
End If
Next
Else
'這格是空的，顯示可能的數字
All = "123456789"
a = (i - 1) \ 9 + 1
b = (i - 1) Mod 9 + 1
For x = 1 + (a - 1) * 9 To a * 9
'T1(i).BackColor = vbRed
If i <> x Then
All = Replace(All, T1(x), "")
End If
Next x
For x = b To 81 Step 9
If i <> x Then
All = Replace(All, T1(x), "")
End If
Next x
'九個小區的檢查是否重複(n,m)=(1,1)~(3,3) 共九區
'(1,1),(1,2),(1,3)
'(2,1),(2,2),(2,3)
'(3,1),(3,2),(3,3)
n = (a - 1) \ 3 + 1
m = (b - 1) \ 3 + 1
'Print "("; n; ","; m; ")"
For z = 1 + (n - 1) * 27 To 19 + (n - 1) * 27 Step 9
For x = z + (m - 1) * 3 To z + 2 + (m - 1) * 3
If i <> x Then
All = Replace(All, T1(x), "")
End If
Next x
Next z
MsgBox All
End If
End Sub
2010年6月7日 星期一
vb選手第二次測試
vb選手第二次測試
1.請找出在integer範圍內最大的兩個質數。(10%)
2.請找出在long範圍內最大的兩個質數。(10%)
3.請找出在long範圍內最大的費氏數，並找出它是第幾項。(10%)
(f1=1, f2=1, f3=2, ......)
4.請試著找出大於long的第一個質數。(10%)
如果找不出來，也請試著寫寫該如何做，應該可以找出來。
5.數字遊戲，3位數的幾a幾b。(40%)
例：謎底為175，若猜123，得到1a；若猜456，得到1b；若猜135，得到2a。
位置相同、數字相同的猜測數字，得到1a；位置不同，但數字相同的猜測數字，得到1b。
問題5-1，第1個數不可為0的謎底，若有幾組?並將這麼多組的謎底，輸出到out1.txt。
問題5-2，若猜完123，得到1b。則符合這個猜測的謎底，還有幾組?
並將這麼多組的謎底，輸出到out2.txt。
6.輸入的in.txt檔，去判斷是否完成"數獨"遊戲。(20%)
數獨的每個直行、每個橫行都由不重複的1到9的數字組成，
並且將81格依井字分成9個小區，每個小區也是由不重複的1到9數字組成。
輸入檔說明：
第1行的數字，表示有幾組待判斷的數獨解。
每組數獨解，有9行，每行9個1到9的數字。
例in.txt：
2
123456789
456789123
789123456
231564897
564897231
897231564
312645978
645978312
978312645
123456789
287654321
335724689
412345678
534567898
686543292
754698723
823445679
923445678
輸出說明：
第1組數獨解：正確
第2組數獨解：不正確
訂閱：
文章 (Atom)