Image Konturen anzeigen

Übersicht BlitzBasic Codearchiv

Neue Antwort erstellen

StepTiger

Betreff: Image Konturen anzeigen

BeitragFr, Sep 08, 2006 22:49
Antworten mit Zitat
Benutzer-Profile anzeigen
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 Laughing
Seit der Earthlings-Diskussion überzeugter Fleisch(fr)esser.

BlitzChecker

BeitragSa, Sep 09, 2006 9:08
Antworten mit Zitat
Benutzer-Profile anzeigen
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

BeitragSa, Sep 09, 2006 9:11
Antworten mit Zitat
Benutzer-Profile anzeigen
Hast du schonmal was von ql:FileType und ql:select gehört? Deine Lade Routine
da oben sieht schon sehr abenteuerlich aus Wink

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... Wink

StepTiger

BeitragMo, Sep 11, 2006 20:54
Antworten mit Zitat
Benutzer-Profile anzeigen
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 Laughing
Seit der Earthlings-Diskussion überzeugter Fleisch(fr)esser.

Blitzcoder

Newsposter

BeitragMo, Sep 11, 2006 21:56
Antworten mit Zitat
Benutzer-Profile anzeigen
Ist echt gut geworden. Ich glaube ich vergleiche morgen mal die Ergebnisse mit dem ensprechendem Photoshop Filter Rolling Eyes

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
________________
|°°°°°°°°°°°°°°||'""|""\__,_
|______________ ||__ |__|__ |)
|(@) |(@)"""**|(@)(@)****|(@)

Neue Antwort erstellen


Übersicht BlitzBasic Codearchiv

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group