Bilder verändern

Übersicht BlitzBasic Allgemein

Neue Antwort erstellen

 

m a j o r

Betreff: Bilder verändern

BeitragSo, Jun 27, 2004 17:17
Antworten mit Zitat
Benutzer-Profile anzeigen
Hallo!
Unter diesem ganzen guten Code-beiträgen mag meiner vielleicht etwas simpel erscheinen aber ich hoffe ihr gebt einem Neuling eine Chance Embarassed

Also ich habe ein einfaches Programm erstellt(auch auf das Risiko hin das es das hier schon gibt) und lange mit mir gerungen bis ich mich entschieden habe es upzuloaden.

Es dient dazu Bilder


  • nach Schwarzweiß umzuwandeln
  • einzufärben/eine Farbe reduzieren
  • zu verwischen
  • aufzuhellen/abzudunkeln


Ich habe versucht den Code so gut wie möglich zu kommentieren.
Hier ist er:

Code: [AUSKLAPPEN]

;      #####################################################
;      #            Written by M.A.J.O.R.            #   
;      #                                       #
;      #      Wandelt Farbbilder nach Schwarzweiß um      #
;      #      bzw. färbt sie ein/verwischt sie oder      #
;      #      hellt sie auf :)                     #
;      #      Endung (.bmp) muss angegeben werden         #
;      #      depth gibt die Farbtiefe des Bildes an      #
;      #      bei sonstigen Fragen email an:            #
;      #                                       #
;      #            major.home@gmx.de               #
;      #####################################################
      
            
Const depth=32                ;Farbtiefe
Const ausf=1               ;Soll das Bild danach gezeigt werden?
Const fscreen=1               ;Vollbild
;Bei Vollbild:
Const maxX=1024               ;maximale auflösung x
Const maxY=768               ;maximale auflösung y

Global fr$,fto$,img,gsizex,gsizey,r,g,b,sw,rgb,modus,faktor,oldr,oldb,oldg,farbe$


AppTitle "ImageTools v. 1.00","Schon beenden?"

Print "ImageTools v. 1.00"
Print "verändert Farbbilder"
Print "major.home@gmx.de"
Print
Print "Modus wählen:"


.nem
Print "1) Schwarzweiß"
Print "2) aufhellen"
Print "3) einfärben"
Print "4) verwischen"
modus=Input()

If modus<1 Or modus>4 Then Goto nem


If modus=2 Then
faktor=Input("Aufhellungsgrad -255 bis 255 ")
End If


If modus=3 Then

.reenter_farbe

farbe$=Lower$(Input("(R)ot (G)rün (B)lau "))

If farbe$="" Then Goto reenter_farbe

faktor=Input("Einfärbungsgrad -255 bis 255 ")

End If

.ne
fr$=Input("Welche Datei? ")      
fto$=Input("Speichern unter:")

If FileType(fr$)=0 Then       ;wenn Datei nicht existiert, dann nochmal eingeben

Cls
Locate 0,0
Print "Datei existiert nicht"
Print

Goto ne
End If



img=LoadImage(fr$)            ;Bild laden


sizeX=ImageWidth (img)         ;Breite und
sizeY=ImageHeight (img)         ;Höhe des Bildes



If fscreen=1 Then            ;Bei Vollbild beste Auflösung setzen
next_size(sizex,sizey)
Else                     ;Bei Fenster egal
gsizex=sizex
gsizey=sizey

If gsizex<minx Then gsizex=minx
If gsizey<miny Then gsizey=miny

End If



Cls
Locate 0,0

Print "Bildbreite:"+sizex      ;Kurze Info
Print "Bildhöhe:"+sizey
Print "Farbtiefe:"+depth
Print "------------------"      
Print "Auflösung:"+gsizex+" mal "+gsizey      


FreeImage img

Delay 2000


Graphics gsizeX,gsizeY,depth,fscreen   ;Grafikmodus auf Bildbreite/Höhe setzen


img=LoadImage(fr$)
FlushKeys
Print "Das Bild wird nun umgewandelt. Dieser Vorgang kann etwas dauern."
Print "Zum Starten Taste drücken"
WaitKey


DrawBlock img,0,0      ;Bild zeichnen

