常用的的测量程序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测量程序设计代码
此代码仅供参考。