For Local X:Int = 0 Until 800
	For Local Y:Int = 0 Until 600
	Next
Next

Global Image_Source:TPixmap = LoadPixmap( "BlitzQuiz-Quadrate.png" )

Local pix_x:Int, pix_y:Int, time_need:Int = MilliSecs( )
For pix_x = 0 To Image_Source.width-1
	For pix_y = 0 To Image_Source.height-1
	Next
Next 
time_need = MilliSecs( ) - time_need
Print "Time : "+time_need

Local pix_x:Int, pix_y:Int, time_need:Float = MilliSecs( )
Local a:Int = 100, i:Int

For i = 1 To a

	For pix_x = 0 Until 799
		For pix_y = 0 Until 599
		Next
	Next 
	
Next 
time_need = Float(MilliSecs( ) - time_need) / Float( a )
Print "Time : "+time_need

Global RechtsX%, UntenY%, PM:TPixmap = LoadPixmap("BlitzQuiz-Quadrate.png")
Local PMWidth% = PixmapWidth(PM)
Local PMHeight% = PixmapHeight(PM)
Global ReadARGB%[PMWidth,PMHeight]
For Local i% = 0 Until PMWidth
	For Local j% = 0 Until PMHeight
		ReadARGB[i,j] = ReadPixel(PM, i, j)
	Next
Next	'... das war bisher nur das Einlesen der Daten ...
Local Quadratanzahl%, Rechteckanzahl%, time% = MilliSecs()	 'die eigentliche Rechteck-Suche beginnt erst jetzt, ätsch ... 
For Local x% = 0 Until PMWidth
	For Local y% = 0 Until PMHeight
		If ReadARGB[x,y] <> -1 Then   'Falls die Pixelfarbe nicht rein weiß ist, hat man ein Rechteck aufgespürt
			RechtsX = x
			UntenY = y	 'dessen Ausmaße man jetzt analysiert und gleichzeitig "ausradiert":
			FarbflaechenRekursion(x, y, ReadARGB[x,y])
			Rechteckanzahl:+1
			If RechtsX - x = UntenY - y Then Quadratanzahl:+1
		End If
	Next
Next
Print "Nach " + (MilliSecs() - time) + " Millisekunden steht fest: Es gibt " + Rechteckanzahl + " Rechtecke, von denen " + Quadratanzahl + " Quadrate sind."
Function FarbflaechenRekursion(x%, y%, ARGB%) 'grenzt das gleichfarbige Areal ein und "radiert es weiß aus"
	If ReadARGB[x,y] = ARGB Then   'falls die Pixelfarbe identisch ist, gehört sie anscheinend zum gleichen Viereck!
		RechtsX = Max(RechtsX, x)	'Außenmaße aktualisieren
		UntenY = Max(UntenY, y)	
		ReadARGB[x,y] = -1   'damit das gleiche Viereck nicht mehrmals gezählt wird, "färben wir es weiß"
		FarbflaechenRekursion(x+1, y, ARGB)   'und suchen nach gleichfarbigen Nachbarpixeln, wobei es genügt,
		FarbflaechenRekursion(x, y+1, ARGB)	  'Rechts und Unten zu suchen, da es nur nicht-gedrehte Rechtecke gibt
	End If 'und durch die Hauptschleife jedes Rechteck stets mit dem linken oberen Pixel aufgespürt wird.
End Function

AppTitle "Uber1337 Quadratezähler"
Graphics 800,600,32,2

Global nor,nog,nob,rgb
Global counterq,counterr,counter
Global pic = LoadImage ("BlitzQuiz-Quadrate.png")
Global time = MilliSecs ()

nor = 255
nog = 255
nob = 255
rgb = nor*$10000 + nog*$100 + nob

Local rgb3

SetBuffer ImageBuffer (pic)
LockBuffer ImageBuffer (pic)

	For y = 1 To 599
		For x = 1 To 799
			
			rgb3 = ReadPixelFast (x,y)
			r = (rgb3 And $FF0000)/$10000
			g = (rgb3 And $FF00)/$100 
			b = rgb3 And $FF 
			If r = nor And nog = g And nob = b Then
			Else
				counter = counter + 1
				Select ColorPart (x,y)
					Case 1 counterq = counterq + 1
					Case 0 counterr = counterr + 1
				End Select
			EndIf
			
		Next
	Next

