Dim Board(12, 16) As Boolean
Dim RockPX(4, 28) As Integer
Dim RockPY(4, 28) As Integer
Dim X, Y, X1, Y1, T, P, M As Integer
Dim RockX, RockY, RX, RY, RS As Integer
Dim RockN, RockC, RockR, RR As Integer
Dim Playing As Boolea
									

The first thing to do is declare all the global variables because we don't want do any excessive parameter passing. Board(,) stores the state of the game board. If a coordinate is true, a rock occupies that spot. RockPX(,) and RockPY(,) stores how to draw all seven rocks. That is, the first index (4) selects a subrock of a rock, the next index (28) store the rock and their possible rotations. X, Y, X1, Y1, T, P, M are variables that are used a lot. So, to reduce the amount of memory VBA will leak and to improve performance, I declared them here. The falling and next rocks are the only rocks we need to track. Thus, the next set of variables store x and y position, falling speed, which rock is next, which is current, the current rotation of the rock - you get the point. Playing simply indicates if the game is playing, as opposed to waiting for it to be started.

Sub Init()
  Dim XStng, YStng As String
  Dim T As Integer

  XStng = "01120112001100000012001201120011001100110123000101110001" & _
           01120112001100000122012201120011001100110123011100010111"
  YStng = "11222121212101231222121121221210011221211111012000120121" & _
           11222121212101231112222111211210011221212222201201221012"
  T = 1
  For Y = 0 To 27
    For X = 0 To 3
      RockPX(X, Y) = Int(Val(Mid(XStng, T, 1)))
      RockPY(X, Y) = Int(Val(Mid(YStng, T, 1)))
      T = T + 1
    Next
  Next

  RS = 3
  RockN = Int(Rnd * 6)
  ClearBoard
End Su
									

Init initializes the rock position matrices, sets the falling speed to 3, randomly generates the next rock, and clears any rocks that might be on the game board. It should all make sense except the first part. You see, VBA doesn't have data statements and I didn't want to use an external data file. So, I stored the rock position data in a string. There are exactly four subrocks for each rock. So, the subrocks positons can be described as offsets with a range between 0 and 3.

Sub ClearBoard()
  For X = 1 To 12
    For Y = 1 To 16
      If X = 1 Or X = 12 Or Y = 16 Then
        Board(X, Y) = True
      Else
        Board(X, Y) = False
      End If
    Next
  Next
End Su
									

Clear the game board by setting all the coordinates to false. Of course, the left, right and bottom edge are set to true. This helps with collision detection by making it seem like there is a rock in at those coordinates.

Sub Begin()
  Randomize
  Init
  Setup
  NewRock
  Playing = True
  Play
End Su
									

Begin is the routine that is called when a person starts a new game. It starts by randomizing the randomizer. Then it calls Init which resets the variables for a new game. Setup is called to draw the visible layout of the document. That included the table, shading and all text that is static in the game. To play the game, we need a falling rock. So, NewRock is called. Playing is set to true and the play routine is called to commence game play.

Sub Play()
  While (Playing)
    For P = 1 To RS
      EraseRock
      RockR = RR
      RockX = RX
      DrawRock
      SendKeys "%h"
      DoEvents
    Next

    If DropRock Then
      CheckLine
      CheckDead
      NewRock
    End If
  Wend

  GameOver
End Su
									

The Play sub loops until Playing=false which happens when the player loses or presses the key that calls the StopGame sub. The next code section iterates RS time, which is the number associated with the play speed. The lower RS the faster the rock drops. We are about to update the falling rock with a new position. So, EraseRock is called. If EraseRock wasn't called, the rock would leave a trail. RockR and RockX are updated with new position a rotation coordinates which are associtated with keyboard input. Yet, there is no code for reading the keyboard. Instead, Words' built-in keyboard customizing is used to assign game keys to their associated sub. Thus, since these subs may execute at any time, we track the rocks rotation and position with separate variables and update them here. Once the falling rock is updated, DrawRock is called to draw it on the game board. SendKeys "%h" sends alt + h to the keyboard message buffers. That key is assigned to a sub which moves the cursor off the game board. Calling the sub directly creates problems. This is the trick to getting it done right. DoEvents is a VB command that tells VB to give up the processor so other processesn namely the OS can get a time slice. If you don't call this routine regularly in a VB application that run for an extended time period, you will wish you did. The rock is falling and now is a good time to move it down one position. So, DropRock is called and will return true if it landed on something. If so, two situations could arise. First, a line may have been completed. So, CheckLine checks for that. The player may have filled the column. In which case the game is over. So, CheckDead checks for that. We will assume the game isn't over and fetch a NewRock. If the player lost or manually terminated the game, the while loop ends and GameOver is called to display that the game is over.

