在擲骰子的遊戲程式中各種數字組合有非常多種排列情況，請說明如何用最精簡的邏輯來設計Private Sub compare() ?程式如下

自學程式設計

31502a 2019-03-24 12:26:02 ‧ 2754 瀏覽

分享至

在擲骰子的遊戲程式中各種數字組合有非常多種排列情況，請說明如何用最精簡的邏輯來設計Private Sub compare() ?程式如下
Dim score_computer, score_player As Integer '積分
Dim a, b, c, d, e, f, g, h, i, j, k, x, z As Integer '點數和其他變數
Dim roll As Integer '滾動效果
Dim whoshow As Boolean '身份識別
Dim ok As Boolean '已完成一次比賽
Private Sub Command1_Click() '玩家1擲出
player(0).Picture = LoadPicture(Empty)
Label3 = Empty
whoshow = False '玩家1play
Randomize
a = Fix(6 * Rnd) + 1 '點數
roll = 0 '滾動預設
ok = False '換玩家2
Timer1.Enabled = True
Command3.Enabled = True '致能按鈕
player(1).Picture = LoadPicture(Empty)
Label3 = Empty
whoshow = False '玩家1play
Randomize
d = Fix(6 * Rnd) + 1 '點數
roll = 0 '滾動預設
ok = False '換玩家
Timer1.Enabled = True
Command3.Enabled = True '致能按鈕
player(2).Picture = LoadPicture(Empty)
Label3 = Empty
whoshow = False '玩家1play
Randomize
e = Fix(6 * Rnd) + 1 '點數
roll = 0 '滾動預設
ok = False '換玩家2
Timer1.Enabled = True
Command3.Enabled = True '致能按鈕
End Sub
Private Sub Command2_Click() '玩家2擲出
whoshow = True '玩家2play
Randomize
b = Fix(6 * Rnd) + 1 '點數
f = Fix(6 * Rnd) + 1
g = Fix(6 * Rnd) + 1
roll = 0
Timer1.Enabled = True
ok = True
End Sub
Private Sub Command3_Click() '重新比賽，清除積分
z = InputBox("輸入你想要的金額", "下注金額")
x = z
Command1.Enabled = True
Command2.Enabled = False
score_computer = 1000
score_player = 1000
Label4(0) = score_computer
Label4(1) = score_player
Command1.Caption = "玩家1"
Label3 = Empty
player(0).Picture = LoadPicture(Empty)
player(1).Picture = LoadPicture(Empty)
player(2).Picture = LoadPicture(Empty)
computer(0).Picture = LoadPicture(Empty)
computer(1).Picture = LoadPicture(Empty)
computer(2).Picture = LoadPicture(Empty)
End Sub
Private Sub Form_Activate()
Dim z As Integer, sum As Integer
z = InputBox("輸入你想要的金額", "下注金額")
x = z
End Sub
Private Sub Form_Load() '預設值設定
score_computer = 1000
score_player = 1000
Label3 = Empty
Label4(0) = 1000
Label4(1) = 1000
Timer1.Interval = 100
Command2.Enabled = False '還沒開始比賽
Command3.Enabled = False
Timer1.Enabled = False
For i = 0 To 5 '隱藏圖片
Picture1(i).Visible = False
Next
End Sub
Private Sub Timer1_Timer()
Randomize
c = Fix(6 * Rnd) + 1 '滾動的骰子
h = Fix(6 * Rnd) + 1
i = Fix(6 * Rnd) + 1
If Not whoshow Then
computer(0).Picture = Picture1(c - 1) '玩家1方滾動
computer(1).Picture = Picture1(h - 1)
computer(2).Picture = Picture1(i - 1)
Else
player(0).Picture = Picture1(c - 1) '玩家2方滾動
player(1).Picture = Picture1(h - 1)
player(2).Picture = Picture1(i - 1)
End If
roll = roll + 1 '滾動20次再顯示結果
If roll >= 20 Then
Timer1.Enabled = False
If Not whoshow Then
computer(0).Picture = Picture1(a - 1)
computer(1).Picture = Picture1(d - 1)
computer(2).Picture = Picture1(e - 1)
Command1.Enabled = False
Command2.Enabled = True
Else
player(0).Picture = Picture1(b - 1)
player(1).Picture = Picture1(f - 1)
player(2).Picture = Picture1(g - 1)
Command1.Enabled = True
Command2.Enabled = False
End If
If ok Then compare
Command1.Caption = "玩家1繼續"
End If
End Sub
Private Sub compare()
If a <> d And d <> e And e <> a And a + d + e <> 6 And a + d + e <> 15 Then
j = a + d + e
ElseIf a <> d And d <> e And e <> a And a + d + e = 15 Then
j = 19
ElseIf a <> d And d <> e And e <> a And a + d + e = 6 Then
j = 0
ElseIf a = d And d <> e And a <> e Then
j = e
ElseIf d = e And d <> a And e <> a Then
j = a
ElseIf a = e And e <> d And a <> d Then
j = d
ElseIf a = 1 And d = 1 And e = 1 Then
j = 13
ElseIf a = 2 And d = 2 And e = 2 Then
j = 14
ElseIf a = 3 And d = 3 And e = 3 Then
j = 15
ElseIf a = 4 And d = 4 And e = 4 Then
j = 16
ElseIf a = 5 And d = 5 And e = 5 Then
j = 17
ElseIf a = 6 And d = 6 And e = 6 Then
j = 18
End If
If b <> f And f <> g And g <> b And b + f + g <> 6 And b + f + g <> 15 Then
k = b + f + g
ElseIf b <> f And f <> g And g <> b And b + f + g = 15 Then
k = 19
ElseIf b <> f And f <> g And g <> b And b + f + g = 6 Then
k = 0
ElseIf b = f And f <> g And b <> g Then
k = g
ElseIf g = f And f <> b And g <> b Then
k = b
ElseIf b = g And g <> f And b <> f Then
k = f
ElseIf b = 1 And f = 1 And g = 1 Then
k = 13
ElseIf b = 2 And f = 2 And g = 2 Then
k = 14
ElseIf b = 3 And f = 3 And g = 3 Then
k = 15
ElseIf b = 4 And f = 4 And g = 4 Then
k = 16
ElseIf b = 5 And f = 5 And g = 5 Then
k = 17
ElseIf b = 6 And f = 6 And g = 6 Then
k = 18
End If
Select Case j - k
Case Is > 0
Label3.Caption = "玩家1贏!"
score_computer = score_computer + x
Label4(0) = score_computer
score_player = score_player - x
Label4(1) = score_player
Case Is = 0
Label3.Caption = "雙方平手!"
Case Is < 0
Label3.Caption = "玩家2贏!"
score_computer = score_computer - x
Label4(0) = score_computer
score_player = score_player + x
Label4(1) = score_player
End Select
If score_computer <= 0 Then
Command1.Enabled = False
Command2.Enabled = False
Label3.Caption = "遊戲結束,玩家2獲勝!"
End If
If score_player <= 0 Then
Command1.Enabled = False
Command2.Enabled = False
Label3.Caption = "遊戲結束,玩家1獲勝!"
End If
End Sub

