オブジェクト指向の例

このページのコードについて

このページの著者ZISIRUが練習用に書いたコードです。
他で公開、配布、販売、使用する場合は変数名等、一部でもいいので改変して公開してください。
上記に違反しない限り私はすべての権利を主張しません。ご自由にお使いください。
本コードの使用において、この文章の表記、著者名の表記は不要です。
本コードは「現状のまま」提供され、明示または黙示を問わず、商品性、特定目的への適合性、非侵害に対する保証を含むがこれらに限定されない、いかなる種類の保証もありません。いかなる場合も、著者または著作権保有者は、契約行為、不法行為、またはその他の行為にかかわらず、本コード、または本コードの使用もしくはその他の取り扱いから生じる、またはそれに関連するいかなる請求、損害、またはその他の責任についても責任を負わないものとします。

About the code on this page

The code on this page was written by the author, ZISIRU, for practice purposes.
If you wish to publish, distribute, or sell the code elsewhere, please modify it, even if only in terms of variable names, before making it public.
As long as the above is not violated, I do not claim any rights and you are free to use it.
There is no need to include this statement or the author’s name when using this code.
This code is provided “as is”, and no warranties of any kind are offered, including but not limited to warranties of merchantability, fitness for a particular purpose, or non-infringement, whether expressed or implied. In no event shall the author or copyright holder be liable for any claims, damages, or other liabilities arising from or related to the use of this code, regardless of whether they are based on contract, tort, or other legal theory.

VBA、落ちものゲームで説明(メインページ)

オブジェクト指向とはプログラムを役割ごとに分割して(部品にするイメージ)メインから呼び出して使う感じです。
こうする事により一か所に書くコードを短く出来てメンテナンス性や拡張性、コードの可読性を上げることが出来ます。

これとは別に関数型プログラミングという物があり、こちらは性質がちょっと違いますが似たようなものがあります。
そしてクラスを応用することにより多態性(ポリモーフィズム)とか難しいこともできます。

以前、職場が暇な時にVBAで作ったゲームのプログラムがあるので(初めて作ったゲーム)、これでオブジェクト指向の概念が説明できればなと思います。

実際にコピペで動かしたい場合にはまずシートに下の画像のようなシートを作ります。
無くてもセルの境界がわからないだけでゲーム自体は出来ます。
なのでセルの色や文字、サイズは任意に指定してください。
※Uの22のセル(スコア表示部)は小さいと文字が表示されないのでセル統合か書式設定で調整してください。(画像ではセル統合しています)

ちゃんとは詰めてないので機能はいまいちですが、まぁ普通に動いて遊べます。(クラスモジュールとシートのオブジェクト名を合わせればコピペだけで動くはずです。)
底足掻き処理とかいうのはうまく機能してないですｗ
しかもこの時はパブリック変数使ってますねlol【許してください】

Option Explicit

Public 回転 As Long           'ブロックは連想配列にレンジで各形を格納している為、 各形をこれで管理
Public 底回転数 As Long     '底で即固定を回転で回避する限界数
Public 壁 As Range
Public 底 As Range
Public 天井 As Range

Declare PtrSafe Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Integer

Sub MAIN()
    Dim 初期化 As 初期化_
    Dim 次ブロック As Dictionary
    Dim 落下中 As Dictionary
    Dim f変数 As Variant
    
    Set 次ブロック = New Dictionary
    Set 落下中 = New Dictionary
    Set 初期化 = New 初期化_

    初期化.消去
    
    Dim ブロック As ブロック_

    Set ブロック = New ブロック_
    回転 = 0

    '待機ブロックの生成
    ブロック.R = 5
    ブロック.C = 23
    ブロック.生成
    Set 次ブロック = ブロック.形状

    Set ブロック = Nothing
    Set ブロック = New ブロック_

    '落下するブロックの生成
    ブロック.R = 3
    ブロック.C = 11
    ブロック.生成
    Set 落下中 = ブロック.形状

    Set ブロック = Nothing

    Dim 落下 As 落下_
    Dim 右移動 As 右移動_
    Dim 左移動 As 左移動_
    Dim 回す As 回す_
    Dim 加速 As 落下速_
    Dim 消去 As 消去_
    Dim 得点 As 得点_
    Dim 今 As Date, 待機 As Date
    Dim 仮底 As Range
    Dim 仮壁 As Range
    Dim 色 As Long
    Dim 待ち時間 As Double
    Dim 条件スコア As Long

    Set 壁 = Union(GAME.Range("E1:E25"), GAME.Range("R1:R25"))
    Set 底 = GAME.Range("F25:Q25")
    Set 天井 = GAME.Range("E4:R4")
    Set 落下 = New 落下_
    Set 右移動 = New 右移動_
    Set 左移動 = New 左移動_
    Set 回す = New 回す_
    Set 加速 = New 落下速_

    待ち時間 = 0.5
    条件スコア = 500
    