Sub StopGame()
  Playing = False
End Su
									

Without this routine, there would be no way to halt this program without letting it run its course. So, we create this sub and assign a key to it. Press that key and the game halts.

Sub SpeedDown()
  RS = RS + 1
  If RS > 5 Then
    RS = 5
  End If

  ActiveDocument.Tables(1).Cell(16, 19).Select
  Selection.Text = 6 - RS
End Su
									

SpeedUp increase RS (falling speed variable) by one. It shouldn't be allowed to be greater than 5. So, if it is, just set it equal to 5. Since the game speed just changed, the text displaying the game speed should be updated. A table was used to make the entire game layout into a text grid (like the C= 64). So, to update the speed text, just select the texts' cell and write the new value.

Sub SpeedUp()
  RS = RS - 1
  If RS < 1 Then
    RS = 1
  End If

  ActiveDocument.Tables(1).Cell(16, 19).Select
  Selection.Text = 6 - RS
End Su
									

SpeedDown decreases RS (falling speed variable) by one. It shouldn't be allowed to be less than 1. So, if it is, just set it equal to 1. Since the game speed just changed, the text displaying the game speed should be updated. A table was used to make the entire game layout into a text grid (like the C= 64). So, to update the speed text, just select the texts' cell and write the new value.

Sub CheckLine()
  For Y = 0 To 3
    M = 0
    For X = 2 To 11
      If RockY + Y < 16 And RockY + Y > 0 Then
        If Board(X, RockY + Y) Then
          M = M + 1
        End If
      End If
    Next
    If M = 10 Then
      RemoveLine
    End If
  Next
End Su
									

CheckLine check for the completion of a line. Since, this sub is called only when a rock lands, only four lines need to be checked. Thus, Y is 0 to 3 or from the rock position to its greatest possible offset. M counts the occupied spots for each line. So, it should start counting at zero. X iterates between 2 and 11 because X coordinates of 1 and 12 are the left and right edge. Even though four lines are checked, only one rock, the straight line rock, rotated on end could complete all four lines. Therefore, we should check to see that the line we are counting is within the bounds of the game. Valid Y coordinates are between 1 and 15 inclusively. If the line is in the playable game area, add 1 to M whenever a piece of rock occupies that coordinate. If M counted 10 occupied coordinates, that line is completed and should be removed.

Sub RemoveLine()
  For Y1 = RockY + Y To 2 Step -1
    For X1 = 2 To 11
      Beep
      Board(X1, Y1) = Board(X1, Y1 - 1)
      ActiveDocument.Tables(1).Cell(Y1, X1).Select
      If Board(X1, Y1) Then
        Selection.Text = "X"
      Else
        Selection.Text = ""
      End If
    Next
  Next
End Su
									

The line RockY + Y is the one we need to remove. This is done by shifting the game board above this line down one line. Note that Y is a Global with multiple meanings in this module. I am careful to enter this sub only when Ys' meaning is valid. Incidentally, this is bad coding practice. So, don't do this at home, kids. Anyhow, the Y1 iterates up the game board from the line in question. X1 iterates across the line. An beep is play to make things exciting. Then, the X1, Y1 coordinate is updated with the X1, Y1-1 coordinate. To draw this visually on the document, the associated cell is selected and an X or nothing is type accordingly.

Sub CheckDead()
  If RockY < 1 Then
    Playing = False
  End If
End Su
									

If the rock couldn't move completely onto the game board (Rock < 1), the player loses. So, set Playing to False to end the game.

Sub GameOver()
  ActiveDocument.Tables(1).Cell(8, 2).Select
  Selection.Text = "G"
  Beep
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "A"
  Beep
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "M"
  Beep
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "E"
  Beep
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = ""
  Beep
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = ""
  Beep
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "O"
  Beep
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "V"
  Beep
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "E"
  Beep
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "R"
  Beep
  Selection.MoveRight Unit:=wdCell, Count:=1

  Selection.EndOf wdStory
