(790)  S'inscrire

Français
Source/ Codesnippets

Bildbearbeitungsfilter Bitmaps

 

KompilierenMarqueSéparation
'Source wurde am 15.07.2007 aus qui MMJ-Quellcodesammlung (Dietmar Horn) dans qui Babyklappe sur XProfan.Com abgelegt:
'Bitmaps: Bildbearbeitungsfilter
'Lauffähig ab Profan-Version 5.0
'+----------------------------------------------------------+
'| bild.prf                                                 |
'| Autor: Sebastian König                                   |
'| email: koenig.hil@t-online.de                            |
'| Page d'accueil: https://www.sekoenig.mysite.de                  |
'| quelques Beispiel trop Bildbearbeitungsfiltern avec Profan.   |
'| VORSICHT: Läuft im Interpreter extrem lente.           |
'+----------------------------------------------------------+
 $I filtre.inc'----------------------------------------------------------------------------
'--Deklarationen
declare f1%,f2%,f3%,f4%
declare ende%
declare fichier$
'--Neues la fenêtre
style de fenêtre 24
window 0,0-%maxx,%maxY
windowtitle "Einige Beispiele pour Bildbearbeitungsfilter"
'SetTrueColor 1   <--Ist besser so
textcolor 0,-1
drawtext 0,0,"Bitte choisir..."
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

tandis que ende%

    waitinput

    si  @getfocus(f1%)

        @destroywindow(f1%)
        @destroywindow(f2%)
        @destroywindow(f3%)
        @destroywindow(f4%)
        let fichier$=@LoadFile$("Datei ouvrir...","*.BMP")
        LoadBmp fichier$,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 fichier$=@LoadFile$("Datei ouvrir...","*.BMP")' Dossier auswählen...
        LoadBmp fichier$,0,0;0'...magasin...
        halbton 0,0,%BmpX,%BmpY'...et filtre anwenden
        @messagebox("Fertig!","Meldung",0)
        end

    elseif @getfocus(f3%)

        @destroywindow(f1%)
        @destroywindow(f2%)
        @destroywindow(f3%)
        @destroywindow(f4%)
        let fichier$=@LoadFile$("Datei ouvrir...","*.BMP")
        LoadBmp fichier$,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 fichier$=@LoadFile$("Datei ouvrir...","*.BMP")
        LoadBmp fichier$,0,0;0
        stark_weichzeichnen 0,0,%BmpX,%BmpY
        @messagebox("Fertig!","Meldung",0)
        end

    endif

Wend

end

KompilierenMarqueSéparation
' $I filtre.inc  Include Dossier avec 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%)

    tandis que @Lt(y%,endy%)

        tandis que @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)

    tandis que @Lt(y%,endy%)

        tandis que @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)

    tandis que @Lt(y%,endy%)

        tandis que @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%)

    tandis que @Lt(y%,endy%)

        tandis que @Lt(x%,endx%)

            let color%=@div&(@add(@add(@GetRValue(@GetPixel(% X, y%)),@GetGValue(\
            @GetPixel(% X, y%))),@GetBValue(@GetPixel(% X, y%))),3)
            cas @equ(color%,@div&(255,2)) : let color%=@RGB(255,255,255)
            cas @Lt(color%,@div&(255,2))  : let color%=@RGB(0,0,0)
            cas @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