L1:

    回転 = 0
    底回転数 = 1

    '底に付くまで落下する処理
    Do Until Not Intersect(底.Offset(-1, 0), 落下中.Keys(回転)) Is Nothing

        今 = [Now()]
        待機 = [Now()] + 待ち時間 / 86400                            '落下間隔

        'キー移動処理
        Do Until 今 >= 待機                                               '落下間隔以内に入力があれば処理
            Application.Wait [Now()] + 0.08 / 86400             '入力間隔の待機時間

            DoEvents

            If GetAsyncKeyState(vbKeyBack) Or GetAsyncKeyState(vbKeyDelete) Then
                MsgBox "GAME OVER" & vbCrLf & "得点 " & GAME.Range("U21").Value & "点"
                End                                                              '強制停止
            End If
        
            '左右移動
            If GetAsyncKeyState(vbKeyRight) Then
                右移動.落下物 = 落下中
                右移動.移動
            ElseIf GetAsyncKeyState(vbKeyLeft) Then
                左移動.落下物 = 落下中
                左移動.移動
            End If

            '回転
            If GetAsyncKeyState(vbKeyUp) Then
                回す.落下物 = 落下中
                回す.回すよ
            End If

            '落下追加移動
            If GetAsyncKeyState(vbKeyDown) Then
                加速.落下物 = 落下中
                加速.下移動
            End If
    
            今 = [Now]
        Loop

        '底足掻き処理
        If Not Intersect(底.Offset(-1, 0), 落下中.Keys(回転)) Is Nothing Then
            Application.Wait [Now()] + 0.3 / 86400            '入力間隔の待機時間
            Do While 底回転数 < 5 And GetAsyncKeyState(vbKeyUp)
                回す.落下物 = 落下中
                回す.回すよ
            Loop
        End If

        '底に付いていなければ落下処理
        If Intersect(底.Offset(-1, 0), 落下中.Keys(回転)) Is Nothing Then
            落下.落下物 = 落下中
            落下.落下処理
        End If
    
        If Not GetAsyncKeyState(vbKeyDown) Then
            If Not Intersect(底.Offset(-1, 0), 落下中.Keys(回転)) Is Nothing Then
                Application.Wait [Now()] + 0.3 / 86400            '入力間隔の待機時間
            
                '左右移動
                If GetAsyncKeyState(vbKeyRight) Then
                    右移動.落下物 = 落下中
                    右移動.移動
                ElseIf GetAsyncKeyState(vbKeyLeft) Then
                    左移動.落下物 = 落下中
                    左移動.移動
                End If
    
                Application.Wait [Now()] + 0.1 / 86400          '入力間隔の待機時間
        
                '左右移動
                If GetAsyncKeyState(vbKeyRight) Then
                    右移動.落下物 = 落下中
                    右移動.移動
                ElseIf GetAsyncKeyState(vbKeyLeft) Then
                    左移動.落下物 = 落下中
                    左移動.移動
                End If
            End If
        End If
    Loop

    Set 仮底 = 落下中.Keys(回転)
    Set 仮壁 = 落下中.Keys(回転)
    Set 底 = Union(底, 仮底)
    Set 壁 = Union(壁, 仮壁)

    '揃ったら消す
    Set 消去 = New 消去_

    消去.消す

    '得点処理
    Set 得点 = New 得点_

    得点.加点 = 消去.スコア元
    得点.計算

    '落下間隔
    If GAME.Range("U21").Value >= 条件スコア Then
        待ち時間 = 待ち時間 - 0#
        条件スコア = 条件スコア + 500
    End If

    Set 消去 = Nothing

    'ブロック準備
    Set 落下中 = Nothing
    Set 落下中 = New Dictionary
    
    For Each f変数 In 次ブロック
        落下中.Add f変数.Offset(-2, -12), 次ブロック.Item(f変数)
    Next f変数
    色 = 次ブロック.Keys(0).Interior.ColorIndex
    落下中.Keys(0).Interior.ColorIndex = 色
    落下中.Keys(0).Borders.LineStyle = xlContinuous

    次ブロック.RemoveAll
    Set 次ブロック = New Dictionary

    GAME.Range("V4:Y6").Clear
    Set ブロック = New ブロック_
    
    ブロック.R = 5
    ブロック.C = 23
    ブロック.生成

    Set 次ブロック = ブロック.形状
    Set ブロック = Nothing

    If Not Intersect(底, 天井) Is Nothing Then
        MsgBox "GAME OVER" & vbCrLf & "得点 " & GAME.Range("U21").Value & "得点"
        End
    End If
    
    GoTo L1
