XProfan

Italia

Hier meine Sprite.inc, welche der Prospeed.dll in Sachen Sprites naturalmente nie den Rang ablaufen kann, aber mir bevor ich die Prospeed.dll kannte gute Dienste geleistet hatte.
Kompilieren Markieren Separieren

iFs Sprite.inc
Declare diff%,maxnumsprites%
Let Maxnumsprites%=100
Declare Frachtx%[Maxnumsprites%,1],Frachty%[Maxnumsprites%,1],Frachtxw%[Maxnumsprites%,1],Frachtyw%[Maxnumsprites%,1],Backworkx%,Backworky%,OldFrachtx%[Maxnumsprites%,1],OldFrachty%[Maxnumsprites%,1]
Declare Frachtspritexpos%[Maxnumsprites%,1],Frachtspriteypos%[Maxnumsprites%,1],kollidstr$,white&,gray&,Gray2&,Mainx%,Mainy%

Proc Restoretop

    SUB Diff%,Diff%
    SUB Diff%,OldFrachtY%[NUM%,1]
    ADD Diff%,Frachty%[NUM%,1]
    Mcopybmp add(Backworkx%,Oldfrachtx%[NUM%,1]),add(Backworky%,Oldfrachty%[NUM%,1]) - Frachtxw%[NUM%,1],diff% > add(Mainx%,Oldfrachtx%[NUM%,1]),add(Mainy%,Oldfrachty%[NUM%,1]);0

Endproc

Proc Restoreleft

    SUB Diff%,Diff%
    SUB Diff%,OldFrachtx%[NUM%,1]
    ADD Diff%,Frachtx%[NUM%,1]
    Mcopybmp add(Backworkx%,Oldfrachtx%[NUM%,1]),@add(Backworky%,Oldfrachty%[NUM%,1]) - diff%,Frachtyw%[NUM%,1] > add(Mainx%,Oldfrachtx%[NUM%,1]),add(Mainy%,Oldfrachty%[NUM%,1]);0

Endproc

Proc Restorebottom

    SUB Diff%,Diff%
    SUB Diff%,Frachty%[NUM%,1]
    ADD Diff%,OldFrachtY%[NUM%,1]
    Mcopybmp add(Backworkx%,Oldfrachtx%[NUM%,1]),@add(Backworky%,@ADD(Frachty%[NUM%,1],Frachtyw%[NUM%,1])) - Frachtxw%[NUM%,1],diff% > add(Mainx%,Oldfrachtx%[NUM%,1]),add(mainy%,ADD(frachty%[NUM%,1],Frachtyw%[NUM%,1]));0

Endproc

Proc Restoreright

    SUB Diff%,Diff%
    SUB Diff%,Frachtx%[NUM%,1]
    ADD Diff%,OldFrachtx%[NUM%,1]
    Mcopybmp add(Backworkx%,@ADD(FrachtX%[NUM%,1],FrachtXw%[NUM%,1])),@add(Backworky%,Oldfrachty%[NUM%,1]) - diff%,Frachtyw%[NUM%,1] > add(Mainx%,ADD(frachtx%[NUM%,1],Frachtxw%[NUM%,1])),add(Mainy%,Oldfrachty%[NUM%,1]);0

Endproc

Proc Declarebackground

    Parameters S$,x%,y%,workfield%
    SUB Backworkx%,Backworkx%
    SUB Backworky%,Backworky%
    ADD BACKWORKX%,0
    ADD BACKWORKY%,@add(Y%,10)
    MCLS @add(X%,workfield%),@add(20,@Mul(Y%,2))
    Startpaint -1
    loadsizedbmp s$,0,0-x%,y% ;0
    loadsizedbmp s$,Backworkx%,Backworky%-x%,y% ;0
    Endpaint
    Mcopybmp 0,0 - X%,y% > Mainx%,Mainy%;0

Endproc

Proc Declaresprite

    Parameters S$,X%,Y%,num%
    Startpaint -1
    Loadbmp S$,X%,Y%;0
    Endpaint
    LET Frachtspritexpos%[num%,1]=X%
    LET Frachtspriteypos%[num%,1]=Y%
    LET FRACHTXW%[num%,1]=%BMPX
    LET FRACHTYW%[num%,1]=%BMPY

Endproc

Proc Declaremovesprite

    Parameters X%,Y%,num%
    let Frachtx%[Num%,1]=X%
    let Frachty%[Num%,1]=Y%
    CopyBmp FRACHTSPRITEXPOS%[NUM%,1],FRACHTSPRITEYPOS%[NUM%,1] - Frachtxw%[NUM%,1],frachtyw%[NUM%,1] > ADD(Backworkx%,Frachtx%[Num%,1]),aDD(Backworky%,Frachty%[num%,1]);-1

