计算机测绘程序设计代码.docx
《计算机测绘程序设计代码.docx》由会员分享,可在线阅读,更多相关《计算机测绘程序设计代码.docx(15页珍藏版)》请在冰豆网上搜索。
计算机测绘程序设计代码
计算机测绘程序设计实验代码
矩阵运算代码:
OptionBase1
Dima()AsDouble
Dimb()AsDouble
Dimc()AsDouble
PrivateSubCommand1_Click()
Dimn1AsInteger
Dimm1AsInteger
Dimn2AsInteger
Dimm2AsInteger
Dimmystring()AsString
Diml()AsString
mystring()=Split(Text1.Text,vbCrLf)
m1=UBound(mystring,1)-LBound(mystring,1)
l()=Split(mystring(0),"")'第一行数据
n1=UBound(l,1)-LBound(l,1)+1
ReDima(m1,n1)
Fori=1Tom1
l()=Split(mystring(i-1),"")
n1=UBound(l,1)-LBound(l,1)+1
Forj=1Ton1
a(i,j)=l(j-1)
Nextj
Nexti
'Dimmystring()AsString
'Diml()AsString
mystring()=Split(Text2.Text,vbCrLf)
m1=UBound(mystring,1)-LBound(mystring,1)
l()=Split(mystring(0),"")'第一行数据
n1=UBound(l,1)-LBound(l,1)+1
ReDimb(m1,n1)
Fori=1Tom1
l()=Split(mystring(i-1),"")
n1=UBound(l,1)-LBound(l,1)+1
Forj=1Ton1
b(i,j)=l(j-1)
Nextj
Nexti
ReDimc(m1,n1)
Callmadd(a,b,c)
Text3.Text=""
Fori=1Tom1
Forj=1Ton1
Text3.Text=Text3.Text+Str(c(i,j))+""
Nextj
Text3.Text=Text3.Text+vbCrLf
Nexti
EndSub
Submadd(mtxA()AsDouble,mtxB()AsDouble,mtxC()AsDouble)'矩阵相加
DimiAsInteger,jAsInteger
DimmAsInteger,nAsInteger
m=UBound(mtxA,1)-LBound(mtxA,1)+1
n=UBound(mtxA,2)-LBound(mtxA,2)+1
Fori=1Ton
Forj=1Tom
mtxC(i,j)=mtxA(i,j)+mtxB(i,j)
Text3.Text=mtxC(i,j)
Nextj
Nexti
EndSub
角度与弧度的相互转换代码:
PublicFunctionjdzh#(jd#,Optionalsrdw%=0,Optionalscdw%=0)
Constpi#=3.14159265358979
Dimd%,f%,m#,fh%
fh=Sgn(jd)
jd=Abs(jd)
SelectCasesrdw
Case0
d=Int(jd)
f=Int((jd-d)*100)
m=((jd-d)*100-f)*100
jdzh=d+f/60+m/3600
Case1
jdzh=jd
CaseElse
jdzh=jd*180/pi
EndSelect
SelectCasescdw
Case0
jdzh=jdzh*pi/180*fh
Case1
jdzh=jdzh*fh
Case2
jdzh=jdzh*60*fh
Case3
jdzh=jdzh*3600*fh
CaseElse
d=Int(jdzh)
f=Int((jdzh-d)*60)
m=((jdzh-d)*60-f)*60
jdzh=d+f/100+m/10000*fh
EndSelect
EndFunction
矩阵:
OptionBase1
DimA()AsDouble
DimB()AsDouble
DimC()AsDouble
PrivateSubCommand1_Click()
Text3.Text=""
DimiAsInteger
DimjAsInteger
Dimn1AsInteger
Dimm1AsInteger
Dimn2AsInteger
Dimm2AsInteger
Dimmystring()AsString
Diml()AsString
mystring()=Split(Text1.Text,vbCrLf)
n1=UBound(mystring,1)-LBound(mystring,1)
l()=Split(mystring(0),"")
m1=UBound(l,1)-LBound(l,1)+1
ReDimA(n1,m1)
Fori=1Ton1
l()=Split(mystring(i-1),"")
Forj=1Tom1
A(i,j)=l(j-1)
Nextj
Nexti
mystring()=Split(Text2.Text,vbCrLf)
n2=UBound(mystring,1)-LBound(mystring,1)
l()=Split(mystring(0),"")
m2=UBound(l,1)-LBound(l,1)+1
ReDimB(n2,m2)
Fori=1Ton2
l()=Split(mystring(i-1),"")
Forj=1Tom2
B(i,j)=l(j-1)
Nextj
Nexti
ReDimC(n1,m1)
Callmadd(A,B,C)
Fori=1Ton2
Forj=1Tom2
Text3.Text=Text3.Text+Str(C(i,j))+""
Nextj
Text3.Text=Text3.Text+vbCrLf
Nexti
EndSub
PrivateSubCommand2_Click()
Text3.Text=""
Dimmystring()AsString
Diml()AsString
mystring()=Split(Text1.Text,vbCrLf)
n1=UBound(mystring,1)-LBound(mystring,1)
l()=Split(mystring(0),"")
m1=UBound(l,1)-LBound(l,1)+1
ReDimA(n1,m1)
Fori=1Ton1
l()=Split(mystring(i-1),"")
Forj=1Tom1
A(i,j)=l(j-1)
Nextj
Nexti
mystring()=Split(Text2.Text,vbCrLf)
n2=UBound(mystring,1)-LBound(mystring,1)
l()=Split(mystring(0),"")
m2=UBound(l,1)-LBound(l,1)+1
ReDimB(n2,m2)
Fori=1Ton2
l()=Split(mystring(i-1),"")
Forj=1Tom2
B(i,j)=l(j-1)
Nextj
Nexti
ReDimC(n1,m1)
Callmcut(A,B,C)
Fori=1Ton2
Forj=1Tom2
Text3.Text=Text3.Text+Str(C(i,j))+""
Nextj
Text3.Text=Text3.Text+vbCrLf
Nexti
EndSub
PrivateSubCommand3_Click()
Text3.Text=""
Dimmystring()AsString
Diml()AsString
mystring()=Split(Text1.Text,vbCrLf)
n1=UBound(mystring,1)-LBound(mystring,1)
l()=Split(mystring(0),"")
m1=UBound(l,1)-LBound(l,1)+1
ReDimA(n1,m1)
Fori=1Ton1
l()=Split(mystring(i-1),"")
Forj=1Tom1
A(i,j)=l(j-1)
Nextj
Nexti
mystring()=Split(Text2.Text,vbCrLf)
n2=UBound(mystring,1)-LBound(mystring,1)
l()=Split(mystring(0),"")
m2=UBound(l,1)-LBound(l,1)+1
ReDimB(n2,m2)
Fori=1Ton2
l()=Split(mystring(i-1),"")
Forj=1Tom2
B(i,j)=l(j-1)
Nextj
Nexti
ReDimC(n1,m1)
Callmmul(A,B,C)
Fori=1Ton2
Forj=1Tom2
Text3.Text=Text3.Text+Str(C(i,j))+""
Nextj
Text3.Text=Text3.Text+vbCrLf
Nexti
EndSub
PrivateSubCommand4_Click()
Text3.Text=""
Dimmystring()AsString
Diml()AsString
mystring()=Split(Text1.Text,vbCrLf)
n1=UBound(mystring,1)-LBound(mystring,1)
l()=Split(mystring(0),"")
m1=UBound(l,1)-LBound(l,1)+1
ReDimA(n1,m1)
Fori=1Ton1
l()=Split(mystring(i-1),"")
Forj=1Tom1
A(i,j)=l(j-1)
Nextj
Nexti
ReDimC(n1,m1)
CallMRinv(A)
Fori=1Ton1
Forj=1Tom1
Text3.Text=Text3.Text+Str(Format(A(i,j),"0.0000"))+""
Nextj
Text3.Text=Text3.Text+vbCrLf
Nexti
EndSub
PrivateSubCommand5_Click()
Text3.Text=""
DimAT()AsDouble
Dimmystring()AsString
Diml()AsString
mystring()=Split(Text1.Text,vbCrLf)
n1=UBound(mystring,1)-LBound(mystring,1)
l()=Split(mystring(0),"")
m1=UBound(l,1)-LBound(l,1)+1
ReDimA(n1,m1)
Fori=1Ton1
l()=Split(mystring(i-1),"")
Forj=1Tom1
A(i,j)=l(j-1)
Nextj
Nexti
ReDimAT(m1,n1)
CallMtrans(A,AT)
Fori=1Ton1
Forj=1Tom1
Text3.Text=Text3.Text+Str(Format(AT(i,j),"0.0000"))+""
Nextj
Text3.Text=Text3.Text+vbCrLf
Nexti
EndSub
Submadd(mtxA()AsDouble,mtxB()AsDouble,mtxC()AsDouble)'矩阵相加
DimiAsInteger,jAsInteger
DimmAsInteger,nAsInteger
m=UBound(mtxA,1)-LBound(mtxA,1)+1
n=UBound(mtxA,2)-LBound(mtxA,2)+1
Fori=1Ton
Forj=1Tom
mtxC(i,j)=mtxA(i,j)+mtxB(i,j)
Nextj
Nexti
EndSub
Submcut(mtxA()AsDouble,mtxB()AsDouble,mtxC()AsDouble)'矩阵相减
DimiAsInteger,jAsInteger
DimmAsInteger,nAsInteger
m=UBound(mtxA,1)-LBound(mtxA,1)+1
n=UBound(mtxA,2)-LBound(mtxA,2)+1
Fori=1Ton
Forj=1Tom
mtxC(i,j)=mtxA(i,j)-mtxB(i,j)
Nextj
Nexti
EndSub
SubMtrans(mtxA()AsDouble,mtxAT()AsDouble)'矩阵转置
DimiAsInteger,jAsInteger
DimmAsInteger,nAsInteger
m=UBound(mtxA,1)-LBound(mtxA,1)+1
n=UBound(mtxA,2)-LBound(mtxA,2)+1
Fori=1Ton
Forj=1Tom
mtxAT(i,j)=mtxA(j,i)
Nextj
Nexti
EndSub
Submmul(mtxA()AsDouble,mtxB()AsDouble,mtxC()AsDouble)'矩阵相乘
DimmAsInteger
DimnAsInteger
DimlAsInteger
DimiAsInteger,jAsInteger,KAsInteger
m=UBound(mtxA,1)-LBound(mtxA,1)+1
n=UBound(mtxA,2)-LBound(mtxA,2)+1
l=UBound(mtxB,2)-LBound(mtxB,2)+1
Fori=1Tom
Forj=1Tol
mtxC(i,j)=0#
ForK=1Ton
mtxC(i,j)=mtxC(i,j)+mtxA(i,K)*mtxB(K,j)
NextK
Nextj
Nexti
EndSub
FunctionMRinv(mtxA()AsDouble)AsBoolean'矩阵求逆
DimnAsInteger
n=UBound(mtxA,1)-LBound(mtxA,1)+1
ReDimnIs(0Ton)AsInteger,nJs(0Ton)AsInteger
DimiAsInteger,jAsInteger,KAsInteger
DimDAsDouble,pAsDouble
ForK=1Ton
D=0#
Fori=KTon
Forj=KTon
p=Abs(mtxA(i,j))
If(p>D)Then
D=p
nIs(K)=i
nJs(K)=j
EndIf
Nextj
Nexti
If(D+1#=1#)Then
MRinv=False
ExitFunction
EndIf
If(nIs(K)<>K)Then
Forj=1Ton
p=mtxA(K,j)
mtxA(K,j)=mtxA(nIs(K),j)
mtxA(nIs(K),j)=p
Nextj
EndIf
If(nJs(K)<>K)Then
Fori=1Ton
p=mtxA(i,K)
mtxA(i,K)=mtxA(i,nJs(K))
mtxA(i,nJs(K))=p
Nexti
EndIf
mtxA(K,K)=1#/mtxA(K,K)
Forj=1Ton
If(j<>K)ThenmtxA(K,j)=mtxA(K,j)*mtxA(K,K)
Nextj
Fori=1Ton
If(i<>K)Then
Forj=1Ton
If(j<>K)ThenmtxA(i,j)=mtxA(i,j)-mtxA(i,K)*mtxA(K,j)
Nextj
EndIf
Nexti
Fori=1Ton
If(i<>K)ThenmtxA(i,K)=-mtxA(i,K)*mtxA(K,K)
Nexti
NextK
ForK=nTo1Step-1
If(nJs(K)<>K)Then
Forj=1Ton
p=mtxA(K,j)
mtxA(K,j)=mtxA(nJs(K),j)
mtxA(nJs(K),j)=p
Nextj
EndIf
If(nIs(K)<>K)Then
Fori=1Ton
p=mtxA(i,K)
mtxA(i,K)=mtxA(i,nIs(K))
mtxA(i,nIs(K))=p
Nexti
EndIf
NextK
MRinv=True
EndFunction