' version 04-12-2016
' compile with: fbc -s console

' define true and false for older versions
#Ifndef TRUE
#Define FALSE 0
#Define TRUE Not FALSE
#EndIf

#Define max 1000000   ' maximum for number to be tested

Function kaprekar(n As ULong) As ULong

    If n = 1 Then Return TRUE

    Dim As ULong x, p1, p2
    Dim As ULongInt sq = CLngInt(n) * n
    Dim As String sq_str = Str(sq)
    Dim As ULong l = Len(sq_str)

    ' decrease the lenght l for every "0"
    ' at the end of the string
    For x = l -1 To 1 Step -1
        If sq_str[x] = Asc("0") Then
            l = l -1
        Else
            Exit For
        End If
    Next

    For x = 1 To l -1
        p2 = Val(Mid(sq_str, x +1))
        If p2 > n Then
            Continue For
        End If
        p1 = Val(Left(sq_str, x))
        If p1 > n Then Return FALSE  ' p1 > n leave
        If (p1 + p2) = n Then Return TRUE
    Next

End Function

' ------=< MAIN >=------

Dim As ULong n, count

Print "Kaprekar numbers below 10000"

For n = 1 To max -1
    If kaprekar(n) = TRUE Then
        count = count + 1
        If n < 10000 Then
            Print count, n
        End If
    End If
Next

Print
Print count;" numbers below "; Str(max);" are Kaprekar numbers"

' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End