用vb实现利用三次样条插值函数进行编程.docx
- 文档编号:9470371
- 上传时间:2023-02-04
- 格式:DOCX
- 页数:27
- 大小:21.85KB
用vb实现利用三次样条插值函数进行编程.docx
《用vb实现利用三次样条插值函数进行编程.docx》由会员分享,可在线阅读,更多相关《用vb实现利用三次样条插值函数进行编程.docx(27页珍藏版)》请在冰豆网上搜索。
用vb实现利用三次样条插值函数进行编程
用vb实现利用三次样条插值函数进行编程
问题内容:
要求输入节点数,节点值与端点二阶导数,能获得屏幕输出插值函数表达式
网友cz5360于提问
最佳回答:
vb三次样条插值函数绘图
DimX(1000)AsSingle,Y(1000)AsSingle
Dimu1(0To80000)AsSingle,v1(0To80000)AsSingle
DimnumAsLong
DimtAsInteger
PrivateDeclareSubSleepLib"kernel32"(ByValdwMillisecondsAsLong)
DimdeAsInteger
DimToInitAsBoolean
DimDownXAsSingle,DownYAsSingle
SubDrawposi(IndexAsInteger)
Me.Picture1.ForeColor=0
Me.Picture1.Line(0,Y(Index))-(1024,Y(Index))
Me.Picture1.Line(X(Index),0)-(X(Index),770)
EndSub
Functionhypot(ByValXAsSingle,ByValYAsSingle)
hypot=Sqr(X^2+Y^2)
EndFunction
SubMovePic(IndexAsInteger)
DimiAsInteger
X(Index)=Picture2(Index).Left+4
Y(Index)=Picture2(Index).Top+4
lblX.Caption="X:
"+CStr(CInt(X(Index)))
lblY.Caption="Y:
"+CStr(CInt(Y(Index)))
lblX.Refresh
lblY.Refresh
Me.Picture1.Cls
Me.Picture1.ForeColor=QBColor(10)
Fori=0Tot-1
Me.Picture1.CurrentX=X(i)+4
Me.Picture1.CurrentY=Y(i)+4
Me.Picture1.Printi
Nexti
EndSub
PrivateSubCommand1_Click()
DimiAsLong
'Picture1.Scale(0,0)-(640,550)
DrawWidth=3
Picture1.Cls
'IfCheck1.ValueThenCommand2_Click
'X(0)=1
'Y(0)=1
'X(t-1)=638
'Y(t-1)=548
Picture1.ForeColor=QBColor(10)
Fori=0Tot-1
Picture1.Line(X(i)-1,Y(i)-1)-(X(i)+1,Y(i)+1),QBColor(10),B
Picture1.Printi
Nexti
Picture1.ForeColor=QBColor(12)
DrawWidth=1
tspLinet-1,2,0,0,0,0
Picture1.PSet(u1(0),v1(0))
Fori=1Tonum-1
Picture1.Line-(u1(i),v1(i))
'Forde=1To12000:
Nextde'Sleep1
Nexti
Picture1.ForeColor=QBColor(10)
Fori=0Tot-1
Picture1.Line(X(i)-1,Y(i)-1)-(X(i)+1,Y(i)+1),QBColor(10),B
Picture1.Printi
Nexti
EndSub
PrivateSubCommand2_Click()
DimiAsInteger
RandomizeTimer
ToInit=NotToInit
IfToInitThen
Me.Command1.Enabled=False
Me.Command2.Caption="结束初始化"
Me.Cls
Fori=1Tot-1
LoadMe.Picture2(i)
Nexti
Fori=0Tot-1
Picture2(i).Left=X(i)-4
Picture2(i).Top=Y(i)-4
Picture2(i).Visible=True
Nexti
Picture1.Cls
Me.Picture1.ForeColor=QBColor(10)
Fori=0Tot-1
Picture1.Line(X(i)-1,Y(i)-1)-(X(i)+1,Y(i)+1),QBColor(10),B
Picture1.Printi
Nexti
Else
Me.Command1.Enabled=True
Me.Command2.Caption="开始初始化"
Fori=1Tot-1
UnloadMe.Picture2(i)
Nexti
Me.Picture2(0).Visible=False
EndIf
ExitSub
Fori=0Tot
X(i)=Rnd
(1)*500+Rnd
(1)*50+12
Y(i)=Rnd
(1)*400+Rnd
(1)*100+12
'X(i)=i*20+Rnd
(1)*10+12
'Y(i)=i*10+Rnd
(1)*300+22-Rnd
(1)*200
Nexti
EndSub
SubtspLine(ByValnAsInteger,ByValchAsInteger,ByValtx1AsSingle,ByValtx2AsSingle,ByValty1AsSingle,ByValty2AsSingle)
Dima(1000)AsSingle,b(1000)AsSingle,c(1000)AsSingle,dX(1000)AsSingle,dY(1000)AsSingle
Dimqx(1000)AsSingle,qy(1000)AsSingle
DimttAsSingle,bx3AsSingle,bx4AsSingle,by3AsSingle,by4AsSingle
DimcxAsSingle,cyAsSingle,t(1000)AsSingle,px(1000)AsSingle,py(1000)AsSingle
Dimu(3000)AsSingle,v(3000)AsSingle,iAsInteger
num=0
Fori=1Ton
t(i)=hypot(X(i)-X(i-1),Y(i)-Y(i-1))
Nexti
SelectCasech
Case0'抛物条件
u(0)=(X
(1)-X(0))/t
(1):
u
(1)=(X
(2)-X
(1))/t
(2)
u
(2)=(u
(1)-u(0))/(t
(2)+t
(1))
tx1=u(0)-u
(2)*t
(1)
u(0)=(Y
(1)-Y(0))/t
(1):
u
(1)=(Y
(2)-Y
(1))/t
(2)
u
(2)=(u
(1)-u(0))/(t
(2)+t
(1))
ty1=u(0)-u
(2)*t
(1)
u(0)=(X(n)-X(n-1))/t(n):
u
(1)=(X(n-1)-X(n-2))/t(n-1)
u
(2)=(u(0)-u
(1))/(t(n)+t(n-1))
tx2=u(0)+u
(2)*t(n)
u(0)=(Y(n)-Y(n-1))/t(n):
u
(1)=(Y(n-1)-Y(n-2))/t(n-1)
u
(2)=(u(0)-u
(1))/(t(n)+t(n-1))
ty2=u(0)+u
(2)*t(n)
Case1'夹持条件
a(0)=1:
c(0)=0:
dX(0)=tx1:
dY(0)=ty1
a(n)=1:
b(n)=0:
dX(n)=tx2:
dY(n)=ty2
Case2'自由条件
a(0)=2:
c(0)=1
dX(0)=3*(X
(1)-X(0))/t
(1):
dY(0)=3*(Y
(1)-Y(0))/t
(1)
a(n)=2:
b(n)=1
dX(n)=3*(X(n)-X(n-1))/t(n):
dY(n)=3*(Y(n)-Y(n-1))/t(n)
Case3'循环条件
a(0)=2:
c(0)=1
dX(0)=3*(X
(1)-X(0))/t
(1)-(t
(1)*(X
(2)-X
(1))/t
(2)-X
(1)+X(0))/(t
(1)+t
(2))
dY(0)=3*(Y
(1)-Y(0))/t
(1)-(t
(1)*(Y
(2)-Y
(1))/t
(2)-Y
(1)+Y(0))/(t
(1)+t
(2))
a(n)=2:
b(n)=1
dX(n)=3*(X(n)-X(n-1))/t(n)
dX(n)=dX(n)+(X(n)-X(n-1)-t(n)*(X(n-1)-X(n-2))/t(n-1))/(t(n)+t(n-1))
dY(n)=3*(Y(n)-Y(n-1))/t(n)
dY(n)=dY(n)+(Y(n)-Y(n-1)-t(n)*(Y(n-1)-Y(n-2))/t(n-1))/(t(n)+t(n-1))
EndSelect
'计算方程组系数阵和常数阵
Fori=1Ton-1
a(i)=2*(t(i)+t(i+1)):
b(i)=t(i+1):
c(i)=t(i)
dX(i)=3*(t(i)*(X(i+1)-X(i))/t(i+1)+t(i+1)*(X(i)-X(i-1))/t(i))
dY(i)=3*(t(i)*(Y(i+1)-Y(i))/t(i+1)+t(i+1)*(Y(i)-Y(i-1))/t(i))
Nexti
'采用追赶法解方程组
c(0)=c(0)/a(0)
Fori=1Ton-1
a(i)=a(i)-b(i)*c(i-1):
c(i)=c(i)/a(i)
Nexti
a(n)=a(n)-b(n)*c(i-1)
qx(0)=dX(0)/a(0):
qy(0)=dY(0)/a(0)
Fori=1Ton
qx(i)=(dX(i)-b(i)*qx(i-1))/a(i)
qy(i)=(dY(i)-b(i)*qy(i-1))/a(i)
Nexti
px(n)=qx(n):
py(n)=qy(n)
Fori=n-1To0Step-1
px(i)=qx(i)-c(i)*px(i+1)
py(i)=qy(i)-c(i)*py(i+1)
Nexti
'计算曲线上点的坐标
Fori=0Ton-1
bx3=(3*(X(i+1)-X(i))/t(i+1)-2*px(i)-px(i+1))/t(i+1)
bx4=((2*(X(i)-X(i+1))/t(i+1)+px(i)+px(i+1))/t(i+1))/t(i+1)
by3=(3*(Y(i+1)-Y(i))/t(i+1)-2*py(i)-py(i+1))/t(i+1)
by4=((2*(Y(i)-Y(i+1))/t(i+1)+py(i)+py(i+1))/t(i+1))/t(i+1)
tt=0
While(tt<=t(i+1))
cx=X(i)+(px(i)+(bx3+bx4*tt)*tt)*tt
cy=Y(i)+(py(i)+(by3+by4*tt)*tt)*tt
u1(num)=cx:
v1(num)=cy:
num=num+1:
tt=tt+0.5
Wend
u1(num)=X(i+1):
v1(num)=Y(i+1):
num=num+1
Nexti
EndSub
PrivateSubForm_Load()
DimiAsInteger
t=30
ToInit=False
'Picture1.Scale(0,0)-(640,550)
RandomizeTimer
Me.Command2.Caption="开始初始化"
Fori=0Tot
X(i)=Rnd
(1)*500+Rnd
(1)*50+12
Y(i)=Rnd
(1)*400+Rnd
(1)*100+12
Nexti
Fori=0Tot
X(i)=i*30+20
Y(i)=i*20+20
Nexti
'Me.Picture1.Picture=LoadPicture("c:
\mydocuments\MenuBack.bmp")
Me.Picture1.BackColor=QBColor(0)
EndSub
PrivateSubForm_Resize()
OnErrorResumeNext
Me.Picture1.Height=Me.ScaleHeight-40
EndSub
PrivateSubForm_Unload(CancelAsInteger)
End
EndSub
PrivateSubPicture2_MouseDown(IndexAsInteger,ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)
OnErrorResumeNext
IfButton=1Then
DownX=X
DownY=Y
Picture2(Index).ZOrder0
Picture2(Index-1).BackColor=QBColor(12)
Picture2(Index+1).BackColor=QBColor(12)
lblX.Caption="X:
"+CStr(CInt(Picture2(Index).Left+4))
lblY.Caption="Y:
"+CStr(CInt(Picture2(Index).Top+4))
lblX.Refresh
lblY.Refresh
MovePicIndex
DrawposiIndex
EndIf
EndSub
PrivateSubPicture2_MouseMove(IndexAsInteger,ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)
IfButton=1Then
Picture2(Index).Left=Picture2(Index).Left-DownX+X
Picture2(Index).Top=Picture2(Index).Top-DownY+Y
MovePicIndex
Command1_Click
DrawposiIndex
EndIf
EndSub
PrivateSubPicture2_MouseUp(IndexAsInteger,ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)
OnErrorResumeNext
IfButton=1Then
DownX=X
DownY=Y
Picture2(Index-1).BackColor=QBColor(15)
Picture2(Index+1).BackColor=QBColor(15)
'MovePicIndex
lblX.Caption="X:
"
lblY.Caption="Y:
"
lblX.Refresh
lblY.Refresh
Command1_Click
EndIf
EndSub
vb三次样条插值函数绘图
DimX(1000)AsSingle,Y(1000)AsSingle
Dimu1(0To80000)AsSingle,v1(0To80000)AsSingle
DimnumAsLong
DimtAsInteger
PrivateDeclareSubSleepLib"kernel32"(ByValdwMillisecondsAsLong)
DimdeAsInteger
DimToInitAsBoolean
DimDownXAsSingle,DownYAsSingle
SubDrawposi(IndexAsInteger)
Me.Picture1.ForeColor=0
Me.Picture1.Line(0,Y(Index))-(1024,Y(Index))
Me.Picture1.Line(X(Index),0)-(X(Index),770)
EndSub
Functionhypot(ByValXAsSingle,ByValYAsSingle)
hypot=Sqr(X^2+Y^2)
EndFunction
SubMovePic(IndexAsInteger)
DimiAsInteger
X(Index)=Picture2(Index).Left+4
Y(Index)=Picture2(Index).Top+4
lblX.Caption="X:
"+CStr(CInt(X(Index)))
lblY.Caption="Y:
"+CStr(CInt(Y(Index)))
lblX.Refresh
lblY.Refresh
Me.Picture1.Cls
Me.Picture1.ForeColor=QBColor(10)
Fori=0Tot-1
Me.Picture1.CurrentX=X(i)+4
Me.Picture1.CurrentY=Y(i)+4
Me.Picture1.Printi
Nexti
EndSub
PrivateSubCommand1_Click()
DimiAsLong
'Picture1.Scale(0,0)-(640,550)
DrawWidth=3
Picture1.Cls
'IfCheck1.ValueThenCommand2_Click
'X(0)=1
'Y(0)=1
'X(t-1)=638
'Y(t-1)=548
Picture1.ForeColor=QBColor(10)
Fori=0Tot-1
Picture1.Line(X(i)-1,Y(i)-1)-(X(i)+1,Y(i)+1),QBColor(10),B
Picture1.Printi
Nexti
Picture1.ForeColor=QBColor(12)
DrawWidth=1
tspLinet-1,2,0,0,0,0
Picture1.PSet(u1(0),v1(0))
Fori=1Tonum-1
Picture1.Line-(u1(i),v1(i))
'Forde=1To12000:
Nextde'Sleep1
Nexti
Picture1.ForeColor=QBColor(10)
Fori=0Tot-1
Picture1.Line(X(i)-1,Y(i)-1)-(X(i)+1,Y(i)+1),QBColor(10),B
Picture1.Printi
Nexti
EndSub
PrivateSubCommand2_Click()
DimiAsInteger
RandomizeTimer
ToInit=NotToInit
IfToInitThen
Me.Command1.Enabled=False
Me.Command2.Caption="结束初始化"
Me.Cls
Fori=1Tot-1
LoadMe.Picture2(i)
Nexti
Fori=0Tot-1
Picture2(i).Left=X(i)-4
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- vb 实现 利用 三次 样条插值 函数 进行 编程