EnableExplicit
DisableDebugger

Macro CheckVamp(CheckNum)
  c=0 : i=CheckNum : Print(~"\nCheck number: "+Str(i)+~"\n")
  Gosub VampireLoop : If c=0 : Print(Str(i)+" is not vampiric.") : EndIf : PrintN("")
EndMacro

Procedure.i Factor(number.i,counter.i)
  If number>0 And number>=counter*counter And number%counter=0
      ProcedureReturn counter
  EndIf
  ProcedureReturn 0
EndProcedure

Procedure.b IsVampire(f1.i,f2.i)
  Define a.s=Str(f1*f2),
         b.s=Str(f1),
         c.s=Str(f2),
         d.s=b+c,
         i.i
  If Len(a)=Len(d) And Len(b)=Len(c)
    While Len(a)
      i=FindString(d,Left(a,1))
      If i
        a=Mid(a,2)
        d=RemoveString(d,Mid(d,i,1),#PB_String_NoCase,i,1)
      Else
        ProcedureReturn #False
      EndIf
    Wend
    ProcedureReturn Bool(Len(d)=0)
  EndIf
  ProcedureReturn #False
EndProcedure

OpenConsole("Vampire number")
Define i.i,
       j.i,
       m.i,
       c.i=0

PrintN("The first 25 Vampire numbers...")
While c<25 : i+1 : Gosub VampireLoop : Wend
PrintN("")
CheckVamp(16758243290880) : CheckVamp(24959017348650) : CheckVamp(14593825548650)
Input()
End

VampireLoop:
  For j=1 To Int(Sqr(i))
    If Factor(i,j)>0
      m=i/j
    Else
      Continue
    EndIf
    If IsVampire(m,j)
      c+1
      PrintN(RSet(Str(c),3," ")+". "+RSet(Str(i),10," ")+": ["+Str(j)+", "+Str(m)+"]")
    EndIf
  Next
Return