オートモンテカルロ、参考ソース
投稿者 HiDE-Ada (社会人)
投稿日時
2013/11/5 02:36:21
続き
clsCard.vb
clsCard.vb
Public Class clsCard
Public Structure typCard
Dim mark As String
Dim num As Integer
Dim img As Bitmap
End Structure
Public Enum enMark
SPADE = 0
DIA
CLOVER
HEART
End Enum
Public cardMark() As String = {"s", "d", "c", "h"}
Private cardList(51) As typCard
Private index As Integer
Sub New()
index = 0
Dim n As Integer = 0
For m As Integer = enMark.SPADE To enMark.HEART
For i As Integer = 1 To 13
cardList(n).mark = cardMark(m)
cardList(n).num = i
cardList(n).img = My.Resources.ResourceManager.GetObject(String.Format("{0}{1:00}", cardMark(m), i))
n += 1
Next
Next
End Sub
Public Sub shuffle()
Dim rnd As New Random
For i As Integer = cardList.Length - 1 To 1 Step -1
Dim x As Integer = rnd.Next(i)
Dim tmp As typCard = cardList(i)
cardList(i) = cardList(x)
cardList(x) = tmp
Next
End Sub
Public Sub reset()
index = 0
End Sub
Public Function nextCard() As typCard
Dim ret As typCard = New typCard
ret.num = -1
If index < cardList.Length Then
ret = cardList(index)
index += 1
End If
Return ret
End Function
Public Function restCard() As Integer
Return 52 - index
End Function
End Class
投稿者 HiDE-Ada (社会人)
投稿日時
2013/11/5 02:45:27
続き
clsField.vb
clsField.vb
Public Class clsField
Private Const CARD_WIDTH As Integer = 80
Private Const CARD_HEIGHT As Integer = 120
Public Shared offset As Integer = 0
Private Shared field(24) As clsCard.typCard
Private Shared nonbrush As Drawing.Brush = Drawing.Brushes.LimeGreen
Private Shared selpen As Drawing.Pen = New Pen(Color.Red, 3.0)
Private Shared failed As Boolean = False
Shared Sub setup(ByVal card As clsCard)
failed = False
Dim index As Integer = 0
For y As Integer = 0 To 4
For x As Integer = 0 To 4
field(index) = card.nextCard
index += 1
Next
Next
End Sub
Shared Sub draw(ByVal g As Graphics, ByVal selpnt As Integer)
Dim idx As Integer = 0
Dim yp As Integer = 10
Dim xp As Integer
For y As Integer = 0 To 4
xp = 10
For x As Integer = 0 To 4
If field(idx).num > 0 Then
g.DrawImage(field(idx).img, New Rectangle(xp + offset, yp, CARD_WIDTH, CARD_HEIGHT))
End If
xp += 84
idx += 1
Next
yp += 124
Next
If selpnt <> -1 Then
xp = (selpnt Mod 5) * CARD_WIDTH + 10
yp = (selpnt \ 5) * CARD_HEIGHT + 10
g.DrawRectangle(selpen, xp - 2 + offset, yp - 2, CARD_WIDTH + 4, CARD_HEIGHT + 4)
End If
If failed Then
drawFailed(g)
End If
End Sub
Shared Sub drawFailed(ByVal g As Graphics)
g.DrawString("FAILED!!", New Font("Arial Black", 48), Brushes.Yellow, New Point(offset + 60, 280))
End Sub
Shared Sub discard(ByVal pnt() As Integer)
Dim tmp As Integer = pnt(0)
If pnt(1) < pnt(0) Then
pnt(0) = pnt(1)
pnt(1) = tmp
End If
Dim i As Integer
For i = pnt(1) To 23
field(i) = field(i + 1)
Next
field(24).num = -1
For i = pnt(0) To 23
field(i) = field(i + 1)
Next
field(24).num = -1
End Sub
Shared Sub drawcard(ByVal card As clsCard)
For i As Integer = 23 To 24
field(i) = card.nextCard
Next
End Sub
Shared Function judge(ByVal pnt() As Integer) As Boolean
Dim ret As Boolean = False
If field(pnt(0)).num = field(pnt(1)).num Then
ret = True
End If
Return ret
End Function
Shared Function isFailed() As Boolean
Return failed
End Function
Shared Function checkFail() As Boolean
Dim tmp(6, 6) As Integer
Dim idx As Integer
Dim x As Integer = 1
Dim y As Integer = 1
Dim n As Integer
idx = 0
For y = 1 To 5
For x = 1 To 5
tmp(x, y) = field(idx).num
idx += 1
Next
Next
For y = 1 To 5
For x = 1 To 5
n = tmp(x, y)
If n <= 0 Then
failed = True
Return True
End If
If n = tmp(x - 1, y) OrElse n = tmp(x + 1, y) _
OrElse n = tmp(x - 1, y - 1) OrElse n = tmp(x, y - 1) OrElse n = tmp(x + 1, y - 1) _
OrElse n = tmp(x - 1, y + 1) OrElse n = tmp(x, y + 1) OrElse n = tmp(x + 1, y + 1) Then
Return False
End If
Next
Next
failed = True
Return True
End Function
Shared Sub drawone(ByVal g As Graphics, ByVal idx As Integer, ByVal sel As Boolean)
Dim xp As Integer = (idx Mod 5) * (CARD_WIDTH + 4) + 10
Dim yp As Integer = (idx \ 5) * (CARD_HEIGHT + 4) + 10
g.FillRectangle(nonbrush, xp - 3 + offset, yp - 3, CARD_WIDTH + 6, CARD_HEIGHT + 6)
If field(idx).num > 0 Then
g.DrawImage(field(idx).img, New Rectangle(xp + offset, yp, CARD_WIDTH, CARD_HEIGHT))
If sel Then
g.DrawRectangle(selpen, xp - 1 + offset, yp - 1, CARD_WIDTH + 1, CARD_HEIGHT + 1)
End If
End If
End Sub
投稿者 HiDE-Ada (社会人)
投稿日時
2013/11/5 02:46:56
clsField.vbの続き
カードの表示はPictureboxを使わずに描画しています。
clsFieldクラスがSharedばかりなのは、ちょっとわけたかっただけです。
モジュールでも、Form1.vbに記述してもよいルーチンばかりです。
つっこみ満載だと思います＾＾；
Shared Function cardon(ByVal idx As Integer) As Boolean
Return field(idx).num <> -1
End Function
Shared Function calcPos(ByVal x As Integer, ByVal y As Integer, ByRef xp As Integer, ByRef yp As Integer) As Integer
Dim idx As Integer = -1
x = x - offset
If x < 10 OrElse 84 * 5 + 10 <= x _
OrElse y < 10 OrElse 124 * 5 + 10 <= y Then Return idx
xp = CInt((x - 10) \ (CARD_WIDTH + 4))
yp = CInt((y - 10) \ (CARD_HEIGHT + 4))
idx = yp * 5 + xp
Return idx
End Function
End Class
カードの表示はPictureboxを使わずに描画しています。
clsFieldクラスがSharedばかりなのは、ちょっとわけたかっただけです。
モジュールでも、Form1.vbに記述してもよいルーチンばかりです。
つっこみ満載だと思います＾＾；
投稿者 HiDE-Ada (社会人)
投稿日時
2013/11/5 02:50:34
記述漏れがありました＾＾；
手順の３．Form1のBackColorをWebのLimeGreenとする。
として下さい。
設定しなくても、動作には問題ないのですが見た目が＾＾；
手順の３．Form1のBackColorをWebのLimeGreenとする。
として下さい。
設定しなくても、動作には問題ないのですが見た目が＾＾；
投稿者 shu (社会人)
投稿日時
2013/11/7 08:07:57
一応コメント
クラスや構造体のメンバ変数(フィールド）定義は
DimではなくPrivate,Protected,Friend,Publicで定義した方が
どこまで公開しているのかが分かりやすくなります。
クラスや構造体のメンバ変数(フィールド）定義は
DimではなくPrivate,Protected,Friend,Publicで定義した方が
どこまで公開しているのかが分かりやすくなります。
投稿者 HiDE-Ada (社会人)
投稿日時
2013/11/7 18:25:19
ご指摘のとおりですね。
特にクラス変数をDim宣言するのは、よくないですね。
次回掲載時は、注意します。
コメント、ありがとうございます。
特にクラス変数をDim宣言するのは、よくないですね。
次回掲載時は、注意します。
コメント、ありがとうございます。
投稿プログラムとしてでもいいんですが、それほどのものでも
ないので＾＾；
手順
１．Windowsフォームアプリケーションのプロジェクトを作成する。
２．Form1のSizeをWidth=600、Height=680以上とする。
３．Form1のBackColorを
４．ButtonコントロールをButton1として追加する。（必須）
５．LabelコントロールをLabel1として追加する。（必須）
６．クラスファイルclsCard.vb、clsField.vbを追加する。
７．それぞれのファイルに以下のソースを貼り付ける。
８．トランプカードのデータを
http://sozai.7gates.net/docs/trump/
からダウンロードして、リソースとして追加する。
９．ビルドして問題なければ、完了
Form1.vb