接着上面






SUB BlClear
'擦除当前位置的方块
    N% = 1
    FOR Y% = 0 TO CurBl.Hei - 1
        FOR X% = 0 TO CurBl.Wid - 1
            IF MID$(CurBl.Bit, N%, 1) = "1" THEN
               Rx% = (X% + Blx%) * Pexx% + bordx%
               Ry% = (Y% + Bly%) * Pexy% + Bordy%
               LINE (Rx%, Ry%)-(Rx% + 15, Ry% + 15), 0, BF
            END IF
            N% = N% + 1
        NEXT
    NEXT
END SUB

SUB BlDraw
'画当前位置的方块
    N% = 1
    FOR Y% = 0 TO CurBl.Hei - 1
        FOR X% = 0 TO CurBl.Wid - 1
            IF MID$(CurBl.Bit, N%, 1) = "1" THEN
                Ry% = (Bly% + Y%) * Pexx% + Bordy%
                Rx% = (Blx% + X%) * Pexy% + bordx%
                PUT (Rx%, Ry%), BPic, PSET
            END IF
            N% = N% + 1
        NEXT
    NEXT
END SUB

SUB BlGet (e AS BlType)
'随机生成一个方块并随机旋转位置
    RANDOMIZE TIMER
    N% = INT(RND * 11)
    e = Bl(N%)
    N% = INT(RND * 4)
    FOR i% = 1 TO N%: Turn.Left e: NEXT
END SUB

SUB BlInit
    IF NextBl.Wid = 0 THEN
           BlGet NextBl
           BlGet CurBl
        ELSE
           CurBl = NextBl
           BlGet NextBl
    END IF
    '-------------------------
    Blx% = Bgnx%: Bly% = Bgny%
    CALL BlDraw
    
    LINE (460, 70)-(524, 134), BackClr%, BF
    N% = 1
    FOR Y% = 0 TO NextBl.Hei - 1
        FOR X% = 0 TO NextBl.Wid - 1
            IF MID$(NextBl.Bit, N%, 1) = "1" THEN
                PUT (X% * Pexx% + 461, Y% * Pexy% + 70), BPic, PSET
            END IF
            N% = N% + 1
        NEXT
    NEXT
END SUB

接着上面






SUB GameOver
    M% = MsgBox("你失败了,按Space继续,Esc退出")
    IF M% THEN
        REDIM Xy(Hei%, Wid%)  AS INTEGER'桶方块数据
        Fast% = 10: NextBl.Wid = 0
        LINE (bordx%, Bordy%)-(bordx% + Wid% * Pexx%, Bordy% + Hei% * Pexy%), 0, BF
        M$ = LTRIM$(RTRIM$(STR$(10 - Fast%)))
        LINE (500, 390)-(520, 407), BackClr%, BF
        MyPrn 501, 391, M$, 13, BackClr%, 0
        MyPrn 500, 390, M$, 4, 0, 0
        Works& = 0
        M$ = LTRIM$(RTRIM$(STR$(Works&)))
        LINE (500, 360)-(550, 377), BackClr%, BF
        MyPrn 501, 361, M$, 13, BackClr%, 0
        MyPrn 500, 360, M$, 4, 0, 0
        Staring% = -1
        CALL BlInit
    ELSE
        END
    END IF
END SUB

SUB Is.CanDown
'判断当前方块是否能够下落,并处理之
    IF Bly% + CurBl.Hei > Hei% - 1 THEN  '已经到达底部
       CALL XYSet
       CALL XYClear
       CALL BlInit
       EXIT SUB
    END IF
    N% = 1
    FOR Y% = 0 TO CurBl.Hei - 1          '看是否能下落
        FOR X% = 0 TO CurBl.Wid - 1
            IF Xy(X% + Blx%, Bly% + Y% + 1) AND MID$(CurBl.Bit, N%, 1) = "1" THEN
                IF Bly% = 0 THEN
                    CALL GameOver
                    EXIT SUB
                END IF
                CALL XYSet
                CALL XYClear
                CALL BlInit
                EXIT SUB
            END IF
            N% = N% + 1
        NEXT
    NEXT
    '能下落,将方块下移一格
    CALL BlClear
    Bly% = Bly% + 1
    CALL BlDraw