filtre.inc et Hauptprogramm zusammengefasst.
cela wäre doch la fois quoi, si qui Code pour ASM portiert serait...
KompilierenMarqueSéparation
'Source wurde am 15.07.2007 aus qui MMJ-Quellcodesammlung (Dietmar Horn) dans qui Babyklappe sur XProfan.Com abgelegt:
'Bitmaps: Bildbearbeitungsfilter
'Lauffähig ab Profan-Version 5.0
'+----------------------------------------------------------+
'| bild.prf                                                 |
'| Autor: Sebastian König                                   |
'| email: koenig.hil@t-online.de                            |
'| Page d'accueil: https://www.sekoenig.mysite.de                  |
'| quelques Beispiel trop Bildbearbeitungsfiltern avec Profan.   |
'| VORSICHT: Läuft im Interpreter extrem lente.           |
'+----------------------------------------------------------+
' $I filtre.inc  Include Dossier avec 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%)

    tandis que @Lt(y%,endy%)

        tandis que @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)

    tandis que @Lt(y%,endy%)

        tandis que @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)

    tandis que @Lt(y%,endy%)

        tandis que @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%)

    tandis que @Lt(y%,endy%)

        tandis que @Lt(x%,endx%)

            let color%=@div&(@add(@add(@GetRValue(@GetPixel(% X, y%)),@GetGValue(\
            @GetPixel(% X, y%))),@GetBValue(@GetPixel(% X, y%))),3)
            cas @equ(color%,@div&(255,2)) : let color%=@RGB(255,255,255)
            cas @Lt(color%,@div&(255,2))  : let color%=@RGB(0,0,0)
            cas @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

'filtre.inc Ende
'----------------------------------------------------------------------------
'--Deklarationen
declare f1%,f2%,f3%,f4%
declare ende%
declare fichier$
'--Neues la fenêtre
style de fenêtre 24
window 0,0-%maxx,%maxY
windowtitle "Einige Beispiele pour Bildbearbeitungsfilter"
'SetTrueColor 1   <--Ist besser so
textcolor 0,-1
drawtext 0,0,"Bitte choisir..."
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

tandis que ende%

    waitinput

    si  @getfocus(f1%)

        @destroywindow(f1%)
        @destroywindow(f2%)
        @destroywindow(f3%)
        @destroywindow(f4%)
        let fichier$=@LoadFile$("Datei ouvrir...","*.BMP")
        LoadBmp fichier$,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 fichier$=@LoadFile$("Datei ouvrir...","*.BMP")' Dossier auswählen...
        LoadBmp fichier$,0,0;0'...magasin...
        halbton 0,0,%BmpX,%BmpY'...et filtre anwenden
        @messagebox("Fertig!","Meldung",0)
        end

    elseif @getfocus(f3%)

        @destroywindow(f1%)
        @destroywindow(f2%)
        @destroywindow(f3%)
        @destroywindow(f4%)
        let fichier$=@LoadFile$("Datei ouvrir...","*.BMP")
        LoadBmp fichier$,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 fichier$=@LoadFile$("Datei ouvrir...","*.BMP")
        LoadBmp fichier$,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


Topictitle, max. 100 marque.
 

Systemprofile:

ne...aucune Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

s'il te plaît s'inscrire um une Beitrag trop verfassen.
 

Options du sujet

Unreaded
abonner
La liste de voeux
Notes
guests
Effacer
Permanent
Done

3.602 Views

Untitledvor 0 min.
Stringray05.01.2022
Rolf Koch06.09.2020
Georg Teles26.08.2019
Pedro Miguel17.05.2019
plus...

Themeninformationen

cet Thema hat 2 participant:

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


Admins  |  AGB  |  Applications  |  Auteurs  |  Chat  |  protection des données  |  Télécharger  |  Entrance  |  Aider  |  Merchantportal  |  Empreinte  |  Mart  |  Interfaces  |  SDK  |  Services  |  Jeux  |  cherche  |  Support

un projet aller XProfaner, qui il y a!


Mon XProfan
Privé Nouvelles
Eigenes Ablageforum
Sujets-La liste de voeux
Eigene Posts
Eigene Sujets
Zwischenablage
Annuler
 Deutsch English Français Español Italia
Traductions

protection des données


Wir verwenden Cookies seulement comme Session-Cookies à cause de qui technischen Notwendigkeit et chez uns gibt es aucun Cookies de Drittanbietern.

si du ici sur unsere Webseite klickst ou bien navigierst, stimmst du unserer Erfassung de Informationen dans unseren Cookies sur XProfan.Net trop.

Weitere Informationen trop unseren Cookies et en supplément, comment du qui Kontrolle par-dessus behältst, findest du dans unserer nachfolgenden Datenschutzerklärung.

d'accordDatenschutzerklärung
je voudrais keinen Cookie