a=255

                     
For x=0 To sizeX      ; Jeder Punkt des Bildes wird abgefragt
For y=0 To sizeY      ;


LockBuffer
rgb=ReadPixelFast (x,y)         

r=(rgb And $FF0000)/$10000      ;Farbwerte werden ermittelt,...
g=(rgb And $FF00)/$100
b=rgb And $FF


                        ;===MODUS 1===
If modus=1 Then
sw=Int((r+g+b)/3)            ;... addiert und durch 3 geteilt um
r=sw                     ;    den Durschnitt zu erhalten
g=sw
b=sw
End If                     ;=ENDE=

                     
                     
                        ;===MODUS 2===
If modus=2 Then               ;Farben verstärken bzw abschwächen
r=r+faktor
g=g+faktor
b=b+faktor
End If                     ;=ENDE=

If modus=3                  ;===MODUS 3===
If farbe="r" Then r=r+faktor   ;Nur 1 Farbe verstäreken bzw abschwächen
If farbe="g" Then g=g+faktor
If farbe="b" Then b=b+faktor
End If
                        ;=ENDE=
                        
If modus=4                  ;===MODUS 4===
                        ;Durchschnittswert des letztens Pixels und des Aktuellen
r=(r+oldr)/2               ;berechnen ->verwischen
g=(g+oldg)/2               
b=(b+oldb)/2

oldr=(oldr+r)/2
oldg=(oldg+g)/2
oldb=(oldb+b)/2

End If                     ;=ENDE=



If r>255 Then r=255            ;nur gültige Werte zulassen...      
If g>255 Then g=255
If b>255 Then b=255

If r<0 Then r=0
If g<0 Then g=0
If b<0 Then b=0



rgb=a*$1000000 + r*$10000 + g*$100 + b



WritePixelFast x,y,rgb         ;Pixel setzen...
UnlockBuffer

If KeyHit(1) Then             ;ESC
FreeImage img
RuntimeError "Abgebrochen" 
End If

Next
Next
FreeImage img
img=CreateImage (sizeX, sizeY)         ;... und Bild abspeichern
GrabImage img,0,0
SaveImage (img,fto$)




FreeImage img

EndGraphics

If ausf=1 Then ExecFile fto$

End                              ;und ende :)


Function next_size(x,y)
If x>maxX Or y>maxY Then RuntimeError "Maximale Bildgröße zu niedrig!":End

If x>800 And x<=1024 Or y>600 And y<=768 Then
x=1024:y=768
Else
If x>640 And x<=800 Or y>480 And y<=600 Then
x=800:y=600
Else
x=640:y=480
End If
End If



gsizex=x
gsizey=y
Return
End Function



Kritik etc. erwünscht! Shocked

dominik

BeitragSo, Jun 27, 2004 17:41
Antworten mit Zitat
Benutzer-Profile anzeigen
also
Code: [AUSKLAPPEN]
AppTitle "ImageTools v. 1.00","Schon beenden?"

kann nicht funktionieren. muss wenn dann
Code: [AUSKLAPPEN]
AppTitle "ImageTools v. 1.00   Schon beenden?"

heißen.

außerdem findet das prog das bild nicht es ist im gleichen ordner, oder muss ich da den gnazen pfad mitangegebn?

und den rest hab ich mir noch nicht angeschaut.
 

OJay

BeitragSo, Jun 27, 2004 17:50
Antworten mit Zitat
Benutzer-Profile anzeigen
das mit dem apptitle haut schon hin.

nur währe es sinnvoller, du würdest das ganze in funktionen verpacken...so kann das ja keiner verwenden Wink
 

m a j o r

BeitragSo, Jun 27, 2004 18:43
Antworten mit Zitat
Benutzer-Profile anzeigen
@Dominik
Hast du die Endung mit angegeben?
Steht extra dabei!
@OJay
Ja... irgendwie hast du schon recht Rolling Eyes

dominik

BeitragSo, Jun 27, 2004 18:47
Antworten mit Zitat
Benutzer-Profile anzeigen
jo hab ich

also bei mir kommt bei Code: [AUSKLAPPEN]
AppTitle "ImageTools v. 1.00","Schon beenden?"
too many parameters.
 