END SUB

接着上面






SUB Is.CanLeft
'判断当前方块是否能够左移
   IF Blx% = 0 THEN EXIT SUB    '己到达最左边
   N% = 1
   FOR Y% = 0 TO CurBl.Hei - 1  '看是否能向左移
       FOR X% = 0 TO CurBl.Wid - 1
           IF Xy(Blx% + X% - 1, Bly% + Y%) AND MID$(CurBl.Bit, N%, 1) = "1" THEN
              EXIT SUB
           END IF
           N% = N% + 1
       NEXT
   NEXT
   '左移一格
   CALL BlClear
   Blx% = Blx% - 1
   CALL BlDraw
END SUB

SUB Is.CanRight
'判断当前方块是否能够右移
   IF Blx% + CurBl.Wid > Wid% - 1 THEN EXIT SUB  '已经到达最右边
   N% = 1
   FOR Y% = 0 TO CurBl.Hei - 1                   '看是否能右移
       FOR X% = 0 TO CurBl.Wid - 1
           IF Xy(Blx% + X% + 1, Bly% + Y%) AND MID$(CurBl.Bit, N%, 1) = "1" THEN
               EXIT SUB
           END IF
           N% = N% + 1
       NEXT
   NEXT
   '方块向右移一格
   CALL BlClear
   Blx% = Blx% + 1
   CALL BlDraw
END SUB

SUB Is.CanTurnLeft
'判断当前方块是否能够向左旋转
    Turn.Left CurBl           '先向左旋转看再说
    '超出边界,无法旋转
    IF CurBl.Hei + Bly% > Hei% THEN : Turn.Right CurBl: EXIT SUB
    IF CurBl.Wid + Blx% > Wid% THEN : Turn.Right CurBl: EXIT SUB
    N% = 1
    FOR Y% = 0 TO CurBl.Hei - 1    '未出边界,看是否能够旋过去
        FOR X% = 0 TO CurBl.Wid - 1
            IF MID$(CurBl.Bit, N%, 1) = "1" AND Xy(Blx% + X%, Bly% + Y) THEN
                Turn.Right CurBl    '旋不过去,转回原来形状
                EXIT SUB
            END IF
            N% = N% + 1
        NEXT
    NEXT
    '可能旋转,将方块旋转并放到最后的位置
    Turn.Right CurBl
    CALL BlClear
    Turn.Left CurBl
    CALL BlDraw
END SUB

SUB Is.CanTurnRight
'判断当前方块是否能够向右旋转
    Turn.Right CurBl          '先向右转了再说
    '超出边界,无法旋转,转回去
    IF CurBl.Hei + Bly% > Hei%  THEN : Turn.Left CurBl: EXIT SUB
    IF CurBl.Wid + Blx% > Wid%  THEN : Turn.Left CurBl: EXIT SUB
    N% = 1
    FOR Y% = 0 TO CurBl.Hei - 1     '未出边界,看是否可能转
        FOR X% = 0 TO CurBl.Wid - 1
            IF MID$(CurBl.Bit, N%, 1) = "1" AND Xy(Blx% + X%, Bly% + Y) THEN
                Turn.Left CurBl      '有方块挡着,转回去
                EXIT SUB
            END IF
            N% = N% + 1
        NEXT
    NEXT
    '可能旋转,旋转后并把方块放到最后位置
    Turn.Left CurBl
    CALL BlClear
    Turn.Right CurBl
    CALL BlDraw
END SUB

接着上面





FUNCTION MsgBox (stil$)
    N% = LEN(stil$) * 8
    LINE (bordx% + 100, 220)-(bordx% + N% + 116, 244), 14, B
    PAINT (bordx% + 102, 222), 9, 14
    MyPrn bordx% + 108, 224, stil$, 15, 0, 0
    WHILE Quit% = 0
          ikey$ = INKEY$
          IF ikey$ = CHR$(27) THEN EXIT FUNCTION
          IF ikey$ = CHR$(32) THEN MsgBox = -1: EXIT FUNCTION
    WEND
END FUNCTION

