クラスモジュールとコレクションを使ったゲームを作りたいですけど．． (ID:104818)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文 課題は試行錯誤しながら作成するのが大切だと思いますが・・・ 具体的なら例です 縦横のチェックはこんな感じに出来ます。 少しテストしただけなので不具合があるかも(;^_^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