OJay

BeitragSo, Jun 27, 2004 19:01
Antworten mit Zitat
Benutzer-Profile anzeigen
möglich, das das erst bei b3d ging...aber wer nutzt schon noch 2d? Wink

Jan_

Ehemaliger Admin

BeitragSo, Jun 27, 2004 20:14
Antworten mit Zitat
Benutzer-Profile anzeigen
Geht nur in B3D!
between angels and insects

dominik

BeitragSo, Jun 27, 2004 20:18
Antworten mit Zitat
Benutzer-Profile anzeigen
manche komische leutz nutzen auch B+.
 

m a j o r

BeitragSo, Jun 27, 2004 20:41
Antworten mit Zitat
Benutzer-Profile anzeigen
@Dominik
Hmm also bei mir funzt es ohne Probleme wenn ich Dateiname angebe(vorrausgesetzt die Datei liegt im selben Ordner)!
Hat noch einer das selbe Problem?

Suco-X

Betreff: ....

BeitragMo, Jun 28, 2004 4:25
Antworten mit Zitat
Benutzer-Profile anzeigen
Domnik hat doch anscheinend ein AppTitle Problem, wie kommst du jetzt auf Dateinamen? Das du Anfänger bist endschuldigt zwar den doch noch ziemlich hässlichen Code, aber wieso hast du das ganze nicht in Funktionen gepackt wie Ojay schon anbrachte? Hol das doch noch flott nach. Aber so schon sehr gut, wen man bedenkt das die meisten Anfänger bei WritePixelFast und dessen Farbberechnungen schon heulend unter den Tisch kuschen. Ich denke du hast sicher schon Standart erfahrungen im Programmieren. QBasic? VBasic!?
bye
Intel Core 2 Quad Q8300, 4× 2500 MHz, 4096 MB DDR2-Ram, GeForce 9600GT 512 MB

Travis

BeitragMo, Jun 28, 2004 14:24
Antworten mit Zitat
Benutzer-Profile anzeigen
Also ich betrachte mich mittlerweile auch nicht mehr als blutiger Anfänger, aber wenn ich mit den WritePixelFast-Befehle arbeite, bekomme ich immer noch Depressionen wegen dieser blöden Farbberechnung und dem ständigen Vergessens des LockBuffer-Befehls.

Wenn man das Ganze noch in Funktionen packt (wie schon erwähnt), dann ist's sicher ganz nützlich. Man könnte ja mal eine Sammlung von verschiedenen Bildeffekten machen und irgendwie zusammenstellen. Irgendwer hier hat doch schon mal ein Blur-Effekt gemacht, oder Bildvergrößerung ect. Ich selbst habe auch schon ein paar Effekte beisammen.
www.funforge.org

Ich hasse WASD-Steuerung.

Man kann alles sagen, man muss es nur vernünftig begründen können.

Suco-X

Betreff: .....

BeitragMo, Jun 28, 2004 15:01
Antworten mit Zitat
Benutzer-Profile anzeigen
DarkShadow und ich hatten da früher mal angefangen mit Effekt Funktionen. Ich denke hier wären sie am besten aufgehoben wo wir schonmal beim Thema sind.

Code: [AUSKLAPPEN]

;Bild schärfen (by DS)
Function Sharp(temp_image)
Local r, g, b
Local Pixel[1]
LockBuffer ImageBuffer(temp_image)
For x = 0 To ImageWidth(temp_image)-1
   For y = 0 To ImageHeight(temp_image)-1

   Pixel[0] = ReadPixelFast(x,y, ImageBuffer(temp_image))
   Pixel[1] = ReadPixelFast(x-1,y-1, ImageBuffer(temp_image))

   r = GetR(Pixel[0]) + 0.5 * (GetR(Pixel[0]) - GetR(Pixel[1]))
   g = GetG(Pixel[0]) + 0.5 * (GetG(Pixel[0]) - GetG(Pixel[1]))
   b = GetB(Pixel[0]) + 0.5 * (GetB(Pixel[0]) - GetB(Pixel[1]))

   If r > 255 Then r = 255
   If r < 0 Then r = 0
   If g > 255 Then g = 255
   If g < 0 Then g = 0
   If b > 255 Then b = 255
   If b < 0 Then b = 0

   WritePixelFast(x,y,CombineRGB(r,g,b), ImageBuffer(temp_image))

   Next
