几个vb小程序

ysr

Private Function ksm3(sa As String, sb As String) As String '某数的快速幂程序
Dim A, B
A = Trim(sa): B = sb
If B = 1 Then
ksm3 = A
ElseIf B = 0 Then
ksm3 = 1
Else
a1 = A
Do While B > 1
s = Int(Log(B) / Log(2))
s1 = 0
Do While s1 < s
A = MbC(Trim(A), Trim(A))
s1 = s1 + 1
Loop
a2 = A
B = B - 2 ^ s
A = a1
If s2 > 0 Then
a3 = MbC(Trim(a3), Trim(a2))
Else
a3 = a2
End If
s2 = s2 + 1
Loop
If B = 1 Then
ksm3 = MbC(Trim(a3), Trim(a1))
Else
ksm3 = a3
End If
s3 = Len(ksm3)
ksm3 = ksm3
End If


End Function

ysr

111111244769~111111244777内有0组蔡氏整数与素数对:
用时7574.482秒

ysr

111111244819~111111244837内有0组蔡氏整数与素数对:
用时-75905.444秒

ysr

Private Sub Command1_Click()
'验证李明波幂和猜想的程序
Dim a, b
a = Val(Text1)
b = Val(Text2)
a1 = a
Do While a <= b
q = a ^ (1 / 2)
a2 = 2
Do While InStr(Log(a) / Log(a2), ".") > 0 And a2 < q
a2 = a2 + 1
Loop

r = Log(a) / Log(a2)
a3 = a - Int(q) ^ 2
If InStr(r, ".") = 0 Then
Text3 = Text3 & a & "=" & a2 & "^" & r & vbCrLf
ElseIf a3 = 1 Then
Text3 = Text3 & a & "=" & Int(q) & "^" & 2 & "+1" & vbCrLf
ElseIf a3 = 2 Then
Text3 = Text3 & a & "=" & Int(q) & "^" & 2 & "+1+1" & vbCrLf
Else
q1 = Sqr(Val(a3))
a2 = 2
Do While InStr(Log(a3) / Log(a2), ".") > 0 And a2 < q1
a2 = a2 + 1
Loop
r1 = Log(a3) / Log(a2)
a4 = a - Int(q) ^ 2 - Int(q1) ^ 2
If InStr(r1, ".") = 0 Then
Text3 = Text3 & a & "=" & Int(q) & "^2" & "+" & a2 & "^" & r1 & vbCrLf
ElseIf a4 = 1 Then
Text3 = Text3 & a & "=" & Int(q) & "^2" & "+" & Int(q1) & "^" & 2 & "+1" & vbCrLf
Else
q2 = Sqr(Val(a4))
a2 = 2
Do While InStr(Log(a4) / Log(a2), ".") > 0 And a2 < q2
a2 = a2 + 1
Loop
r2 = Log(a4) / Log(a2)
If InStr(r2, ".") = 0 Then
Text3 = Text3 & a & "=" & Int(q) & "^2" & "+" & Int(q1) & "^2+" & a2 & "^" & r2 & vbCrLf
Else
s = s + 1
Text3 = Text3 & a & "=无解" & vbCrLf
End If
End If
End If
a = a + 1
Loop

Combo1 = a1 & "~" & b & "之间，有" & s & "个无解：" & vbCrLf & Text3


End Sub


Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""
Combo1 = ""

End Sub

ysr