paicheng0111 iT邦大師 5 級 ‧ 2019-03-24 13:24:11 檢舉

這種問法有點像是課堂考題

小魚 iT邦大師 1 級 ‧ 2019-03-24 23:55:40 檢舉

我猜是作業

小魚 iT邦大師 1 級 ‧ 2019-03-24 23:55:40 檢舉

我猜是作業

登入發表討論

直播研討會

{{ item.channelVendor }} {{ item.webinarstarted }} |

直播中

3 個回答

小魚

iT邦大師 1 級 ‧ 2019-03-24 13:11:16

通常, 第一件事應該是先排序

回應 2
分享
檢舉

31502a iT邦新手 5 級 ‧ 2019-03-24 22:14:07 檢舉

謝謝

31502a iT邦新手 5 級 ‧ 2019-03-24 22:14:08 檢舉

謝謝

登入發表回應

海綿寶寶

iT邦大神 1 級 ‧ 2019-03-24 16:46:37

'改成這樣
Private Sub compare()
   '換成這兩列
   j = GetWeightedNumber(a, d, e)
   k = GetWeightedNumber(b, f, g)
   '以下維持原樣
   Select Case j - k
      Case Is > 0
      Label3.Caption = "玩家1贏!"
      score_computer = score_computer + x
   ......
End Sub

'加個底下這個 function
Function GetWeightedNumber(ByVal x, ByVal y, ByVal z) As Integer
    Dim Dice(3) As Integer
    Dim Result As Integer
    Dim Leopard
    '設初值
    Leopard = Array(0, 13, 14, 15, 16, 17, 18)
    Dice(1) = x: Dice(2) = y: Dice(3) = z
    '排序三個數字, 由小到大
    For i = 1 To 2
        For j = i + 1 To 3
            If Dice(i) > Dice(j) Then
                temp = Dice(i)
                Dice(i) = Dice(j)
                Dice(j) = temp
            End If
        Next j
    Next i
    '計算加權數
    If ((Dice(1) = Dice(2)) And (Dice(2) = Dice(3))) Then   '情形1，三個數字相同
        Result = Leopard(Dice(1))
    ElseIf ((Dice(1) = Dice(2)) Or (Dice(2) = Dice(3))) Then    '情形2，兩個數字相同
        Result = Dice(1) - Dice(2) + Dice(3)
    Else    '情形3，三個數字都不相同
        If ((Dice(1) = 4) And (Dice(2) = 5) And (Dice(3) = 6)) Then '特例 4-5-6 最大值
            Result = 19
        ElseIf ((Dice(1) = 1) And (Dice(2) = 2) And (Dice(3) = 3)) Then '特例 1-2-3 最小值
            Result = 0
        Else
            Result = Dice(1) + Dice(2) + Dice(3)    '其他情形
        End If
    End If
    '回傳結果
    GetWeightedNumber = Result
End Function