Endproc

Proc Declarepaintsprite

    Parameters num%
    MCopybmp ADD(Backworkx%,Frachtx%[Num%,1]),ADD(Backworky%,Frachty%[num%,1]) -  Frachtxw%[NUM%,1],frachtyw%[NUM%,1] > add(Mainx%,Frachtx%[NUM%,1]),add(Mainy%,Frachty%[NUM%,1]);0
    Case gt(Frachty%[NUM%,1],Oldfrachty%[NUM%,1]) : Restoretop
    Case gt(Frachtx%[NUM%,1],Oldfrachtx%[NUM%,1]) : Restoreleft
    Case lt(Frachty%[NUM%,1],Oldfrachty%[NUM%,1]) : Restorebottom
    Case lt(Frachtx%[NUM%,1],Oldfrachtx%[NUM%,1]) : Restoreright
    let Oldfrachtx%[NUM%,1]=frachtx%[NUM%,1]
    let Oldfrachty%[NUM%,1]=Frachty%[NUM%,1]

Endproc

Proc Declarerefresh

    Parameters num%
    CopyBmp Frachtx%[NUM%,1],Frachty%[NUM%,1] - Frachtxw%[NUM%,1],Frachtyw%[NUM%,1] > @ADD(Backworkx%,Frachtx%[Num%,1]),@ADD(Backworky%,Frachty%[num%,1]);0

endproc

Proc Killsprite

    Parameters num%
    Startpaint -1
    Usepen 0,1,0
    Usebrush 1,0
    Rectangle Frachtx%[NUM%,1],Frachty%[NUM%,1] - Frachtxw%[NUM%,1],Frachtyw%[NUM%,1]
    Endpaint
    Declarerefresh num%
    Startpaint -1
    MCopyBmp Frachtx%[NUM%,1],Frachty%[NUM%,1] - Frachtxw%[NUM%,1],Frachtyw%[NUM%,1] > @ADD(Backworkx%,Frachtx%[Num%,1]),@ADD(Backworky%,Frachty%[num%,1]);0
    Endpaint
    Declarepaintsprite num%

endproc

Proc declarerepaint

    Parameters num%
    declarerefresh num%
    declaremovesprite frachtx%[num%,1],frachty%[num%,1],num%
    declarepaintsprite num%

endproc

Let kollidstr$=nokollid
Let white&=rgb(255,255,255)
Let gray& =rgb(192,192,192)
Let gray2&=rgb(100,100,100)
Let Mainx%=an>
Let Mainy%=0

Ein dazugehöriges funktionierendes Beispiel wäre folgendes:
Kompilieren Markieren Separieren

 $I Sprites.inc
Def Sleep(1) !KERNEL32,Sleep
DEF EnumDisplaySettings(3) !USER32,EnumDisplaySettingsA
DEF ChangeDisplaySettings(2) !USER32,ChangeDisplaySettingsA
Declare devmode#, int_resoOldValue%
dim devmode#,148

Proc res

    Parameters x%,bpp%
    declare a&,b%,fehl&,y%
    Let int_ResoOldValue%=%maxx
    Decimals 0
    Case equ(X%,320) : let y%=240
    Case equ(X%,640) : Let y%=480
    Case equ(X%,800) : Let y%=600
    Case equ(X%,1024): Let y%=768
    Case equ(X%,1152): Let y%=864
    Case equ(X%,1280): Let y%=1024
    Case equ(X%,1600): Let y%=1200
    Case equ(X%,1900): Let y%=1600
    Case gt(X%,1900) : Let y%=mul(3,div(X%,4))
    let a&=1

    while a&

        let a&=EnumDisplaySettings(0,b%,devmode#)
        inc b%

    wend

    long devmode#,40=1572864
    long devmode#,104=bpp%
    long devmode#,108=x%
    long devmode#,112=y%
    ChangeDisplaySettings(devmode#,0)

endproc

res 640,32
windowstyle 112
windowtitle Game
window 0,0 - 640,480
Declarebackground bg.bmp,640,480,500
Declaresprite sprite.bmp,650,0,1

whilenot %Mousepressed

    startpaint -1
    declarerefresh 1
    declarerefresh 2
    declaremovesprite %Mousex,%Mousey,1
    declaremovesprite %Mousex,%Mousey,2
    endpaint
    declarepaintsprite 1
    declarepaintsprite 2

wend

res int_resooldvalue%,32
dispose devmode#

Salve, iF.