Next
UnlockBuffer ImageBuffer(temp_image)
End Function


;Pixelweises Verwischen. Beste Einstellung wäre im Berreich von 1-10(by Suco-X)
Function Verwischen(temp_image,strong = 1)
If strong<=0
   strong = 0
ElseIf strong>=10
   strong = 10
EndIf

Local farbe,r,g,b
Local temp_x, temp_y

SeedRnd(MilliSecs())
LockBuffer ImageBuffer(temp_image)

For x = 0 To ImageWidth(temp_image) Step 3
   For y = 0 To ImageHeight(temp_image) Step 3
   
   farbe = ReadPixelFast(x,y, ImageBuffer(temp_image))
   r = GetR(farbe)
   g = GetG(farbe)
   b = GetB(farbe)
   
      For i = 1 To strong
         temp_x = x+Rand(-strong*1.5,strong*1.5)
         temp_y = y+Rand(-strong,strong)
         
         If temp_x>=0 And temp_x<ImageWidth(temp_image) And temp_y>=0 And temp_y<ImageHeight(temp_image)   
            WritePixelFast(temp_x,temp_y,combineRGB(r,g,b), ImageBuffer(temp_image))
         EndIf
      Next
   
   Next
Next

UnlockBuffer ImageBuffer(temp_image)
End Function


;Bild weichzeichnen (by DS)
Function Smooth(temp_image)
Local r, g, b
Local Pixel[8]
LockBuffer ImageBuffer(temp_image)
For x = 0 To ImageWidth(temp_image)
   For y = 0 To ImageHeight(temp_image)

   Pixel[0] = ReadPixelFast(x+1,y+1, ImageBuffer(temp_image))
   Pixel[1] = ReadPixelFast(x-1,y-1, ImageBuffer(temp_image))
   Pixel[2] = ReadPixelFast(x-1,y, ImageBuffer(temp_image))
   Pixel[3] = ReadPixelFast(x-1,y+1, ImageBuffer(temp_image))
   Pixel[4] = ReadPixelFast(x,y-1, ImageBuffer(temp_image))
   Pixel[5] = ReadPixelFast(x,y, ImageBuffer(temp_image))
   Pixel[6] = ReadPixelFast(x,y+1, ImageBuffer(temp_image))
   Pixel[7] = ReadPixelFast(x+1,y-1, ImageBuffer(temp_image))
   Pixel[8] = ReadPixelFast(x+1,y, ImageBuffer(temp_image))

   r = GetR(Pixel[1]) + GetR(Pixel[2]) + GetR(Pixel[3]) + GetR(Pixel[4]) + GetR(Pixel[5]) + GetR(Pixel[6]) + GetR(Pixel[7]) + GetR(Pixel[8]) + GetR(Pixel[0])
   g = GetG(Pixel[1]) + GetG(Pixel[2]) + GetG(Pixel[3]) + GetG(Pixel[4]) + GetG(Pixel[5]) + GetG(Pixel[6]) + GetG(Pixel[7]) + GetG(Pixel[8]) + GetG(Pixel[0])
   b = GetB(Pixel[1]) + GetB(Pixel[2]) + GetB(Pixel[3]) + GetB(Pixel[4]) + GetB(Pixel[5]) + GetB(Pixel[6]) + GetB(Pixel[7]) + GetB(Pixel[8]) + GetB(Pixel[0])

   WritePixelFast(x,y,CombineRGB(r/9,g/9,b/9), ImageBuffer(temp_image))

   Next
Next
UnlockBuffer ImageBuffer(temp_image)
End Function


;Bild überbelichten (by DS)
Function Solarize(temp_image)
Local farbe, r, g, b
LockBuffer ImageBuffer(temp_image)
For x = 0 To ImageWidth(temp_image)
   For y = 0 To ImageHeight(temp_image)

   farbe = ReadPixelFast(x,y, ImageBuffer(temp_image))

   r = GetR(farbe)
   g = GetG(farbe)
   b = GetB(farbe)

   If r < 128 Or r > 255 Then r = 255 - r
   If g < 128 Or g > 255 Then g = 255 - g
   If b < 128 Or b > 255 Then b = 255 - b

   WritePixelFast(x,y,CombineRGB(r,g,b), ImageBuffer(temp_image))

   Next