SUB MyPrn (X%, Y%, st$, bfclr%, bkclr%, over%)
    CONST Hz$ = "→←↓你失败了按继续退出关卡积分加快减慢下落右移左俄罗斯方块秋风暂停开始旋一"
    CONST Dig$ = "0123456789,=/.():SpaceEsPgUDnCoyRihtAV"
    STATIC Digs() AS INTEGER, Hzs() AS INTEGER
    '76.37
    IF LEN(st$) = 0 THEN EXIT SUB
    Slen% = LEN(st$)
    IF over% <> 0 THEN LINE (X%, Y%)-(X% + Slen% * 8, Y% + 16), bkclr%, BF
    '************************************************************************
    STATIC Lc%
    IF Lc% = 0 THEN
         N% = LEN(Hz$) / 2: M% = LEN(Dig$): Lc% = 1
         REDIM Hzs(N%, 32) AS INTEGER, Digs(M%, 16) AS INTEGER
         FOR i% = 0 TO N% - 1
             FOR J% = 0 TO 31: READ Hzs(i%, J%): NEXT
         NEXT
         FOR i% = 0 TO M% - 1
             FOR J% = 0 TO 15: READ Digs(i%, J%): NEXT
         NEXT
    END IF
    '************************************************************************
    Rx% = X%: N% = 1
    WHILE N% <= Slen%
         B$ = MID$(st$, N%, 1)
         Byte% = ASC(B$)
         IF Byte% < 161 AND Byte% > 32 THEN
              Nober% = INSTR(Dig$, B$) - 1
              FOR i% = 0 TO 15
                     LINE (Rx%, Y% + i%)-(Rx% + 7, Y% + i%), bfclr%, B, Digs(Nober%, i%)
              NEXT
         END IF
         '===================================================================
         IF Byte% >= 161 AND N% <> Slen% THEN
              T$ = MID$(st$, N%, 2)
              Nober% = (INSTR(Hz$, T$) - 1) / 2
              FOR i% = 0 TO 15
                       LINE (Rx%, Y% + i%)-(Rx% + 7, Y% + i%), bfclr%, B, Hzs(Nober%, i% * 2)
                       LINE (Rx% + 8, Y% + i%)-(Rx% + 15, Y% + i%), bfclr%, B, Hzs(Nober%, i% * 2 + 1)
              NEXT
              N% = N% + 1: Rx% = Rx% + 8
         END IF
         N% = N% + 1: Rx% = Rx% + 8
    WEND
END SUB

接着上面





SUB Set.Palete
'设置调色板
    STATIC rgb() AS INTEGER
    STATIC Lc%
    IF Lc% = 0 THEN
            Lc% = 1
            REDIM rgb(16, 3) AS INTEGER
            OUT &H3C6, 255
            FOR i = 0 TO 15
                OUT &H3C7, i
                rgb(i, 0) = INP(&H3C9)
                rgb(i, 1) = INP(&H3C9)
                rgb(i, 2) = INP(&H3C9)
            NEXT
            Clr# = 63 / 13
            FOR i% = 1 TO 13
                OUT &H3C8, i%
                OUT &H3C9, i% * Clr#
                OUT &H3C9, i% * Clr#
                OUT &H3C9, i% * Clr#
            NEXT
                '-----------------
                OUT &H3C8, 14
                OUT &H3C9, 63
                OUT &H3C9, 0
                OUT &H3C9, 0
                '-----------------
                OUT &H3C8, 15
                OUT &H3C9, 10
                OUT &H3C9, 10
                OUT &H3C9, 63
                '-----------------
                EXIT SUB
    END IF
    OUT &H3C6, 255
    FOR i = 0 TO 15
        OUT &H3C8, i
        OUT &H3C9, rgb(i, 0)
        OUT &H3C9, rgb(i, 1)
        OUT &H3C9, rgb(i, 2)
    NEXT
END SUB

接着上面





SUB SysInit
'初始化程序
Set.Palete
'-------------------------
'先画一个方块图形保存起来
LINE (0, 0)-(15, 15), 15, B
PAINT (1, 1), 9, 15
FOR i% = 1 TO 13 STEP 3
    Up.Pset i%, 1
    Up.Pset i%, 13