UnlockBuffer ImageBuffer (pic)
SetBuffer FrontBuffer ()

DrawBlock pic,0,0

Color 0,0,0
Print "Anzahl Quadrate und Rechtecke: "+counter
Print "Anzahl Quadrate: "+counterq
Print "Anzahl Rechtecke: "+counterr
Print "Benötigte Zeit:  "+(MilliSecs ()-time)
WaitKey ()
End

Function ColorPart (x,y)

	Local rgb1,rgb2
	Local r,g,b
	Local width,length
	
		rgb1 = ReadPixelFast (x,y)
	
		endit = 0
		Repeat
			Repeat
				rgb2 = ReadPixelFast (x+xx,y+yy,ImageBuffer (pic))
				If rgb2 = rgb1 Then
					WritePixelFast (x+xx,y+yy,rgb,ImageBuffer (pic))
					If xx > width Then width = xx
					If yy > length Then length = yy
					;##################################################
					;Diesen Teil entkommentieren um zu beobachten, wie der Code funktioniert
					;##################################################
					;UnlockBuffer ImageBuffer (pic)
					;SetBuffer FrontBuffer ()
					;DrawBlock pic,0,0
					;Repeat
					;Until KeyDown (28)
					;SetBuffer ImageBuffer (pic)
					;LockBuffer ImageBuffer (pic)
				Else
					r = (rgb2 And $FF0000)/$10000 
					g = (rgb2 And $FF00)/$100
					b = rgb2 And $FF
					If r = nor And g = nog And b = nob Then endit = 1
				EndIf
				ox = xx
				xx = xx + 1
			Until endit
			If endit = 1 Then endit = 0
			oy = yy
			yy = yy + 1
			xx = 0
			rgb2 = ReadPixelFast (x,y+yy,ImageBuffer (pic))
			If rgb2 = rgb1 Then
			Else
				r = (rgb2 And $FF0000)/$10000 
				g = (rgb2 And $FF00)/$100
				b = rgb2 And $FF
				If r = nor And g = nog And b = nob Then endit = 1
			EndIf
		Until endit

	If width = length Then
		Return 1
	Else
		Return 0
	EndIf

End Function

SuperStrict


Local Image:TPixmap = LoadPixmap("BlitzQuiz-Quadrate.png")

Global Array:Int[PixmapWidth(Image), PixmapHeight(Image)]

Local tmpMilli:Int = MilliSecs()
Local tmpErgebniss:Int = SearchSquare(Image)
Local tmpZeit:Int = (MilliSecs() - tmpMilli)
Print "Es hat " + tmpErgebniss + " Quadrate auf dem Bild"
Print "Berechnungszeit: " + tmpZeit + " Millisekunden"

Function SearchSquare:Int(Image:TPixmap, X:Int = 0, Y:Int = 0, Art:Int = 0)
	If X = 0 And Y = 0
		For Local tmpX:Int = 0 Until PixmapWidth(Image)
			For Local tmpY:Int = 0 Until PixmapHeight(Image)
				Array:Int[tmpX, tmpY] = 0
			Next
		Next
	End If

	Local RectColor:Int = ReadPixel(Image, X, Y)
	Local X2:Int = X
	Local Y2:Int = Y
	
	'#Region Rechteck Grösse ermitteln
		Repeat
			Local tmpColor:Int = ReadPixel(Image, X2, Y)
			If tmpColor = RectColor
				X2:+1
				If X2 + 1 > PixmapWidth(Image)
					Exit
				EndIf
			Else
				Exit
			EndIf
		Forever
		
		Repeat
			Local tmpColor:Int = ReadPixel(Image, X, Y2)
			If tmpColor = RectColor
				Y2:+1
				If Y2 + 1 > PixmapHeight(Image)
					Exit
				EndIf
			Else
				Exit
			EndIf
		Forever
		
		Repeat
			If X - 1 < 0
				Exit
			EndIf
			Local tmpColor:Int = ReadPixel(Image, X - 1, Y)
			If tmpColor = RectColor
				X:-1
			Else
				Exit
			EndIf
		Forever
		
		Repeat
			If Y - 1 < 0
				Exit
			EndIf
			Local tmpColor:Int = ReadPixel(Image, X, Y - 1)
			If tmpColor = RectColor
				Y:-1
			Else
				Exit
			EndIf
		Forever
	'#End Region 
	
	Local tmpCount:Int
	If Art = 0
		If (X2 - X) = (Y2 - Y) Then tmpCount:+1 ' Falls Quadrat Zähler erhöhen
	ElseIf Art = 1
		If (X2 - X) <> (Y2 - Y) Then tmpCount:+1
	ElseIf Art = 2
		tmpCount:+1
	EndIf
	'#Region Neue Rechtecke Suchen
		
		
		For Local tmpX:Int = X Until X2
			For Local tmpY:Int = Y Until Y2
				Local tmpColor:Int = ReadPixel(Image, tmpX, tmpY)
				If tmpColor <> RectColor And Array[tmpX, tmpY] = 0
					tmpCount:+SearchSquare(Image, tmpX, tmpY, Art)
				EndIf
			Next
		Next
	'#End Region 
	
	For Local tmpX:Int = X Until X2
		For Local tmpY:Int = Y Until Y2
			Array[tmpX, tmpY] = 1
		Next
	Next
	
	Return tmpCount