Next
UnlockBuffer ImageBuffer(temp_image)
End Function


;Bild prägen (by DS)
Function Emboss(temp_image)
Local r, g, b
Local Pixel[1]
LockBuffer ImageBuffer(temp_image)
For x = 0 To ImageWidth(temp_image)-1
   For y = 0 To ImageHeight(temp_image)-1

   Pixel[0] = ReadPixelFast(x,y, ImageBuffer(temp_image))
   Pixel[1] = ReadPixelFast(x+1,y+1, ImageBuffer(temp_image))

   r = Abs(GetR(Pixel[0]) - GetR(Pixel[1]) + 128)
   g = Abs(GetG(Pixel[0]) - GetG(Pixel[1]) + 128)
   B = Abs(GetB(Pixel[0]) - GetB(Pixel[1]) + 128)

   WritePixelFast(x,y,CombineRGB(r,g,b), ImageBuffer(temp_image))

   Next
Next
UnlockBuffer ImageBuffer(temp_image)
End Function


;Gewünschte werte werden durch schwarz ersetzt. Toleranz von 0-255(by Suco-X)
Function ReplaceColor(temp_image,temp_r = 0, temp_g = 0, temp_b = 0, toleranz = 0)
Local farbe, r,g,b

If toleranz<=0
   toleranz = 0
ElseIf toleranz>=255
   toleranz = 254
EndIf

LockBuffer ImageBuffer(temp_image)
For x =0 To ImageWidth(temp_image)-1
   For y = 0 To ImageHeight(temp_image)-1
   
   farbe = ReadPixelFast(x,y,ImageBuffer(temp_image))
   r = GetR(farbe)
   g = GetG(farbe)
   b = GetB(farbe)
   
   If r>=temp_r-toleranz And r<=temp_r+toleranz And g>=temp_g-toleranz And g<=temp_g+toleranz And b>=temp_b-toleranz And b<=temp_b+toleranz
      r = 0
      g = 0
      b = 0
   EndIf
   
   WritePixelFast(x,y, CombineRGB(r,g,b), ImageBuffer(temp_image))
   Next
Next

UnlockBuffer ImageBuffer(temp_image)
End Function


; Von -255 bis +255(by Suco-X)
Function SetImageColor(temp_image,temp_r, temp_g, temp_b)
Local farbe, r, g, b
LockBuffer ImageBuffer(temp_image)

For x = 0 To ImageWidth(temp_image)-1
   For y = 0 To ImageHeight(temp_image)-1
   
   farbe = ReadPixelFast(x,y, ImageBuffer(temp_image))
   r = GetR(farbe)
   g = GetG(farbe)
   b = GetB(farbe)
   
   If r+temp_r>0 And r+temp_r<255
      r = r+temp_r
   ElseIf r+temp_r>=255
      r = 255
   Else
      r = 0
   EndIf
   
   If g+temp_g>0 And g+temp_g<255
      g = g+temp_g
   ElseIf g+temp_g>=255
      g = 255
   Else
      g = 0
   EndIf

   If b+temp_b>0 And b+temp_b<255
      b = b+temp_b
   ElseIf b+temp_b>=255
      b = 255
   Else
      b = 0
   EndIf

   WritePixelFast(x,y,CombineRGB(r,g,b), ImageBuffer(temp_image))
   
   Next
Next

UnlockBuffer ImageBuffer(temp_image)
End Function


;Helligkeit von -100 bis +100(by Suco-X)
Function SetBright(temp_image, wert = 0)
Local farbe, r, g, b
wert = wert*2
LockBuffer ImageBuffer(temp_image)

