PureBoard

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