(305)  Anmelden

Deutsch
Quelltexte/ Codesnippets

Bildbearbeitungsfilter Bitmaps

 

KompilierenMarkierenSeparieren
'Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
'Bitmaps: Bildbearbeitungsfilter
'Lauffähig ab Profan-Version 5.0
'+----------------------------------------------------------+
'| bild.prf                                                 |
'| Autor: Sebastian König                                   |
'| email: koenig.hil@t-online.de                            |
'| Homepage: https://www.sekoenig.mysite.de                  |
'| Einige Beispiel zu Bildbearbeitungsfiltern mit Profan.   |
'| VORSICHT: Läuft im Interpreter extrem langsam.           |
'+----------------------------------------------------------+
 $I filter.inc'----------------------------------------------------------------------------
'--Deklarationen
declare f1%,f2%,f3%,f4%
declare ende%
declare datei$
'--Neues Fenster
windowstyle 24
window 0,0-%maxX,%maxY
windowtitle "Einige Beispiele für Bildbearbeitungsfilter"
'SetTrueColor 1   <--Ist besser so
textcolor 0,-1
drawtext 0,0,"Bitte wählen..."
let f1%=@create("button",%hwnd,"Graustufen",100,100,200,30)
let f2%=@create("button",%hwnd,"Halbton",100,140,200,30)
let f3%=@create("button",%hwnd,"Weichzeichnen",100,180,200,30)
let f4%=@create("button",%hwnd,"Stark Weichzeichnen",100,220,200,30)
let ende%=1
chdir $winpath

while ende%

    waitinput

    if  @getfocus(f1%)

        @destroywindow(f1%)
        @destroywindow(f2%)
        @destroywindow(f3%)
        @destroywindow(f4%)
        let datei$=@LoadFile$("Datei öffnen...","*.BMP")
        LoadBmp datei$,0,0;0
        graustufen 0,0,%BmpX,%BmpY
        @messagebox("Fertig!","Meldung",0)
        end

    elseif @getfocus(f2%)

        @destroywindow(f1%)
        @destroywindow(f2%)
        @destroywindow(f3%)
        @destroywindow(f4%)
        let datei$=@LoadFile$("Datei öffnen...","*.BMP")' Datei auswählen...
        LoadBmp datei$,0,0;0'...laden...
        halbton 0,0,%BmpX,%BmpY'...und Filter anwenden
        @messagebox("Fertig!","Meldung",0)
        end

    elseif @getfocus(f3%)

        @destroywindow(f1%)
        @destroywindow(f2%)
        @destroywindow(f3%)
        @destroywindow(f4%)
        let datei$=@LoadFile$("Datei öffnen...","*.BMP")
        LoadBmp datei$,0,0;0
        weichzeichnen 0,0,%BmpX,%BmpY
        @messagebox("Fertig!","Meldung",0)
        end

    elseif @getfocus(f4%)

        @destroywindow(f1%)
        @destroywindow(f2%)
        @destroywindow(f3%)
        @destroywindow(f4%)
        let datei$=@LoadFile$("Datei öffnen...","*.BMP")
        LoadBmp datei$,0,0;0
        stark_weichzeichnen 0,0,%BmpX,%BmpY
        @messagebox("Fertig!","Meldung",0)
        end

    endif

wend

end

KompilierenMarkierenSeparieren
' $I filter.inc  Include Datei mit Filtern
'----------------------------------------------------------------------------
 $I profalt.inc

proc Graustufen

    parameters startx%,starty%,endx%,endy%
    declare x%,y%
    declare r%,g%,b%
    let x%=startx%
    let y%=starty%
    let endx%=@add(startx%,endx%)
    let endy%=@add(starty%,endy%)

    while @Lt(y%,endy%)

        while @Lt(x%,endx%)

            let r%=@div&(@add(@add(@GetRValue(@GetPixel(x%,y%)),@GetGValue(\
            @GetPixel(x%,y%))),@GetBValue(@GetPixel(x%,y%))),3)
            let g%=r%
            let b%=g%
            SetPixel x%,y%,@RGB(r%,g%,b%)
            inc x%

        wend

        let x%=startx%
        inc y%

    wend

endproc