NEXT
FOR i% = 1 TO 13 STEP 3
    Up.Pset 1, i%
    Up.Pset 13, i%
NEXT
GET (0, 0)-(15, 15), BPic
'这是方块的形状,共有11个
'==========================================================================
'             [] []            []   []  []      [][]    []   [][] [][]
'[][][][] [][][] [][][] []   [][][] [][][] [][] [][]  []   [][]     [][]
'(0)      (1)    (2)    (3)  (4)    (5)    (6)  (7)   (8)  (9)    (10)
'==========================================================================
'下面是各个方块形状的数据
Bl(0).Wid = 4: Bl(0).Hei = 1: Bl(0).Bit = "1111"
Bl(1).Wid = 3: Bl(1).Hei = 2: Bl(1).Bit = "001111"
Bl(2).Wid = 3: Bl(2).Hei = 2: Bl(2).Bit = "100111"
Bl(3).Wid = 1: Bl(3).Hei = 1: Bl(3).Bit = "1"
Bl(4).Wid = 3: Bl(4).Hei = 2: Bl(4).Bit = "010111"
Bl(5).Wid = 3: Bl(5).Hei = 2: Bl(5).Bit = "101111"
Bl(6).Wid = 2: Bl(6).Hei = 1: Bl(6).Bit = "11"
Bl(7).Wid = 2: Bl(7).Hei = 2: Bl(7).Bit = "1111"
Bl(8).Wid = 2: Bl(8).Hei = 2: Bl(8).Bit = "0110"
Bl(9).Wid = 3: Bl(9).Hei = 2: Bl(9).Bit = "011110"
Bl(10).Wid = 3: Bl(10).Hei = 2: Bl(10).Bit = "110011"
'==========================================================================
'先画好桶
CLS
FOR i% = 2 TO 6
   LINE (50 - i%, 10 - i%)-(550 + i%, 470 + i%), 11 - i%, B
NEXT
PAINT (100, 100), BackClr%, 9
LINE (bordx% - 1, Bordy% - 1)-(bordx% + 384, Bordy% + 384), 0, BF
FOR i% = 2 TO 6
    LINE (bordx% - i%, Bordy% - 1)-(bordx% - i%, Bordy% + Hei% * Pexy% + i% - 1), i% + 3
    LINE (bordx% + i% + Wid% * Pexx% - 1, Bordy% - 1)-(bordx% + i% + Wid% * Pexx% - 1, Bordy% + Hei% * Pexy% + i% - 1), i% + 3
NEXT
FOR i% = 2 TO 6
    LINE (bordx% - i% + 1, Bordy% + Hei% * Pexy% + i% - 1)-(bordx% + Wid% * Pexx% + i% - 1, Bordy% + Hei% * Pexy% + i% - 1), i% + 3
NEXT
'==========================================================================
'界面
MyPrn 130, 20, "俄罗斯方块 V1.0 秋风 CopyRight(C) 2005.1", 13, 0, 0
MyPrn 129, 19, "俄罗斯方块 V1.0 秋风 CopyRight(C) 2005.1", 4, 0, 0
MyPrn 180, 445, "SPACE 暂停/开始", 13, 0, 0
MyPrn 179, 444, "SPACE 暂停/开始", 0, 0, 0

MyPrn 460, 50, "下一方块", 13, 0, 0
MyPrn 459, 49, "下一方块", 3, 0, 0

MyPrn 461, 151, " A   左旋", 13, 0, 0
MyPrn 460, 150, " A   左旋", 4, 0, 0
MyPrn 461, 181, " S   右旋", 13, 0, 0
MyPrn 460, 180, " S   右旋", 4, 0, 0
MyPrn 461, 211, "←   左移", 13, 0, 0
MyPrn 460, 210, "←   左移", 4, 0, 0
MyPrn 461, 241, "→   右移", 13, 0, 0
MyPrn 460, 240, "→   右移", 4, 0, 0
MyPrn 461, 271, "↓   下落", 13, 0, 0
MyPrn 460, 270, "↓   下落", 4, 0, 0
MyPrn 461, 301, "PgUp 加快", 13, 0, 0
MyPrn 460, 300, "PgUp 加快", 4, 0, 0
MyPrn 461, 331, "PgDn 减慢", 13, 0, 0
MyPrn 460, 330, "PgDn 减慢", 4, 0, 0
MyPrn 461, 361, "积分=0", 13, 0, 0
MyPrn 460, 360, "积分=0", 4, 0, 0
M$ = LTRIM$(RTRIM$(STR$(10 - Fast%)))
MyPrn 461, 391, "关卡=" + M$, 13, 0, 0
MyPrn 460, 390, "关卡=" + M$, 4, 0, 0
END SUB