End Su
									

This routine draws GAME OVER on the game board. It is pretty self explainatory. If it is not, study the Word object model and things should clear up. If nothing else, record a bunch of macros and study the code that Word creates.

Sub NewRock()
  RockX = 5
  RX = RockX
  RockY = -2
  RockR = 0
  RR = RockR
  RockC = RockN
  RockN = Int(Rnd * 6)
  DrawNext
End Su
									

NewRock creates a new falling rock. It is centered (RockX=5) and above (RockY=-2) the game board. The rocks' rotation is normalized (RockR=0). The next rock becomes the current rock and then, a new Next rock is randomly computed and drawn on the document.

Sub EraseRock()
  For T = 0 To 3
    If RockPY(T, (7 * RockR) + RockC) + RockY > 0 Then
      ActiveDocument.Tables(1).Cell(RockPY(T, (7 * RockR) + RockC) + RockY, _
                            RockPX(T, (7 * RockR) + RockC) + RockX).Select
      Selection.Text = ""
    End If
  Next
End Su
									

To erase a rock, just select each subrocks' cell and type a null string. Of course, we need to check whether the cell is in the visible game area or not. Otherwise, VBA would flag an error.

Sub DrawRock()
  For T = 0 To 3
    If RockPY(T, (7 * RockR) + RockC) + RockY > 0 Then
      ActiveDocument.Tables(1).Cell(RockPY(T, (7 * RockR) + RockC) + RockY, _
                            RockPX(T, (7 * RockR) + RockC) + RockX).Select
      Selection.Text = "X"
    End If
  Next
End Su
									

To Draw a rock, just select each subrocks' cell and type an X. Of course, we need to check whether the cell is in the visible game area or not. Otherwise, VBA would flag an error.

Sub DrawNext()
  For X = 0 To 3
    For Y = 0 To 3
      ActiveDocument.Tables(1).Cell(6 + Y, 15 + X).Select
      Selection.Text = ""
    Next
  Next

  For T = 0 To 3
    ActiveDocument.Tables(1).Cell(6 + RockPY(T, RockN), _
                                  15 + RockPX(T, RockN)).Select
    Selection.Text = "X"
  Next
End Su
									

To draw the 'next' rock, the area where it is displayed is cleared by setting each cell equal to the null string. Then, the new 'next' rock is drawn by selecting the appropriate cell and typing an X.

Sub HoldRock()
  Selection.EndOf wdStory
  Selection.Text = " "
  Selection.Text = ""
End Su
									

HoldRock actually moves the cursor out of the game playing area. A little bit of extra code is needed to make it less visible.

Sub PutRock()
  Beep
  For T = 0 To 3
    If RockPY(T, (7 * RockR) + RockC) + RockY > 0 Then
      Board(RockPX(T, (7 * RockR) + RockC) + RockX, _
            RockPY(T, (7 * RockR) + RockC) + RockY) = True
    End If
  Next
End Su
									

PutRock is called when a rock lands. In which case, the game board needs to be updated accordingly. So, lets make a beep to signal the landing. Then, iterate through the four subrocks setting the corresponding board coordinates True. Remember, RockPX and RockPY store the subrock offsets for all seven rocks and their rotations. Don't let the math scare you, it is just simple algebra. (7*RockR)+RockC means the seven the rocks are grouped sequentially with each rotation following the next. T references each subrock. This finds the subrock offsets which is added to the rocks' board location, RockX/Y.

Function DropRock() As Boolean
  EraseRock
  DropRock = False

  For T = 0 To 3
    Y = RockPY(T, (7 * RockR) + RockC) + RockY + 1
    If Y > 0 Then
      If Board(RockPX(T, (7 * RockR) + RockC) + RockX, Y) Then
        DropRock = True
      End If
    End If
  Next

  If Not DropRock Then
    RockY = RockY + 1
  Else
    PutRock
  End If

  DrawRock
End Functio
									