4~100之间，有14个无解：
4=2^2
5=2^2+1
6=2^2+1+1
7=2^2+1^2+2^1
8=2^3
9=3^2
10=3^2+1
11=3^2+1+1
12=3^2+1^2+2^1
13=3^2+2^2
14=3^2+2^2+1
15=3^2+2^2+2^1
16=2^4
17=4^2+1
18=4^2+1+1
19=4^2+1^2+2^1
20=4^2+2^2
21=4^2+2^2+1
22=4^2+2^2+2^1
23=无解
24=4^2+2^3
25=5^2
26=5^2+1
27=3^3
28=5^2+1^2+2^1
29=5^2+2^2
30=5^2+2^2+1
31=5^2+2^2+2^1
32=2^5
33=5^2+2^3
34=5^2+3^2
35=5^2+3^2+1
36=6^2
37=6^2+1
38=6^2+1+1
39=6^2+1^2+2^1
40=6^2+2^2
41=6^2+2^2+1
42=6^2+2^2+2^1
43=无解
44=6^2+2^3
45=6^2+3^2
46=6^2+3^2+1
47=6^2+3^2+2^1
48=无解
49=7^2
50=7^2+1
51=7^2+1+1
52=7^2+1^2+2^1
53=7^2+2^2
54=7^2+2^2+1
55=7^2+2^2+2^1
56=无解
57=7^2+2^3
58=7^2+3^2
59=7^2+3^2+1
60=7^2+3^2+2^1
61=无解
62=7^2+3^2+2^2
63=无解
64=2^6
65=8^2+1
66=8^2+1+1
67=8^2+1^2+2^1
68=8^2+2^2
69=8^2+2^2+1
70=8^2+2^2+2^1
71=无解
72=8^2+2^3
73=8^2+3^2
74=8^2+3^2+1
75=8^2+3^2+2^1
76=无解
77=8^2+3^2+2^2
78=无解
79=无解
80=8^2+2^4
81=3^4
82=9^2+1
83=9^2+1+1
84=9^2+1^2+2^1
85=9^2+2^2
86=9^2+2^2+1
87=9^2+2^2+2^1
88=无解
89=9^2+2^3
90=9^2+3^2
91=9^2+3^2+1
92=9^2+3^2+2^1
93=无解
94=9^2+3^2+2^2
95=无解
96=无解
97=9^2+2^4
98=9^2+4^2+1
99=9^2+4^2+2^1
100=10^2

ysr

Private Sub Command1_Click()
'验证李明波幂和猜想的程序
Dim a, b
a = Val(Text1)
b = Val(Text2)
a1 = a
Do While a <= b
q = Sqr(Val(a))
a2 = 2
Do While InStr(Log(a) / Log(a2), ".") > 0 And a2 < q
a2 = a2 + 1
Loop

r = Log(a) / Log(a2)
a5 = a2
If a5 > 2 Then
a5 = a5 - 1
Else
a5 = a5
End If
jr = Int(Log(a) / Log(a5))
a3 = a - a5 ^ jr

If InStr(r, ".") = 0 Then
Text3 = Text3 & a & "=" & a2 & "^" & r & vbCrLf
ElseIf a3 = 1 Then
Text3 = Text3 & a & "=" & a5 & "^" & jr & "+1" & vbCrLf
ElseIf a3 = 2 Then
Text3 = Text3 & a & "=" & a5 & "^" & jr & "+1+1" & vbCrLf

Else
q1 = Sqr(Val(a3))
a2 = 2
Do While InStr(Log(a3) / Log(a2), ".") > 0 And a2 < q1
a2 = a2 + 1
Loop
r1 = Log(a3) / Log(a2)
a6 = a2
If a6 > 2 Then
a6 = a6 - 1
Else
a6 = a6
End If
jr1 = Int(Log(a3) / Log(a6))
a4 = a3 - a6 ^ jr1
If InStr(r1, ".") = 0 Then
Text3 = Text3 & a & "=" & a5 & "^" & jr & "+" & a2 & "^" & r1 & vbCrLf
ElseIf a4 = 1 Then
Text3 = Text3 & a & "=" & a5 & "^" & jr & "+" & a6 & "^" & jr1 & "+1" & vbCrLf


Else
q2 = Sqr(Val(a4))
a2 = 2
Do While InStr(Log(a4) / Log(a2), ".") > 0 And a2 < q2
a2 = a2 + 1
Loop
r2 = Log(a4) / Log(a2)
If InStr(r2, ".") = 0 Then
Text3 = Text3 & a & "=" & Int(q) & "^2" & "+" & Int(q1) & "^2+" & a2 & "^" & r2 & vbCrLf
Else
s = s + 1
Text3 = Text3 & a & "=无解" & vbCrLf
End If
End If
End If
a = a + 1
Loop

Combo1 = a1 & "~" & b & "之间，有" & s & "个无解：" & vbCrLf & Text3


