Const max=9999999
Const digits=7

Dim power_of_10(digits)
power_of_10(0)=1
For i=1 To digits
	power_of_10(i)=power_of_10(i-1)*10
Next

start=MilliSecs() 

For i=1 To max 
	val=0 
	valm=1
	temp=i
	do=False
	For j=digits To 0 Step -1
		num=temp/power_of_10(j)
		If num<>0 Then do=True
		If do Then
			temp=temp-num*power_of_10(j)
			val=val+num
			valm=valm*num
		EndIf
	Next 
	If i=val*valm Then
		Print "found ! "+i
	EndIf 
Next 


Print "It took me: "+(MilliSecs()-start)/1000+" seconds" 

Input

End

;Ziffern aus Zahl extrahieren

	zahl = 1337

	temp = zahl
	While temp > 0
		Print temp Mod 10 ;letzte Stelle anzeigen
		temp = temp / 10  ;letzte Stelle "abschneiden"
	Wend

	WaitKey
	End

Function Quersumme:Int(x:Int)
	Local r:Int = 0
	While x > 0
		r = r + x Mod 10
		x = x /10
	Wend
	Return r
End Function

Function Querprodukt:Int(x:Int)
	Local r:Int = 1
	While x > 0
		r = r * (x Mod 10)
		x = x/10
	Wend
	Return r
End Function
Local c:Int = 0

Local timer:Int = MilliSecs()
While c < 999999
	If (c = Quersumme(c) * Querprodukt(c)) Then Print c
	c = c + 1
Wend

Print "Zeit: " + (MilliSecs() - timer)

Const max=9999999

	startzeit = MilliSecs()
	found = 0

	For zahl = 1 To max

		qs = 0 ;Quersumme
		qp = 1 ;Querprodukt
		temp = zahl
		fail = False
		While temp > 0 And (Not fail)
			letzteZiffer = temp Mod 10
			If letzteZiffer > 0 Then If zahl Mod letzteZiffer <> 0 Then fail = True
			qs = qs + letzteZiffer
			qp = qp * letzteZiffer
			temp = temp / 10  ;letzte Stelle "abschneiden"
		Wend
		If Not fail Then
			If zahl = qs * qp Then Text 0, 16 * found, zahl: found = found + 1
		End If

	Next

	Text 0, GraphicsHeight() - 16, "Benötigte Zeit: " + (MilliSecs() - startzeit) + " Millisekunden"
	WaitKey
	End

Const NUM_DIGITS = 7

Dim zahl(NUM_DIGITS - 1)

Local quersumme   = 0
Local querprodukt = 0

Const QUERSUMME_END   = 9 * NUM_DIGITS
Const QUERPRODUKT_END = 9^NUM_DIGITS

Const CODE_0 = 48 ; = Asc("0")

Local startTime = MilliSecs()

Local count = 0
While Not (quersumme = QUERSUMME_END And querprodukt = QUERPRODUKT_END)
	If zahl(NUM_DIGITS - 1) = 10 Then ; Übertrag
		For i = NUM_DIGITS - 1 To 1 Step -1
			zahl(i) = 0
			If zahl(i - 1) <> 9
				zahl(i - 1) = zahl(i - 1) + 1
				Exit
			EndIf
		Next
	EndIf

	quersumme   = 0
	querprodukt = 1
	Local inQuerprodukt = False
	
	For i = 0 To NUM_DIGITS - 1
		quersumme = quersumme + zahl(i)
		; Führende Nullen ignorieren
		If inQuerprodukt = False And zahl(i) <> 0 Then inQuerprodukt = True
		If inQuerprodukt = True Then querprodukt = querprodukt * zahl(i)
	Next
	
	If count = (quersumme * querprodukt) Then Print zahlToString()
	count = count + 1
	zahl(NUM_DIGITS - 1) = zahl(NUM_DIGITS - 1) + 1
Wend
Print "ready in " + (MilliSecs() - startTime) + " ms"

WaitKey

Function zahlToString$()
	Local out$ = ""
	
	Local start = 0
	While zahl(start) = 0
		start = start + 1
		If start = NUM_DIGITS Then Return "0"
	Wend

	For i = start To NUM_DIGITS - 1
		out = out + Chr(CODE_0 + zahl(i))
	Next
	
	Return out
End Function

SuperStrict

Const max_digits% = 7 'maximale Stellenanzahl (von 9.999.999)
Local time% = MilliSecs()

Print "Found: 0"	'Der Sonderfall 0
			'(ansonsten darf die Null als Ziffer nie mehr vorkommen)

search(0, 0, 1, 0)	'Suche mit Startwerten beginnen...

Print "time = " + (MilliSecs() - time) + " ms"

Function search(digits%, sum%, product%, ten_number%)
		'Die Funktionsargumente:
		'digits: Anzahl der Stellen bzw. Ziffern
		'sum: bisherige Quersumme
		'product: bisheriges "Querprodukt"
		'ten_number: bisherige "Zahl", mit 10 multiplziert

	Local new_sum%, new_product%, new_number%
	Local new_digits% = digits+1	
	
	If new_digits < max_digits Then	'falls kleiner als maximale Stellenanzahl
		
		For Local d% = 1 To 9	 'alle erlaubten Ziffern durchgehen
			
			new_sum = sum + d	'Quersumme erweitern
			new_product = product * d	'"Querprodukt" erweitern
			new_number = ten_number + d	'neue "Zahl" aus Zehnerzahl und Einerziffer
			
			'Vergleich:
			If new_sum * new_product = new_number Then Print "Found: " + new_number
			
			'rekursiv fortschreiten:
			search(new_digits, new_sum, new_product, 10 * new_number)

		Next
		
	Else
		
		'(das Gleiche, nur ohne rekursiven Funktionsaufruf)
		For Local d% = 1 To 9
			new_sum = sum + d
			new_product = product * d
			new_number = ten_number + d
			If new_sum * new_product = new_number Then Print "Found: " + new_number
		Next
	
	End If
	
End Function