Image Konturen anzeigen
Übersicht

![]() |
StepTigerBetreff: Image Konturen anzeigen |
![]() Antworten mit Zitat ![]() |
---|---|---|
Nach langer(?) Zeit wieder mal ein Code von mir!
Zeigt die Konturen eines Bildes an. Nicht Echtzeitnah, jedoch als Versuch durchaus geeignet. Das Einzige daran, was interessiert ist die Funktion. Sie gibt die Kontur eines Bildes mit dem Optimalparameter Toleranz an (je nach Bild zwischen 30 und 130) Code: ; ImageKonturen
Graphics 800,600,32,2 Dim col(GraphicsWidth(),GraphicsHeight()) bla$=Input("Wo ist das Bild? ") img=LoadImage(bla$) If img=0 img=LoadImage(bla$+".bmp") If img=0 img=LoadImage(bla$+".jpg") If img=0 img=LoadImage(bla$+".png") If img=0 img=LoadImage(bla$+".tga") If img=0 img=LoadImage(bla$+".tcx") If img=0 img=LoadImage(bla$+".Iff") If img=0 Then RuntimeError "Image konnte nicht geladen werden."+Chr(13)+"Es ist eventuell nicht verfügbar." EndIf EndIf EndIf EndIf EndIf EndIf Cls img=imgrelief%(img) DrawImage img,0,0 FlushKeys Flip WaitKey End Function imgrelief(img,toleranz=50) wid=ImageWidth(img) hei=ImageHeight(img) If wid>GraphicsWidth() Then wid=GraphicsWidth() If hei>GraphicsHeight() Then hei=GraphicsHeight() newimg=CreateImage(wid, hei) Dim col(wid,hei) LockBuffer ImageBuffer(img) For x=0 To wid-1 For y=0 To hei-1 col(x,y)=ReadPixelFast(x,y,ImageBuffer(img)) Next Next UnlockBuffer ImageBuffer(img) SetBuffer ImageBuffer(newimg) LockBuffer ImageBuffer(newimg) For x=0 To wid-1 For y=0 To hei-1 c=0 tcol=0 For px=-1 To 1 For py=-1 To 1 nx=x+px ny=y+py If nx<wid And ny<hei And nx>0 And ny>0 colr1=col(x,y) Shr 16 And 255 colg1=col(x,y) Shr 8 And 255 colb1=col(x,y) And 255 colr2=col(nx,ny) Shr 16 And 255 colg2=col(nx,ny) Shr 8 And 255 colb2=col(nx,ny) And 255 difr=Abs(colr1-colr2) difg=Abs(colg1-colg2) difb=Abs(colb1-colb2) dif=(difr+difg+difb)/3 tcol=tcol+Abs(dif) c=c+1 EndIf Next Next tcol=tcol/c If tcol>=toleranz WritePixelFast x,y,0 Else WritePixelFast x,y,255 Shl 16 + 255 Shl 8 +255 EndIf Next Next UnlockBuffer ImageBuffer(newimg) SetBuffer BackBuffer() Return newimg% End Function |
||
Noch gestern standen wir am Abgrund, doch heute sind wir schon einen Schritt weiter.
Computer: AMD Sempron 3000+; ATI Radeon 9800 Pro; 512 MB DDR RAM 400Mhz; Asus E7N8X-E Deluxe; Samsung 200GB HD 5.4ns acces t Gewinner: BP Code Compo #2 Π=3.141592653589793238...<--- und das aus dem kopf ![]() Seit der Earthlings-Diskussion überzeugter Fleisch(fr)esser. |
![]() |
BlitzChecker |
![]() Antworten mit Zitat ![]() |
---|---|---|
Genial!
Grad wollt ich fragen, wie man sowas am besten proggt xD thx, kann ich gut gebrauchen. EDIT: hab jetzt mal erste gute ergebnisse erzielt (toleranz=5): http://blitzchecker.redio.de/vorher.jpg http://blitzchecker.redio.de/nachher.png |
||
- Zuletzt bearbeitet von BlitzChecker am Sa, Sep 09, 2006 9:20, insgesamt einmal bearbeitet
![]() |
d-bug |
![]() Antworten mit Zitat ![]() |
---|---|---|
Hast du schonmal was von ql:FileType und ql:select gehört? Deine Lade Routine
da oben sieht schon sehr abenteuerlich aus ![]() Code: If Not FileType(bla$)
For i = 0 To 5 Select i Case 0 : suffix$ = ".bmp" Case 1 : suffix$ = ".jpg" Case 2 : suffix$ = ".png" Case 3 : suffix$ = ".tga" Case 4 : suffix$ = ".tcx" Case 5 : suffix$ = ".iff" End Select If FileType(bla$+suffix$) bla = bla+suffix Exit EndIf Next EndIf img = LoadImage(bla$) If Not img RuntimeError "Image konnte nicht geladen werden."+Chr(13)+"Es ist eventuell nicht verfügbar." Meine Meinung... ![]() |
||
![]() |
StepTiger |
![]() Antworten mit Zitat ![]() |
---|---|---|
Die Laderoutine ist ja kein Zwang sondern lediglich Zusatz, da ich beim editieren zu faul war, ständig die endung einzugeben (die datei hieß "e.bmp", somit komplett unnötig ^^)
danke d-bug! |
||
Noch gestern standen wir am Abgrund, doch heute sind wir schon einen Schritt weiter.
Computer: AMD Sempron 3000+; ATI Radeon 9800 Pro; 512 MB DDR RAM 400Mhz; Asus E7N8X-E Deluxe; Samsung 200GB HD 5.4ns acces t Gewinner: BP Code Compo #2 Π=3.141592653589793238...<--- und das aus dem kopf ![]() Seit der Earthlings-Diskussion überzeugter Fleisch(fr)esser. |
![]() |
BlitzcoderNewsposter |
![]() Antworten mit Zitat ![]() |
---|---|---|
Ist echt gut geworden. Ich glaube ich vergleiche morgen mal die Ergebnisse mit dem ensprechendem Photoshop Filter ![]() MfG Blitzcoder |
||
P4 3 Ghz@3,55Ghz|GF 6600GT 256MB|Samsung 80GB | 2x Samsung 160GB|2048MB DDR-400 RAM|6 Mbit Flatrate | Logitech G15 | Samsung 225BW-TFT | Ubuntu Gutsy Linux | Windows Vista | Desktop | Blog | CollIDE | Worklog
________________ |°°°°°°°°°°°°°°||'""|""\__,_ |______________ ||__ |__|__ |) |(@) |(@)"""**|(@)(@)****|(@) |
Übersicht


Powered by phpBB © 2001 - 2006, phpBB Group