End Sub


Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""
Combo1 = ""

End Sub

ysr

Private Sub Command1_Click()
'验证李明波幂和猜想的程序
Dim a, b
a = Val(Text1)
b = Val(Text2)
a1 = a
Do While a <= b
q = Sqr(Val(a))
a2 = 2
Do While InStr(Log(a) / Log(a2), ".") > 0 And a2 < q
a2 = a2 + 1
Loop

r = Log(a) / Log(a2)
a5 = a2
If a5 > 2 Then
a5 = a5 - 1
Else
a5 = a5
End If
jr = Int(Log(a) / Log(a5))
a3 = a - a5 ^ jr

If InStr(r, ".") = 0 Then
Text3 = Text3 & a & "=" & a2 & "^" & r & vbCrLf
ElseIf a3 = 1 Then
Text3 = Text3 & a & "=" & a5 & "^" & jr & "+1" & vbCrLf
ElseIf a3 = 2 Then
Text3 = Text3 & a & "=" & a5 & "^" & jr & "+1+1" & vbCrLf
ElseIf a3 = 3 Then
s = s + 1
Text3 = Text3 & a & "=无解" & vbCrLf
Else
q1 = Sqr(Val(a3))
a2 = 2
Do While InStr(Log(a3) / Log(a2), ".") > 0 And a2 < q1
a2 = a2 + 1
Loop
r1 = Log(a3) / Log(a2)
a6 = a2
If a6 > 2 Then
a6 = a6 - 1
Else
a6 = a6
End If
jr1 = Int(Log(a3) / Log(a6))
a4 = a3 - a6 ^ jr1
If InStr(r1, ".") = 0 Then
Text3 = Text3 & a & "=" & a5 & "^" & jr & "+" & a2 & "^" & r1 & vbCrLf
ElseIf a4 = 1 Then
Text3 = Text3 & a & "=" & a5 & "^" & jr & "+" & a6 & "^" & jr1 & "+1" & vbCrLf
ElseIf a4 = 2 Then
s = s + 1
Text3 = Text3 & a & "=无解" & vbCrLf

Else
q2 = Sqr(Val(a4))
a2 = 2
Do While InStr(Log(a4) / Log(a2), ".") > 0 And a2 < q2
a2 = a2 + 1
Loop
r2 = Log(a4) / Log(a2)
If InStr(r2, ".") = 0 Then
Text3 = Text3 & a & "=" & Int(q) & "^2" & "+" & Int(q1) & "^2+" & a2 & "^" & r2 & vbCrLf
Else
s = s + 1
Text3 = Text3 & a & "=无解" & vbCrLf
End If
End If
End If
a = a + 1
Loop

Combo1 = a1 & "~" & b & "之间，有" & s & "个无解：" & vbCrLf & Text3


End Sub

Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""
Combo1 = ""

End Sub

ysr

Private Sub Command1_Click()
'验证李明波幂和猜想的程序
Dim a, b
a = Val(Text1)
b = Val(Text2)
a1 = a
Do While a <= b
q = a ^ (1 / 2)
a2 = 2
Do While InStr(Log(a) / Log(a2), ".") > 0 And a2 < q
a2 = a2 + 1
Loop

r = Log(a) / Log(a2)
a3 = a - Int(q) ^ 2
If InStr(r, ".") = 0 Then
Text3 = Text3 & a & "=" & a2 & "^" & r & vbCrLf
ElseIf a3 = 1 Then
Text3 = Text3 & a & "=" & Int(q) & "^" & 2 & "+1" & vbCrLf
ElseIf a3 = 2 Then
Text3 = Text3 & a & "=" & Int(q) & "^" & 2 & "+1+1" & vbCrLf
Else
q1 = Sqr(Val(a3))
a2 = 2
Do While InStr(Log(a3) / Log(a2), ".") > 0 And a2 < q1
a2 = a2 + 1
Loop
r1 = Log(a3) / Log(a2)
a4 = a - Int(q) ^ 2 - Int(q1) ^ 2
If InStr(r1, ".") = 0 Then
Text3 = Text3 & a & "=" & Int(q) & "^2" & "+" & a2 & "^" & r1 & vbCrLf
ElseIf a4 = 1 Then
Text3 = Text3 & a & "=" & Int(q) & "^2" & "+" & Int(q1) & "^" & 2 & "+1" & vbCrLf
Else
q2 = Sqr(Val(a4))
a2 = 2
Do While InStr(Log(a4) / Log(a2), ".") > 0 And a2 < q2
a2 = a2 + 1
Loop
r2 = Log(a4) / Log(a2)
If a4 = 2 Then
js = ksm4(Trim(a), Val(s))
If InStr(js, "+") = 0 Then
s = s + 1
Text3 = Text3 & a & "=无解" & vbCrLf
Else
Text3 = Text3 & js & vbCrLf
End If
ElseIf InStr(r2, ".") = 0 Then
Text3 = Text3 & a & "=" & Int(q) & "^2" & "+" & Int(q1) & "^2+" & a2 & "^" & r2 & vbCrLf