proc Weichzeichnen

    parameters startx%,starty%,endx%,endy%
    declare x%,y%
    declare r%,g%,b%
    let x%=startx%
    let y%=starty%
    let endx%=@sub(@add(startx%,endx%),1)
    let endy%=@sub(@add(starty%,endy%),1)

    while @Lt(y%,endy%)

        while @Lt(x%,endx%)

            let r%=@div&(@add(@add(@GetRValue(@getPixel(x%,y%)),@GetRValue(@getPixel(@add(x%,1),y%))),\
            @GetRValue(@getPixel(x%,@add(y%,1)))),3)
            let g%=@div&(@add(@add(@GetGValue(@getPixel(x%,y%)),@GetGValue(@getPixel(@add(x%,1),y%))),\
            @GetGValue(@getPixel(x%,@add(y%,1)))),3)
            let b%=@div&(@add(@add(@GetBValue(@getPixel(x%,y%)),@GetBValue(@getPixel(@add(x%,1),y%))),\
            @GetBValue(@getPixel(x%,@add(y%,1)))),3)
            SetPixel x%,y%,@RGB(r%,g%,b%)
            inc x%

        wend

        let x%=startx%
        inc y%

    wend

endproc

proc Stark_Weichzeichnen

    parameters startx%,starty%,endx%,endy%
    declare x%,y%
    declare r%,g%,b%
    declare value1%,value2%,value3%,value4%,value5%
    let x%=@add(startx%,1)
    let y%=@add(starty%,1)
    let endx%=@sub(@add(startx%,endx%),1)
    let endy%=@sub(@add(starty%,endy%),1)

    while @Lt(y%,endy%)

        while @Lt(x%,endx%)

            let value1%=@getRValue(@GetPixel(x%,y%))
            let value2%=@getRValue(@GetPixel(@add(x%,1),y%))
            let value3%=@getRValue(@GetPixel(x%,@add(y%,1)))
            let value4%=@getRValue(@getPixel(@sub(x%,1),y%))
            let value5%=@getRValue(@getPixel(x%,@sub(y%,1)))
            let r%=@div&(@add(@add(@add(value1%,value2%),@add(value3%,value4%)),value5%),5)
            let value1%=@getGValue(@GetPixel(x%,y%))
            let value2%=@getGValue(@GetPixel(@add(x%,1),y%))
            let value3%=@getGValue(@GetPixel(x%,@add(y%,1)))
            let value4%=@getGValue(@getPixel(@sub(x%,1),y%))
            let value5%=@getGValue(@getPixel(x%,@sub(y%,1)))
            let g%=@div&(@add(@add(@add(value1%,value2%),@add(value3%,value4%)),value5%),5)
            let value1%=@getBValue(@GetPixel(x%,y%))
            let value2%=@getBValue(@GetPixel(@add(x%,1),y%))
            let value3%=@getBValue(@GetPixel(x%,@add(y%,1)))
            let value4%=@getBValue(@getPixel(@sub(x%,1),y%))
            let value5%=@getBValue(@getPixel(x%,@sub(y%,1)))
            let b%=@div&(@add(@add(@add(value1%,value2%),@add(value3%,value4%)),value5%),5)
            SetPixel x%,y%,@RGB(r%,g%,b%)
            inc x%

        wend

        let x%=startx%
        inc y%

    wend

endproc

proc Halbton

    parameters startx%,starty%,endx%,endy%
    declare x%,y%
    declare color%
    let x%=startx%
    let y%=starty%
    let endx%=@add(startx%,endx%)
    let endy%=@add(starty%,endy%)

    while @Lt(y%,endy%)

        while @Lt(x%,endx%)

            let color%=@div&(@add(@add(@GetRValue(@GetPixel(x%,y%)),@GetGValue(\
            @GetPixel(x%,y%))),@GetBValue(@GetPixel(x%,y%))),3)
            case @equ(color%,@div&(255,2)) : let color%=@RGB(255,255,255)
            case @Lt(color%,@div&(255,2))  : let color%=@RGB(0,0,0)
            case @Gt(color%,@div&(255,2))  : let color%=@RGB(255,255,255)
            SetPixel x%,y%,color%
            inc x%

        wend

        let x%=startx%
        inc y%

    wend

endproc
 
15.07.2007  ▲
 




Jörg
Sellmeyer
filter.inc und Hauptprogramm zusammengefasst.
Das wäre doch mal was, wenn der Code nach ASM portiert würde...
KompilierenMarkierenSeparieren
'Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
'Bitmaps: Bildbearbeitungsfilter
'Lauffähig ab Profan-Version 5.0
'+----------------------------------------------------------+
'| bild.prf                                                 |
'| Autor: Sebastian König                                   |
'| email: koenig.hil@t-online.de                            |
'| Homepage: https://www.sekoenig.mysite.de                  |
'| Einige Beispiel zu Bildbearbeitungsfiltern mit Profan.   |
'| VORSICHT: Läuft im Interpreter extrem langsam.           |
'+----------------------------------------------------------+
' $I filter.inc  Include Datei mit Filtern
'----------------------------------------------------------------------------
 $I profalt.inc

