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
(931)
Deutsch
English
Français
Español
Italia