クラスモジュールとコレクションを使ったゲームを作りたいですけど．．
今、大学のプロジェクトの一環で、クラスモジュールとコレクションを利用したBINGOゲームを作ろうかと思っています。が、初心者な自分はクラスモジュールとコレクションがイマイチ分りません。詳しく説明したサイトなど有りましたら教えていただきたいな思います。参考になるサンプルソースの紹介などあったら最高です。
ゲームの概略は
縦列と横列のマスの数をテキストボックスで入力（例、縦４マス横５マスとか）
各マスにランダムで１〜99までの数字を配列（arrayかな？）
コマンドボタンで、ランダムに番号を抽出
該当すればコレクションに収めて、縦もしくは横が揃えばBINGO！
全部のマスが埋まるまで、継続して全部の数が揃えばフルハウス！
ゲーム終了
注意、番号抽出はランダムで、当然二度と同じ番号は出てはいけない。
長くなりましたが、宜しくお願いします。
> 初心者な自分はクラスモジュールとコレクションがイマイチ分りません。
参考になるかも。わたしは最初、読んでもわかりませんでしたけどね^^;
http://homepage1.nifty.com/CavalierLab/lab/vb/clsmdl/
コレクションは、要素の名前に、
文字列をつけられるぐらいで、配列と大差はなかったと思います。
サンプルもあんまり見かけませんね。
配列の使い方がわかれば、問題ないということでしょうか？
> 注意、番号抽出はランダムで、当然二度と同じ番号は出てはいけない。
この方法は正攻法じゃないと思いますけど、わたしはこんな方法でやりました。
1.ランダムで数字を出す。その数字を、文字列にして用意した変数に追加
2.区切り文字を文字列変数に追加
3.新しい数字を出したときに、文字列を検索して、重複があったらやり直し
こんな感じです。
文字列変数に、1が出たら"1|"、次2がでたら、それに追加して"1|2|"
とやっていって、
ランダムで数字を出すたびに、この変数の中に、それと同じものが含まれているかどうかを調べます。
もしあったら、もう一度ランダムで数字を出しなおします。
こんなのでどうでしょうか？
> 注意、番号抽出はランダムで、当然二度と同じ番号は出てはいけない。
シャッフルですね。
古典ですが，
Dim array(1 To 99) As Integer
Dim i As Integer, j As Integer, Temp As Integer
' 初期化
For i = 1 To 99
array(i) = i
Next i
' シャッフル
For i = 1 To 99
j = Int(Rnd() * 99) + 1 ' 数値をひとつ選ぶ
'入れ替え
Temp = array(j)
array(j) = array(i)
array(i) = Temp
Next i
なんてのはどうでしょう。
コレクションの例（固定値の場合）
Const 値_01 as Long = 128
Const 値_02 as Long = 256
Const 値_03 as Long = 512
Const 値_04 as Long = 4096512
Dim Myクラス as New 自作クラス
Dim col As Collection
Dim itm As Variant
Set col = New Collection ’コレクションの追加
col.Add 値_01
col.Add 値_02
col.Add 値_03
col.Add 値_04
For Each itm In col ’コレクションの中身を取り出しつつ、クラス側で別処理
Call Myクラス.NEW_SET_NAME(設定_01, 設定_02, 設定_03, _
設定_04, itm, "CODE1")
Next
Set col = Nothing ’コレクションの開放（コレやらないと値が残ります）
Set Myクラス = Nothing
コレクションが変動値の場合は、ForやDoで値の入力可
皆さんお早いアドバイスありがとうございます。
追加項目をここであげたいなと思います。
１．縦マスの数1〜４まで、横マスの数1〜5まで、テキストボックスにプレイヤーが入力して、コマンドボタンでBINGOカードを随時作成するのですが、何と！一つのラベルの中に、個々の数字を配列していかなくてはなりません．．．．．これも課題のうちの一つで、簡単に表示する方法はありませんか？
例）縦３、横３とテキストボックスに入力した場合
３×３で合計９マスのカードが作成されます。この９マスの中に数字を入れていき、一つのラベルに表示しなければなりません．．．．
３ ４５ ５６
７６ ８２ ９８
１６ ３４ ５０
こんな感じにラベル一つに表示させるにはどうしたらよいのでしょうか？
２、クラスモジュールは全部で３つになり構成されなくてはなりません。
一つ目はBingoCard=CheckCall(Value)AnyLineCovered()CardCovered()
二つ目はBingoLine=CheckCall(Value)LineCovered()
三つ目はBingoNumber=CheckCall(Value)
こんな感じになります。
この場合、どこのクラスモジュールに、Arrayやコレクションを持っていけばよいのか分りません。
かなり込み入った内容になりますが、ご指導の程お願いします。
>一つのラベルに表示
Dim Name_01, Name_02, Name_03 As String
Name_01 = Text1.Text & " " & Text11.Text
Name_02 = Text2.Text & " " & Text22.Text
Name_03 = Text3.Text & " " & Text33.Text
Label1.Caption = Name_01 & vbCrLf & Name_02 & vbCrLf & Name_03
>どこのクラスモジュールに、Arrayやコレクションを持っていけばよいのか
作り手の自由だと思いますが？
まず、クラスの役割を理解しなければ答えは出ないかと思います。
BingoCard、BingoLine、BingoNumber
それぞれに何をさせるべきなのか考えましょう。
あんちゃんさま、アドバイスありがとう御座います。
BINGOカードを作るコマンドボタンのソースを自分なりに作ってみましたが、
いまいちアドバイスの内容が分りません……Text11？Text22？Text33？
以下に記しますんで、Label1.Captionの所にどうやったら、該当する数字全部を綺麗に並べることが出来るのでしょうか？？
すみませんアドバイスお願いします。
Private Sub Command1_Click()
Dim intNum As Integer
If Not IsNumeric(Text1) Then
MsgBox "数字１〜４を入力して下さい", vbOKOnly, "error"
Exit Sub
End If
If Not IsNumeric(Text2) Then
MsgBox "数字１〜５を入力して下さい", vbOKOnly, "error"
Exit Sub
End If
If (Val(Text1.Text) <= 4) And (Val(Text2.Text) <= 5) Then
mintLaw = Val(Text1.Text)
mintCol = Val(Text2.Text)
intNum = mintLaw * mintCol
Dim ary(1 To 99) As Integer
Dim i As Integer, j As Integer, Temp As Integer
' 初期化
For i = 1 To 99
ary(i) = i
Next i
' シャッフル
For i = 1 To intNum
j = Int(Rnd() * 99) + 1 ' 数値をひとつ選ぶ
'入れ替え
Temp = ary(j)
ary(j) = ary(i)
ary(i) = Temp
Label1.Caption = ary(i)
Next i
Label1.Caption = ary(i)を以下のように書き換えるのはいかがでしょう？
Dim 出力用 As String
if i mod 3 then
出力用 = 出力用 & ary(i) & vbcrlf
else
出力用 = 出力用 & ary(i) & " " ' " "はスペース
end if
Next i
Label1.Caption = 出力用
あんちゃんさま、返信ありがとう御座います。
アドバイス通り自分なりにやってみたのですが、あんちゃんさまのプログラムだと、縦に数字が並んでいき一定の数（３）になると、次の列に数字が並ぶようになってるみたいですが、実際は３の次に１個だけが横に並んで、次の数字からは一列目の下に並んでしまいます．．．．．
縦マス３、横マス３と指定した場合
７０
５６
５８ ４５
８８
３４
２２ １４
３５
こんな感じになってしまいます．．．．．
今度は自分なりにあんちゃんさんのプログラムを改善して、横列に数字を並べていき、一定の数（テキストボックスに入力された横マスの数）になったら、下の列に改行していく方法にしました。そこで問題が発生しました。
例えば縦３、横３にした場合、最初の横マス３は（i）から取得できるのですが、次の３個目（プログラム上は６）の取得が出来ません。つまり２列目の折り返しが出来ないのです。
７０ ５８ ５６
３４ ７８ ２４ １３ ５９ ２３
となってしまいます．．．．．
この場合、どういうふうにすればいいのでしょうか？？
プログラムは以下のとうりです。
Private Sub Command1_Click()
Dim intNum As Integer
'Dim i As Integer
Dim 出力用 As String
If Not IsNumeric(Text1) Then
MsgBox "Please enter a number for the raws", vbOKOnly, "error"
Exit Sub
End If
If Not IsNumeric(Text2) Then
MsgBox "Please enter a number for the column", vbOKOnly, "error"
Exit Sub
End If
If (Val(Text1.Text) <= 4) And (Val(Text2.Text) <= 5) Then
mintLaw = Val(Text1.Text)
mintCol = Val(Text2.Text)
intNum = mintLaw * mintCol
Dim ary(1 To 99) As Integer
Dim i As Integer, j As Integer, Temp As Integer
' 初期化
For i = 1 To 99
ary(i) = i
Next i
' シャッフル
For i = 1 To intNum
j = Int(Rnd() * 99) + 1 ' 数値をひとつ選ぶ
'入れ替え
Temp = ary(j)
ary(j) = ary(i)
ary(i) = Temp
If i = mintLaw Then
出力用 = 出力用 & ary(i) & vbCrLf
Else
出力用 = 出力用 & ary(i) & " " ' " "はスペース
End If
Label1.Caption = 出力用
Next i
Else
MsgBox "The number is error"
Exit Sub
End If
End Sub
自分なりにこうやってみましたがどうでしょうか？
For i = 1 To intNum
j = Int(Rnd() * 99) + 1 ' 数値をひとつ選ぶ
'入れ替え
Temp = ary(j)
ary(j) = ary(i)
ary(i) = Temp
'Label1.Caption = ary(i)
If i = mintLaw Or i = mintLaw * 2 Or i = mintLaw * 3 Or i = mintLaw * 4 Then
出力用 = 出力用 & ary(i) & vbCrLf
Else
出力用 = 出力用 & ary(i) & " " ' " "はスペース
End If
Label1.Caption = 出力用
Next i
今度はBINGOカードの中の数字をコレクションに入れていきたいのですが、ここで分らないのが、コレクションの中に入れた数字に対して、横列が揃った場合BINGOになるのですが、横列は２〜５まで条件が変わります。どうしたらランダムに抽出した数字をプログラム上で確認しながらBINGOを確定させる事が出来るのでしょうか？
宜しくお願いします。
訂正
Dim 出力用 As String
if i mod 3 = 0 then
出力用 = 出力用 & ary(i) & vbcrlf
else
出力用 = 出力用 & ary(i) & " " ' " "はスペース
end if
Next i
Label1.Caption = 出力用
>ランダムに抽出した数字をプログラム上で確認
□□□ ＜−−イメージはこんな感じでしょうか
□□□
□□□
□□
□□
３×３、２×２の場合（それ以外も）でも
配列やコレクションの位置から
構造を取得するのは可能です。
配列と変数を使えば出来ますよ。
あんちゃんさま返信ありがとう御座います。
イメージはまったくその通りです！
そのイメージの横列のみ、確認していき一つでも列が揃えばBINGOです。さらにゲームは継続され、全部の数字が揃えばフルハウスで、ゲーム終了になります。
配列と変数を使えば出来るとの事ですが、具体的な例を上げていただけないでしょうか？お手数掛けてしまうかもしれませんが、個人的にいきなりこのようなプログラムの課題を受けてしまい、一人苦労しています……
課題は試行錯誤しながら作成するのが大切だと思いますが・・・
具体的なら例です
縦横のチェックはこんな感じに出来ます。
少しテストしただけなので不具合があるかも(;^_^A
コードの解説はしません。
実行して参考になる動きであれば解析してみて下さいm(_ _)m
・使用数字1〜99
・縦横は同じ数字で変更可(2〜9)(初期表示は5)
・ラインは縦横斜め
・縦横が3,5,7,9の場合、真ん中はFree
使用モジュール
フォームモジュール２つ(Form1,Form2)
クラスモジュール２つ(Class1,Class2)
Form1配置コントロール
テキストボックス１つ(Text1)
リストボックス１つ(List1)
コマンドボタン２つ(Command1,Command2)
**********Form1コード**********
Option Explicit
Private clsNo As Class1
Private clsBingoForm As Class2
Private colBingoForms As Collection
Private Sub Command1_Click()
For Each clsBingoForm In colBingoForms
If Text1.Text Like "[2-9]" Then clsBingoForm.RowCol = CLng(Text1.Text)
clsBingoForm.SheetChange
Next clsBingoForm
clsNo.Clear
List1.Clear
End Sub
Private Sub Command2_Click()
Dim lNo As Long
lNo = clsNo.GetNo
If lNo > 0 Then
List1.AddItem Format(lNo, "@@@")
List1.ListIndex = List1.ListCount - 1
List1.Refresh
For Each clsBingoForm In colBingoForms
clsBingoForm.AddNo lNo
Next clsBingoForm
End If
End Sub
Private Sub Form_Load()
Set clsNo = New Class1
Set colBingoForms = New Collection
Call Init
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim i As Long
For i = 1 To colBingoForms.Count
colBingoForms.Remove 1
Next i
Set colBingoForms = Nothing
Set clsNo = Nothing
Set Form1 = Nothing
End Sub
Private Sub Init()
Dim i As Long
Me.Move 0, 0, 2000, 2000
List1.Move 0, 0, 600, 1500
Text1.Move List1.Left + List1.Width, 0, 1200, 500
Command1.Move List1.Left + List1.Width, Text1.Top + Text1.Height, 1200, 500
Command2.Move List1.Left + List1.Width, Command1.Top + Command1.Height, 1200, 500
Text1.Text = 5
Command1.Caption = "シート変更"
Command2.Caption = "番号取得"
For i = 0 To 3
Set clsBingoForm = New Class2
clsBingoForm.Show
clsBingoForm.Move 3500 * i, Me.Top + Me.Height, 3500, 3000
colBingoForms.Add Item:=clsBingoForm, Key:=CStr(i)
Set clsBingoForm = Nothing
Next i
End Sub
**********Class1コード**********
Option Explicit
Private mbNoFlg(1 To 99) As Boolean
Private mlNoCnt As Long
Property Get GetNo() As Long
Dim lNo As Long
GetNo = 0
If mlNoCnt >= 99 Then Exit Property
Randomize
Do
lNo = Int((99 * Rnd) + 1)
Loop Until Not mbNoFlg(lNo)
mbNoFlg(lNo) = True
mlNoCnt = mlNoCnt + 1
GetNo = lNo
End Property
Public Sub Clear()
mlNoCnt = 0
Erase mbNoFlg
End Sub
**********Class2コード**********
Option Explicit
Private mlNo() As Long
Private mlColor() As Long
Private mbFlg() As Boolean
Private mlRowCol As Long
Private mlLineCnt As Long
Private WithEvents mFrm As Form
Public Sub Show()
Set mFrm = New Form2
mFrm.Show
End Sub
Public Sub Move(lLeft As Single, lTop As Single, lWidth As Single, lHeight As Single)
If IsForm Then mFrm.Move lLeft, lTop, lWidth, lHeight
End Sub
Public Sub AddNo(lNo As Long)
If IsForm Then Call sCheckNo(lNo)
End Sub
Property Let RowCol(lRowCol As Long)
If 1 < lRowCol And lRowCol < 10 Then mlRowCol = lRowCol
End Property
Public Sub SheetChange()
mlLineCnt = 0
ReDim mlNo(1 To mlRowCol, 1 To mlRowCol)
ReDim mbFlg(1 To mlRowCol, 1 To mlRowCol)
ReDim mlColor(1 To mlRowCol, 1 To mlRowCol)
Call sSheetClear
Call sDsp
End Sub
Private Sub sCheckNo(lNo As Long)
Dim bMatch As Boolean
Dim i&, j&
mlLineCnt = 0
bMatch = False
For i = 1 To mlRowCol
For j = 1 To mlRowCol
If mlNo(i, j) = lNo Then bMatch = True
If bMatch Then Exit For
Next j
If bMatch Then Exit For
Next i
If Not bMatch Then Exit Sub
mbFlg(i, j) = True
mlColor(i, j) = vbBlue
Call sLineCheck
Call sDsp
End Sub
Private Sub sLineCheck()
Dim bVertical As Boolean
Dim bHorizontal As Boolean
Dim bOblique1 As Boolean
Dim bOblique2 As Boolean
Dim i&, j&
bOblique1 = True
bOblique2 = True
For i = 1 To mlRowCol
bVertical = True
bHorizontal = True
For j = 1 To mlRowCol
If Not mbFlg(i, j) Then bVertical = False
If Not mbFlg(j, i) Then bHorizontal = False
Next j
If bVertical Then mlLineCnt = mlLineCnt + 1
If bHorizontal Then mlLineCnt = mlLineCnt + 1
For j = 1 To mlRowCol
If bVertical Then mlColor(i, j) = vbRed
If bHorizontal Then mlColor(j, i) = vbRed
Next j
If Not mbFlg(i, i) Then bOblique1 = False
If Not mbFlg(i, mlRowCol - (i - 1)) Then bOblique2 = False
Next i
If bOblique1 Then mlLineCnt = mlLineCnt + 1
If bOblique2 Then mlLineCnt = mlLineCnt + 1
For i = 1 To mlRowCol
If bOblique1 Then mlColor(i, i) = vbRed
If bOblique2 Then mlColor(i, mlRowCol - (i - 1)) = vbRed
Next i
End Sub
Private Sub sSheetClear()
Dim clsNo As Class1
Dim i&, j&
Set clsNo = New Class1
For i = 1 To mlRowCol
For j = 1 To mlRowCol
mlNo(j, i) = clsNo.GetNo
Next j
Next i
If mlRowCol Mod 2 = 1 Then
i = mlRowCol \ 2 + 1
mlNo(i, i) = -1
mbFlg(i, i) = True
mlColor(i, i) = vbGreen
End If
Set clsNo = Nothing
End Sub
Private Sub sDsp()
Dim i&, j&
If Not IsForm Then Exit Sub
mFrm.Cls
For i = 1 To mlRowCol
For j = 1 To mlRowCol
mFrm.ForeColor = mlColor(i, j)
mFrm.Print IIf(mlNo(i, j) = -1, "Free", Format(mlNo(i, j), "@@@") & Space(1));
Next j
mFrm.Print
Next i
If mlLineCnt > 0 Then
mFrm.Print
mFrm.ForeColor = vbBlack
mFrm.Print Space(5) & CStr(mlLineCnt) & "ライン"
End If
mFrm.Refresh
End Sub
Private Function IsForm() As Boolean
IsForm = Not (mFrm Is Nothing)
End Function
Private Sub Class_Initialize()
RowCol = 5
End Sub
Private Sub Class_Terminate()
If IsForm Then Unload mFrm
End Sub
Private Sub mFrm_Load()
With mFrm
.Font.Name = "ＭＳ ゴシック"
.Font.Size = 9
.AutoRedraw = True
End With
Call SheetChange
End Sub
Private Sub mFrm_Unload(Cancel As Integer)
Set mFrm = Nothing
End Sub
あき☆彡さん返信ありがとう御座います。
今、一生懸命自分なりに解析してますが、ビンゴカードを作る過程で、Class1とClass2を行き来する文があります。ここでビンゴカードを作っているのだなという事は分かっているのですが、何故？Class1とClass２を行き来させなければいけない理由が分かりません。
この質問で大丈夫でしょうか？
アドバイスお願いします。
Class2のビンゴカードを作るところの文
Private Sub sSheetClear()
Dim clsNo As Class1
Dim i&, j&
Set clsNo = New Class1
For i = 1 To mlRowCol
For j = 1 To mlRowCol
mlNo(j, i) = clsNo.GetNo
Next j
Next i
If mlRowCol Mod 2 = 1 Then
i = mlRowCol \ 2 + 1
mlNo(i, i) = -1
mbFlg(i, i) = True
mlColor(i, i) = vbGreen
End If
Set clsNo = Nothing
End Sub
Class1のビンゴカードを作るところの文
Property Get GetNo() As Long
Dim lNo As Long
GetNo = 0
If mlNoCnt >= 99 Then Exit Property
Randomize
Do
lNo = Int((99 * Rnd) + 1)
Loop Until Not mbNoFlg(lNo)
mbNoFlg(lNo) = True
mlNoCnt = mlNoCnt + 1
GetNo = lNo
End Property
この文でどうしてClass1とClass2に分ける必要があるのでしょうか？
どうゆうコンセプトの元で、まっさらな白紙の状態からここまでたどり着けるのでしょうか？
| ツイート |  |