Else

js = ksm4(Trim(a), Val(s))
If InStr(js, "+") = 0 Then
s = s + 1
Text3 = Text3 & a & "=无解" & vbCrLf
Else
Text3 = Text3 & js & vbCrLf
End If
End If
End If
End If
a = a + 1
Loop

Combo1 = a1 & "~" & b & "之间，有" & s & "个无解：" & vbCrLf & Text3


End Sub


Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""
Combo1 = ""

End Sub

Private Function ksm4(sa As String, sb As String) As String '某数的快速幂程序
Dim a, b
a = Val(sa)
s = Val(sb)
a1 = a
ja = 2
b = Int(Log(a) / Log(3))
Do Until ja > b
a3 = a - 3 ^ ja

If a3 = 1 Then
ksm = a & "=" & 3 & "^" & ja & "+1" & "  "
ElseIf a3 = 2 Then
ksm = a & "=" & 3 & "^" & ja & "+1+1" & "  "
Else
q1 = Sqr(Val(a3))
a2 = 2
Do While InStr(Log(a3) / Log(a2), ".") > 0 And a2 < q1
a2 = a2 + 1
Loop
r1 = Log(a3) / Log(a2)
a5 = a2
a4 = a3 - Int(Sqr(a3)) ^ 2
If a4 = 1 Then
ksm = a & "=3^" & ja & "+" & a2 & "^" & Int(r1) & "+1" & "  "
ElseIf InStr(r1, ".") = 0 Then
ksm = a & "=3^" & ja & "+" & a2 & "^" & r1 & "  "

Else
q2 = Sqr(Val(a4))
a2 = 2
Do While InStr(Log(a4) / Log(a2), ".") > 0 And a2 < q2
a2 = a2 + 1
Loop
r2 = Log(a4) / Log(a2)
If InStr(r2, ".") = 0 Then
ksm = a & "=3^" & ja & "+" & Int(Sqr(a3)) & "^" & 2 & "+" & a2 & "^" & r2 & "  "
Else

s = s + 1
ksm = a & "=无解" & vbCrLf
End If
End If
End If

If InStr(ksm, "无解") > 0 Then
ksm4 = 无解
Else
ksm4 = ksm4 & ksm
End If
ja = ja + 1
Loop

End Function

ysr

Private Sub Command1_Click()
'验证李明波幂和猜想的程序
Dim a, b
a = Val(Text1)
jb = Val(Text2)
ja2 = a
Do While a <= jb
q = a ^ (1 / 2)
a2 = 2
Do While InStr(Log(a) / Log(a2), ".") > 0 And a2 < q
a2 = a2 + 1
Loop