End Function

Graphics 800, 600, 16, 2
SetBuffer BackBuffer( )

Global Image = LoadImage( "BlitzQuiz-Quadrate.png" ), Image_Buffer = ImageBuffer( Image )

Type Surface
	Field x, y
	Field w, h, d
	Field col
	Field quad
End Type 

Global QuadCount = 0
Global RectCount = 0

LockBuffer Image_Buffer

Global Aufrufe = 0
Local ms = MilliSecs( )
GetSurfaces( Image_Buffer, 0, 0, ImageWidth( Image )-1, ImageHeight( Image )-1 )
ms = MilliSecs( ) - ms

UnlockBuffer Image_Buffer

Print "Time : "+ms+" ms"
Print "Calls : "+Aufrufe
Print "Time per Call : "+(Float(ms) / Float(Aufrufe))+" ms"

WaitKey( )

Local tmpSurface.Surface
Repeat
	DrawBlock( Image, 0, 0, 0 )
	Color( 255, 0, 0 )
	For tmpSurface.Surface = Each Surface
		Rect( tmpSurface\x, tmpSurface\y, tmpSurface\w, tmpSurface\h, 0 )
	Next 
	Color( 0, 0, 0 )
	Rect( 0, 0, 150, 40, 1 )
	Color( 255, 255, 255 )
	Text( 0, 0, "Quads : "+QuadCount )
	Text( 0, 20, "Rects : "+RectCount )
	Flip
Until KeyHit( 1 )
End


Function GetSurfaces( tmpBuffer, tmpX, tmpY, tmpW, tmpH, tmpBgColor=$FFFFFFFF, tmpD=0 )
	;DebugLog "Suchtiefe momentan : "+tmpD+" {"+tmpX+"/"+tmpY+"}:{"+tmpW+"/"+tmpH+"} BGCOLOR : "+Hex( tmpBgColor )
	Aufrufe = Aufrufe + 1
	
	If tmpW < 3 Or tmpH <3 Or tmpD > 8 Then Return 
	
	Local tmpPixelX, tmpPixelY, tmpPixel, tmpSurface.Surface, tmpCheck=tmpBgColor
	For tmpPixelX = tmpX To tmpW
		For tmpPixelY = tmpY To tmpH
			tmpPixel = ReadPixelFast( tmpPixelX, tmpPixelY, tmpBuffer ) 
			If tmpPixel <> tmpBgColor Then
				If tmpCheck = tmpBgColor Then 
					If CheckSurface( tmpPixelX, tmpPixelY, tmpPixel, tmpD ) Then 
						tmpSurface = GetRect( tmpBuffer, tmpPixelX, tmpPixelY, tmpPixel, tmpD )
						GetSurfaces( tmpBuffer, tmpSurface\x, tmpSurface\y, tmpSurface\w, tmpSurface\h, tmpPixel, tmpD+1 )
						tmpCheck = tmpPixel
					EndIf 
				EndIf 
			Else
				If tmpCheck <> tmpBgColor Then tmpCheck = tmpBgColor
			EndIf 
		Next 
	Next 
	
