個人積分：19分
文章編號：3698885
個人積分：51分
文章編號：3699414
以下僅提供判斷幾A幾B。亂數產生及其他的部份就自行研究一下吧
======================================================
''' <summary>
''' 第一個參數放題目，第二個參數放使用者所輸入的
''' </summary>
''' <param name="Src">題目</param>
''' <param name="Key_in">使用者所輸入的</param>
''' <returns>幾A幾B</returns>
''' <remarks></remarks>
Public Function Check_Number(ByVal Src As String, ByVal Key_in As String) As String
Dim ht As New Hashtable '利用HashTable來放原始的題目，用來判斷幾B用的
Dim A_Count As Integer = 0 '幾A的個數
Dim B_Count As Integer = 0 '幾B的個數
Src = Src.Trim '去掉空白
Key_in = Key_in.Trim '去掉空白
If IsNumeric(Key_in) = False Or IsNumeric(Src) = False Then '確認為1~9
Return "輸入錯誤"
End If
For i As Integer = 0 To Key_in.Length - 1
ht.Add(i, Src.Substring(i, 1)) '把題目1個字1個字拆開放到HashTable
If Key_in.Substring(i, 1) = Src.Substring(i, 1) Then '順便先比較幾A的部份
A_Count += 1
End If
Next
For i As Integer = 0 To Key_in.Length - 1
If ht.ContainsValue(Key_in.Substring(i, 1)) = True Then '比較B的部份
B_Count += 1
End If
Next
If B_Count > 0 Then '如果B的數目大於0的話，就扣掉A的數目才會正確
B_Count -= A_Count
End If
Return A_Count & "A" & B_Count & "B" '輸出結果
End Function
個人積分：0分
文章編號：3699626
當時是使用 vb 5 寫的.
貼上來的內容, 是主要的程式, 配合 form 的話, 請參考附加檔案.
對了, 由於當時上課的進度, 多加了一個變換顏色無用的功能, 請自行刪除不用理會.
=============================================
Dim oldtime As Date '要設為全域變數
Dim pc(4) As String * 1 '設定為儲存電腦產生亂數的陣列
Dim user(4) As String * 1 '儲存使用者輸入的資料
Dim times As Integer '計算猜的次數
Dim y As Integer
Dim z As Integer
Private Sub Command1_Click()
times = times + 1
s = Text1.Text '取得輸入的字串,並存入user陣列中
For i = 1 To 4
user(i) = Mid(s, i, 1)
Next i
a = 0
b = 0
For i = 1 To 4 '比較相同位置相同數字的有多少
x = x & user(i)
If pc(i) = user(i) Then a = a + 1
Next i
For i = 1 To 4 '比較相同數字有多少
For j = 1 To 4
If pc(i) = user(j) Then b = b + 1
Next j
Next i
b = b - a '因b多算了a次, 故要減掉
If a = 4 Then
s = "答案是" & x & ", 你總共猜了" & times & "次!!"
v = MsgBox(s, vbOKOnly, "恭禧你!")
End
End If
Print "你輸入的數字是"; x, a; "A"; b; "B"
End Sub
Private Sub Form_Load() '產生不重覆的四個數字
oldtime = Now '儲存開始play的時間
Text1.MaxLength = 4 '設定文字編修框最多輸入四個字元
times = 0
For i = 1 To Hour(Now) * Minute(Now) * Second(Now)
Rnd '先讓亂數執行隨機次數,確保亂數不會重覆
Next i
i = 1
Do While i <= 4 '當產生四個數字後才結束程式
a = Int(Rnd * 10)
For j = 1 To i '比較a值有沒有重覆
If pc(j) = a Then k = 1
Next j
If k <> 1 Then '當a值未重覆則存入陣列, 且i+1
pc(i) = a
i = i + 1
End If
k = 0 '將旗標歸0
Loop
For i = 1 To 4
Debug.Print pc(i)
Next i
End Sub
==============================================
附加壓縮檔: 200709/mobile01-c21fa8b207755636479b55b2513a0c9a.zip
======================
樹的方向, 由風決定.
人的方向, 自己決定.
個人積分：1分
文章編號：3700445
建議樓主時間還夠趕緊多融會貫通吧! 自己寫的才是自己的喔!
若樓主老闆跟之前我老師一樣...
----------n年前---------------
老師: 恩 不錯!猜數字寫出來了下次交反猜數字
...
反猜數字交差後
老師: 恩 猜的次數太多了, 演算法太差, 試著在最少次數猜出來
...
就這樣一直不斷的題目
--------------------------------
單純提醒罷了, 因為這次交差了, 下次的"作業"應該會更有挑戰性吧...
學程式就是要熱血吧!
記得大一計概老師要大家學期初決定一個題目, 用C來寫, 期末交出來打分數...
我因為正沉迷於PC game瘋狂醫生...
就說我要寫一個看病程式, 當場被老師消遣, 建議我換一個...
我是那種受不了被刺激的,
鐵齒說不改... 全靠"F1" 學C,
期末交出來的程式, 雖然現在看起來簡直是玩票性質, 搞笑作品!
但實實在在得到一個A+
加油吧!樓主!
敗家-初心者
Hello More 敗~
個人積分：1分
文章編號：3700447
個人積分：0分
文章編號：3700480
根據你所描述有三種可能
1.電腦亂數產生一個答案讓人來猜
這情況是最簡單的，幾本上就是字串比對，應該可以在短時間內完成，如果你真的不會，而且你還想靠寫程式吃飯，那你應該再多花點時間練習你的程式技巧。
2.讓電腦來猜人的答案
這個情況稍微複雜一點點，不過也不是真的那麼難。
做法很多種，我想最容易的應該是用迴圈來跑，也就是一個四層的槽狀迴圈（看你是要作幾個數字）。你可以說這個做法基本上就是消去法，而且以四個數字來說，電腦大概平均四或五次可以猜出答案（人來玩也差不多是這樣）。
當然，我想人工智慧的方法也是可以的，方法高級了一點，效果我想不會比較好，但若是當作練習人工智慧（如GA）的題目倒也不錯。
3.人和電腦對戰
就是把上面二種做法合併在一起。
以上給你做為參考
個人積分：71分
文章編號：3700590
個人積分：0分
文章編號：3700756
根據您所給的 4 位數 以及幾 A 幾 B
可以跟猜數字做交叉測試
給您參考參考
使用的元件:
VB.TextBox txtAns
VB.CommandButton cmdReset
VB.TextBox txtB
VB.TextBox txtA
VB.CommandButton cmdAns
VB.ListBox lsResult
VB.Label lbCnt
VB.Label lbB
VB.Label lbA
程式碼:
Const MaxNums = 4
Dim Ans(), Ans2(), Nums()
Dim Idx
Private Sub cmdAns_Click()
A = Val(txtA.Text)
B = Val(txtB.Text)
MsgBox UBound(Ans)
For I = LBound(Ans) To UBound(Ans)
If ABp(txtAns.Text, Ans( I ), A, B) = True Then
N = N + 1
ReDim Preserve Ans2(1 To N)
Ans2( N ) = Ans( I )
End If
Next
lbCnt.Caption = N
'If N = 0 Then
' MsgBox "輸入結果不正確", vbCritical + vbOKOnly
' Exit Sub
'End If
lsResult.Clear
ReDim Ans(1 To UBound(Ans2))
For I = LBound(Ans2) To UBound(Ans2)
Ans( I ) = Ans2( I )
lsResult.AddItem Ans2( I )
Next
End Sub
Private Sub cmdReset_Click()
lsResult.Clear
Form_Load
End Sub
Private Sub Form_Load()
txtAns.MaxLength = MaxNums
Nums = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "0")
P Nums, 0, MaxNums
lbCnt.Caption = UBound(Ans) - LBound(Ans) + 1
End Sub
Private Sub P(Arr(), I As Integer, N As Integer)
If I = 0 Then Idx = 0
If I = N Then
Idx = Idx + 1
ReDim Preserve Ans(1 To Idx)
Ans(Idx) = Mid(Join(Arr, ""), 1, N)
Else
For J = I To UBound(Arr)
SwapArr Arr, I, J
P Arr, I + 1, N
SwapArr Arr, I, J
Next
End If
End Sub
Private Sub SwapArr(Arr(), ByVal I As Integer, ByVal J As Integer)
Dim T As Variant
T = Arr( I )
Arr( I ) = Arr( J )
Arr( J ) = T
End Sub
Private Function ABp(ByVal Str1 As String, ByVal Str2 As String, ByVal A As Integer, ByVal B As Integer) As Boolean
Dim nA As Integer, nB As Integer
For I = 1 To Len(Str1)
J = InStr(Str2, Mid(Str1, I, 1))
If J > 0 Then
If I = J Then nA = nA + 1 Else nB = nB + 1
End If
Next
ABp = ((nA = A) And (nB = B))
End Function
個人積分：13分
文章編號：3701771
個人積分：4分
文章編號：3702384
