Bilder verändern
Übersicht

m a j o rBetreff: Bilder verändern |
![]() Antworten mit Zitat ![]() |
|
---|---|---|
Hallo!
Unter diesem ganzen guten Code-beiträgen mag meiner vielleicht etwas simpel erscheinen aber ich hoffe ihr gebt einem Neuling eine Chance ![]() 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
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 "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" 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! ![]() |
||
![]() |
dominik |
![]() Antworten mit Zitat ![]() |
---|---|---|
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 |
![]() Antworten mit Zitat ![]() |
|
---|---|---|
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 ![]() |
||
m a j o r |
![]() Antworten mit Zitat ![]() |
|
---|---|---|
@Dominik
Hast du die Endung mit angegeben? Steht extra dabei! @OJay Ja... irgendwie hast du schon recht ![]() |
||
![]() |
dominik |
![]() Antworten mit Zitat ![]() |
---|---|---|
jo hab ich
also bei mir kommt bei Code: [AUSKLAPPEN] AppTitle "ImageTools v. 1.00","Schon beenden?" too many parameters.
|
||
OJay |
![]() Antworten mit Zitat ![]() |
|
---|---|---|
möglich, das das erst bei b3d ging...aber wer nutzt schon noch 2d? ![]() |
||
![]() |
Jan_Ehemaliger Admin |
![]() Antworten mit Zitat ![]() |
---|---|---|
Geht nur in B3D! | ||
between angels and insects |
![]() |
dominik |
![]() Antworten mit Zitat ![]() |
---|---|---|
manche komische leutz nutzen auch B+. | ||
m a j o r |
![]() Antworten mit Zitat ![]() |
|
---|---|---|
@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-XBetreff: .... |
![]() Antworten mit Zitat ![]() |
---|---|---|
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 |
![]() Antworten mit Zitat ![]() |
---|---|---|
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-XBetreff: ..... |
![]() Antworten mit Zitat ![]() |
---|---|---|
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 rBetreff: Re: .... |
![]() Antworten mit Zitat ![]() |
|
---|---|---|
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... ![]() 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? ![]() |
||
![]() |
Suco-XBetreff: ....... |
![]() Antworten mit Zitat ![]() |
---|---|---|
Ist Allgemein bezogen die Signatur ![]() 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 |
![]() Antworten mit Zitat ![]() |
|
---|---|---|
kA Frag ich mich auch ![]() |
||
Übersicht


Powered by phpBB © 2001 - 2006, phpBB Group