XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Animationen erstellen
Lauffähig ab Profan-Version 5.0
<========================================================================>
<               Animationen in Masse                                     >
<                                                                        >
<Beschreibung:                                                           >
<Dieser Quellcode soll zeigen, wie einfach es ist mit Profan²            >
<ansprechende Animationen zu programmieren. Durch die von mir            >
<entwickelte BMPEngine ist es auch kein Nachteil mehr, daß man in        >
<Profan² nur eine Memory-Bitmap hat.                                     >
<                                                                        >
<Autor: Waldemar Derr                                                    >
<eMail: Waldemar.Derr@t-online.de                                        >
<Home : http://home.t-online.de/home/waldemar.derr                       >
<                                                                        >
<Status: Dieser Code ist natürlich Freeware.                             >
<                                                                        >
<Hinweis:                                                                >
<In Version 6.1 läuft es nur im compilierten Zustand.                    >
<========================================================================>
 $I bmpengine.inc
windowstyle 16
window div&(sub(%maxx,512),2),div&(sub(%maxy,400),2)-512,400
windowtitle Animationen in Masse
randomize
settruecolor 1
setautopaint 0
declare bmp_cd%,bmp_draw%,bmp_hint%,cds%,count%,record%,bmp_wd%,timer&,frame%,frames%
declare cdx%,cdy%,cdx1%,cdy1%,cdxricht%,cdyricht%,cdframe%,cdspeed%
declare cds#,wechsel%,wechsel_timer&,wd%,akt_cds%,cd%,fast_area%
declare bmp_drawx%,bmp_drawy%,bmp_hintx%,bmp_hinty%,knoten%,width%,height%
declare t1%,t2%,t3%,t4%,t5% Temporäre Variablen
let width%=width(%hwnd)
let height%=height(%hwnd)
let cds%=1000
let akt_cds%=3
let record%=12
let fast_area%=createtext(%hwnd,,0,0,width%,height%) Das Zeichnen in einem Textfeld läuft viel schneller ab.
let wd%=1
let knoten%=0
let cd%=1
dim cds#,mul(record%,cds%)
dim$ 5
list$ 0=Mit rechter Maustaste beenden
list$ 1=Mit +/- Tasten die Anzahl der Objekte bestimmen
list$ 2=Mit Leertaste das Autor-Bild ein- oder ausblenden
list$ 3=Mit K-Taste die Knotenpunkte ein- oder ausblenden
list$ 4=Mit C-Taste die CDs ein- oder ausblenden
list$ 5=© Waldemar Derr

proc init_cds

    declare rndx%,rndy%
    let count%=0

    while neq(count%,cds%)

        let rndx%=rnd(sub(width%,30))
        let rndy%=rnd(sub(height%,26))
        word cds#,mul(count%,record%)=rndx%
        word cds#,add(mul(count%,record%),2)=rndy%
        word cds#,add(mul(count%,record%),4)=add(rndx%,30)
        word cds#,add(mul(count%,record%),6)=add(rndy%,26)
        byte cds#,add(mul(count%,record%),8)=rnd(2) xricht
        byte cds#,add(mul(count%,record%),9)=rnd(2) yricht
        byte cds#,add(mul(count%,record%),10)=rnd(5) frame
        byte cds#,add(mul(count%,record%),11)=add(rnd(10),1) speed
        inc count%

    wend

endproc

init_cds
bmpengineinit BMPEngine initialisieren (muß sein)
addbmp width%,height%
let bmp_draw%=@%(0) Handle für die Zeichenfläche
addbmp width%,height%
let bmp_hint%=@%(0) Handle für den Hintergrund
addbmp 120,26
let bmp_cd%=@%(0) handle für die CD-Bitmap
addbmp 141,183
let bmp_wd%=@%(0)
bmpenginerun Die Positionen der Bitmaps berechnen
let bmp_drawx%=bmpx(bmp_draw%)
let bmp_drawy%=bmpy(bmp_draw%)
let bmp_hintx%=bmpx(bmp_hint%)
let bmp_hinty%=bmpy(bmp_hint%)
mcls reqx(),reqy()
startpaint -1
usepen 0,1,rgb(255,255,255)
rectangle 0,0-reqx(),reqy()
rectangle bmp_hintx%,bmp_hinty%-add(bmp_hintx%,bmpwidth(bmp_hint%)),add(bmp_hinty%,bmpheight(bmp_hint%))
loadbmp cd.bmp,bmpx(bmp_cd%),bmpy(bmp_cd%);0
loadbmp wd.bmp,bmpx(bmp_wd%),bmpy(bmp_wd%);0
loadsizedbmp hint.bmp,bmp_hintx%,bmp_hinty%-width%,height%;0
endpaint
let timer&=add(&gettickcount,1000)
let wechsel_timer&=add(&gettickcount,3000)