End Function

Function GetRect.Surface( tmpBuffer, tmpX, tmpY, tmpBgColor, tmpD )
	Local tmpNX = tmpX
	Local tmpNY = tmpY
	Repeat
		tmpNX = tmpNX + 1 
	Until ReadPixelFast( tmpNX, tmpY, tmpBuffer ) <> tmpBgColor
	Repeat
		tmpNY = tmpNY + 1 
	Until ReadPixelFast( tmpX, tmpNY, tmpBuffer ) <> tmpBgColor
	Return AddSurface( tmpX, tmpY, tmpNX-tmpX, tmpNY-tmpY, tmpBgColor, tmpD )
End Function 

Function AddSurface.Surface( tmpX, tmpY, tmpW, tmpH, tmpCol, tmpD )
	Local tmpSurface.Surface = New Surface
	tmpSurface\x = tmpX 
	tmpSurface\y = tmpY 
	tmpSurface\w = tmpW 
	tmpSurface\h = tmpH
	tmpSurface\d = tmpD
	tmpSurface\col = tmpCol
	If tmpSurface\w = tmpSurface\h Then 
		tmpSurface\quad = True : QuadCount = QuadCount + 1
	Else	
		tmpSurface\quad = False : RectCount = RectCount + 1
	EndIf 
	Return tmpSurface
End Function 


Function CheckSurface( tmpX, tmpY, tmpCol, tmpD )
	Local tmpSurface.Surface
	For tmpSurface = Each Surface 
		If tmpSurface\d = tmpD And tmpSurface\col = tmpCol Then 
			If RectsOverlap( tmpSurface\x, tmpSurface\y, tmpSurface\w, tmpSurface\h, tmpX, tmpY, 1, 1 ) Then 
				Return False
			EndIf
		EndIf 
	Next
	Return True
End Function 



;~IDEal Editor Parameters:
;~C#Blitz3D

SuperStrict

Local pixmap:TPixmap = LoadPixmap("BlitzQuiz-Quadrate.png")

Local ms:Int = MilliSecs()
Local squares:Int, rectangles:Int
CountSquares(pixmap, squares, rectangles)
Notify("Es wurden " + rectangles + " Rechtecke gezählt, von denen " + squares + " Quadrate sind, in " + (MilliSecs() - ms) + "ms")


Function CountSquares(pixmap:TPixmap, squares:Int Var, rectangles:Int Var)
	Local w:Int = PixmapWidth(pixmap)
	Local h:Int = PixmapHeight(pixmap)
	
	For Local y:Int = 0 Until h
		For Local x:Int = 0 Until w
			Global _rgb:Int = $FFFFFFFF
			
			Local rgb:Int = ReadPixel(pixmap, x, y)
			
			If rgb <> _rgb Then
				If TopRight(pixmap, x, y, rgb) Then
					If IsSquare(pixmap, x, y, rgb) Then squares:+1
					rectangles:+1
				EndIf
			EndIf
			_rgb = rgb
		Next
	Next
End Function


Function RectWidth:Int(pixmap:TPixmap, x:Int, y:Int, rgb:Int)
	Local count:Int
	
	While ReadPixel(pixmap, x, y) = rgb
		count:+1
		x:+1
		If x >= PixmapWidth(pixmap) Then Exit
	Wend
	
	Return count
End Function

Function RectHeight:Int(pixmap:TPixmap, x:Int, y:Int, rgb:Int)
	Local count:Int
	
	While ReadPixel(pixmap, x, y) = rgb
		count:+1
		y:+1
		If y >= PixmapHeight(pixmap) Then Exit
	Wend
	
	Return count
End Function


Function TopRight:Int(pixmap:TPixmap, x:Int, y:Int, rgb:Int)
	Return (y = 0 Or ReadPixel(pixmap, x, y - 1) <> rgb)
End Function


Function IsSquare:Int(pixmap:TPixmap, x:Int, y:Int, rgb:Int)
	Return RectWidth(pixmap, x, y, rgb) = RectHeight(pixmap, x, y, rgb)
End Function