DropRock moves the rock down one position. Since the rocks' position may change, it must be erased to avoid leaving trails. The return value is set to false, which means we start with the assumption that the rock didn't land. Then, iterate through the four subrocks checking whether a move down one position will cause a collision (it landed). If there is a collision, DropRock is set to True indicating the rock landed. If the rock is still falling move the rock down one position else embed the rock into the gameboard. Finally, draw the updated rock.

Sub RotateRock()
  RR = RockR + 1
  If RR > 3 Then
    RR = 0
  End If

  For T = 0 To 3
    X = RockPX(T, (7 * RR) + RockC) + RockX
    Y = RockPY(T, (7 * RR) + RockC) + RockY
    If Y > 0 Then
      If Board(X, Y) Then
        Beep
        RR = RockR
      End If
    End If
  Next
End Su
									

RotateRock does exactly what it says. This game only allows rotations in one direction and adding 1 to RockR performs this rotation. Note, RR store this value, not RockR because this sub is assigned a key and may execute at any time. So, we just want to track the rotation in this sub. RockR gets updated in the Play sub. Rotations greater than 3 don't have meaning because there is only 4 posible unique rotations. So, anything greater should loop back to 0. Now, we need to check if the rotation caused a collision. So, iterate through the four subrocks. Extract the X and Y offsets for the subrock. If Y is in the visible game area, check the board coordinates for occupation. If a subrock already exists in that coordinate, beep and unrotate the rock.

Sub RockDown()
  P = RS
End Su
									

RockDown is assigned a key which allows the player to move the rock down at full speed. This didn't work very well because the game doesn't detect if the key is held down and setting P=RS only drops the rock one position quickly.

Sub RockLeft()
  M = 1

  For T = 0 To 3
    X = RockPX(T, (7 * RockR) + RockC) + RockX - M
    Y = RockPY(T, (7 * RockR) + RockC) + RockY
    If Y > 0 Then
      If Board(X, Y) Then
        Beep
        M = 0
      End If
    End If
  Next

  RX = RockX - M
End Su
									

RockLeft moves the rock left one position. It first checks for collisions. if a collision is detected, a beep is played and M is set to 0. RockX - M computes the new location. Note, we don't need an 'If' statement here because if a collision occurred, M=0!

Sub RockRight()
  M = 1

  For T = 0 To 3
    X = RockPX(T, (7 * RockR) + RockC) + RockX + M
    Y = RockPY(T, (7 * RockR) + RockC) + RockY
    If Y > 0 Then
      If Board(X, Y) Then
        Beep
        M = 0
      End If
    End If
  Next

  RX = RockX + M
End Su
									

RockLeft moves the rock right one position. It first checks for collisions. if a collision is detected, a beep is played and M is set to 0. RockX - M computes the new location. Note, we don't need an 'If' statement here because if a collision occurred, M=0!