接着上面





SUB Turn.Left (e AS BlType)
'将方块向左旋转
DIM T AS STRING * 6
N% = 1
FOR i% = 1 TO e.Hei
    FOR J% = 1 TO e.Wid
        M% = (e.Wid - J%) * e.Hei + i%
        IF MID$(e.Bit, N%, 1) = "1" THEN
              MID$(T$, M%, 1) = "1"
           ELSE
              MID$(T$, M%, 1) = "0"
        END IF
        N% = N% + 1
    NEXT
NEXT
SWAP e.Hei, e.Wid
e.Bit = T$
END SUB

SUB Turn.Right (e AS BlType)
'将方块向右旋转
DIM T AS STRING * 6
N% = 1
FOR i% = 1 TO e.Hei
    FOR J% = 1 TO e.Wid
        M% = J% * e.Hei - i% + 1
        IF MID$(e.Bit, N%, 1) = "1" THEN
              MID$(T$, M%, 1) = "1"
           ELSE
              MID$(T$, M%, 1) = "0"
        END IF
        N% = N% + 1
    NEXT
NEXT
SWAP e.Hei, e.Wid
e.Bit = T$
END SUB

接着上面




SUB Up.Pset (X%, Y%)
    PSET (X%, Y%), 12
    PSET (X%, Y% + 1), 6
    PSET (X% + 1, Y%), 5
    PSET (X% + 1, Y% + 1), 0
END SUB

SUB XYClear
'判断当前方块填充后是否已满
    FOR Y% = Bly% + CurBl.Hei - 1 TO Bly% STEP -1  '只看当前方块高度
        N% = 0
        FOR X% = 0 TO Wid - 1
            IF Xy(X%, Y%) THEN N% = N% + 1
        NEXT
        IF N% = Wid% THEN    '满了,清除并下移上面的方块           
            Works& = Works& + 35
            M$ = LTRIM$(RTRIM$(STR$(Works&)))
            LINE (500, 360)-(550, 377), BackClr%, BF
            MyPrn 501, 361, M$, 13, BackClr%, 0
            MyPrn 500, 360, M$, 4, 0, 0
            IF Works& MOD 700 = 0 THEN
                 Fast% = Fast% - 1
                 M$ = LTRIM$(RTRIM$(STR$(10 - Fast%)))
                 LINE (500, 390)-(520, 407), BackClr%, BF
                 MyPrn 501, 391, M$, 13, BackClr%, 0
                 MyPrn 500, 390, M$, 4, 0, 0
            END IF
            IF Fast% = 0 THEN
            END IF
            FOR i% = Y% TO 1 STEP -1
                FOR J% = 0 TO Wid% - 1
                    Xy(J%, i%) = Xy(J%, i% - 1)
                    Rx% = J% * Pexx% + bordx%
                    Ry% = i% * Pexy% + Bordy%
                    IF Xy(J%, i%) THEN
                          PUT (Rx%, Ry%), BPic, PSET
                       ELSE
                          LINE (Rx%, Ry%)-(Rx% + 15, Ry% + 15), 0, BF
                    END IF
                NEXT
            NEXT
            Y% = Y% + 1
        END IF
    NEXT
END SUB

接着上面




SUB XYSet
'方块最后停在这个位置,把数据写到数组
    N% = 1
    FOR Y% = 0 TO CurBl.Hei - 1
        FOR X% = 0 TO CurBl.Wid - 1
            IF MID$(CurBl.Bit, N%, 1) = "1" THEN
                Xy(X% + Blx%, Y% + Bly%) = 1
            END IF
            N% = N% + 1
        NEXT
    NEXT
END SUB

这贴我早看过了