常用的的测量程序vb代码

常用的的测量程序vb代码 VB测量程序代码 取一元、二元、五元的硬币共十枚，付给25元钱，有多少种不同的取法? 方法一 Private Sub Command1_Click() Print "一元", "两元", "五元" For a = 0 To 10 For b = 0 To 10 For c = 0 To 10 If a + 2 * b + 5 * c = 25 And a + b + c = 10 Then Print a, b, c End If Next c Next b Next a End Sub: 方法二 Private Sub Command1_Click() Print "一元", "两元", "五元" For a = 0 To 10 For b = 0 To 10 c = 10 - a - b If a + 2 * b + 5 * c = 25 And c > 0 Then VB测量程序设计代码 Print a, b, c End If Next b Next a End Sub 九九乘法表 方法一 Private Sub Command1_Click() Print Tab(12); "九九乘法表" For i = 1 To 9 For j = 1 To i Print i * j; Next j Print Next i End Sub 方法二 Private Sub Command2_Click() Show FontSize = 15 Print Tab(12); FontSize = 12 VB测量程序设计代码 Print For k = 0 To 9 Print Tab(k * 4); k; Next kjiu Print For j = 1 To 9 Print j; For k = 1 To j Print Tab(k * 4); j * k; Next k Print Next j End Sub 求T = 8! = 1×2×3×…×8 Private Sub Command1_Click() jc = 1 n = Val(Text1.Text) For c = 1 To n jc = jc * c Next c Print "jc="; jc End Sub VB测量程序设计代码 用100 元买100 只鸡，母鸡3元1只，小鸡1元3只，问各应买多少只? Private Sub Command1_Click() VB测量程序设计代码 Dim x As Integer, y As Integer For x = 1 To 30 y = 100 - x If 3 * x + y / 3 = 100 Then Print "母鸡只数为:"; x, Print "小鸡只数为:"; y End If Next x End Sub 数组 打印数组的上界和下界数值 Private Sub Command1_Click() Dim a(1 To 10) As Integer Print "下界值", "上界值" Print LBound(a), UBound(a) End Sub VB测量程序设计代码 数组解决1+2+3+4+5+6+7+8=, Private Sub Command1_Click() Dim a(1 To 10) As Integer Dim sum As Integer For b = 1 To 8 a(b) = b sum = sum + a(b) Next b Text1.Text = sum Print "1+2+3+4+5+6+7+8=" & sum End Sub VB测量程序设计代码 任意五个数字之和 Private Sub Command1_Click() Dim Data(5) As Integer Dim Sum, I As Integer For I = 1 To 5 Data(I) = InputBox("输入第" & I & "个数据") Next I For I = 1 To 5 Sum = Sum + Data(I) Next I Text1.Text = Sum Print Sum End Sub VB测量程序设计代码 连续输入5个数字 例如1，2，3，4，5 1+3+5+7+9=,奇数和 VB测量程序设计代码 Private Sub Command1_Click() Dim a(1 To 5) As Integer Dim sum As Integer For x = 1 To 5 a(x) = x * 2 - 1 sum = sum + a(x) Next x Text1.Text = sum Print sum End Sub Private Function pf(x As Long, y As Long) As Long s = Sqr(x ^ 2 + y ^ 2) pf = s VB测量程序设计代码 End Function Private Sub Command1_Click() Dim a As Long Dim b As Long Dim c As Long a = Val(Text1.Text) b = Val(Text2.Text) s = pf(a, b) Print s End Sub Sub过程 和 Function过程 3. 编写过程，求两个数的最大公约数。 Private Sub pd(x As Integer, y As Integer, z As Integer) For j = 1 To y If x Mod j = 0 And y Mod j = 0 Then z = j End If Next j End Sub Private Sub Command1_Click() Dim a As Integer Dim b As Integer VB测量程序设计代码 Dim c As Integer a = Val(Text1.Text) b = Val(Text2.Text) Call pd(a, b, c) Print c End Sub 4. 编写一个计算平方根的Function过程 Private Function pf(x As Long, y As Long) As Long s = Sqr(x ^ 2 + y ^ 2) pf = s End Function Private Sub Command1_Click() VB测量程序设计代码 Dim a As Long Dim b As Long Dim s As Long a = Val(Text1.Text) b = Val(Text2.Text) s = pf(a, b) Print s End Sub 判断一个数是奇数还是偶数 Private Sub pd(a As Integer, b As String) If a Mod 2 = 0 Then b = "偶数 " Else VB测量程序设计代码 b = "奇数" End If End Sub Private Sub Command1_Click() Dim x As Integer Dim y As String x = Val(Text1.Text) Call pd(x, y) Print y End Sub 10. 有5个人坐在一起，问第5个人多少岁,他说比第4个人大2岁。问第4个人岁数，他说比第3个人大2岁。问第3个人，又说比第2个人大2岁。问第2个人，说比第1个人大2岁。最后问第1 VB测量程序设计代码 个人，他说是10岁。请问第5个人有多大岁数, 第一种 Private Sub pd(a As Integer, b As Integer, c As Integer, d As Integer, e As Integer) a = 10 b = a + 2 c = b + 2 d = c + 2 e = d + 2 End Sub Private Sub Command1_Click() Dim m As Integer Dim n As Integer Dim l As Integer Dim k As Integer Call pd(10, m, n, l, k) Print 10, m, n, l, k End Sub 第二种 Private Function pd(a As Integer) As Integer a = 10 VB测量程序设计代码 For i = 1 To 4 a = a + 2 Print a Next i pd = a End Function Private Sub Command1_Click() Dim s As Integer Dim a As Integer s = pd(10) Print 10 Print s End Sub 1+2+3+…….100=, 方法一 Private Sub Command1_Click() Dim i As Integer s = 0 Do While i <= 100 s = s + i i = i + 1 Loop VB测量程序设计代码 Print s End Sub 方法二 Private Sub Command1_Click() s = 0 For i = 1 To 100 s = s + i Next i Print s End Sub 角度转换 Private Sub Command1_Click() Dim dfm As Double dfm = Val(Text1.Text) Dim hd As Double Call dfmtohd(dfm, hd) Text2.Text = hd End Sub Private Sub dfmtohd(dfm1 As Double, hd1 As Double) Dim du As Integer Dim fen As Double VB测量程序设计代码 Dim miao As Double Dim pi As Double pi = 3.1415926 du = Int(dfm1) fen = Int((dfm1 - du) * 100) miao = ((dfm1 - du) * 100 - fen) * 100 Print du, fen, miao hd1 = (du + fen / 60 + miao / 3600) * pi / 180 End Sub 弧度换算角度 Private Sub Command2_Click() Dim hd As Double hd = Val(Text3.Text) Dim dfm As Double Call hdtodfm(hd, dfm) Text4.Text = dfm End Sub Private Sub hdtodfm(hd2, dfm1) Dim du1 As Integer Dim fen As Integer Dim miao As Double VB测量程序设计代码 Dim pi As Double pi = 3.1415926 dfm1 = hd2 * 180 / pi du = Int(dfm1) fen = Int((dfm1 - du) * 60) miao = ((dfm1 - du) * 60 - fen) * 60 dfm1 = du + fen / 100 + miao / 10000 End Sub 坐标正算代码 Private Sub Command1_Click() Dim xa As Double Dim ya As Double Dim pj As Double VB测量程序设计代码 Dim fwj As Double xa = Val(Text1.Text) ya = Val(Text2.Text) pj = Val(Text3.Text) fwj = Val(Text4.Text) Dim xb As Double Dim yb As Double Call zbzs(xa, ya, pj, fwj, xb, yb) Text5.Text = Format(xb, "0.000") Text6.Text = Format(yb, "0.000") End Sub Private Sub zbzs(xa1 As Double, ya1 As Double, pj1 As Double, fwj1 As Double, xb1 As Double, yb1 As Double) Dim fwj2 As Double Call dfmtohd(fwj1, fwj2) xb1 = xa1 + pj1 * Cos(fwj2) yb1 = ya1 + pj1 * Sin(fwj2) End Sub Private Sub dfmtohd(szj1 As Double, fwj2 As Double) Dim du As Integer VB测量程序设计代码 Dim fen As Double Dim miao As Double Dim pi As Double pi = 3.1415926 du = Int(szj1) fen = Int((szj1 - du) * 100) miao = ((szj1 - du) * 100 - fen) * 100 fwj2 = (du + fen / 60 + miao / 3600) * pi / 180 End Sub 三角高差计算 Private Sub Command1_Click() VB测量程序设计代码 Dim xj As Double Dim szj As Double Dim yqg As Double Dim ljg As Double Dim gc As Double xj = Val(Text1.Text) szj = Val(Text2.Text) yqg = Val(Text3.Text) ljg = Val(Text4.Text) Call gcjs(xj, szj, yqg, ljg, gc) Text5.Text = gc End Sub Private Sub gcjs(xj1 As Double, szj1 As Double, yqg1 As Double, ljg1 As Double, gc1 As Double) Dim sjz2 As Double Call dfmtohd(szj1, sjz2) gc1 = xj1 * Sin(sjz2) + yqg1 - ljg1 End Sub Private Sub dfmtohd(szj1 As Double, szj2 As Double) Dim du As Integer Dim fen As Double Dim miao As Double VB测量程序设计代码 Dim pi As Double pi = 3.1415926 du = Int(szj1) fen = Int((szj1 - du) * 100) miao = ((szj1 - du) * 100 - fen) * 100 szj2 = (du + fen / 60 + miao / 3600) * pi / 180 End Sub 坐标反算 Private Sub Command1_Click() Dim xa As Double Dim ya As Double Dim xb As Double Dim yb As Double VB测量程序设计代码 xa = Val(Text1.Text) ya = Val(Text2.Text) xb = Val(Text3.Text) yb = Val(Text4.Text) Dim jl As Double Dim fwj As Double Call zbfs(xa, ya, xb, yb, jl, fwj) Text5.Text = jl Text6.Text = fwj End Sub Private Sub zbfs(xa1 As Double, ya1 As Double, xb1 As Double, yb1 As Double, jl1 As Double, fwj1 As Double) Dim dx As Double Dim dy As Double dx = xb1 - xa1 dy = yb1 - ya1 jl1 = Sqr(dx ^ 2 + dy ^ 2) Const pi = 3.1415926 If dx = 0 And dy > 0 Then fwj = 0 ElseIf dx = 0 And dy < 0 Then VB测量程序设计代码 fwj = 0 ElseIf dx > 0 And dy = 0 Then fwj = pi / 2 ElseIf dx < 0 And dy = 0 Then fwj = 3 / 2 * pi ElseIf dx > 0 And dy > 0 Then fwj = Atn(dy / dx) ElseIf dx > 0 And dy < 0 Then fwj = 1.5 * pi + Atn(Abs(dy / dx)) ElseIf dx < 0 And dy > 0 Then fwj = pi - Atn(Abs(dy / dx)) ElseIf dx < 0 And dy < 0 Then fwj = pi + Atn(Abs(dy / dx)) Else MsgBox "两点重合～" End If Call hdtodfm(fwj, fwj2) fwj1 = fwj2 End Sub Private Sub hdtodfm(hd2, dfm1) Dim du1 As Integer Dim fen As Integer VB测量程序设计代码 Dim miao As Double Dim pi As Double pi = 3.1415926 dfm1 = hd2 * 180 / pi du = Int(dfm1) fen = Int((dfm1 - du) * 60) miao = ((dfm1 - du) * 60 - fen) * 60 dfm1 = du + fen / 100 + miao / 10000 End Sub 角度前方交会代码 Private Sub Command1_Click() Dim xa As Double Dim ya As Double Dim xb As Double Dim yb As Double Dim m As Double Dim n As Double Dim xp As Double Dim yp As Double xa = Val(Text1.Text) ya = Val(Text2.Text) xb = Val(Text3.Text) VB测量程序设计代码 yb = Val(Text4.Text) m = Val(Text5.Text) n = Val(Text6.Text) Call qfjh(xa, ya, xb, yb, m, n, xp, yp) Text7.Text = xp Text8.Text = yp End Sub Private Sub qfjh(xa1 As Double, ya1 As Double, xb1 As Double, yb1 As Double, m1 As Double, n1 As Double, xp1 As Double, yp1 As Double) Dim m As Double Dim n As Double Call dfmtohd(m1, m) Call dfmtohd(n1, n) Const pi = 3.1415926 If m + n = pi Or m + n > pi Then MsgBox "输入有误不能交会～" Else xp1 = (xa1 * (1 / Tan(n)) + xb1 * (1 / Tan(m)) - ya1 + yb1) / ((1 / Tan(m)) + (1 / Tan(n))) yp1 = (ya1 * (1 / Tan(n)) + yb1 * (1 / Tan(m)) + xa1 - xb1) / VB测量程序设计代码 ((1 / Tan(m)) + (1 / Tan(n))) End If End Sub Private Sub dfmtohd(szj1 As Double, fwj2 As Double) Dim du As Integer Dim fen As Double Dim miao As Double Dim pi As Double pi = 3.1415926 du = Int(szj1) fen = Int((szj1 - du) * 100) miao = ((szj1 - du) * 100 - fen) * 100 fwj2 = (du + fen / 60 + miao / 3600) * pi / 180 End Sub VB测量程序设计代码 此代码仅供参考。