本程序是在[url=http://pfan.cn/club/showbbs.asp?id=26558]刘红石 的俄罗斯方块源码[/url]的基础上改编而成的，在此表示感谢。
相对原程序主要的改动有：
合并 原程序中的FUNCTION xialuo% () 和SUB yidong (p%) 为FUNCTION move% (dx%, dy%)
合并 原程序中的SUB hua()，SUB ca()和SUB kuai(x%, y%, c%)为SUB drawfk (cc$)
另外 将原程序中的SUB zhuan () 改进为SUB turn (side%)使之能在两个方向旋转
在检测有无满行时，只检测刚落下的方块所在的几行以增加程序的效率。
欢迎各位QBASIC爱好者对本程序提出更多的宝贵意见，使该程序更加完善。
本人邮箱为turebaojian@163.com QQ为281860270


DECLARE SUB nextfk ()       '产生下一个方块
DECLARE SUB turn (side%)    '旋转拼块的子程序
DECLARE SUB drawfk (cc$)    '画或擦除小方块的子程序
DECLARE SUB ending ()     '结束画面
DECLARE FUNCTION move% (dx%, dy%) '拼块左右移动及下落的函数
DECLARE FUNCTION max% (array() AS INTEGER, n%) '求数列中最大项
DECLARE FUNCTION min% (array() AS INTEGER, n%) '求数列中最小项
DIM SHARED fk(7, 4, 2) AS INTEGER  ' 定义数组 FK,此数组存放7种拼块的形状
DIM SHARED tong(-1 TO 14, 1 TO 25) AS INTEGER
DIM SHARED kx(4) AS INTEGER, ky(4) AS INTEGER  '此数组存放当前拼块的位置
DIM SHARED kx0(4) AS INTEGER, ky0(4) AS INTEGER  '此数组存放下一个拼块的形状

CONST x0 = 20, left = -1, right = 1, down = 1, still = 0
DIM i AS INTEGER, j AS INTEGER, k AS INTEGER, t AS INTEGER, m AS INTEGER

' 下段程序段读入拼块形状数据
FOR i = 1 TO 7: FOR j = 1 TO 4: FOR k = 1 TO 2
  READ fk(i, j, k)
NEXT k, j, i
DATA 1,1,1,2,1,3,1,4
DATA 1,1,1,2,1,3,2,3
DATA 1,3,2,1,2,2,2,3
DATA 1,1,1,2,2,1,2,2
DATA 1,2,1,3,2,1,2,2
DATA 1,1,1,2,2,2,2,3
DATA 1,1,1,2,1,3,2,2
FOR i = 1 TO 25
  tong(0, i) = 1: tong(13, i) = 1
NEXT i
FOR i = 1 TO 12
  tong(i, 25) = 1
NEXT i
CLS : VIEW PRINT 1 TO 25
LOCATE 14, 9: PRINT "NEXT"
LOCATE 8, 50: PRINT "KEY PRESS:"
LOCATE 10, 50: PRINT "LEFT  :move left"
LOCATE 11, 50: PRINT "RIGHT :move right"
LOCATE 12, 50: PRINT "UP    :turn left"
LOCATE 13, 50: PRINT "DOWN  :turn right"
LOCATE 14, 50: PRINT "SPACE :move down fast"
LOCATE 15, 50: PRINT "ENTER :pause"
LOCATE 16, 50: PRINT "ESC   :exit"
LOCATE 1, x0 + 1: PRINT CHR$(201); STRING$(24, CHR$(205)); CHR$(187)
FOR j = 2 TO 24
   LOCATE j, x0 + 1: PRINT CHR$(186); SPC(24); CHR$(186)
NEXT j
DEF SEG = &HB800
POKE 24 * 160 + 2 * x0, 200
FOR i = 2 TO 48 STEP 2
POKE 24 * 160 + 2 * x0 + i, 205
NEXT i
POKE 24 * 160 + 2 * x0 + 50, 188

DIM score AS INTEGER
RANDOMIZE TIMER
CALL nextfk
DO
  FOR i = 1 TO 4
   kx(i) = kx0(i) + 5
   ky(i) = ky0(i) + 1
  NEXT i
  CALL drawfk("[]")
  CALL nextfk
  LOCATE 10, 8: PRINT "SCORE:"; score
  FOR i = 1 TO 4
   IF tong(kx(i), ky(i)) = 1 THEN   '如果有其它的块,则桶满,游戏结束
     CALL ending
     END
   END IF
  NEXT i
  DO
    newtime = TIMER + .5
    DO
     key$ = INKEY$
     SELECT CASE key$
      CASE CHR$(0) + CHR$(72)  '按键 上:左旋
       CALL turn(left)
      CASE CHR$(0) + CHR$(80)  '按键 下:右旋
       CALL turn(right)
      CASE CHR$(0) + CHR$(75)  '按键 左:左移
       t = move%(left, still)
      CASE CHR$(0) + CHR$(77)  '按键 右:右移
       t = move%(right, still)
      CASE " "                 '按键 空格：速降
       EXIT DO
      CASE CHR$(13)            '按键 回车：暂停
       DO WHILE INKEY$ = ""
       LOOP
     CASE CHR$(27)            '按键 ESCape :退出
       CALL ending
       END
    END SELECT
   LOOP UNTIL TIMER > newtime
  t = move%(still, down)
  LOOP UNTIL t = 0
REM 消去满行的方块行
under = max%(ky(), 4): upon = min%(ky(), 4)
FOR j = under TO upon STEP -1    '从方块底到方块顶依次检查是否有填满的行
   p = 0       'P为此行方块数
   FOR i = 1 TO 12
    p = p + tong(i, j)   '计算此行的方块数
   NEXT i
  IF p = 12 THEN      '如果此行填满(方块数为12),则奏乐、清除此行、上面的行下移一行
    score = score + 1
    PLAY "mbc16d16g16"
   FOR k = j TO 1 STEP -1
     q = 0        'q为当前行的方块数
    FOR i = 1 TO 12     '依次将上一行的1至12块移至当前行
     tong(i, k) = tong(i, k - 1): q = q + tong(i, k)
     IF tong(i, k) = 1 THEN cc$ = "[]" ELSE cc$ = "  "
      LOCATE k, i * 2 + x0: PRINT cc$
    NEXT i
   IF q = 0 THEN EXIT FOR     '当前行的方块数为0，即是空行则转入上一行的检测
   NEXT k
    j = j + 1: upon = upon + 1  '下移后，当前行不变，方块最高行下移
  END IF
NEXT j
LOOP

SUB drawfk (cc$)      'cc$为"[]"画出拼块;为"  "擦除拼块
DIM i AS INTEGER
FOR i = 1 TO 4
LOCATE ky(i), kx(i) * 2 + x0: PRINT cc$
NEXT i
END SUB

SUB ending      '结束画面
DIM i AS INTEGER
FOR i = 24 TO 1 STEP -1
  LOCATE i, x0 + 2: PRINT "[][][][][][][][][][][][]"
  FOR j = 1 TO 10000: NEXT j
NEXT i
FOR i = 24 TO 1 STEP -1
  LOCATE i, x0 + 2: PRINT SPACE$(24)
NEXT i
END SUB

FUNCTION max% (array() AS INTEGER, n%) '求数列中最大项，n%为项数
DIM i AS INTEGER, num AS INTEGER
num = array(1)
FOR i = 2 TO n%
IF num < array(i) THEN num = array(i)
NEXT i
max% = num
END FUNCTION

FUNCTION min% (array() AS INTEGER, n%) '求数列中最小项，n%为项数
DIM i AS INTEGER, num AS INTEGER
num = array(1)
FOR i = 2 TO n%
IF num > array(i) THEN num = array(i)
NEXT i
min% = num
END FUNCTION

FUNCTION move% (dx%, dy%)  'dx%取left:左移 right:右移 still: 水平方向不动
DIM i AS INTEGER, t AS INTEGER    'dy%取down:下移 still:竖直方向不动
CALL drawfk("  ")   '擦除拼块
t = 1       '先设拼块还能移动
FOR i = 1 TO 4         '依次检查组成拼块的各个方块的位置
  IF tong(kx(i) + dx%, ky(i) + dy%) = 1 THEN
    t = 0: EXIT FOR     '如果方块运动方向已有方块则不能移动
  END IF                '如果方块到桶壁或桶底则不能再移动
NEXT i
IF t = 1 THEN        '如果拼块能移动时,拼块移动一格
  FOR i = 1 TO 4
    kx(i) = kx(i) + dx%: ky(i) = ky(i) + dy%
  NEXT i
  move% = 1
ELSEIF dy% = down THEN    '拼块不能下落
  FOR i = 1 TO 4
    tong(kx(i), ky(i)) = 1
  NEXT i
  move% = 0
ELSE                    '拼块不能左右移动
  move% = -1
END IF
CALL drawfk("[]")    '画出此时的拼块
END FUNCTION

SUB nextfk   '产生一个方块
  m = INT(RND * 7 + 1)     '随机产生一个数,这个数是拼块的编号
  FOR i = 1 TO 4           '用kx0(i),ky0(i)记录下一个方块
   kx0(i) = fk(m, i, 1)
   ky0(i) = fk(m, i, 2)
  NEXT i
  FOR i = x0 - 10 TO x0 - 2     '清空上一个方块
  FOR j = 16 TO 20
   LOCATE j, i: PRINT "  "
  NEXT j, i
  FOR i = 1 TO 4         '显示下一个方块
    LOCATE ky0(i) + 15, kx0(i) * 2 + 8: PRINT "[]"
  NEXT i
END SUB

' 转动拼块
SUB turn (side%)        'side%取left:左旋 right:右旋
DIM i AS INTEGER, t AS INTEGER, x AS INTEGER, y AS INTEGER
DIM kx1(4) AS INTEGER, ky1(4) AS INTEGER '定义暂时存放拼块状态的数组
CALL drawfk("  ")       '擦除拼块
IF side% = right THEN   '右旋
  x = max(kx(), 4): y = max(ky(), 4)
ELSEIF side% = left THEN    '左旋
  x = min(kx(), 4): y = max(ky(), 4)
END IF
FOR i = 1 TO 4     '依次计算旋转后各个方块的位置
  kx1(i) = -side% * (ky(i) - y + 1) + x  '左旋则以左下角方块或空格的右上角为旋转中心
  ky1(i) = side% * (kx(i) - x) + y       '右旋则以右下角方块或空格的左上角为旋转中心
NEXT i
t = 1       't是一个标志, 拼块能旋转时为1
FOR i = 1 TO 4                        '如果旋转后的方块出了桶的边界
  IF tong(kx1(i), ky1(i)) = 1 THEN    '或与已有方块重叠,则不能旋转拼块
    t = 0: EXIT FOR
  END IF
NEXT i
IF t = 1 THEN          '如果拼块能够旋转,则给出旋转后方块的位置
  FOR i = 1 TO 4
   kx(i) = kx1(i): ky(i) = ky1(i)
  NEXT i
END IF
CALL drawfk("[]")     '画出此时的拼块
END SUB