proc Graustufen

    parameters startx%,starty%,endx%,endy%
    declare x%,y%
    declare r%,g%,b%
    let x%=startx%
    let y%=starty%
    let endx%=@add(startx%,endx%)
    let endy%=@add(starty%,endy%)

    while @Lt(y%,endy%)

        while @Lt(x%,endx%)

            let r%=@div&(@add(@add(@GetRValue(@GetPixel(x%,y%)),@GetGValue(\
            @GetPixel(x%,y%))),@GetBValue(@GetPixel(x%,y%))),3)
            let g%=r%
            let b%=g%
            SetPixel x%,y%,@RGB(r%,g%,b%)
            inc x%

        wend

        let x%=startx%
        inc y%

    wend

endproc

proc Weichzeichnen

    parameters startx%,starty%,endx%,endy%
    declare x%,y%
    declare r%,g%,b%
    let x%=startx%
    let y%=starty%
    let endx%=@sub(@add(startx%,endx%),1)
    let endy%=@sub(@add(starty%,endy%),1)

    while @Lt(y%,endy%)

        while @Lt(x%,endx%)

            let r%=@div&(@add(@add(@GetRValue(@getPixel(x%,y%)),@GetRValue(@getPixel(@add(x%,1),y%))),\
            @GetRValue(@getPixel(x%,@add(y%,1)))),3)
            let g%=@div&(@add(@add(@GetGValue(@getPixel(x%,y%)),@GetGValue(@getPixel(@add(x%,1),y%))),\
            @GetGValue(@getPixel(x%,@add(y%,1)))),3)
            let b%=@div&(@add(@add(@GetBValue(@getPixel(x%,y%)),@GetBValue(@getPixel(@add(x%,1),y%))),\
            @GetBValue(@getPixel(x%,@add(y%,1)))),3)
            SetPixel x%,y%,@RGB(r%,g%,b%)
            inc x%

        wend

        let x%=startx%
        inc y%

    wend

endproc

proc Stark_Weichzeichnen

    parameters startx%,starty%,endx%,endy%
    declare x%,y%
    declare r%,g%,b%
    declare value1%,value2%,value3%,value4%,value5%
    let x%=@add(startx%,1)
    let y%=@add(starty%,1)
    let endx%=@sub(@add(startx%,endx%),1)
    let endy%=@sub(@add(starty%,endy%),1)

    while @Lt(y%,endy%)

        while @Lt(x%,endx%)

            let value1%=@getRValue(@GetPixel(x%,y%))
            let value2%=@getRValue(@GetPixel(@add(x%,1),y%))
            let value3%=@getRValue(@GetPixel(x%,@add(y%,1)))
            let value4%=@getRValue(@getPixel(@sub(x%,1),y%))
            let value5%=@getRValue(@getPixel(x%,@sub(y%,1)))
            let r%=@div&(@add(@add(@add(value1%,value2%),@add(value3%,value4%)),value5%),5)
            let value1%=@getGValue(@GetPixel(x%,y%))
            let value2%=@getGValue(@GetPixel(@add(x%,1),y%))
            let value3%=@getGValue(@GetPixel(x%,@add(y%,1)))
            let value4%=@getGValue(@getPixel(@sub(x%,1),y%))
            let value5%=@getGValue(@getPixel(x%,@sub(y%,1)))
            let g%=@div&(@add(@add(@add(value1%,value2%),@add(value3%,value4%)),value5%),5)
            let value1%=@getBValue(@GetPixel(x%,y%))
            let value2%=@getBValue(@GetPixel(@add(x%,1),y%))
            let value3%=@getBValue(@GetPixel(x%,@add(y%,1)))
            let value4%=@getBValue(@getPixel(@sub(x%,1),y%))
            let value5%=@getBValue(@getPixel(x%,@sub(y%,1)))
            let b%=@div&(@add(@add(@add(value1%,value2%),@add(value3%,value4%)),value5%),5)
            SetPixel x%,y%,@RGB(r%,g%,b%)
            inc x%

        wend

        let x%=startx%
        inc y%

    wend

endproc

proc Halbton

    parameters startx%,starty%,endx%,endy%
    declare x%,y%
    declare color%
    let x%=startx%
    let y%=starty%
    let endx%=@add(startx%,endx%)
    let endy%=@add(starty%,endy%)

    while @Lt(y%,endy%)

        while @Lt(x%,endx%)

            let color%=@div&(@add(@add(@GetRValue(@GetPixel(x%,y%)),@GetGValue(\
            @GetPixel(x%,y%))),@GetBValue(@GetPixel(x%,y%))),3)
            case @equ(color%,@div&(255,2)) : let color%=@RGB(255,255,255)
            case @Lt(color%,@div&(255,2))  : let color%=@RGB(0,0,0)
            case @Gt(color%,@div&(255,2))  : let color%=@RGB(255,255,255)
            SetPixel x%,y%,color%
            inc x%

        wend

        let x%=startx%
        inc y%

    wend

