回 帖 发 新 帖 刷新版面

主题:在QBasic中实现动画

/*支持背景透明,无闪烁*/
DefInt A-Z

DECLARE SUB ClipBitmap (bmpdest() AS INTEGER, bmpsrc() AS INTEGER, x AS INTEGER, y AS INTEGER)
DECLARE SUB AlphaBitmap (bmpdest() AS INTEGER, bmpsrc() AS INTEGER, x AS INTEGER, y AS INTEGER, ColorKey AS INTEGER)
DECLARE SUB CreateBitmap (bmpData() AS INTEGER, w AS INTEGER, h AS INTEGER)
DECLARE FUNCTION GetDIMSize% (w AS INTEGER, h AS INTEGER)
DECLARE SUB CopyLine (bmpdest() AS INTEGER, bmpsrc() AS INTEGER, destoff AS LONG, srcoff AS LONG, length AS INTEGER)
DECLARE SUB AlphaLine (bmpdest() AS INTEGER, bmpsrc() AS INTEGER, destoff AS LONG, srcoff AS LONG, length AS INTEGER, ColorKey AS INTEGER)

SCREEN 13
DIM bg(32002) AS INTEGER
DIM ft(GetDIMSize(100, 100)) AS INTEGER
DIM fin(GetDIMSize(102, 100)) AS INTEGER

LINE (0, 0)-(319, 199), 2, BF
FOR i = 0 TO 10000
PSET (RND * 320, RND * 200), RND * 256
NEXT
GET (0, 0)-(319, 199), bg

CLS
CIRCLE (50, 50), 49, 1
CIRCLE (50, 50), 45, 1, 0, 6.28, .5
PAINT (2, 50), 1, 1
PAINT (50, 50), 0, 1
CIRCLE (50, 50), 20, 4
PAINT (50, 50), 4, 4
GET (0, 0)-(99, 99), ft

CreateBitmap fin(), 102, 100

CLS
PUT (0, 0), bg, PSET
i = 0

DO
IF i < 10 THEN z = 1
IF i > 210 THEN z = -1
ClipBitmap fin(), bg(), i, 30
AlphaBitmap fin(), ft(), 1, 0, 0
PUT (i, 30), fin, PSET
i = i + z
LOOP UNTIL INP(&H60) = 1

a$ = INPUT$(1)

SUB AlphaBitmap (bmpdest() AS INTEGER, bmpsrc() AS INTEGER, x AS INTEGER, y AS INTEGER, ColorKey AS INTEGER)
    DIM srch AS INTEGER
    DIM srcw AS INTEGER
    DIM destw AS LONG
    DIM srcoff AS LONG
    DIM destoff AS LONG
    srcw = bmpsrc(0) \ 8
    srch = bmpsrc(1)
    destw = bmpdest(0) \ 8
    FOR i = 0 TO srch - 1
        srcoff = i * srcw + 4
        destoff = (i + y) * destw + x + 4
        AlphaLine bmpdest(), bmpsrc(), destoff, srcoff, srcw - 1, c
    NEXT
END SUB

SUB AlphaLine (bmpdest() AS INTEGER, bmpsrc() AS INTEGER, destoff AS LONG, srcoff AS LONG, length AS INTEGER, ColorKey AS INTEGER)
    DIM c AS INTEGER
    FOR i = 0 TO length
        DEF SEG = VARSEG(bmpsrc(0))
        c = PEEK(i + srcoff)
        IF c <> ColorKey THEN
            DEF SEG = VARSEG(bmpdest(0))
            POKE i + destoff, c
        END IF
    NEXT
    DEF SEG
END SUB

SUB ClipBitmap (bmpdest() AS INTEGER, bmpsrc() AS INTEGER, x AS INTEGER, y AS INTEGER)
    DIM destw AS INTEGER
    DIM desth AS INTEGER
    DIM srcw AS LONG
    DIM srcoff AS LONG
    DIM destoff AS LONG
    destw = bmpdest(0) \ 8
    desth = bmpdest(1)
    srcw = bmpsrc(0) \ 8
    FOR i = 0 TO desth - 1
        destoff = i * destw + 4
        srcoff = (i + y) * srcw + x + 4
        CopyLine bmpdest(), bmpsrc(), destoff, srcoff, destw - 1
    NEXT
    EXIT SUB
END SUB

SUB CopyLine (bmpdest() AS INTEGER, bmpsrc() AS INTEGER, destoff AS LONG, srcoff AS LONG, length AS INTEGER)
    IF destoff MOD 2 = 0 AND srcoff MOD 2 = 0 THEN
        FOR i = 0 TO length \ 2
            bmpdest(destoff \ 2 + i) = bmpsrc(srcoff \ 2 + i)
        NEXT
    ELSE
        DIM c AS INTEGER
        FOR i = 0 TO length
            DEF SEG = VARSEG(bmpsrc(0))
            c = PEEK(i + srcoff)
            DEF SEG = VARSEG(bmpdest(0))
            POKE i + destoff, c
        NEXT
        DEF SEG
    END IF
END SUB

SUB CreateBitmap (bmpData() AS INTEGER, w AS INTEGER, h AS INTEGER)
    bmpData(0) = w * 8
    bmpData(1) = h
END SUB

FUNCTION GetDIMSize% (w AS INTEGER, h AS INTEGER)
    GetDIMSize% = (w * h + 1) \ 2 + 4
END FUNCTION

回复列表 (共11个回复)

11 楼

jsdkff

我来回复

您尚未登录,请登录后再回复。点此登录或注册