XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Bilder überblenden
Lauffähig ab Profan-Version 5.0
Andreas Miethe * Bielefeld
Bei diesem Beispiel sollten alle Bilder gleich groß sein !
***********************************************************
DEF @Centerx(1) sub(div(%maxx,2),div(@!(1),2))
DEF @Centery(1) sub(div(%maxy,2),div(@!(1),2))
Declare ww%,w%,h%,z%,zz%
settruecolor 1
windowstyle 240
Window 0,0-%maxx,%maxy
cls rgb(0,0,0)

Proc pause

    Parameters t%
    Settimer t%
    Waitinput
    case %wmtimer:killtimer

Endproc

mloadbmp pic1.bmp
Let ww%=@CreateWindow(%hwnd,,centerx(%bmpx),centery(%bmpy),%bmpx,%bmpy)
setwindowpos ww%=centerx(%bmpx),centery(%bmpy)-%bmpx,%bmpy;0
startpaint ww%
showcursor 0
Let w%=%bmpx
Let h%=%bmpy
MCopyBmp 0,0-w%,h% > 0,0;0
mloadbmp pic2.bmp
Pause 1000
setwindowpos ww%=centerx(%bmpx),centery(%bmpy)-%bmpx,%bmpy;0
Zeilenweise von links nach rechts
Let z%=0

whilenot @equ(z%,w%)

    MCopyBmp z%,0-1,h% > z%,0;0
    inc z%

wend

mloadbmp pic1.bmp
Pause 1000
mloadbmp pic3.bmp
Pause 1000
Zeilenweise von rechts nach links
let z%=%bmpx

whilenot @equ(z%,0)

    MCopyBmp z%,0-1,h% > z%,0;0
    dec z%

wend

mloadbmp pic4.bmp
Pause 1000
Zeilenweise von oben nach unten
let z%=0

whilenot @equ(z%,240)

    MCopyBmp 0,z%-w%,1 > 0,z%;0
    inc z%

wend

mloadbmp pic1.bmp
Pause 1000
Zeilenweise von unten nach oben
let z%=%bmpy

whilenot @equ(z%,0)

    MCopyBmp 0,z%-w%,1 > 0,z%;0
    dec z%

wend

mloadbmp pic2.bmp
Pause 1000
Zeilenweise von links nach rechts und rechts nach links
Declare z1%
Let z1%=%bmpx
Let z%=0

whilenot @gt(z%,160)

    MCopyBmp z%,0-1,h% > z%,0;0
    MCopyBmp z1%,0-1,h% > z1%,0;0
    inc z%
    dec z1%

wend

mloadbmp pic1.bmp
Pause 1000
Zeilenweise von oben nach unten und unten nach oben
let z1%=%Bmpy
let z%=0

whilenot @gt(z%,120)

    MCopyBmp 0,z%-w%,1 > 0,z%;0
    MCopyBmp 0,z1%-w%,1 > 0,z1%;0
    inc z%
    dec z1%

wend

mloadbmp pic2.bmp
Pause 1000
Abschnittsweise von links nach rechts
Let z%=0

whilenot @equ(z%,40)

    MCopyBmp z%,0-1,h% > z%,0;0
    MCopyBmp add(z%,40),0-1,h% > add(z%,40),0;0
    MCopyBmp add(z%,80),0-1,h% > add(z%,80),0;0
    MCopyBmp add(z%,120),0-1,h% > add(z%,120),0;0
    MCopyBmp add(z%,160),0-1,h% > add(z%,160),0;0
    MCopyBmp add(z%,200),0-1,h% > add(z%,200),0;0
    MCopyBmp add(z%,240),0-1,h% > add(z%,240),0;0
    MCopyBmp add(z%,280),0-1,h% > add(z%,280),0;0
    inc z%

wend

mloadbmp pic4.bmp
Pause 1000
Abschnittsweise von oben nach unten
let z%=0

whilenot @equ(z%,30)

    MCopyBmp 0,add(z%,0)-w%,1 > 0,add(z%,0);0
    MCopyBmp 0,add(z%,30)-w%,1 > 0,add(z%,30);0
    MCopyBmp 0,add(z%,60)-w%,1 > 0,add(z%,60);0
    MCopyBmp 0,add(z%,90)-w%,1 > 0,add(z%,90);0
    MCopyBmp 0,add(z%,120)-w%,1 > 0,add(z%,120);0
    MCopyBmp 0,add(z%,150)-w%,1 > 0,add(z%,150);0
    MCopyBmp 0,add(z%,180)-w%,1 > 0,add(z%,180);0
    MCopyBmp 0,add(z%,210)-w%,1 > 0,add(z%,210);0
    inc z%

wend

mloadbmp pic3.bmp
Pause 1000
Von links einschieben
Let z%=-320

whilenot @gt(z%,0)

    MCopyBmp 0,0-w%,h% > z%,0;0
    add z%,4

wend

mloadbmp pic1.bmp
Pause 1000
Von oben einschieben
let z%=-240

whilenot @gt(z%,0)

    MCopyBmp 0,0-w%,h% > 0,z%;0
    add z%,4

wend

endpaint
pause 1500
showcursor 1
end