- このページの著者ZISIRUが練習用に書いたコードです。
- 他で公開、配布、販売、使用する場合は変数名等、一部でもいいので改変して公開してください。
- 上記に違反しない限り私はすべての権利を主張しません。ご自由にお使いください。
- 本コードの使用において、この文章の表記、著者名の表記は不要です。
- 本コードは「現状のまま」提供され、明示または黙示を問わず、商品性、特定目的への適合性、非侵害に対する保証を含むがこれらに限定されない、いかなる種類の保証もありません。いかなる場合も、著者または著作権保有者は、契約行為、不法行為、またはその他の行為にかかわらず、本コード、または本コードの使用もしくはその他の取り扱いから生じる、またはそれに関連するいかなる請求、損害、またはその他の責任についても責任を負わないものとします。
- 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クラスモジュール、オブジェクト名：回す_
内容は、まず回転数を増やしたときに壁がないことを確認、大丈夫だったら現在のブロックを消して回転数をインクリメント。
描写する前に壁にめり込んでいれば壁がない方にマイナス１オフセットしてやってから再描写。
※ここで長物分のマイナス２オフセットしていないので長物で右に隣接した場合回転しなくなっていますねｗ
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 |
Option Explicit Private 落下物_ As Dictionary Property Let 落下物(ByVal R As Dictionary) Set 落下物_ = R End Property Property Get 落下物() As Dictionary Set 落下物 = 落下物_ End Property Sub 回すよ() Dim 色 As Long Dim f落下 As Variant If 底回転数 >= 5 Then Exit Sub If 落下物_.Count > 1 Then '回転先が入らなかったら回転させない If 落下物_.Count - 1 = 回転 Then If Not Intersect(壁, 落下物_.Keys(0).Offset(0, 1)) Is Nothing And Not Intersect(壁, 落下物_.Keys(0).Offset(0, -1)) Is Nothing Then Exit Sub End If Else If Not Intersect(壁, 落下物_.Keys(回転 + 1).Offset(0, 1)) Is Nothing And Not Intersect(壁, 落下物_.Keys(回転 + 1).Offset(0, -1)) Is Nothing Then Exit Sub End If End If 色 = 落下物_.Keys(回転).Interior.ColorIndex 落下物_.Keys(回転).ClearFormats If 落下物_.Count - 1 = 回転 Then 回転 = 0 Else 回転 = 回転 + 1 End If If Not Intersect(壁, 落下物_.Keys(回転).Offset(0, 1)) Is Nothing Then '右にめり込んでいれば回避 Do Until Intersect(壁, 落下物_.Keys(回転)) Is Nothing For Each f落下 In 落下物_ 落下物_.Key(f落下) = f落下.Offset(0, -1) Next f落下 Loop ElseIf Not Intersect(壁, 落下物_.Keys(回転).Offset(0, -1)) Is Nothing Then '左にめり込んでいれば回避 Do Until Intersect(壁, 落下物_.Keys(回転)) Is Nothing For Each f落下 In 落下物_ 落下物_.Key(f落下) = f落下.Offset(0, 1) Next f落下 Loop ElseIf Not Intersect(底, 落下物_.Keys(回転)) Is Nothing Then '底にめり込んでいれば回避 Do Until Intersect(底, 落下物_.Keys(回転)) Is Nothing For Each f落下 In 落下物_ 落下物_.Key(f落下) = f落下.Offset(-1, 0) Next f落下 Loop 底回転数 = 底回転数 + 1 ElseIf Not Intersect(底.Offset(-1, 0), 落下物_.Keys(回転)) Is Nothing Then '底足掻き回転 Do Until Intersect(底, 落下物_.Keys(回転)) Is Nothing For Each f落下 In 落下物_ 落下物_.Key(f落下) = f落下.Offset(-1, 0) Next f落下 Loop 底回転数 = 底回転数 + 1 End If 落下物_.Keys(回転).Interior.ColorIndex = 色 落下物_.Keys(回転).Borders.LineStyle = xlContinuous End If GAME.Cells(1, 1).Select Application.Wait [Now()] + 0.05 / 86400 End Sub |
コメント