End Sub

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

Option Explicit

Public 回転 As Long 'ブロックは連想配列にレンジで各形を格納している為、各形をこれで管理

Public 底回転数 As Long '底で即固定を回転で回避する限界数

Public 壁 As Range

Public 底 As Range

Public 天井 As Range

Declare PtrSafe Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Integer

Sub MAIN()

Dim 初期化 As 初期化_

Dim 次ブロック As Dictionary

Dim 落下中 As Dictionary

Dim f変数 As Variant

Set 次ブロック = New Dictionary

Set 落下中 = New Dictionary

Set 初期化 = New 初期化_

初期化.消去

Dim ブロック As ブロック_

Set ブロック = New ブロック_

回転 = 0

'待機ブロックの生成

ブロック.R = 5

ブロック.C = 23

ブロック.生成

Set 次ブロック = ブロック.形状

Set ブロック = Nothing

Set ブロック = New ブロック_

'落下するブロックの生成

ブロック.R = 3

ブロック.C = 11

ブロック.生成

Set 落下中 = ブロック.形状

Set ブロック = Nothing

Dim 落下 As 落下_

Dim 右移動 As 右移動_

Dim 左移動 As 左移動_

Dim 回す As 回す_

Dim 加速 As 落下速_

Dim 消去 As 消去_

Dim 得点 As 得点_

Dim 今 As Date, 待機 As Date

Dim 仮底 As Range

Dim 仮壁 As Range

Dim 色 As Long

Dim 待ち時間 As Double

Dim 条件スコア As Long

Set 壁 = Union(GAME.Range("E1:E25"), GAME.Range("R1:R25"))

Set 底 = GAME.Range("F25:Q25")

Set 天井 = GAME.Range("E4:R4")

Set 落下 = New 落下_

Set 右移動 = New 右移動_

Set 左移動 = New 左移動_

Set 回す = New 回す_

Set 加速 = New 落下速_

待ち時間 = 0.5

条件スコア = 500

L1:

回転 = 0

底回転数 = 1

'底に付くまで落下する処理

Do Until Not Intersect(底.Offset(-1, 0), 落下中.Keys(回転)) Is Nothing

今 = [Now()]

待機 = [Now()] + 待ち時間 / 86400 '落下間隔

'キー移動処理

Do Until 今 >= 待機 '落下間隔以内に入力があれば処理

Application.Wait [Now()] + 0.08 / 86400 '入力間隔の待機時間

DoEvents

If GetAsyncKeyState(vbKeyBack) Or GetAsyncKeyState(vbKeyDelete) Then

MsgBox "GAME OVER" & vbCrLf & "得点 " & GAME.Range("U21").Value & "点"

End '強制停止

End If

'左右移動

If GetAsyncKeyState(vbKeyRight) Then

右移動.落下物 = 落下中

右移動.移動

ElseIf GetAsyncKeyState(vbKeyLeft) Then

左移動.落下物 = 落下中

左移動.移動

End If

'回転

If GetAsyncKeyState(vbKeyUp) Then

回す.落下物 = 落下中

回す.回すよ

End If

'落下追加移動

If GetAsyncKeyState(vbKeyDown) Then

加速.落下物 = 落下中

加速.下移動

End If

今 = [Now]

Loop

'底足掻き処理

If Not Intersect(底.Offset(-1, 0), 落下中.Keys(回転)) Is Nothing Then

Application.Wait [Now()] + 0.3 / 86400 '入力間隔の待機時間

Do While 底回転数 < 5 And GetAsyncKeyState(vbKeyUp)

回す.落下物 = 落下中

回す.回すよ

Loop

End If

'底に付いていなければ落下処理

