XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Bild rotieren (Flip-Rotator)
Lauffähig ab Profan-Version 5.0
###############################
WIRKUNGSWEISE DIESES PROGRAMMS
VON THOMAS KUSE
HTTP://WWW.UNICON-GMBH.COM/~thk
###############################
Das Programm liest zwei Pixel-Kordinaten ein, links-oben und rechts-unten.
Dann wird die Farbe bestimmt, die dann als eine Zahl vorliegt.
Und die beiden Farbwerte werden vertauscht.
Getestet wurde das Programm auf:
- einem Win95 Rechner mit einem Intel 150Mhz, 32 MB RAM und einer Elsa 2MB Grafikkarte
- einem WinNT Rechner mit einem AMD K6 200Mhz, 40 MB RAM und einer Miro 2MB Grafikkarte  (<--meiner)
- einem Win95 Rechner mit einem AMD K5 166Mhz, 16 MB RAM, und einer normalen 2MB Grafikkarte
Viel Spaß!!!!!!!!
Einstellung der Farbtiefe
case @gt(%BitsPixel,15):settruecolor 1
case @lt(%BitsPixel,8):end
Declarierung der Variablen
declare name$,color1&,x1%,y1%,schleife%,rot1&,grün1&,blau1&,rot2&,blau2&,grün2&,message%,name2$,rot3&,blau3&,grün3&,color3&
declare maxx%,maxy%,x2%,y2%,color2&
Fenster erstellen
windowstyle 31
window 0,0-%maxx,%maxy
windowtitle Der Flip-Rotator von Thomas Kuse
Bild laden
Let name$ = @LoadFile$(Lade ein Bild,Normal|*.BMP|komprimiert|*.RLE)
LoadBmp name$, 0,0;0
Eingabe
let maxx%=@input$(Gib den Endwert für x an, der gescaled werden soll!,Höchster Wert für x,%bmpx)
let maxy%=@input$(Gib den Endwert für y an, der gescaled werden soll!,Höchster Wert für y,%bmpy)
casenot @equ(@Mod(maxx%,2),0):inc maxx%
casenot @equ(@Mod(maxy%,2),0):inc maxy%
let x2%=maxx%
let y2%=maxy%
Beginn der Schleife

whilenot schleife%

    let color1&=@getpixel(x1%,y1%)
    let color2&=@getpixel(x2%,y2%)
    SetPixel x1%,y1%,color2&
    SetPixel x2%,y2%,color1&

    if @equ(x1%,maxx%)

        let x1%=0
        inc y1%

    endif

    if @equ(x2%,0)

        let x2%=maxx%
        dec y2%

    endif

    if @equ(x1%,x2%)

        if @equ(y1%,y2%)

            let schleife%=1

        endif

    endif

    weiter:
    inc x1%
    dec x2%

wend

@messagebox(Der Flip-Rotator ist beendet!,Fertig,64)
let message%=@messagebox(Wollen Sie den Auschnitt nun abspeichern?,Abspeichern?,68)

if @equ(message%,6)

    Let name2$ = @saveFile$(Lade ein Bild,name$)
    SaveBmp name2$,0,0-maxx%,maxy%

else

endif

waitinput