這程式需要用到一個樸克牌物件 (CARD.OCX)。
原始程式碼如下 :
Option Explicit
Dim poker(51) As Integer '樸克牌
Dim flag As Integer '目前在第幾張牌
Dim a(6) As Integer '玩的牌有幾張
Dim h(6) As Integer '是否按保留鍵
Dim b(5) As Integer '判斷用陣列
Dim card_number As Integer '總牌數
Dim hand As Integer '手數
Dim i, j, k, temp, kk As Integer
Private Sub Card_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
If h(Index) = 0 Then
ho(Index).Caption = "保留"
h(Index) = 1
Else
ho(Index).Caption = ""
h(Index) = 0
End If
End Sub
Private Sub Command1_Click()
'====================
' show card value
'====================
Dim temp1, temp2, temp3, temp4 As Integer
Print "show"
For j = 0 To 4
temp1 = a(j) \ 13 + 1
temp2 = a(j) Mod 13 + 1
temp3 = b(j) \ 13 + 1
temp4 = b(j) Mod 13 + 1
Print temp1; "-"; temp2
Print temp3; "-"; temp4
Next j
End Sub
Sub wash()
'=============
' 洗牌作業
'=============
For i = 0 To 51
poker(i) = 0
Next i
For i = 0 To 51
reselect:
j = Int(Rnd(1) * 52)
If poker(j) = 0 Then
poker(j) = i
Else
GoTo reselect
End If
Next i
End Sub
Sub clear_text()
'==========================
' 清除文字反向背景顏色
'==========================
L9.BackColor = RGB(212, 208, 200)
Lc9.BackColor = RGB(212, 208, 200)
L8.BackColor = RGB(212, 208, 200)
Lc8.BackColor = RGB(212, 208, 200)
L7.BackColor = RGB(212, 208, 200)
Lc7.BackColor = RGB(212, 208, 200)
L6.BackColor = RGB(212, 208, 200)
Lc6.BackColor = RGB(212, 208, 200)
L5.BackColor = RGB(212, 208, 200)
Lc5.BackColor = RGB(212, 208, 200)
L4.BackColor = RGB(212, 208, 200)
Lc4.BackColor = RGB(212, 208, 200)
L3.BackColor = RGB(212, 208, 200)
Lc3.BackColor = RGB(212, 208, 200)
L2.BackColor = RGB(212, 208, 200)
Lc2.BackColor = RGB(212, 208, 200)
L1.BackColor = RGB(212, 208, 200)
Lc1.BackColor = RGB(212, 208, 200)
End Sub
Sub see_card()
Dim v1, v2, pair, pair_flag, ss, same, score As Integer
pair = 0
'判斷結果
For i = 0 To 3
For j = i + 1 To 4
v1 = a(i) Mod 13 + 1
v2 = a(j) Mod 13 + 1
If v1 = v2 Then
pair = pair + 1
pair_flag = v1
End If
Next j
Next i
'=====================
' 一對 (11,12,13,A)
'=====================
If pair = 1 And (pair_flag = 1 Or pair_flag = 11 Or pair_flag = 12 Or pair_flag = 13) Then
score = 1
End If
'==========
' 二對
'==========
If pair = 2 Then
score = 2
End If
'==========
' 三對
'==========
If pair = 3 Then
score = 3
End If
'==========
' 葫蘆
'==========
If pair = 4 Then
score = 10
End If
'==========
' 四梅
'==========
If pair = 6 Then
score = 40
End If
'==============
' 判斷 順
'==============
'取得牌值
For i = 0 To 4
b(i) = a(i)
b(i) = b(i) Mod 13 + 1 '取餘數
Next i
'排序
For i = 0 To 3
For j = i + 1 To 4
If b(i) > b(j) Then
temp = b(i)
b(i) = b(j)
b(j) = temp
End If
Next j
Next i
'判斷是否差 1
ss = 0
temp = b(0)
For i = 1 To 4
If temp + 1 <> b(i) Then
ss = 0 '不是順
Exit For
Else
temp = b(i)
ss = 1
End If
Next i
' 特例 (大順)
For i = 0 To 4
b(i) = a(i)
b(i) = b(i) Mod 13 + 1 '取餘數
Next i
'排序
For i = 0 To 3
For j = i + 1 To 4
If b(i) > b(j) Then
temp = b(i)
b(i) = b(j)
b(j) = temp
End If
Next j
Next i
If b(0) = 1 And b(1) = 10 And b(2) = 11 And b(3) = 12 And b(4) = 13 Then
ss = 2
End If
If ss = 1 Or ss = 2 Then
score = 5
End If
'============
' 是否同花
'============
For i = 0 To 4
b(i) = a(i)
b(i) = b(i) \ 13 + 1 '取整數
Next i
same = 0
For i = 0 To 3
If b(i) <> b(i + 1) Then
same = 0
Exit For
Else
same = 1
End If
Next i
If same = 1 Then
score = 7
End If
'==========
' 同花順
'==========
If same = 1 And ss = 1 Then
score = 100
End If
'============
' 同花大順
'============
If same = 1 And ss = 2 Then
score = 500
End If
'==================
' 顯示所得倍數
'==================
Select Case score
Case 1
L9.BackColor = RGB(255, 255, 0)
Lc9.BackColor = RGB(255, 255, 0)
Case 2
L8.BackColor = RGB(255, 255, 0)
Lc8.BackColor = RGB(255, 255, 0)
Case 3
L7.BackColor = RGB(255, 255, 0)
Lc7.BackColor = RGB(255, 255, 0)
Case 5
L6.BackColor = RGB(255, 255, 0)
Lc6.BackColor = RGB(255, 255, 0)
Case 7
L5.BackColor = RGB(255, 255, 0)
Lc5.BackColor = RGB(255, 255, 0)
Case 10
L4.BackColor = RGB(255, 255, 0)
Lc4.BackColor = RGB(255, 255, 0)
Case 40
L3.BackColor = RGB(255, 255, 0)
Lc3.BackColor = RGB(255, 255, 0)
Case 100
L2.BackColor = RGB(255, 255, 0)
Lc2.BackColor = RGB(255, 255, 0)
Case 500
L1.BackColor = RGB(255, 255, 0)
Lc1.BackColor = RGB(255, 255, 0)
Case Else
End Select
End Sub
Private Sub Command2_Click()
Call see_card
End Sub
Private Sub Command3_Click()
'=============
' 看牌作業
'=============
hand = hand + 1
Call clear_text
If hand = 1 Then
Call show_card '第一輪
Command3.Caption = "換牌"
Command6.Enabled = False
Else
Call show_card '第二輪
Call see_card
hand = 0
Command3.Caption = "出牌"
Command6.Enabled = True
Command3.Enabled = False
End If
End Sub
Sub show_card()
Dim temp As Integer
temp = 0
' 蓋牌
For i = 0 To 4
If h(i) = 0 Then
temp = temp + 1
Card(i).Value = 0
End If
Next i
' 顯示牌
For i = 0 To 4
If h(i) = 0 Then
flag = flag + 1
a(i) = poker(flag)
Card(i).Suit = a(i) \ 13 + 1
Card(i).Value = a(i) Mod 13 + 1
Call Delay
End If
Next i
End Sub
Private Sub Command4_Click()
'==============
' 程式結束
'==============
End
End Sub
Private Sub Command5_Click()
'================
' 換牌背面花色
'================
Static switch As Integer
switch = switch + 1
If switch > 65 Then switch = 53
If switch < 53 Then switch = 53
For i = 0 To card_number - 1
Card(i).CardBackStyle = switch
Next i
End Sub
Private Sub Command6_Click()
Command3.Enabled = True
Call Form_Load
Call Command3_Click
End Sub
Private Sub Command7_Click()
'============
' 測試牌
'============
poker(1) = 0
poker(2) = 9
poker(3) = 10
poker(4) = 24
poker(5) = 12
flag = 0
End Sub
Private Sub Form_Load()
'===================
' 程式起始設定
'===================
Randomize Timer '設定亂數種子
'
' 設定樸克牌的初值(測試用)
'
Call wash
flag = 0
hand = 0
card_number = 5
Command3.Enabled = True
'
' 清除按鈕標題
'
For i = 0 To card_number - 1
ho(i).Caption = ""
h(i) = 0
Next i
'
' 顯示牌背
'
For i = 0 To card_number - 1
Card(i).Value = 0
Next i
End Sub
Public Sub Delay()
'==================
' 延時程式
'==================
Dim x As Long
For x = 1 To 10000000
x = x + 1
Next x
End Sub
1 則留言:
hi
可以問你一下
樸克牌程式您是用Visual Studio 2008
的windows form應用程式嗎??
張貼留言