r = Log(a) / Log(a2)
a3 = a - Int(q) ^ 2
If InStr(r, ".") = 0 Then
Text3 = Text3 & a & "=" & a2 & "^" & r & vbCrLf
ElseIf a3 = 1 Then
Text3 = Text3 & a & "=" & Int(q) & "^" & 2 & "+1" & vbCrLf
ElseIf a3 = 2 Then
Text3 = Text3 & a & "=" & Int(q) & "^" & 2 & "+1+1" & vbCrLf
Else
a4 = a - 1
a2 = 2
Do While InStr(Log(a4) / Log(a2), ".") > 0 And a2 < q
a2 = a2 + 1
Loop
r1 = Log(a4) / Log(a2)
If InStr(r1, ".") = 0 Then
Text3 = Text3 & a & "=" & "1+" & a2 & "^" & r1 & vbCrLf
Else
a5 = a - 2
a2 = 2
Do While InStr(Log(a5) / Log(a2), ".") > 0 And a2 < q
a2 = a2 + 1
Loop
r2 = Log(a5) / Log(a2)
If InStr(r2, ".") = 0 Then
Text3 = Text3 & a & "=" & "1+1+" & a2 & "^" & r1 & vbCrLf
Else
ja1 = 2
Do While ja1 < q
js = ksm4(Trim(a), Val(ja1))
If InStr(js, "+") = 0 Then
s = s + 1
Text3 = Text3 & a & "=无解" & vbCrLf
Else
Text3 = Text3 & js & vbCrLf
End If
ja1 = ja1 + 1
Loop
End If
End If
End If

a = a + 1
Loop

Combo1 = ja2 & "~" & jb & "之间，有" & Val(s) & "个无解：" & vbCrLf & Text3


End Sub


Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""
Combo1 = ""

End Sub

Private Function ksm4(sa As String, sb As String) As String '某数的快速幂程序
Dim a, b
a = Val(sa)
ja1 = Val(sb)
a1 = a
ja = 2
b = Int(Log(a) / Log(ja1))
Do Until ja > b
a3 = a - ja1 ^ ja

If a3 = 1 Then
ksm = a & "=" & ja1 & "^" & ja & "+1" & "  "
ElseIf a3 = 2 Then
ksm = a & "=" & ja1 & "^" & ja & "+1+1" & "  "
Else
q1 = Sqr(Val(a3))
a2 = 2
Do While InStr(Log(a3) / Log(a2), ".") > 0 And a2 < q1
a2 = a2 + 1
Loop
r1 = Log(a3) / Log(a2)
a5 = a2
a4 = a3 - Int(Sqr(a3)) ^ 2
If a4 = 1 Then
ksm = a & "=" & ja1 & "^" & ja & "+" & a2 & "^" & Int(r1) & "+1" & "  "
ElseIf InStr(r1, ".") = 0 Then
ksm = a & "=" & ja1 & "^" & ja & "+" & a2 & "^" & r1 & "  "

Else
q2 = Sqr(Val(a4))
a2 = 2
Do While InStr(Log(a4) / Log(a2), ".") > 0 And a2 < q2
a2 = a2 + 1
Loop
r2 = Log(a4) / Log(a2)
If InStr(r2, ".") = 0 And r2 <> 1 Then
ksm = a & "=" & ja1 & "^" & ja & "+" & Int(Sqr(a3)) & "^" & 2 & "+" & a2 & "^" & r2 & "  "
Else

s = s + 1
ksm = a & "=无解" & vbCrLf
End If
End If
End If

If InStr(ksm, "无解") > 0 Then
ksm4 = 无解
Else
ksm4 = ksm4 & ksm
End If
ja = ja + 1
Loop

End Function

ysr

Private Sub Command1_Click()
'验证李明波幂和猜想的程序
Dim a, b
a = Val(Text1)
jb = Val(Text2)
ja2 = a
Do While a <= jb
q = a ^ (1 / 2)
a2 = 2
Do While InStr(Log(a) / Log(a2), ".") > 0 And a2 < q
a2 = a2 + 1
Loop