For x = 0 To ImageWidth(temp_image)-1
   For y = 0 To ImageHeight(temp_image)-1
   
   farbe = ReadPixelFast(x,y, ImageBuffer(temp_image))
   r = GetR(farbe)
   g = GetG(farbe)
   b = GetB(farbe)
   
   If r+wert>0 And r+wert<=255
      r = r+wert
   ElseIf r+wert<=0
      r = 0
   Else
      r = 255
   EndIf
   
   If g+wert>=0 And g+wert<=255
      g = g+wert
   ElseIf g+wert<=0
      g = 0
   Else
      g = 255
   EndIf
   
   If b+wert>=0 And b+wert<=255
      b = b+wert
   ElseIf b+wert<=0
      b = 0
   Else
      b = 255
   EndIf
   
   WritePixelFast(x,y,CombineRGB(r,g,b), ImageBuffer(temp_image))
   
   Next
Next

UnlockBuffer ImageBuffer(temp_image)
End Function


; Schwarz/weiß Färben. (by Suco-X)
Function BlackAndWhite(temp_image)
Local farbe, r, g, b
LockBuffer ImageBuffer(temp_image)

For x =0 To ImageWidth(temp_image)-1
   For y = 0 To ImageHeight(temp_image)-1
      farbe = ReadPixelFast(x,y, ImageBuffer(temp_image))
      r = GetR(Farbe)
      g = GetG(Farbe)
      b = GetB(Farbe)
      If r>0 And g>0 And b>0

         If r<128 Or g<128 Or b<128
            r = 1
            g = 1
            b = 1
         Else
            r =255
            g = 255
            b = 255
         EndIf
         WritePixelFast(x,y, CombineRGB(r,g,b), ImageBuffer(temp_image))
   
      EndIf
   Next
Next

UnlockBuffer ImageBuffer(temp_image)
End Function


;Kombiniert aus r,g,b eine farbwert für WritePixel nutzung
Function CombineRGB(r,g,b)
Return a*$1000000 + r*$10000 + g*$100 + b
End Function

;Rot anteile von einem Farbcode
Function GetR(Farbe)
Local r=(Farbe And $FF0000)/$10000: Return r
End Function

;Grün anteile von einem Farbcode
Function GetG(Farbe)
Local g=(Farbe And $FF00)/$100: Return g
End Function


;Blau anteile von einem Farbcode
Function GetB(Farbe)
Local b=farbe And $FF: Return b
End Function


Mfg Suco
Intel Core 2 Quad Q8300, 4× 2500 MHz, 4096 MB DDR2-Ram, GeForce 9600GT 512 MB
 

m a j o r

Betreff: Re: ....

BeitragMo, Jun 28, 2004 15:22
Antworten mit Zitat
Benutzer-Profile anzeigen
Suco-X hat Folgendes geschrieben:
Domnik hat doch anscheinend ein AppTitle Problem, wie kommst du jetzt auf Dateinamen?

Dominik hatte ebenfalls ein Problem mit dem Dateinamen bzw. das die Datei nicht gefunden wurde. (Siehe seinen 1. Beitrag zu diesem Thema.)

Ich habe das ganze nicht in Funktionen gepackt, da ich leider gar nicht wusste, dass man das machen sollte. Ich dachte, es wäre besser, das ganze einfach so zu machen... naja... Embarassed

Kannst du mir vielleicht erklären, was du mit "hässlichem Code" meinst?

Da du nun schon so Funktionen gepostet hast, soll ich den Code dann trotzdem noch in Funktionen packen?

Erfahrung im programmieren habe ich allerdings keine(wenn man mal von der simplen, C ähnlichen Scriptsprache zu dem Spiel Clonk Planet absieht).

Ach ja, bezieht sich die Signatur auf mich oder ist die allgemein? Confused

Suco-X

Betreff: .......

BeitragMo, Jun 28, 2004 21:08
Antworten mit Zitat
Benutzer-Profile anzeigen
Ist Allgemein bezogen die Signatur Laughing
Nurmal so ne Frage, wieso wurde der Thread verschoben @Mods!?
bye
Intel Core 2 Quad Q8300, 4× 2500 MHz, 4096 MB DDR2-Ram, GeForce 9600GT 512 MB
 

m a j o r

BeitragDi, Jun 29, 2004 14:40
Antworten mit Zitat
Benutzer-Profile anzeigen
kA Frag ich mich auch Shocked

Neue Antwort erstellen


Übersicht BlitzBasic Allgemein

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group