几个vb小程序

ysr

Private Sub Command1_Click()
Dim a, b, c
a1 = Trim(Text1)
B1 = Val(Text2)
b = 1
Do While b <= Val(B1)
s2 = 0
a = 2
Do While Val(s2) <= 10
s2 = Val(s2 + 1)
c = qxdcm(Trim(a), 4)
C1 = qxdcm(Trim(b), 4)

C2 = MPC(MbC(MbC(Trim(a), Trim(b)), MPC(Trim(c), Trim(C1))), 1)
p = MPC1(Trim(C2), 2)
p1 = MPC1(Trim(p), Trim(a1))
p2 = MPC1(Trim(p1), 2)
If InStr(fenjieyinzi0(Trim(p)), "*") = 0 And InStr(fenjieyinzi0(Trim(p1)), "*") = 0 And InStr(fenjieyinzi0(Trim(p2)), "*") = 0 Then
s = s & "/" & p & "/" & p1 & "/" & p2 & vbCrLf
s1 = s1 + 1
Else
s1 = s1
End If
a = MPC1(Trim(a), 1)
Loop
b = Val(b + 1)
Loop

If s1 > 0 Then
Text3 = s
Else
Text3 = "无解"
End If
End Sub

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

ysr

/15361/1015361/1015363
/117811/1117811/1117813
/497281/1497281/1497283
/211/1000211/1000213
/1075201/11075201/11075203
/134401/10134401/10134403
/1540141/11540141/11540143
/1815841/101815841/101815843
/345601/100345601/100345603

/2274487/1076016311/1076016313

ysr

Private Sub Command1_Click()
Dim a, b, c
a1 = Trim(Text1)
B1 = Val(Text2)
a1 = qxdcm(2, Trim(a1))
b = 1
Do While b <= Val(B1)
s2 = 0
a = 2
Do While Val(s2) <= 30
s2 = Val(s2 + 1)
c = qxdcm(Trim(a), 4)
C1 = qxdcm(Trim(b), 4)
s3 = 0
C2 = MPC(MbC(MbC(Trim(a), Trim(b)), MPC(Trim(c), Trim(C1))), 1)
p = MPC1(Trim(C2), 2)
Do While InStr(fenjieyinzi0(Trim(p)), "*") > 0 And s3 <= 3
s3 = s3 + 1
p = Val(p + 6)
Loop

p1 = MPC1(Trim(p), Trim(a1))
p2 = MPC1(Trim(p1), 2)
If InStr(fenjieyinzi0(Trim(p)), "*") = 0 And InStr(fenjieyinzi0(Trim(p1)), "*") = 0 And InStr(fenjieyinzi0(Trim(p2)), "*") = 0 Then
s = s & "/" & p & "/" & p1 & "/" & p2 & vbCrLf
s1 = s1 + 1
Else
s1 = s1
End If
a = MPC1(Trim(a), 1)
Loop
b = Val(b + 1)
Loop

If s1 > 0 Then
Text3 = s
Else
Text3 = "无解"
End If
End Sub

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

ysr

/1615333/1125899908457957/1125899908457959
/63700807/1125899970543431/1125899970543433

这里有两对16为的孪生素数

ysr

Private Sub Command1_Click()
Dim a, w, k
a = Val(Text1)
m = 90000
Do While m <= a
k = 30000
Do While k <= a
w = m * (m + 1) / 2
If Val(k * (k + 1)) = w Then
s1 = s1 + 1
s = s & "w=" & w & "  k=" & k & vbCrLf

Else
s = s
End If


k = k + 1
Loop

m = m + 1
Loop

If s1 > 0 Then
Text2 = "k的值在30000~ " & a & " 内有" & s1 & " 组既是长方形数又是三角数的解:" & vbCrLf & s
Else
Text2 = "无解"
End If

End Sub

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

End Sub

ysr

Private Sub Command1_Click()
Dim a, b, c
a = Val(Text1)
b = 1
Do While b <= a
w = ((3 + 2 * Sqr(2)) ^ b - (3 - 2 * Sqr(2)) ^ b) / (4 * Sqr(2))
s1 = s1 & " w=" & w & vbCrLf
b = b + 1
Loop
Text2 = s1
End Sub
Private Sub Command2_Click()
Text1 = ""
Text2 = ""
End Sub

ysr

Private Sub Command1_Click()
Dim a, b, c
a = Val(Text1)
Do While b <= a
d = 24 * b ^ 2 + 16 * b + 1
If InStr(Sqr(d), ".") = 0 Then
s = s + 1
m = (Sqr(d) - 1) / 2
w = m * (m + 1) / 2
s1 = s1 & "n=" & b & "d=24n^2+16n+1=" & Sqr(d) & "^2, w=" & w & vbCrLf
Else
s = s
End If

b = b + 1
Loop
If s > 0 Then
Text2 = s1
Else
Text2 = "无解"
End If


End Sub

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

End Sub

ysr

Private Sub Command1_Click()
Dim a, b, c
a = Val(Text1)
b = 1
Do While b <= a
w = Val(((17 + 12 * Sqr(2)) ^ b - 2 + (17 - 12 * Sqr(2)) ^ b) / 32)
s1 = s1 & " w=" & w & vbCrLf
b = Val(b + 1)
Loop
Text2 = s1
End Sub
Private Sub Command2_Click()
Text1 = ""
Text2 = ""
End Sub

ysr

Private Sub Command1_Click()
Dim a, b, c
a = Val(Text1)
b = 1
Do While b <= a
w = ((3 + 2 * Sqr(2)) ^ b + (3 - 2 * Sqr(2)) ^ b - 2) / 4
s1 = s1 & " w=" & w ^ 2 & vbCrLf
b = b + 1
Loop
Text2 = s1
End Sub
Private Sub Command2_Click()
Text1 = ""
Text2 = ""
End Sub

ysr

Private Sub Command1_Click()
Dim a, b, c
a = Val(Text1)
Do While b <= a
d = Abs(8 * b ^ 2 - 7)
If InStr(Sqr(d), ".") = 0 Then
s = s + 1
m = (Sqr(d) - 1) / 2
w = m * (m + 1) / 2
s1 = s1 & "n=" & b & "d=8n^2-7=" & Sqr(d) & "^2, w=" & w & vbCrLf
Else
s = s
End If

b = b + 1
Loop
If s > 0 Then
Text2 = s1
Else
Text2 = "无解"
End If


End Sub

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

End Sub