Sub Setup()
  Selection.WholeStory
  Selection.Delete Unit:=wdCharacter, Count:=1

  ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=16, NumColumns:=20
  ActiveDocument.Tables(1).Borders(wdBorderBottom).ColorIndex = wdDarkBlue
  ActiveDocument.Tables(1).Borders(wdBorderLeft).ColorIndex = wdDarkBlue
  ActiveDocument.Tables(1).Borders(wdBorderRight).ColorIndex = wdDarkBlue
  ActiveDocument.Tables(1).Borders(wdBorderTop).ColorIndex = wdDarkBlue
  ActiveDocument.Tables(1).Borders(wdBorderHorizontal).ColorIndex = wdWhite
  ActiveDocument.Tables(1).Borders(wdBorderVertical).ColorIndex = wdWhite

  ActiveDocument.Tables(1).Select
  Selection.Cells.SetWidth ColumnWidth:=InchesToPoints(0.2), _
                           RulerStyle:=wdAdjustNone
  Selection.Rows.SpaceBetweenColumns = InchesToPoints(0)
  Selection.Paragraphs.Alignment = wdAlignParagraphCenter

  ActiveDocument.Tables(1).Cell(16, 1).Select
  Selection.MoveRight Unit:=wdCharacter, Count:=11, Extend:=wdExtend
  Selection.Cells.Borders(wdBorderVertical).ColorIndex = wdDarkBlue
  Selection.Cells.Shading.Texture = wdTextureSolid
  Selection.Cells.Shading.ForegroundPatternColorIndex = wdDarkBlue

  ActiveDocument.Tables(1).Cell(1, 1).Select
  Selection.MoveDown Unit:=wdLine, Count:=15, Extend:=wdExtend
  Selection.Cells.Borders(wdBorderHorizontal).ColorIndex = wdDarkBlue
  Selection.Cells.Shading.Texture = wdTextureSolid
  Selection.Cells.Shading.ForegroundPatternColorIndex = wdDarkBlue

  ActiveDocument.Tables(1).Cell(1, 12).Select
  Selection.MoveDown Unit:=wdLine, Count:=15, Extend:=wdExtend
  Selection.Cells.Borders(wdBorderHorizontal).ColorIndex = wdDarkBlue
  Selection.Cells.Shading.Texture = wdTextureSolid
  Selection.Cells.Shading.ForegroundPatternColorIndex = wdDarkBlue

  ActiveDocument.Tables(1).Cell(1, 2).Select
  Selection.MoveRight Unit:=wdCharacter, Count:=9, Extend:=wdExtend
  Selection.MoveDown Unit:=wdLine, Count:=14, Extend:=wdExtend
  Selection.Font.Bold = True

  ActiveDocument.Tables(1).Cell(1, 13).Select
  Selection.Text = "W"
  Selection.Font.Bold = True
  Selection.Font.ColorIndex = wdDarkRed
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "O"
  Selection.Font.Bold = True
  Selection.Font.ColorIndex = wdDarkRed
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "R"
  Selection.Font.Bold = True
  Selection.Font.ColorIndex = wdDarkRed
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "D"
  Selection.Font.Bold = True
  Selection.Font.ColorIndex = wdDarkRed
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "T"
  Selection.Font.Bold = True
  Selection.Font.ColorIndex = wdDarkRed
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "R"
  Selection.Font.Bold = True
  Selection.Font.ColorIndex = wdDarkRed
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "I"
  Selection.Font.Bold = True
  Selection.Font.ColorIndex = wdDarkRed
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "S"
  Selection.Font.Bold = True
  Selection.Font.ColorIndex = wdDarkRed

  ActiveDocument.Tables(1).Cell(5, 15).Select
  Selection.Text = "N"
  Selection.Font.Bold = True
  Selection.Font.ColorIndex = wdDarkBlue
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "E"
  Selection.Font.Bold = True
  Selection.Font.ColorIndex = wdDarkBlue
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "X"
  Selection.Font.Bold = True
  Selection.Font.ColorIndex = wdDarkBlue
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "T"
  Selection.Font.Bold = True
  Selection.Font.ColorIndex = wdDarkBlue
  ActiveDocument.Tables(1).Cell(6, 15).Select
  Selection.MoveRight Unit:=wdCharacter, Count:=3, Extend:=wdExtend
  Selection.MoveDown Unit:=wdLine, Count:=3, Extend:=wdExtend
  Selection.Cells.Borders(wdBorderTop).ColorIndex = wdDarkBlue
  Selection.Cells.Borders(wdBorderBottom).ColorIndex = wdDarkBlue
  Selection.Cells.Borders(wdBorderLeft).ColorIndex = wdDarkBlue
  Selection.Cells.Borders(wdBorderRight).ColorIndex = wdDarkBlue
  Selection.Font.Bold = True

  ActiveDocument.Tables(1).Cell(16, 14).Select
  Selection.Text = "S"
  Selection.Font.ColorIndex = wdDarkBlue
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "P"
  Selection.Font.ColorIndex = wdDarkBlue
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "E"
  Selection.Font.ColorIndex = wdDarkBlue
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "E"
  Selection.Font.ColorIndex = wdDarkBlue
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = "D"
  Selection.Font.ColorIndex = wdDarkBlue
  Selection.MoveRight Unit:=wdCell, Count:=1
  Selection.Text = 6 - RS
  Selection.Font.ColorIndex = wdBlack

  Selection.EndOf wdStory
  Selection.Text = vblfcr & "Coded by Robert Walsh" & _
                   vbCrLf & "MonkeyFighter.com" & vbCrLf
  Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
End Su
									

Setup draws the document. I don't plan to explain the Word specific code. I think if you study the code, you'll be able to figure it out.