API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Jun 16th, 2019
80
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 21.22 KB | None | 0 0
raw download clone embed print report
  1. Public Const w = 10
  2. Public Const h = 20
  3.  
  4. Public piece As Range
  5. Public board As Range
  6. Public lineCounter As Range
  7.  
  8. Public nextPiece As Range
  9.  
  10.  
  11. Public piece2() As Boolean
  12.  
  13. Public running As Boolean
  14. Public falling As Boolean
  15.  
  16. Public canMove As Boolean
  17.  
  18. Public isPaused As Boolean
  19.  
  20. Public queue(1 To 2)
  21.  
  22. Public RunWhen As Double
  23. Public Const cRunIntervalSeconds = 1 ' two minutes
  24. 'Public Const cRunWhat = "TheSub" ' the name of the procedure to run
  25. Public Const cRunWhat = "Update"
  26.  
  27.  
  28. Sub setup()
  29.  
  30. Columns("A:J").ColumnWidth = 2
  31.  
  32. Set board = Range(Cells(1, 1), Cells(h, w))
  33. Set lineCounter = Cells(1, w + 5)
  34.  
  35. Cells.Interior.ColorIndex = -4142
  36. With board.Borders(xlEdgeBottom)
  37. .LineStyle = xlContinuous
  38. .ColorIndex = 0
  39. .TintAndShade = 0
  40. .Weight = xlThin
  41. End With
  42. With board.Borders(xlEdgeRight)
  43. .LineStyle = xlContinuous
  44. .ColorIndex = 0
  45. .TintAndShade = 0
  46. .Weight = xlThin
  47. End With
  48.  
  49. lineCounter.Value = 0
  50.  
  51. Application.OnKey "^t", "toggle"
  52. Application.OnKey "^q", "rotateLeft"
  53. Application.OnKey "^e", "rotateRight"
  54.  
  55. Application.OnKey "^a", "moveLeft"
  56. Application.OnKey "^d", "moveRight"
  57. Application.OnKey "^s", "moveDown"
  58.  
  59. Application.OnKey "^p", "pause"
  60. Application.OnKey "^r", "reset"
  61.  
  62. Application.OnKey "^w", "HelloBusinessBrunch"
  63.  
  64. Range("A1").Value = 0
  65. Range("N1").Value = "Lines:"
  66.  
  67. Range("R1:S1").Merge
  68. Range("R1:S1").Value = "Controls"
  69. Range("R1:S1").Font.Underline = xlUnderlineStyleSingle
  70.  
  71. Columns("R:R").ColumnWidth = 20.86
  72. Range("R2").Value = "Move Left"
  73. Range("S2").Value = "ctrl+a"
  74. Range("R3").Value = "Move Right"
  75. Range("S3").Value = "ctrl+d"
  76. Range("R4").Value = "Move Down"
  77. Range("S4").Value = "ctrl+s"
  78. Range("R5").Value = "Rotate Left"
  79. Range("S5").Value = "ctrl+q"
  80. Range("R6").Value = "Rotate Right"
  81. Range("S6").Value = "ctrl+e"
  82. Range("R7").Value = "Pause"
  83. Range("S7").Value = "ctrl+p"
  84. Range("R8").Value = "Reset"
  85. Range("S8").Value = "ctrl+r"
  86. Range("R9").Value = "Start"
  87. Range("S9").Value = "ctrl+t"
  88.  
  89.  
  90. End Sub
  91.  
  92. Private Sub reset()
  93. MSG1 = MsgBox("Are you sure you want to restart?", vbYesNo, "Restart?")
  94.  
  95. If MSG1 = vbNo Then
  96. Exit Sub
  97. End If
  98.  
  99. running = False
  100. StopTimer
  101. Columns("A:S").Delete Shift:=xlToLeft
  102. Call setup
  103. Set nextPiece = Range(Cells(1, w + 1), Cells(2, w + 4))
  104.  
  105. End Sub
  106.  
  107.  
  108. Private Sub toggle()
  109. If (running = False) Then
  110. begin
  111. Else
  112. running = False
  113. StopTimer
  114. End If
  115.  
  116. End Sub
  117.  
  118. Private Sub begin()
  119.  
  120.  
  121. Set nextPiece = Range(Cells(1, w + 1), Cells(2, w + 4))
  122.  
  123. Set board = Range(Cells(1, 1), Cells(h, w))
  124. Set lineCounter = Cells(1, w + 5)
  125.  
  126. Cells.Interior.ColorIndex = -4142
  127. With board.Borders(xlEdgeBottom)
  128. .LineStyle = xlContinuous
  129. .ColorIndex = 0
  130. .TintAndShade = 0
  131. .Weight = xlThin
  132. End With
  133. With board.Borders(xlEdgeRight)
  134. .LineStyle = xlContinuous
  135. .ColorIndex = 0
  136. .TintAndShade = 0
  137. .Weight = xlThin
  138. End With
  139.  
  140. lineCounter.Value = 0
  141.  
  142. queue(1) = WorksheetFunction.RandBetween(1, 7)
  143. queue(2) = WorksheetFunction.RandBetween(1, 7)
  144.  
  145. running = True
  146. falling = True
  147.  
  148. isPaused = False
  149.  
  150. canMove = True
  151. getPiece
  152. StartTimer
  153.  
  154. End Sub
  155.  
  156. Private Sub StartTimer()
  157.  
  158. RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
  159. Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
  160. Schedule:=True
  161. End Sub
  162.  
  163. Private Sub StopTimer()
  164. On Error Resume Next
  165. Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
  166. Schedule:=False
  167. End Sub
  168.  
  169. Private Sub Update()
  170.  
  171. Cells(1, 1).Value = (Cells(1, 1).Value + 1) Mod 100
  172.  
  173. r = piece.Resize(1, 1).Row + piece.Rows.Count - 1
  174. If (r >= h) Then
  175. checkForLines
  176. If (canMove = True) Then
  177. getPiece
  178. End If
  179.  
  180.  
  181. End If
  182.  
  183.  
  184. canMove = True
  185.  
  186.  
  187. nextTopLeftX = piece.Resize(1, 1).Column
  188. nextTopLeftY = piece.Resize(1, 1).Row + 1
  189. pieceW = piece.Columns.Count
  190. pieceH = piece.Rows.Count
  191.  
  192. flag = False
  193.  
  194. 'Cells(nextTopLeftY, nextTopLeftX).Resize(pieceH, pieceW).Select
  195.  
  196. For i = 1 To piece.Columns.Count
  197. For j = 1 To piece.Rows.Count
  198. If (piece2(j, i) = True) Then
  199. piece.Cells(j, i).Interior.ColorIndex = -4142
  200. End If
  201. Next j
  202. Next i
  203.  
  204.  
  205. For i = 0 To pieceW - 1
  206. For j = 0 To pieceH - 1
  207. If (piece2(j + 1, i + 1) = True And Cells(nextTopLeftY, nextTopLeftX).Offset(j, i).Interior.ColorIndex = 1) Then
  208. flag = True
  209. End If
  210. Next j
  211. Next i
  212.  
  213. If (flag = True) Then
  214. 'MsgBox ("!")
  215. For a = 1 To piece.Columns.Count
  216. For b = 1 To piece.Rows.Count
  217. If (piece2(b, a) = True) Then
  218. piece.Cells(b, a).Interior.ColorIndex = 1
  219. End If
  220. Next b
  221. Next a
  222. checkForLines
  223.  
  224. getPiece
  225. End If
  226.  
  227.  
  228.  
  229. 'If (falling = True) Then
  230. If (flag = False) Then
  231.  
  232. If (piece.Resize(1, 1).Row + piece.Rows.Count <= h) Then
  233.  
  234. 'Move piece down and fill in cells
  235. Set piece = piece.Offset(1, 0)
  236. For a = 1 To piece.Columns.Count
  237. For b = 1 To piece.Rows.Count
  238. If (piece2(b, a) = True) Then
  239. piece.Cells(b, a).Interior.ColorIndex = 1
  240. End If
  241. Next b
  242. Next a
  243.  
  244. End If
  245. End If
  246.  
  247.  
  248.  
  249.  
  250.  
  251. StartTimer
  252.  
  253. End Sub
  254.  
  255. Private Sub getPiece(Optional n = -1)
  256. If (n = -1) Then
  257. n = queue(1)
  258. queue(1) = queue(2)
  259. queue(2) = WorksheetFunction.RandBetween(1, 7)
  260.  
  261.  
  262. 'n = WorksheetFunction.RandBetween(1, 7)
  263. End If
  264.  
  265. 'Line
  266. If (n = 1) Then
  267. Set piece = Range(Cells(1, 4), Cells(1, 7))
  268. ReDim piece2(1 To 1, 1 To 4)
  269. piece2(1, 1) = True
  270. piece2(1, 2) = True
  271. piece2(1, 3) = True
  272. piece2(1, 4) = True
  273. End If
  274.  
  275. 'T
  276. If (n = 2) Then
  277. Set piece = Range(Cells(1, 4), Cells(2, 6))
  278. ReDim piece2(1 To 2, 1 To 3)
  279. piece2(1, 2) = True
  280. piece2(2, 1) = True
  281. piece2(2, 2) = True
  282. piece2(2, 3) = True
  283. End If
  284.  
  285. 'Square
  286. If (n = 3) Then
  287. Set piece = Range(Cells(1, 5), Cells(2, 6))
  288. ReDim piece2(1 To 2, 1 To 2)
  289. piece2(1, 1) = True
  290. piece2(1, 2) = True
  291. piece2(2, 1) = True
  292. piece2(2, 2) = True
  293. End If
  294.  
  295. 'Left zigzag
  296. If (n = 4) Then
  297. Set piece = Range(Cells(1, 4), Cells(2, 6))
  298. ReDim piece2(1 To 2, 1 To 3)
  299. piece2(1, 1) = True
  300. piece2(1, 2) = True
  301. piece2(2, 2) = True
  302. piece2(2, 3) = True
  303. End If
  304.  
  305. 'Right zigzag
  306. If (n = 5) Then
  307. Set piece = Range(Cells(1, 4), Cells(2, 6))
  308. ReDim piece2(1 To 2, 1 To 3)
  309. piece2(1, 2) = True
  310. piece2(1, 3) = True
  311. piece2(2, 1) = True
  312. piece2(2, 2) = True
  313. End If
  314.  
  315. 'Left L
  316. If (n = 6) Then
  317. Set piece = Range(Cells(1, 4), Cells(2, 6))
  318. ReDim piece2(1 To 2, 1 To 3)
  319. piece2(1, 1) = True
  320. piece2(2, 1) = True
  321. piece2(2, 2) = True
  322. piece2(2, 3) = True
  323. End If
  324.  
  325. 'Right L
  326. If (n = 7) Then
  327. Set piece = Range(Cells(1, 4), Cells(2, 6))
  328. ReDim piece2(1 To 2, 1 To 3)
  329. piece2(1, 3) = True
  330. piece2(2, 1) = True
  331. piece2(2, 2) = True
  332. piece2(2, 3) = True
  333. End If
  334.  
  335. flag = False
  336.  
  337. For a = 1 To piece.Columns.Count
  338. For b = 1 To piece.Rows.Count
  339. If (piece2(b, a) = True And piece.Cells(b, a).Interior.ColorIndex = 1) Then
  340. flag = True
  341. End If
  342. Next b
  343. Next a
  344.  
  345. If (flag = False) Then
  346.  
  347. For a = 1 To piece.Columns.Count
  348. For b = 1 To piece.Rows.Count
  349. If (piece2(b, a) = True) Then
  350. piece.Cells(b, a).Interior.ColorIndex = 1
  351. End If
  352. Next b
  353. Next a
  354. Else
  355. StopTimer
  356. If (lineCounter.Offset(0, 1).Value < lineCounter.Value) Then
  357. lineCounter.Offset(0, 1).Value = lineCounter.Value
  358. End If
  359.  
  360. MsgBox ("GAME OVER")
  361.  
  362. End
  363.  
  364. End If
  365.  
  366.  
  367. falling = True
  368.  
  369.  
  370. End Sub
  371.  
  372. Function transpose(arr() As Boolean)
  373.  
  374. y = UBound(arr, 1)
  375. x = UBound(arr, 2)
  376.  
  377. ReDim tempArr(1 To x, 1 To y) As Boolean
  378.  
  379. For a = 1 To x
  380. For b = 1 To y
  381. tempArr(a, b) = arr(b, a)
  382. Next b
  383. Next a
  384.  
  385. transpose = tempArr
  386.  
  387.  
  388. End Function
  389.  
  390. Private Sub rotateLeft()
  391. 'Transpose bottom, stick to left
  392.  
  393. If (running = False) Then
  394. Exit Sub
  395. End If
  396.  
  397.  
  398. If (piece.Resize(1, 1).Column + piece.Rows.Count - 1 <= w And piece.Resize(1, 1).Row + piece.Columns.Count - 1 <= h) Then
  399.  
  400. For i = 1 To piece.Columns.Count
  401. For j = 1 To piece.Rows.Count
  402. If (piece2(j, i) = True) Then
  403. piece.Cells(j, i).Interior.ColorIndex = -4142
  404. End If
  405. Next j
  406. Next i
  407.  
  408. y = UBound(piece2, 1)
  409. x = UBound(piece2, 2)
  410.  
  411. topLeftX = piece.Resize(1, 1).Column
  412. topLeftY = piece.Resize(1, 1).Row
  413.  
  414.  
  415.  
  416. ReDim rotatedPiece(1 To x, 1 To y) As Boolean
  417.  
  418. For bottom = y To 1 Step -1
  419. ReDim layer(1 To 1, 1 To x) As Boolean
  420. 'ReDim rotatedLayer(1 To x, 1 To 1) As Boolean
  421.  
  422. For a = 1 To x
  423. layer(1, a) = piece2(bottom, a)
  424. 'rotatedLayer() = transpose(layer)
  425. rotatedPiece(a, bottom) = piece2(bottom, x - a + 1)
  426.  
  427. Next a
  428. Next bottom
  429.  
  430.  
  431.  
  432.  
  433.  
  434. flag = False
  435.  
  436. For a = 1 To y
  437. For b = 1 To x
  438. If (board.Cells(topLeftY, topLeftX).Offset(b - 1, a - 1).Interior.ColorIndex = 1) Then
  439. If (rotatedPiece(b, a) = True) Then
  440. flag = True
  441. End If
  442.  
  443. End If
  444. Next b
  445. Next a
  446.  
  447. If (flag = False) Then
  448.  
  449. piece2 = rotatedPiece
  450. Set piece = piece.Resize(x, y)
  451.  
  452.  
  453. For a = 1 To x
  454. For b = 1 To y
  455. If (piece2(a, b) = True) Then
  456. piece.Cells(a, b).Interior.ColorIndex = 1
  457.  
  458. End If
  459. Next b
  460. Next a
  461. Else
  462.  
  463. For i = 1 To piece.Columns.Count
  464. For j = 1 To piece.Rows.Count
  465. If (piece2(j, i) = True) Then
  466. piece.Cells(j, i).Interior.ColorIndex = 1
  467. End If
  468. Next j
  469. Next i
  470. End If
  471.  
  472.  
  473. End If
  474.  
  475.  
  476.  
  477.  
  478.  
  479. End Sub
  480.  
  481.  
  482. Private Sub rotateRight()
  483.  
  484. If (running = False) Then
  485. Exit Sub
  486. End If
  487.  
  488. If (piece.Resize(1, 1).Column + piece.Rows.Count - 1 <= w And piece.Resize(1, 1).Row + piece.Columns.Count - 1 <= h) Then
  489.  
  490. 'Transpose bottom, stick to left
  491.  
  492. For i = 1 To piece.Columns.Count
  493. For j = 1 To piece.Rows.Count
  494. If (piece2(j, i) = True) Then
  495. piece.Cells(j, i).Interior.ColorIndex = -4142
  496. End If
  497. Next j
  498. Next i
  499.  
  500. y = UBound(piece2, 1)
  501. x = UBound(piece2, 2)
  502.  
  503. topLeftX = piece.Resize(1, 1).Column
  504. topLeftY = piece.Resize(1, 1).Row
  505.  
  506.  
  507.  
  508.  
  509.  
  510. ReDim rotatedPiece(1 To x, 1 To y) As Boolean
  511.  
  512. 'For bottom = y To 1 Step -1
  513. For bottom = 1 To y
  514. ReDim layer(1 To 1, 1 To x) As Boolean
  515. 'ReDim rotatedLayer(1 To x, 1 To 1) As Boolean
  516.  
  517. For a = x To 1 Step -1
  518. layer(1, a) = piece2(bottom, a)
  519. 'rotatedLayer() = transpose(layer)
  520. rotatedPiece(a, y - bottom + 1) = piece2(bottom, a)
  521.  
  522. Next a
  523. Next bottom
  524.  
  525. flag = False
  526. For a = 1 To y
  527. For b = 1 To x
  528. If (board.Cells(topLeftY, topLeftX).Offset(b - 1, a - 1).Interior.ColorIndex = 1) Then
  529. If (rotatedPiece(b, a) = True) Then
  530. flag = True
  531. End If
  532.  
  533. End If
  534. Next b
  535. Next a
  536.  
  537.  
  538.  
  539.  
  540. If (flag = False) Then
  541. piece2 = rotatedPiece
  542. Set piece = piece.Resize(x, y)
  543.  
  544.  
  545. For a = 1 To x
  546. For b = 1 To y
  547. If (piece2(a, b) = True) Then
  548. piece.Cells(a, b).Interior.ColorIndex = 1
  549. End If
  550. Next b
  551. Next a
  552. Else
  553. For i = 1 To piece.Columns.Count
  554. For j = 1 To piece.Rows.Count
  555. If (piece2(j, i) = True) Then
  556. piece.Cells(j, i).Interior.ColorIndex = 1
  557. End If
  558. Next j
  559. Next i
  560. End If
  561.  
  562.  
  563. End If
  564.  
  565.  
  566. End Sub
  567.  
  568. Private Sub moveLeft()
  569.  
  570. If (running = False) Then
  571. Exit Sub
  572. End If
  573.  
  574. r = piece.Resize(1, 1).Row
  575. c = piece.Resize(1, 1).Column
  576.  
  577. nextTopLeftX = piece.Resize(1, 1).Column - 1
  578. nextTopLeftY = piece.Resize(1, 1).Row
  579. pieceW = piece.Columns.Count
  580. pieceH = piece.Rows.Count
  581. flag = False
  582.  
  583. For i = 1 To piece.Columns.Count
  584. For j = 1 To piece.Rows.Count
  585. If (piece2(j, i) = True) Then
  586. piece.Cells(j, i).Interior.ColorIndex = -4142
  587. End If
  588. Next j
  589. Next i
  590.  
  591. If (nextTopLeftX = 0) Then
  592. flag = True
  593. Else
  594. For i = 0 To pieceW - 1
  595. For j = 0 To pieceH - 1
  596. If (piece2(j + 1, i + 1) = True And Cells(nextTopLeftY, nextTopLeftX).Offset(j, i).Interior.ColorIndex = 1) Then
  597. flag = True
  598. End If
  599. Next j
  600. Next i
  601. End If
  602.  
  603.  
  604. If (flag = True) Then
  605. For a = 1 To piece.Columns.Count
  606. For b = 1 To piece.Rows.Count
  607. If (piece2(b, a) = True) Then
  608. piece.Cells(b, a).Interior.ColorIndex = 1
  609. End If
  610. Next b
  611. Next a
  612. Else
  613.  
  614. If (c > 1) Then
  615.  
  616.  
  617. 'piece.Interior.ColorIndex = -4142
  618. For i = 1 To piece.Columns.Count
  619. For j = 1 To piece.Rows.Count
  620. If (piece2(j, i) = True) Then
  621. piece.Cells(j, i).Interior.ColorIndex = -4142
  622. End If
  623. Next j
  624. Next i
  625.  
  626.  
  627. Set piece = piece.Offset(0, -1)
  628.  
  629. y = UBound(piece2, 1)
  630. x = UBound(piece2, 2)
  631.  
  632. For a = 1 To x
  633. For b = 1 To y
  634. If (piece2(b, a) = True) Then
  635. piece.Cells(b, a).Interior.ColorIndex = 1
  636.  
  637. End If
  638. Next b
  639. Next a
  640. End If
  641. End If
  642.  
  643.  
  644.  
  645. End Sub
  646.  
  647. Private Sub moveRight()
  648.  
  649. If (running = False) Then
  650. Exit Sub
  651. End If
  652.  
  653. 'r = piece.Resize(1, 1).Row + piece.Rows.Count - 1
  654.  
  655.  
  656. nextTopLeftX = piece.Resize(1, 1).Column + 1
  657. nextTopLeftY = piece.Resize(1, 1).Row
  658. pieceW = piece.Columns.Count
  659. pieceH = piece.Rows.Count
  660. flag = False
  661.  
  662. For i = 1 To piece.Columns.Count
  663. For j = 1 To piece.Rows.Count
  664. If (piece2(j, i) = True) Then
  665. piece.Cells(j, i).Interior.ColorIndex = -4142
  666. End If
  667. Next j
  668. Next i
  669.  
  670. If ((nextTopLeftX + pieceW - 1) > w) Then
  671. flag = True
  672. Else
  673.  
  674. For i = 0 To pieceW - 1
  675. For j = 0 To pieceH - 1
  676. If (piece2(j + 1, i + 1) = True And Cells(nextTopLeftY, nextTopLeftX).Offset(j, i).Interior.ColorIndex = 1) Then
  677. flag = True
  678. End If
  679. Next j
  680. Next i
  681. End If
  682.  
  683.  
  684. If (flag = True) Then
  685. For a = 1 To piece.Columns.Count
  686. For b = 1 To piece.Rows.Count
  687. If (piece2(b, a) = True) Then
  688. piece.Cells(b, a).Interior.ColorIndex = 1
  689. End If
  690. Next b
  691. Next a
  692. Else
  693.  
  694.  
  695. c = piece.Resize(1, 1).Column + piece.Columns.Count - 1
  696. 'MsgBox (c)
  697.  
  698.  
  699. If (c < w) Then
  700.  
  701.  
  702. 'piece.Interior.ColorIndex = -4142
  703. For i = 1 To piece.Columns.Count
  704. For j = 1 To piece.Rows.Count
  705. If (piece2(j, i) = True) Then
  706. piece.Cells(j, i).Interior.ColorIndex = -4142
  707. End If
  708. Next j
  709. Next i
  710.  
  711. Set piece = piece.Offset(0, 1)
  712.  
  713. y = UBound(piece2, 1)
  714. x = UBound(piece2, 2)
  715.  
  716. For a = 1 To x
  717. For b = 1 To y
  718. If (piece2(b, a) = True) Then
  719. piece.Cells(b, a).Interior.ColorIndex = 1
  720.  
  721. End If
  722. Next b
  723. Next a
  724.  
  725. End If
  726. End If
  727.  
  728.  
  729.  
  730. End Sub
  731.  
  732. Private Sub moveDown()
  733.  
  734. If (running = False) Then
  735. Exit Sub
  736. End If
  737. If (canMove = True) Then
  738.  
  739. r = piece.Resize(1, 1).Row + piece.Rows.Count - 1
  740.  
  741. nextTopLeftX = piece.Resize(1, 1).Column
  742. nextTopLeftY = piece.Resize(1, 1).Row + 1
  743. pieceW = piece.Columns.Count
  744. pieceH = piece.Rows.Count
  745. flag = False
  746.  
  747. For i = 1 To piece.Columns.Count
  748. For j = 1 To piece.Rows.Count
  749. If (piece2(j, i) = True) Then
  750. piece.Cells(j, i).Interior.ColorIndex = -4142
  751. End If
  752. Next j
  753. Next i
  754.  
  755.  
  756. For i = 0 To pieceW - 1
  757. For j = 0 To pieceH - 1
  758. If (piece2(j + 1, i + 1) = True And Cells(nextTopLeftY, nextTopLeftX).Offset(j, i).Interior.ColorIndex = 1) Then
  759. flag = True
  760. End If
  761. Next j
  762. Next i
  763.  
  764. If (flag = True) Then
  765. 'MsgBox ("!")
  766. For a = 1 To piece.Columns.Count
  767. For b = 1 To piece.Rows.Count
  768. If (piece2(b, a) = True) Then
  769. piece.Cells(b, a).Interior.ColorIndex = 1
  770. End If
  771. Next b
  772. Next a
  773. Else
  774.  
  775.  
  776. If (r >= h) Then
  777.  
  778. For a = 1 To piece.Columns.Count
  779. For b = 1 To piece.Rows.Count
  780. If (piece2(b, a) = True) Then
  781. piece.Cells(b, a).Interior.ColorIndex = 1
  782. End If
  783. Next b
  784. Next a
  785. Else
  786. StopTimer
  787. StartTimer
  788.  
  789. 'piece.Interior.ColorIndex = -4142
  790. Set piece = piece.Offset(1, 0)
  791.  
  792. y = UBound(piece2, 1)
  793. x = UBound(piece2, 2)
  794.  
  795. For a = 1 To x
  796. For b = 1 To y
  797. If (piece2(b, a) = True) Then
  798. piece.Cells(b, a).Interior.ColorIndex = 1
  799.  
  800. End If
  801. Next b
  802. Next a
  803. End If
  804. End If
  805. 'StartTimer
  806.  
  807. End If
  808.  
  809.  
  810.  
  811. End Sub
  812.  
  813. Private Sub pause()
  814. If (isPaused = False) Then
  815. StopTimer
  816. isPaused = True
  817. Else
  818. StartTimer
  819. isPaused = False
  820.  
  821. End If
  822.  
  823. End Sub
  824.  
  825. Private Sub checkForLines()
  826.  
  827. canMove = False
  828.  
  829. For r = 1 To h
  830. If (Range(Cells(r, 1), Cells(r, w)).Interior.ColorIndex = 1) Then
  831. lineCounter.Value = lineCounter.Value + 1
  832.  
  833. Range(Cells(r, 1), Cells(r, w)).Interior.ColorIndex = -4142
  834. For a = r To 2 Step -1
  835. For b = 1 To w
  836. Cells(a, b).Interior.ColorIndex = Cells(a - 1, b).Interior.ColorIndex
  837.  
  838. Next b
  839. Next a
  840.  
  841. End If
  842.  
  843. Next r
  844.  
  845. canMove = True
  846.  
  847. End Sub
  848.  
  849. Private Sub HelloBusinessBrunch()
  850. 'This sub is assigned the ctrl+w shortcut to prevent accidental closing of the amazing game
  851. 'Other than that, this sub does nothing
  852. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!