XProfan

Deutsch

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Farbverlauf erzeugen
Lauffähig ab Profan-Version 5.0
Farbverlauf von BLAU nach SCHWARZ
Andreas Miethe * Bielefeld * März 1998
Vielleicht brauchtbar für eigene SETUP-Programme
************************************************

Proc Verlauf32

    Def APIFillRect(3) ! USER32,FillRect,%#%,%
    Declare f%,zz%,b%,r%,g%,z%,h%
    Declare rect#
    Settruecolor 1
    Dim rect#,16
    Let h%=div&(%maxy,96)
    Let zz%=div&(%maxy,96)
    Let b%=255    -> BLAU
    |
    Usebrush 1,rgb(0,0,b%)
    word rect#,0=0
    word rect#,4=0
    word rect#,8=%maxx
    word rect#,12=h%
    APIFillRect(%hdc,rect#,b%)
    Let b%=255

    whilenot gt(z%,98)

        Usebrush 1,rgb(0,0,b%)
        word rect#,0=0
        word rect#,4=add(h%,div&(%maxy,96))
        word rect#,8=%maxx
        word rect#,12=h%
        APIFillRect(%hdc,rect#,0)
        let h%=add(h%,div&(%maxy,96))
        sub b%,3 			-> bei BLAU wird abgezogen
        case @lt(b%,0):Let b%=0
        inc z%

    wend

    dispose rect#

endproc

Windowstyle 240
Window 0,0-%maxx,%maxy
Verlauf32
Waitinput
End