while neq(%mousepressed,2)

    startpaint -1
    copybmp bmp_hintx%,bmp_hinty%-width%,height% > bmp_drawx%,bmp_drawy%;0
    usepen 0,1,0
    let count%=0

    while neq(count%,akt_cds%)

        let t1%=mul(count%,record%) zwischenspeicherung der variable zur steigerung der geschwindigkeit
        let cdx%=word(cds#,t1%)
        let cdy%=word(cds#,add(t1%,2))
        let cdx1%=word(cds#,add(t1%,4))
        let cdy1%=word(cds#,add(t1%,6))
        let cdxricht%=byte(cds#,add(t1%,8))
        let cdyricht%=byte(cds#,add(t1%,9))
        let cdframe%=byte(cds#,add(t1%,10))
        let cdspeed%=byte(cds#,add(t1%,11))

        if cdxricht%

            add cdx%,cdspeed%
            add cdx1%,cdspeed%

        else

            sub cdx%,cdspeed%
            sub cdx1%,cdspeed%

        endif

        if cdyricht%

            add cdy%,cdspeed%
            add cdy1%,cdspeed%

        else

            sub cdy%,cdspeed%
            sub cdy1%,cdspeed%

        endif

        if lt(cdx%,1)

            let cdxricht%=1
            let cdx%=0

        elseif gt(cdx1%,width%)

            let cdxricht%=0
            let cdx%=sub(width%,30)

        endif

        if lt(cdy%,1)

            let cdyricht%=1
            let cdy%=0

        elseif gt(cdy1%,height%)

            let cdyricht%=0
            let cdy%=sub(height%,26)

        endif

        inc cdframe%
        case gt(cdframe%,3):let cdframe%=0
        case knoten%:lineto add(cdx%,15),add(cdy%,13)
        case cd%:copybmp add(bmpx(bmp_cd%),mul(cdframe%,30)),bmpy(bmp_cd%)-30,26 > add(cdx%,bmp_drawx%),add(cdy%,bmp_drawy%);-1
        let t1%=mul(count%,record%)
        word cds#,t1%=cdx%
        word cds#,add(t1%,2)=cdy%
        word cds#,add(t1%,4)=add(cdx%,30)
        word cds#,add(t1%,6)=add(cdy%,26)
        byte cds#,add(t1%,8)=cdxricht%
        byte cds#,add(t1%,9)=cdyricht%
        byte cds#,add(t1%,10)=cdframe%
        inc count%

    wend

    inc frame%

    if gt(&gettickcount,timer&)

        let timer&=add(&gettickcount,1000)
        let frames%=div&(add(frames%,frame%),2)
        let frame%=0

    endif

    if gt(&gettickcount,wechsel_timer&)

        inc wechsel%
        case gt(wechsel%,5):let wechsel%=0
        let wechsel_timer&=add(&gettickcount,3000)

    endif

    usefont courier new,16,0,0,0,0
    textcolor 0,-1
    usebrush 1,rgb(192,192,192)
    usepen 5,0,0
    let t1%=bmp_drawx%
    let t2%=bmp_drawy%
    rectangle t1%,t2%-add(t1%,frames%),add(t2%,16)
    drawtext t1%,t2%,add$(Frames: ,str$(frames%))
    add t2%,18
    drawtext t1%,t2%,add$(Objekte: ,str$(akt_cds%))
    let t2%=sub(add(bmp_drawy%,height%),18)
    drawtext t1%,t2%,list$(wechsel%)
    let t1%=div&(sub(width%,141),2) X-Mitte im Fenster
    let t2%=div&(sub(height%,183),2) Y-Mitte im Fenster
    case wd%:copybmp bmpx(bmp_wd%),bmpy(bmp_wd%)-141,183 > add(t1%,bmp_drawx%),add(t2%,bmp_drawy%);-1
    endpaint
    Ausgabe des Inhalts auf das Textfeld (weils schneller ist)
    startpaint fast_area%
    mcopybmp bmp_drawx%,bmp_drawy%-width%,height% > 0,0;0
    endpaint
    Tastaturabfrage
    let t1%=1

    if scankey(109)

        dec akt_cds%
        case lt(akt_cds%,1):let akt_cds%=1

    elseif scankey(107)

        inc akt_cds%
        case gt(akt_cds%,cds%):let akt_cds%=cds%

    elseif scankey(32)

        let wd%=not(wd%)

    elseif scankey(75)

        let knoten%=not(knoten%)

    elseif scankey(67)

        let cd%=not(cd%)

    else

        let t1%=0

    endif

    case t1%:sendkey(%hwnd,0)

wend

disposeengine
dispose cds#
end