これをExcelに打ち込むとポーカーになります。

2007年03月07日 23時28分51秒 | 日記風
しかし長い。。。

Sub CommandButton1_Click()
'ホールドの表示
If Cells(14, 2).Value = "hold" Then
Cells(14, 2).Value = ""
Else
Cells(14, 2).Value = "hold"
End If
End Sub
Private Sub CommandButton2_Click()
If Cells(14, 4).Value = "hold" Then
Cells(14, 4).Value = ""
Else
Cells(14, 4).Value = "hold"
End If
End Sub
Private Sub CommandButton3_Click()
If Cells(14, 6).Value = "hold" Then
Cells(14, 6).Value = ""
Else
Cells(14, 6).Value = "hold"
End If
End Sub
Private Sub CommandButton4_Click()
Dim a As Variant

If Cells(14, 8).Value = "hold" Then
Cells(14, 8).Value = ""
Else
Cells(14, 8).Value = "hold"
End If
End Sub
Private Sub CommandButton5_Click()
If Cells(14, 10).Value = "hold" Then
Cells(14, 10).Value = ""
Else
Cells(14, 10).Value = "hold"
End If
End Sub

Private Sub CommandButton6_Click()
'はじめ!のボタン操作

'変数の表示//////
'乱数の受け皿
Dim a(5) As Integer
'トランプの数字の受け皿
Dim num(5) As Integer
'マークの受け皿
Dim su(5) As String
'5枚の手数を引くカウントの受け皿
Dim t As Integer


If (Cells(1, 8) = 0) Then
Cells(1, 8).Value = 1
Else
End
End If

'変数の初期化(カードの選択)
For t = 1 To 5
a(t) = 0
Next t

'hold表示の初期化
For t = 1 To 5
Cells(14, 2 * t).Value = ""
Next t

'カードの選択///////////
For t = 1 To 5
'乱数発生
a(t) = Int(Rnd * 52) + 1


'同様カードを排除
'一緒であるなら、引き直しをする。

If t = 2 Then
If a(1) = a(2) Then
t = t - 1
End If
End If

If t = 3 Then
If a(3) = a(2) Or a(3) = a(1) Then
t = t - 1
End If
End If

If t = 4 Then
If a(4) = a(3) Or a(4) = a(2) Or a(4) = a(1) Then
t = t - 1
End If
End If


If t = 5 Then
If a(5) = a(4) Or a(5) = a(3) Or a(5) = a(2) Or a(5) = a(1) Then
t = t - 1
End If
End If

'//////////////////

'数字a(t)⇒数(num)とマーク(su)に。///////////

If a(t) Mod 4 = 0 Then
su(t) = "スペード"
Else
If a(t) Mod 4 = 1 Then
su(t) = "くらぶ"
Else

If a(t) Mod 4 = 2 Then
su(t) = "ハート"

Else
su(t) = "ダイア"

End If
End If
End If
If a(t) Mod 4 = 0 Then
num(t) = Int(a(t) / 4)
Else
num(t) = Int(a(t) / 4) + 1
End If

Cells(6, 2 * t).Value = su(t)
Cells(7, 2 * t).Value = num(t)
Cells(8, 2 * t) = a(t)
Next t

End Sub

Private Sub CommandButton7_Click()
'次のボタン
'各種変数の設定//////
Dim a(5) As Integer
Dim num(5) As Integer
Dim su(5) As String
'並び替えのえさ
Dim sou(5) As Integer
Dim esa(5) As Integer
Dim hokan1 As Integer
Dim hokan2 As Integer
Dim n As Integer

'5枚の手数を引くカウントの受け皿
Dim t As Integer
'ペアーカードのネタのための引数
Dim pair As Integer
'スリーカードのえさ
Dim thr As Integer
'フラッシュのえさ
Dim fla As Integer
'ストレートのえさ
Dim str As Integer
'ポイントのえさ
Dim add As Integer
Dim point As Integer

'///////////
'2 回以上の変更の防止
If Cells(1, 8).Value = 0 Then
MsgBox ("すでにゲームは終わっています。")
End
Else
Cells(1, 8).Value = 0
End If


add = Cells(3, 9).Value
point = Cells(5, 4).Value
'元の数値の置き換え///////
For t = 1 To 5
a(t) = Cells(8, 2 * t)
Next t

'カードの選択/////////////
'HOLDを変更しない分
For t = 1 To 5
If Cells(14, 2 * t) = "hold" Then
a(t) = a(t)
Else
'乱数発生
a(t) = Int(Rnd * 52) + 1
End If

'同様カードを排除
If t = 1 Then
If a(1) = a(2) Or a(1) = a(3) Or a(1) = a(4) Or a(1) = a(5) Then
t = t - 1
End If
End If

If t = 2 Then
If a(1) = a(2) Or a(2) = a(3) Or a(2) = a(4) Or a(2) = a(5) Then
t = t - 1
End If
End If