endproc

'Filter.inc Ende
'----------------------------------------------------------------------------
'--Deklarationen
declare f1%,f2%,f3%,f4%
declare ende%
declare datei$
'--Neues Fenster
windowstyle 24
window 0,0-%maxX,%maxY
windowtitle "Einige Beispiele für Bildbearbeitungsfilter"
'SetTrueColor 1   <--Ist besser so
textcolor 0,-1
drawtext 0,0,"Bitte wählen..."
let f1%=@create("button",%hwnd,"Graustufen",100,100,200,30)
let f2%=@create("button",%hwnd,"Halbton",100,140,200,30)
let f3%=@create("button",%hwnd,"Weichzeichnen",100,180,200,30)
let f4%=@create("button",%hwnd,"Stark Weichzeichnen",100,220,200,30)
let ende%=1
chdir $winpath

while ende%

    waitinput

    if  @getfocus(f1%)

        @destroywindow(f1%)
        @destroywindow(f2%)
        @destroywindow(f3%)
        @destroywindow(f4%)
        let datei$=@LoadFile$("Datei öffnen...","*.BMP")
        LoadBmp datei$,0,0;0
        graustufen 0,0,%BmpX,%BmpY
        @messagebox("Fertig!","Meldung",0)
        end

    elseif @getfocus(f2%)

        @destroywindow(f1%)
        @destroywindow(f2%)
        @destroywindow(f3%)
        @destroywindow(f4%)
        let datei$=@LoadFile$("Datei öffnen...","*.BMP")' Datei auswählen...
        LoadBmp datei$,0,0;0'...laden...
        halbton 0,0,%BmpX,%BmpY'...und Filter anwenden
        @messagebox("Fertig!","Meldung",0)
        end

    elseif @getfocus(f3%)

        @destroywindow(f1%)
        @destroywindow(f2%)
        @destroywindow(f3%)
        @destroywindow(f4%)
        let datei$=@LoadFile$("Datei öffnen...","*.BMP")
        LoadBmp datei$,0,0;0
        weichzeichnen 0,0,%BmpX,%BmpY
        @messagebox("Fertig!","Meldung",0)
        end

    elseif @getfocus(f4%)

        @destroywindow(f1%)
        @destroywindow(f2%)
        @destroywindow(f3%)
        @destroywindow(f4%)
        let datei$=@LoadFile$("Datei öffnen...","*.BMP")
        LoadBmp datei$,0,0;0
        stark_weichzeichnen 0,0,%BmpX,%BmpY
        @messagebox("Fertig!","Meldung",0)
        end

    endif

wend

end
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
23.06.2018  ▲
 



Zum Quelltext


Thementitel, max. 100 Zeichen.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Beitrag  Schrift  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Themenoptionen

Ungelesen
Abonnieren
Merkliste
Hinweise
Gäste
Löschen
Ständig
Erledigt

3.274 Betrachtungen

Unbenanntvor 0 min.
Stringray05.01.2022
Rolf Koch06.09.2020
Georg Teles26.08.2019
Pedro Miguel17.05.2019
Mehr...

Themeninformationen

Dieses Thema hat 2 Teilnehmer:

Jörg Sellmeyer (1x)
unbekannt (1x)


Admins  |  AGB  |  Anwendungen  |  Autoren  |  Chat  |  Datenschutz  |  Download  |  Eingangshalle  |  Hilfe  |  Händlerportal  |  Impressum  |  Mart  |  Schnittstellen  |  SDK  |  Services  |  Spiele  |  Suche  |  Support

Ein Projekt aller XProfaner, die es gibt!


Mein XProfan
Private Nachrichten
Eigenes Ablageforum
Themen-Merkliste
Eigene Beiträge
Eigene Themen
Zwischenablage
Abmelden
 Deutsch English Français Español Italia
Übersetzungen

Datenschutz


Wir verwenden Cookies nur als Session-Cookies wegen der technischen Notwendigkeit und bei uns gibt es keine Cookies von Drittanbietern.

Wenn du hier auf unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung von Informationen in unseren Cookies auf XProfan.Net zu.

Weitere Informationen zu unseren Cookies und dazu, wie du die Kontrolle darüber behältst, findest du in unserer nachfolgenden Datenschutzerklärung.

einverstandenDatenschutzerklärung
Ich möchte keinen Cookie