ich habe für einen User im englischen Forum eine kleine Routine geschrieben mit der man farbige Objekte in einem Bild (z.B. Personen oder auch Tiere vor einer WebCam) lokalisieren und deren Position im Bild bestimmen kann.
Somit ist es dann z.B. möglich ein Bewegungsprofil dieser Objekte zu erstellen.
Falls also auch jemand hier im deutschen Forum Verwendung für sowas hat, hier mal ein ScreenShot und der Source:
[Rightclick to download the Source]
[Rightclick to download the Windows-EXE]
Code: Alles auswählen
; PB 4.x - should work on all OS-Platforms (tested on Win-XP and Ubuntu-Linux).
EnableExplicit
CompilerIf #PB_Compiler_OS <> #PB_OS_Windows ; On other OS then Windows the following Structures must be defined seperately:
Structure Point
x.l
y.l
EndStructure
Structure RGBQuad
rgbBlue.b
rgbGreen.b
rgbRed.b
rgbReserved.b
EndStructure
CompilerEndIf
Procedure FindObjectInPicture(Image.l, ColRangeMin.l, ColRangeMax.l, *pt.Point)
;
; Description:
; This Routine analyses an image for pixels within an given ColorRange.
; Furthermore it does a weighting of all found points.
; So it is possible to identify an object within the image and get the position of its central point - even if the Image is very noisy.
; By calling this routine multiple times with different ColorRanges, it is possible to identify multiple objects within the same Image.
; Limitations: So far it cannot identify more than one object whithin the same ColorRange.
; In this Case the result will be a weighted middle position of all objects found within this ColorRange.
;
; Parameters:
; - Image : #Image of the Image to be analysed
; - ColRangeMin : specifies the minimum Range for the RGB-Filter
; - ColRangeMax : specifies the maximum Range for the RGB-Filter
; Only the Colorchannels are filtered, which have a value in ColRangeMin or ColRangeMax
; So setting ColRangeMin=$000088 and ColRangeMax=$6600ff means, that
; the valid Range for blue is from $00-$66 and the valid Range for red is from $88-$ff
; Because there is no range set for the green-channel, green could have any value.
;
; - *pt.Point [out] : Pointer to a POINT-Structure
; The x/y-coordinates (center point) of a found Object will be written to this Structure
;
; Results : The Procedure returns a #True if an Object with the specified Range was found - otherwise it returns #False.
Global FindObjectInPicture_StartDrawingActive.l = #False
Structure AnalysePicture_Weighting
Weight.RGBQuad
Pos.w
EndStructure
Protected Result.l = #False
Protected x.l, y.l, ColInRange.l, ActCol.l, *ActCol.RGBQuad
Protected ActRed.w, ActGreen.w, ActBlue.w, MinRed.w, MinGreen.w, CheckBlue.w
Protected xWeight.l, yWeight.l, xMark.l, yMark.l
Protected *ColMin.RGBQuad = @ColRangeMin
Protected *ColMax.RGBQuad = @ColRangeMax
Protected CheckColors.l = ColRangeMin | ColRangeMax
Protected *ColCheck.RGBQuad = @CheckColors
If IsImage(Image)
Protected Dim xWeighting(ImageWidth(Image)-1)
Protected Dim yWeighting(ImageHeight(Image)-1)
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows, #PB_OS_Linux
!extrn _PB_2DDrawing_GlobalStructure ; This little ASM-Code (intel CPU only) just checks, if StartDrawing() is already active or not
!PUSH eax
!MOV eax,[_PB_2DDrawing_GlobalStructure]
!MOV [v_FindObjectInPicture_StartDrawingActive],eax
!POP eax
CompilerEndSelect
If Not FindObjectInPicture_StartDrawingActive
If CheckColors > 0 And StartDrawing(ImageOutput(Image))
; Image ColorRange-Analysis
For y = 0 To ImageHeight(Image)-1
For x = 0 To ImageWidth(Image)-1
ActCol = Point(x,y) ; <== This could be speeded up by an API-Guru if required. ;)
*ActCol = @ActCol
ColInRange = #True
If *ColCheck\rgbRed And (*ActCol\rgbRed & 255 < *ColMin\rgbRed & 255 Or *ActCol\rgbRed & 255 > *ColMax\rgbRed& 255 ) ; red channel
ColInRange = #False
EndIf
If ColInRange And *ColCheck\rgbGreen And (*ActCol\rgbGreen & 255 < *ColMin\rgbGreen & 255 Or *ActCol\rgbGreen & 255 > *ColMax\rgbGreen & 255) ; green channel
ColInRange = #False
EndIf
If ColInRange And *ColCheck\rgbBlue And (*ActCol\rgbBlue & 255 < *ColMin\rgbBlue & 255 Or *ActCol\rgbBlue & 255 > *ColMax\rgbBlue & 255) ; blue channel
ColInRange = #False
EndIf
If ColInRange
xWeighting(x) + 1
yWeighting(y) + 1
; Debug Str(x)+","+Str(y)+" "+Hex(ActCol)+" "+Hex(CheckColors)
EndIf
Next x
Next y
StopDrawing()
; Calculating horizontal Weight
xMark = 0
xWeight = 0
For x = 0 To ImageWidth(Image)-1
xMark = xMark + (x+1) * xWeighting(x)
xWeight = xWeight + xWeighting(x)
Next x
; Calculating vertical Weight
yMark = 0
yWeight = 0
For y = 0 To ImageHeight(Image)-1
yMark = yMark + (y+1) * yWeighting(y)
yWeight = yWeight + yWeighting(y)
Next y
; Write Results to Structure
If xWeight > 0 And yWeight > 0
*pt\x = xMark / xWeight - 1
*pt\y = yMark / yWeight - 1
Result = #True
EndIf
EndIf
Else
MessageRequester("FindObjectInPicture()-Error",Chr(34)+"StopDrawing()"+Chr(34)+" must be called before using FindObjectInPicture().")
EndIf
EndIf
ProcedureReturn Result
EndProcedure
Procedure GenerateNoisyTestImage(Image, Move=#False)
Structure TestImageObject
x.w
y.w
width.w
height.w
shape.b
angle.f
speed.f
anglestep.f
steps.b
dots.w
EndStructure
Static Dim Object.TestImageObject(5)
Protected n, x, y
Protected x1, y1, x2, y2, angle.f
Protected rMin, rMax, gMin, gMax, bMin, bMax
If StartDrawing(ImageOutput(Image))
If Not Move Or Object(0)\x = 0 ; Set new random position and attributes to objects
For n = 0 To 5
Object(n)\x = Random(ImageWidth(Image)-57)+28
Object(n)\y = Random(ImageHeight(Image)-57)+28
Object(n)\width = Random(10)+10
Object(n)\height = Random(10)+10
Object(n)\shape = Random(1)
Object(n)\angle = Random(64000)/10000
Object(n)\speed = Random(3000)/1000 + 3
Object(n)\anglestep = (Random(5000)-2500)/10000
Object(n)\steps = Random(10)+5
Object(n)\dots = Random(50)+100
Next n
Else ; Move Objects
For n = 0 To 5
Object(n)\angle - Object(n)\anglestep
Object(n)\x + Sin(Object(n)\angle) * Object(n)\speed
Object(n)\y + Cos(Object(n)\angle) * Object(n)\speed
If Object(n)\x < 28 Or Object(n)\x > ImageWidth(Image)-28 Or Object(n)\y < 28 Or Object(n)\y > ImageHeight(Image) - 28
Object(n)\angle - 3.2
Object(n)\x + Sin(Object(n)\angle) * Object(n)\speed
Object(n)\y + Cos(Object(n)\angle) * Object(n)\speed
EndIf
Object(n)\steps - 1
If Object(n)\steps < 1
Object(n)\speed = Random(3000)/1000 + 3
Object(n)\anglestep = (Random(5000)-2500)/10000
Object(n)\steps = Random(10)+5
EndIf
Object(n)\width = Random(10)+10
Object(n)\height = Random(10)+10
Object(n)\dots = Random(50)+100
Next n
EndIf
Box(0,0,ImageWidth(Image),ImageHeight(Image),0) ; blank image
For y = 0 To ImageHeight(Image)-1 ; Fill Image with dust
For x = 0 To ImageWidth(Image)-1
If Random(1) : Plot(x,y,RGB(Random($30),Random($30),Random($30))) : EndIf
Next x
Next y
For n = 0 To 5 ; draw Objects
rMin = 0 : rMax = $30
gMin = 0 : gMax = $30
bMin = 0 : bMax = $30
If n = 0 Or n = 3 Or n = 4 : rMin = $40 : rMax = $5f : EndIf
If n = 1 Or n = 3 Or n = 5 : gMin = $40 : gMax = $5f : EndIf
If n = 2 Or n = 4 Or n = 5 : bMin = $40 : bMax = $5f : EndIf
If Object(n)\shape ; draw a colored square
For x = 1 To Object(n)\dots
Plot(Object(n)\x+Random(Object(n)\width)-Object(n)\width/2,Object(n)\y+Random(Object(n)\height)-Object(n)\height/2,RGB(Random(rMax-rMin)+rMin,Random(gMax-gMin)+gMin,Random(bMax-bMin)+bMin))
Next x
Else ; draw a round shape
For x = 1 To Object(n)\dots
angle = Random(6400)/1000
Plot(Object(n)\x+Sin(angle)*Random(Object(n)\width),Object(n)\y+Cos(angle)*Random(Object(n)\height),RGB(Random(rMax-rMin)+rMin,Random(gMax-gMin)+gMin,Random(bMax-bMin)+bMin))
Next x
EndIf
Next n
StopDrawing()
EndIf
EndProcedure
Structure MultiPoint
pt.Point[3]
EndStructure
NewList ObjectPath.MultiPoint()
Define Event
Define tStart, tStop, n, x, y, iCount, Animate
Dim Square.Point(2)
If CreateImage(0,280,200)
If OpenWindow(0,0,0,ImageWidth(0)+20,ImageHeight(0)+80,"Filtering red, green and cyan Objects", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
If CreateGadgetList(WindowID(0))
ImageGadget(0,10,10,0,0,ImageID(0))
ButtonGadget(1,20,WindowHeight(0)-60,WindowWidth(0)-40,20,"Create and analyse single Image")
ButtonGadget(2,20,WindowHeight(0)-30,WindowWidth(0)-40,20,"Continuously animate and trace Objects")
Repeat
Event = WaitWindowEvent(Animate)
If Event = #PB_Event_Gadget Or Animate
If EventGadget() = 2 Or Animate
If Animate
If Event = #PB_Event_Gadget ; stop tracing objects
Animate = #False
SetGadgetText(2,"Continuously animate and trace Objects")
DisableGadget(1,#False)
Else
GenerateNoisyTestImage(0, #True)
FindObjectInPicture(0,RGB($40,$00,$00),RGB($7f,$30,$30),@Square(0)) ; find red : red-Range $40-$7f - green and blue is only valid upto a noiselevel of $30
FindObjectInPicture(0,RGB($00,$40,$00),RGB($30,$7f,$30),@Square(1)) ; find green : green Range $40-$7f - red and blue is only valid upto a noiselevel of $30
FindObjectInPicture(0,RGB($00,$40,$40),RGB($30,$7f,$7f),@Square(2)) ; find cyan : green&blue Range $40-$7f - red is only valid upto a noiselevel of $30
If StartDrawing(ImageOutput(0))
If CountList(ObjectPath()) > 20 ; if Path is longer than 20 steps -> cut it
FirstElement(ObjectPath())
DeleteElement(ObjectPath())
LastElement(ObjectPath())
EndIf
AddElement(ObjectPath())
For n = 0 To 2
Line(Square(n)\x-10,Square(n)\y,20,0,$ffffff) ; draw cross to show object center point
Line(Square(n)\x,Square(n)\y-10,0,20,$ffffff)
ObjectPath()\pt[n]\x = Square(n)\x ; write new center to path
ObjectPath()\pt[n]\y = Square(n)\y
ForEach ObjectPath() ; draw path
x = ObjectPath()\pt[n]\x
y = ObjectPath()\pt[n]\y
If NextElement(ObjectPath())
LineXY(x,y,ObjectPath()\pt[n]\x,ObjectPath()\pt[n]\y,RGB((0 Or n=0)*$5f,(0 Or n>0) *$5f,(0 Or n=2)*$5f))
PreviousElement(ObjectPath())
EndIf
Next
Next n
StopDrawing()
SetGadgetState(0,ImageID(0))
EndIf
EndIf
Else ; start tracing objects
Animate = #True
SetGadgetText(2,"Stop Object tracing")
DisableGadget(1,#True)
EndIf
ElseIf EventGadget() = 1
GenerateNoisyTestImage(0)
SetGadgetState(0,ImageID(0))
iCount = 0
tStart = ElapsedMilliseconds()
iCount + FindObjectInPicture(0,RGB($40,$00,$00),RGB($ff,$30,$30),@Square(0)) ; find red : red-Range $40-$7f - green and blue is only valid upto a noiselevel of $30
iCount + FindObjectInPicture(0,RGB($00,$40,$00),RGB($30,$7f,$30),@Square(1)) ; find green : green Range $40-$7f - red and blue is only valid upto a noiselevel of $30
iCount + FindObjectInPicture(0,RGB($00,$40,$40),RGB($30,$7f,$7f),@Square(2)) ; find cyan : green&blue Range $40-$7f - red is only valid upto a noiselevel of $30
; iCount + FindObjectInPicture(0,RGB($00,$00,$40),RGB($30,$30,$7f),@Square(0)) ; find blue : blue-Range $40-$7f - green and red is only valid upto a noiselevel of $30
; iCount + FindObjectInPicture(0,RGB($40,$40,$00),RGB($7f,$7f,$30),@Square(1)) ; find yellow : red&green Range $40-$7f - blue is only valid upto a noiselevel of $30
; iCount + FindObjectInPicture(0,RGB($40,$00,$40),RGB($7f,$30,$7f),@Square(2)) ; find magenta : red&blue Range $40-$7f - green is only valid upto a noiselevel of $30
tStop = ElapsedMilliseconds()
StartDrawing(ImageOutput(0))
For n = 0 To 2
Line(Square(n)\x-10,Square(n)\y,20,0,$ffffff) ; draw cross to show object center point
Line(Square(n)\x,Square(n)\y-10,0,20,$ffffff)
Next n
DrawingMode(#PB_2DDrawing_Transparent)
DrawText(1,1,Str(iCount)+" Objects identified in "+Str(tStop - tStart)+"ms",$ffffff)
StopDrawing()
SetGadgetState(0,ImageID(0))
ClearList(ObjectPath())
EndIf
EndIf
Until Event = #PB_Event_CloseWindow
EndIf
CloseWindow(0)
EndIf
FreeImage(0)
EndIf