If Intersect(底.Offset(-1, 0), 落下中.Keys(回転)) Is Nothing Then

落下.落下物 = 落下中

落下.落下処理

End If

If Not GetAsyncKeyState(vbKeyDown) Then

If Not Intersect(底.Offset(-1, 0), 落下中.Keys(回転)) Is Nothing Then

Application.Wait [Now()] + 0.3 / 86400 '入力間隔の待機時間

'左右移動

If GetAsyncKeyState(vbKeyRight) Then

右移動.落下物 = 落下中

右移動.移動

ElseIf GetAsyncKeyState(vbKeyLeft) Then

左移動.落下物 = 落下中

左移動.移動

End If

Application.Wait [Now()] + 0.1 / 86400 '入力間隔の待機時間

'左右移動

If GetAsyncKeyState(vbKeyRight) Then

右移動.落下物 = 落下中

右移動.移動

ElseIf GetAsyncKeyState(vbKeyLeft) Then

左移動.落下物 = 落下中

左移動.移動

End If

Loop

Set 仮底 = 落下中.Keys(回転)

Set 仮壁 = 落下中.Keys(回転)

Set 底 = Union(底, 仮底)

Set 壁 = Union(壁, 仮壁)

'揃ったら消す

Set 消去 = New 消去_

消去.消す

'得点処理

Set 得点 = New 得点_

得点.加点 = 消去.スコア元

得点.計算

'落下間隔

If GAME.Range("U21").Value >= 条件スコア Then

待ち時間 = 待ち時間 - 0#

条件スコア = 条件スコア + 500

End If

Set 消去 = Nothing

'ブロック準備

Set 落下中 = Nothing

Set 落下中 = New Dictionary

For Each f変数 In 次ブロック

落下中.Add f変数.Offset(-2, -12), 次ブロック.Item(f変数)

Next f変数

色 = 次ブロック.Keys(0).Interior.ColorIndex

落下中.Keys(0).Interior.ColorIndex = 色

落下中.Keys(0).Borders.LineStyle = xlContinuous

次ブロック.RemoveAll

Set 次ブロック = New Dictionary

GAME.Range("V4:Y6").Clear

Set ブロック = New ブロック_

ブロック.R = 5

ブロック.C = 23

ブロック.生成

Set 次ブロック = ブロック.形状

Set ブロック = Nothing

If Not Intersect(底, 天井) Is Nothing Then

MsgBox "GAME OVER" & vbCrLf & "得点 " & GAME.Range("U21").Value & "得点"

End

End If

GoTo L1

End Sub

上が標準モジュールに書くメインのコードになります。

メインの流れとしては、①描写範囲のクリア、連想配列で落ちるブロックと次のブロックの生成→②時間経過で連想配列に入れたブロックを下にずらしていく→③キーの入力があればそちらに移動、または回転後のオブジェクト描写→④【底】に着いたときに列が埋まったら消す→⑤得点計算→⑥得点の条件で落下待機時間を変動→⑦ブロックの準備→⑧【天井】に【底】が重なったら終了、重なってなかったら②からループ
というようになってます。

で、初期化とか移動、回転等の処理のコードはクラスモジュールに書いて呼び出して使用してます。
クラスモジュールを使っているコードの部分は
初期化.消去
右移動.落下物 = 落下中
右移動.移動
左移動.落下物 = 落下中
左移動.移動
回す.落下物 = 落下中
回す.回すよ
の辺りになります(一部ですが)

各クラスモジュールのコード詳細は下のようになります。(リンク先)

※リンク先にクラスモジュールのコードがあります。
ゲームをするシートのオブジェクト名はGAME
クラスモジュール名は

ブロック_
右移動_
回す_
左移動_
初期化_
消去_
得点_
落下_
落下速_

リンクで分かりにくいですが、全部後ろに半角のアンダーバーが付いています

このメインのページと上のクラスモジュールのサブページを合わせて一つの説明とすることでメインページの文字数を減らせたり、もし同じ説明を繰り返し使うならリンクを貼るだけで良くなり修正も一回で済みます。
例えば、サブページ無しで書いていて右移動の同じ説明を３回していたとします、もし何かあって修正したくなったときは3か所修正しなければなりませんが、オブジェクト指向で作っていた場合だとリンク先の１か所だけ直せば良いということになります。

こんな感じでコードを書くのがオブジェクト指向のイメージになります。