回 帖 发 新 帖 刷新版面

主题:在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个回复)

沙发

很精彩!希望能继续啊。
提醒一下
这是qb,not c,
注释应该这样:
rem
'

板凳

谁试个没有?

3 楼

楼主的店里怎么没有我想要的东西?

4 楼

楼主的东西可以在VB里用吗?[em9]

5 楼

楼主的东东  可以在  vb   中用   但 有一点麻烦啊
        楼主   啊  那个东东是不是你编的啊

6 楼

vb请用API Bitblt或用DirectX

7 楼

顶一下

8 楼

in=1
Error in+0+x+00000009

9 楼

好厉害呀!顶!

10 楼

我顶

我来回复

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