オートモンテカルロ、参考ソース への返答
投稿で使用できる特殊コードの説明。(別タブで開きます。)
以下の返答は逆順(新しい順)に並んでいます。
投稿者 shu (社会人)
投稿日時
2013/11/7 08:07:57
一応コメント
クラスや構造体のメンバ変数(フィールド）定義は
DimではなくPrivate,Protected,Friend,Publicで定義した方が
どこまで公開しているのかが分かりやすくなります。
クラスや構造体のメンバ変数(フィールド）定義は
DimではなくPrivate,Protected,Friend,Publicで定義した方が
どこまで公開しているのかが分かりやすくなります。
投稿者 HiDE-Ada (社会人)
投稿日時
2013/11/5 02:50:34
記述漏れがありました＾＾；
手順の３．Form1のBackColorをWebのLimeGreenとする。
として下さい。
設定しなくても、動作には問題ないのですが見た目が＾＾；
手順の３．Form1のBackColorをWebのLimeGreenとする。
として下さい。
設定しなくても、動作には問題ないのですが見た目が＾＾；
投稿者 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: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: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:35:02
トランプゲーム、モンテカルロのオート版のソースを公開します。
投稿プログラムとしてでもいいんですが、それほどのものでも
ないので＾＾；
手順
１．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
投稿プログラムとしてでもいいんですが、それほどのものでも
ないので＾＾；
手順
１．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
Public Class Form1
Dim card As clsCard
Dim selcard(1) As Integer
Dim selindex As Integer
Dim selflg As Boolean
Dim score As Integer = 0
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
card = New clsCard
clsField.offset = 154
selcard(0) = -1
selcard(1) = -1
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
score = 0
nextStage()
End Sub
Private Sub nextStage()
card.reset()
card.shuffle()
clsField.setup(card)
selindex = 0
selflg = False
selcard(0) = -1
Label1.Text = score.ToString
Me.Refresh()
End Sub
Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseDown
Dim xp As Integer
Dim yp As Integer
If clsField.isFailed Then Exit Sub
Dim index As Integer = clsField.calcPos(e.X, e.Y, xp, yp)
If index < 0 Then Exit Sub
If Not selflg Then
If clsField.cardon(index) Then
selflg = True
selindex = 0
selcard(0) = index
Using g As Graphics = Me.CreateGraphics
clsField.drawone(g, index, True)
End Using
End If
Else
If index = selcard(selindex) Then
selflg = False
selcard(selindex) = -1
Using g As Graphics = Me.CreateGraphics
clsField.drawone(g, index, False)
End Using
Else
Dim xx As Integer = selcard(selindex) Mod 5
Dim yy As Integer = selcard(selindex) \ 5
selindex = 1 - selindex
selcard(selindex) = index
If Math.Abs(xp - xx) <= 1 AndAlso Math.Abs(yp - yy) <= 1 _
AndAlso clsField.judge(selcard) Then
clsField.discard(selcard)
clsField.drawcard(card)
selflg = False
selcard(selindex) = -1
score += 3
Label1.Text = score.ToString
If card.restCard() <= 0 AndAlso Not clsField.cardon(0) Then
nextStage()
Else
clsField.checkFail()
End If
Me.Refresh()
Else
Using g As Graphics = Me.CreateGraphics
clsField.drawone(g, selcard(1 - selindex), False)
clsField.drawone(g, index, True)
selcard(1 - selindex) = -1
End Using
End If
End If
End If
End Sub
Private Sub Form1_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint
Using g As Graphics = Me.CreateGraphics
clsField.draw(g, selcard(selindex))
End Using
End Sub
End Class
特にクラス変数をDim宣言するのは、よくないですね。
次回掲載時は、注意します。
コメント、ありがとうございます。