If t = 3 Then
If a(3) = a(2) Or a(3) = a(1) Or a(3) = a(4) Or a(3) = a(5) Then
t = t - 1
End If
End If

If t = 4 Then
If a(4) = a(3) Or a(4) = a(2) Or a(4) = a(1) Or a(4) = a(5) Then
t = t - 1
End If
End If


If t = 5 Then
If a(5) = a(4) Or a(5) = a(3) Or a(5) = a(2) Or a(5) = a(1) Then
t = t - 1
End If
End If

'スーツの確定
If a(t) Mod 4 = 0 Then
su(t) = "スペード"
Else
If a(t) Mod 4 = 1 Then
su(t) = "くらぶ"
Else

If a(t) Mod 4 = 2 Then
su(t) = "ハート"

Else
su(t) = "ダイア"

End If
End If
End If

'ナンバーの確定
If a(t) Mod 4 = 0 Then
num(t) = Int(a(t) / 4)
Else
num(t) = Int(a(t) / 4) + 1
End If

Cells(6, 2 * t).Value = su(t)
Cells(7, 2 * t).Value = num(t)
Next t

'////////////
'数のソート
'最小値を探す⇒最小値じゃない数を代入(15)⇒も一回最小値を探す。

'ソート用データに転送
For t = 1 To 5
esa(t) = num(t)
Next t

'5回最小値探しをする。
For n = 1 To 5
hokan1 = 25
'最小値探しのブロック
For t = 1 To 5
If esa(t) <hokan1 Then hokan2 = t
End If
Next t
'最小値を転機しつつ、怪しい数値(15)を代入
sou(n) = hokan1
esa(hokan2) = 15
Next n

'///////////////
'thr フォー・スリーカードのカウント
'スリーカード
For t = 1 To 3
If sou(t) = sou(t + 1) And sou(t) = sou(t + 2) Then
thr = 1
End If
Next t

'フォーカード
For t = 1 To 2
If sou(t) = sou(t + 1) And sou(t + 1) = sou(t + 2) And sou(t + 2) = sou(t + 3) Then
thr = 2
End If
Next t

'フルハウス判定
If sou(1) = sou(2) And sou(2) = sou(3) And sou(4) = sou(5) Then
thr = 3
End If

If sou(1) = sou(2) And sou(3) = sou(4) And sou(4) = sou(5) Then
thr = 3
End If



'///////////////
'pair 数のカウント
pair = 0
For t = 1 To 4
If sou(t) = sou(t + 1) Then
pair = pair + 1
End If
Next t

'//////////////////////
'ストレートの判定
str = 0
If sou(2) = sou(1) + 1 And sou(3) = sou(1) + 2 And sou(4) = sou(1) + 3 And sou(5) = sou(1) + 4 Then
str = 1
End If
If sou(1) = 1 And sou(2) = 10 And sou(3) = 11 And sou(4) = 12 And sou(5) = 13 Then
str = 2
End If

'////////////////
'フラッシュの判定
fla = 0
If su(1) = su(2) And su(2) = su(3) And su(3) = su(4) And su(4) = su(5) Then
fla = 1
End If

'////////////////////
'役の判定
If (fla = 1) Then
If (str = 2) Then
Cells(1, 4).Value = "ロイヤルストレートフラッシュ!!!"
Cells(3, 4).Value = add * 500
ElseIf (str = 1) Then
Cells(1, 4).Value = "ストレートフラッシュ!!"
Cells(3, 4).Value = add * 250
Else
Cells(1, 4).Value = "フラッシュ!"
Cells(3, 4).Value = add * 25
End If
End If

If (str = 1 Or str = 2) And (fla = 0) Then
Cells(1, 4).Value = "ストレート!"
Cells(3, 4).Value = add * 10
End If
If (str = 0 And fla = 0) Then
If thr = 3 Then
Cells(1, 4).Value = "フルハウス!"
Cells(3, 4).Value = add * 50
ElseIf thr = 2 Then
Cells(1, 4).Value = "フォーカード!"
Cells(3, 4).Value = add * 100
ElseIf thr = 1 Then
Cells(1, 4).Value = "スリーカード"
Cells(3, 4).Value = add * 5
ElseIf (pair = 2) Then
Cells(1, 4).Value = "ツーペアー"
Cells(3, 4).Value = add * 2

ElseIf (pair = 1) Then
Cells(1, 4).Value = "ワンペアー"
Cells(3, 4).Value = add * 1
Else
Cells(1, 4).Value = "残念。"
Cells(3, 4).Value = add * 0
End If
End If
Cells(5, 4).Value = point + Cells(3, 4).Value - add
Cells(12, 2) = fla
Cells(12, 3) = str
Cells(12, 4) = thr
Cells(12, 5) = pair
End Sub

最新の画像もっと見る

コメントを投稿