r = Log(a) / Log(a2)
a3 = a - Int(q) ^ 2
If InStr(r, ".") = 0 Then
Text3 = Text3 & a & "=" & a2 & "^" & r & vbCrLf
ElseIf a3 = 1 Then
Text3 = Text3 & a & "=" & Int(q) & "^" & 2 & "+1" & vbCrLf
ElseIf a3 = 2 Then
Text3 = Text3 & a & "=" & Int(q) & "^" & 2 & "+1+1" & vbCrLf
Else
a4 = a - 1
a2 = 2
Do While InStr(Log(a4) / Log(a2), ".") > 0 And a2 < q
a2 = a2 + 1
Loop
r1 = Log(a4) / Log(a2)
If InStr(r1, ".") = 0 Then
Text3 = Text3 & a & "=" & "1+" & a2 & "^" & r1 & vbCrLf
Else
a5 = a - 2
a2 = 2
Do While InStr(Log(a5) / Log(a2), ".") > 0 And a2 < q
a2 = a2 + 1
Loop
r2 = Log(a5) / Log(a2)
If InStr(r2, ".") = 0 Then
Text3 = Text3 & a & "=" & "1+1+" & a2 & "^" & r1 & vbCrLf
Else
ja1 = 2
Do While ja1 < q
For i = ja1 To Int(q) Step 1
If InStr(ksm4(Trim(a), Val(i)), "+") = 0 Then
ah = False
Exit For

Else: ah = True
js = ksm4(Trim(a), Val(i))
End If
Next

If ah = True Then
s = s + 1
Text3 = Text3 & a & "=无解" & vbCrLf
Else
If InStr(js, "+") = 0 Then
Text3 = Text3
Else
s1 = s1 + 1
Text3 = Text3 & js & vbCrLf
End If
End If
ja1 = ja1 + 1
Loop
End If
End If
End If

a = a + 1
Loop

Combo1 = ja2 & "~" & jb & "之间，有" & Val(s) & "个无解：" & vbCrLf & Text3


End Sub



Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""
Combo1 = ""

End Sub

Private Function ksm5(sa As String, sb As String) As String '某数的快速幂程序
Dim a, q
a = Val(sa)
q = Val(sb)
ja1 = 2
Do While ja1 < q
For i = ja1 To Int(q) Step 1
If InStr(ksm4(Trim(a), Val(i)), "+") = 0 Then
ah = False
Exit For

Else: ah = True
js = ksm4(Trim(a), Val(i))
End If
Next

If ah = True Then
s = s + 1
m5 = m5 & a & "=无解" & vbCrLf
Else
If InStr(js, "+") = 0 Then
m5 = m5
Else
s1 = s1 + 1
m5 = m5 & js & vbCrLf
End If
End If
ja1 = ja1 + 1
Loop

If s1 > 0 Then
ksm5 = ksm5 & a & "=无解" & vbCrLf
Else
ksm5 = m5
End If
End Function
Private Function ksm4(sa As String, sb As String) As String '某数的快速幂程序
Dim a, b
a = Val(sa)
ja1 = Val(sb)
a1 = a
ja = 2
b = Int(Log(a) / Log(ja1))
Do Until ja > b
a3 = a - ja1 ^ ja

If a3 = 1 Then
ksm = a & "=" & ja1 & "^" & ja & "+1" & "  "
ElseIf a3 = 2 Then
ksm = a & "=" & ja1 & "^" & ja & "+1+1" & "  "
Else
q1 = Sqr(Val(a3))
a2 = 2
Do While InStr(Log(a3) / Log(a2), ".") > 0 And a2 < q1
a2 = a2 + 1
Loop
r1 = Log(a3) / Log(a2)
a5 = a2
a4 = a3 - Int(Sqr(a3)) ^ 2
If a4 = 1 Then
ksm = a & "=" & ja1 & "^" & ja & "+" & a2 & "^" & Int(r1) & "+1" & "  "
ElseIf InStr(r1, ".") = 0 Then
ksm = a & "=" & ja1 & "^" & ja & "+" & a2 & "^" & r1 & "  "

Else
q2 = Sqr(Val(a4))
a2 = 2
Do While InStr(Log(a4) / Log(a2), ".") > 0 And a2 < q2
a2 = a2 + 1
Loop
r2 = Log(a4) / Log(a2)
If InStr(r2, ".") = 0 And r2 <> 1 Then
ksm = a & "=" & ja1 & "^" & ja & "+" & Int(Sqr(a3)) & "^" & 2 & "+" & a2 & "^" & r2 & "  "
Else

s = s + 1
ksm = a & "=无解"
End If
End If
End If

If InStr(ksm, "无解") > 0 Then
ksm4 = 无解
Else
ksm4 = ksm4 & ksm
End If
ja = ja + 1
Loop

End Function