Wie gesagt, ich freue mich auf eure Unterstützung.
Mein Programm funktioniert mit JPEG und BMPs, bei Bedarf auch mit anderen Formaten.
Das Bild kann ein Foto, eine Zeichnung oder irgendwas anderes sein.
Bei folgendem Bild erhalte ich gute Werte:
Ich hab leider kein anderes bei Google gefunden.
Mein Code ist noch nicht auf Geschwindigkeit optimiert, da er noch nicht
vollständig ist. Jemand müsste ihn so umschreiben, dass sich die Finde-Routine immer um 90° dreht und die Objekte nicht in einem festen Array sondern alle Punkte eines Objektes in einer LinkedList speichert.
Wenn ein Objekt/TeilBild nicht mehr geteilt werden kann, ist es ein Objekt.
Code: Alles auswählen
Enumeration
#HauptFenster
#Sprite
#Ball
#Wand
#Bild
EndEnumeration
Global x.l
Global y.l
Global xmax.l
Global ymax.l
dddd.l
;/ Toleranz für Objekterkennung bei Starkem Rauschen
;OpenConsole()
;PrintN("Gib mal was ein: 0..255 ist sinnvoll. Bei starkem Rauschen mit dunkelgrau: 150")
;Print("Toleranz, bei meinem Bild 15: ");
;dddd=Val(Input())
;CloseConsole()
dddd=16
Procedure MachFenster()
hWnd=OpenWindow(#HauptFenster, 0, 0, 410, 310, #PB_Window_SystemMenu | #PB_Window_WindowCentered | #PB_Window_SizeGadget | #PB_Window_TitleBar , "(c) Folker Linstedt 2006 :::: Best View 1024 x 768 and higher")
EndProcedure
;{/ initZeugs
;}/
;sprite$="C:\Sicher\Bild\Neu Bitmap.bmp"
;UsePNGImageDecoder()
UseJPEGImageDecoder()
;UseTGAImageDecoder()
;UseTIFFImageDecoder()
sprite$=OpenFileRequester("Bild auswählen","c:\","BildDaten|*.bmp;*.png;*.jpg;*.jpeg;*.tif;*.tga",-1)
MachFenster()
;OpenWindowedScreen(WindowID(),0,0,1000,700,0,0,0)
LoadImage(1,sprite$)
If IsImage(1)=0
CreateImage(1,400,300)
EndIf
Procedure.l LineSearchS(xx.l,yy.l,l.l)
Ereignis=0
For i=0 To l-2
Punkt=Point(xx,yy+i) ; Punkt/Farbe könnte hier später gleich gespeichert werden
; Plot(x,y+i,RGB(0,0,255))
If Punkt=0
Ereignis=0
Else
Ereignis=yy+i ; Also hier mein ich
Break
EndIf
Next
ProcedureReturn Ereignis
EndProcedure
Dim Dinglis(100,1)
Global Anz.l
#Pic=17
Procedure KantenFinden(d.l)
CreateImage(#Pic,400,300)
p0.l
p1.l
;d=150
For i=0 To 399
StartDrawing(WindowOutput())
p0=Point(i,0)
StopDrawing()
For u=1 To 298
StartDrawing(WindowOutput())
p1=Point(i,u+0)
StopDrawing()
If (Red(p0)-d>Red(p1)) Or (Red(p0)+d<Red(p1)) Or (Green(p0)-d>Green(p1)) Or (Green(p0)+d<Green(p1))Or(Blue(p0)-d>Blue(p1)) Or (Blue(p0)+d<Blue(p1))
StartDrawing(ImageOutput())
Plot(i,u,RGB(255,255,255))
StopDrawing()
EndIf
p0=p1
Next
Next
EndProcedure
Procedure FindDenScheisz()
StartDrawing(WindowOutput())
LineSearchS(x,y,ymax)
While s=0 And x<xmax
x+1
s=LineSearchS(x,y,ymax)
Wend
; Erster Punkt des Objektes x,s
If x<xmax
Circle(x+2,s,2,RGB(0,255,0))
Dinglis(Anz*2, 0)=x
Dinglis(Anz*2, 1)=s
Dinglis(Anz*2+1,1)=s
EndIf
Repeat
x+1
s=LineSearchS(x+1,y,ymax)
; Ausdehnung des Rechtecks soweit wie möglich, einzelne schräge Linien eignen sich am besten
; einzelne Kreise werden knapp halbiert
If s>Dinglis(Anz*2+1,1) : Dinglis(Anz*2+1,1)=s : EndIf
If s<>0 : If s<Dinglis(Anz*2 ,1) : Dinglis(Anz*2,1)=s : EndIf : EndIf
; jedes X, S müsste in eine Liste gespeichert werden
; anschließend muss die Methode noch waagerecht angewandt werden
; zusammenhängende Objekte werden dadurch geteilt ...
; dies muss so oft wiederholt werden, bis kein Objekt mehr teilbar ist
; Zurzeit findet nur ein Durchlauf statt von oben nach unten.
; die Durchläufe könnten so optimiert sein, dass kein Punkt doppelt abgefragt werden müsste
Until s=0 Or x+1>xmax
s=LineSearchS(x,y,ymax)
; Letzter Punkt des Objekts
If x+1<xmax
Circle(x-2,s,2,RGB(255,0,0))
Dinglis(Anz*2+1,0)=x
Anz+1
EndIf
StopDrawing()
EndProcedure
xmax=399 ; Bildgröße X 400
ymax=299 ; Bildgröße Y 300
x=0
y=0
Anz=0
StartDrawing(WindowOutput()) ; geht wohl nicht, keine Ahnung
DrawImage(UseImage(1),0,0)
StopDrawing()
KantenFinden(dddd)
StartDrawing(WindowOutput())
DrawImage(UseImage(17),0,0)
StopDrawing()
While x<xmax
FindDenScheisz()
Wend
Procedure Rectangle(x1.l,y1.l,x2.l,y2.l,f.l)
LineXY(x1,y1,x1,y2,f)
LineXY(x1,y2,x2,y2,f)
LineXY(x2,y2,x2,y1,f)
LineXY(x2,y1,x1,y1,f)
EndProcedure
;/ Pause, damit man das KantenGefundeneBild mit den roten und grünen Punkten sehen kann
Delay(2000)
UseImage(1)
StartDrawing(ImageOutput())
For i=0 To Anz-1
If Dinglis(i*2,0)+5<Dinglis(i*2+1,0) ; Krümel werden nicht umrandet
Rectangle(Dinglis(i*2,0),Dinglis(i*2,1),Dinglis(i*2+1,0),Dinglis(i*2+1,1),RGB(255,255,255))
EndIf
Next
StopDrawing()
Repeat
Event = WaitWindowEvent()
StartDrawing(WindowOutput())
DrawImage(UseImage(1),0,0)
StopDrawing()
Delay(10)
Until Event=#PB_Event_CloseWindowSchreibt ruhig, wie ihr es findet. Das es noch nicht fertig ist, ist mir auch klar. Mit euer Unterstützung würde es schneller gehen können.
!!! Ich würde gern für später noch Rauschunterdrückung einführen. Ist das Bild nämlich mit kleinen Punkten überzogen, wird mit meiner Methode zurzeit noch alles als ein Objekt erkannt. Sicherlich wird das nicht mehr der Fall sein, wenn die Routine wie oben erwähnt erweitert wird, aber ich würde eine zusätzliche Rauschunterdrückung nicht schlecht finden.
Ich würde gern folgenden Filter haben wollen
Serif PhotoPlus Version 6.03 (Freeware) ::
Im Menü oben >> Image / Noise / Median Cut
Kennt den jemand, weiß jemand, wie der als Code aussehen könnte?
Würd mich freuen, wenn sich jemand erbarmt und ihn hier vorstellt.
Vielen Dank.
)
Und nicht sagen, das ist doch nicht möglich. Das es nicht von einer Person allein zu schaffen ist, dürfte uns ja klar sein.
