|
|
楼主 |
发表于 2023-1-19 19:49
|
显示全部楼层
求a+b=偶数m的数能有几个勾股数解就是a^2+b^=c^2其中a+b=m,代码如下：
Private Sub Command1_Click()
Dim x, Y, z
m = Text2
x = 1
Do While x < Val(m) / 2 + 1
Y = Val(m) - x
z = Sqr(x ^ 2 + Y ^ 2)
If InStr(z, ".") = 0 Then
If MPC(MPC1(MbC(Trim(x), Trim(x)), MbC(Trim(Y), Trim(Y))), MbC(Trim(z), Trim(z))) = 0 Then
s = s & "/解/" & x & "/" & Y & "/" & z
s1 = s1 + 1
Else
s1 = s1
End If
Else
s1 = s1
End If
x = x + 1
Loop
Text1 = Text1 & "有" & s1 & "组解： " & s
End Sub
Private Sub Command2_Click()
Text1 = ""
Text2 = ""
End Sub
Public Function MbC(D1 As String, D2 As String) As String '乘法
Dim x, Y '两数长度
x = Len(D1): Y = Len(D2)
Dim a() As Integer
ReDim a(1 To x + Y, 1 To Y)
Dim I, J, C1, C2, CJ, JW
For J = Y To 1 Step -1 'D2
JW = 0 '进位清0
C2 = Mid$(D2, J, 1) '每位数
For I = x To 1 Step -1 'D1
C1 = Mid$(D1, I, 1) '每位数
CJ = C1 * C2 + JW '计算乘积
c = I + J: r = Y + 1 - J
a(c, r) = CJ Mod 10 '本位
JW = CJ \ 10 '进位
Next
a(c - 1, r) = JW
Next
Dim b() As Integer
ReDim b(1 To x + Y)
JW = 0
For I = x + Y To 1 Step -1
Bit = JW
For J = 1 To Y
Bit = Bit + a(I, J)
Next
b(I) = Bit Mod 10
JW = Bit \ 10
Next
If b(1) > 0 Then
MbC = MbC & b(1)
Else
MbC = MbC
End If
For I = 2 To x + Y
MbC = MbC & b(I)
Next
End Function
Public Function MPC(D1 As String, D2 As String) As String ';jianfaqi
Dim x, Y ';两数长度
If Len(D1) >= Len(D2) Then
D4 = String(Len(D1) - Len(D2), "0") & D2
d3 = D1
Else
D4 = D2
d3 = String(Len(D2) - Len(D1), "0") & D1
End If
x = Len(d3): Y = Len(D4)
Dim a() As Integer, B1() As Integer, C1() As Integer, E1() As Integer
ReDim a(1 To x)
ReDim B1(1 To Y)
ReDim C1(1 To x)
ReDim E1(1 To x)
Dim I, J, C2, CJ, JW
For J = Y To 1 Step -1 ';D2
JW = 1 ';yu jie weichuzhi
B1(J) = Mid(D4, J, 1) ';每位数
For I = x To 1 Step -1 ';D1
a(I) = Mid(d3, I, 1) ';每位数
C1(I) = 10 + a(I) - B1(I) - 1 + JW ';计算jia
JW = C1(I) \ 10
E1(I) = C1(I) Mod 10
Next
Next
For r = 1 To x
MPC = MPC & E1(r)
For I = 1 To Len(MPC)
If Not Mid(MPC, I, 1) = "0" Then
Exit For
End If
Next
strtmp = Mid(MPC, I)
If Len(strtmp) = 0 Then
MPC = "0"
Else
MPC = strtmp
End If
Next
End Function
Public Function MPC1(D1 As String, D2 As String) As String 'jiafa
Dim x, Y '两数长度
If Len(D1) >= Len(D2) Then
D4 = String(Len(D1) - Len(D2), "0") & D2
d3 = D1
Else
D4 = D2
d3 = String(Len(D2) - Len(D1), "0") & D1
End If
x = Len(d3): Y = Len(D4)
Dim a() As Integer, B1() As Integer, C1() As Integer, E1() As Integer
ReDim a(1 To x)
ReDim B1(1 To Y)
ReDim C1(1 To x)
ReDim E1(1 To x)
Dim I, J, C2, CJ, JW
For J = Y To 1 Step -1 'D2
JW = 0 '进位清0
B1(J) = Mid$(D4, J, 1) '每位数
For I = x To 1 Step -1 'D1
a(I) = Mid$(d3, I, 1) '每位数
C1(I) = a(I) + B1(I) + JW '计算jia
JW = C1(I) \ 10
E1(I) = C1(I) Mod 10
Next
Next
For r = 1 To x
If JW = 0 Then
MPC1 = MPC1 & E1(r)
Else
jc = jc & E1(r)
MPC1 = JW & jc
End If
Next
End Function |
|
IP卡
狗仔卡
显身卡