vb.net做直线拟合 直线拟合小程序
VB.Net中画直线问题
不想整个重画，最好用单色的背景，例如黑色，线条是白色的
创新互联建站主要从事网站设计制作、网站建设、网页设计、企业做网站、公司建网站等业务。立足成都服务诏安,10年网站建设经验,价格优惠、服务专业,欢迎来电咨询建站服务:18982081108
用变量把线条的内容备份
当想改变线条的位置或者长度之前，先用存下来的变量以黑色重画一次，覆盖原来的白色线条
然后再画新的白色线条，这种重画方法比较节省资源
假如需要用花哨的背景或者图片当背景，也可以用局部重回的方式。
代码就不提供了，只提供思路。
VB直线最小二乘法拟合
'新建窗体，添加text1,command1,picture1
Private Sub Command1_Click()
If Text1.Text = "" Then Exit Sub
Dim x() As Single, y() As Single, cnt As Integer
Dim xmax As Single, xmin As Single, ymax As Single, ymin As Single
Dim p() As String, z() As String
Dim xyh As Single, xh As Single, yh As Single, xph As Single, k As Single, b As Single
p = Split(Text1.Text, "/")
For i = 0 To UBound(p)
If p(i) "" Then
z = Split(p(i), "*")
If UBound(z) = 1 Then
If IsNumeric(z(0)) And IsNumeric(z(1)) Then
If cnt = 0 Then xmax = z(0): xmin = z(0): ymax = z(1): ymin = z(1)
If xmax z(0) Then xmax = z(0)
If xmin z(0) Then xmin = z(0)
If ymax z(1) Then ymax = z(1)
If ymin z(1) Then ymin = z(1)
xyh = xyh + z(0) * z(1): xh = xh + z(0): yh = yh + z(1): xph = xph + z(0) ^ 2
ReDim Preserve x(cnt), y(cnt)
x(cnt) = z(0): y(cnt) = z(1): cnt = cnt + 1
End If
End If
End If
Next
Picture1.Cls
Picture1.DrawWidth = 1
If xmax = xmin And ymax = ymin Then
MsgBox "单点无法拟合"
ElseIf xmax = xmin Then
Picture1.Scale (xmin * 0.5, ymax + 0.2 * (ymax - ymin))-(xmin * 1.5, ymin - 0.2 * (ymax - ymin))
zuobiaozhou xmin * 0.5, ymax + 0.2 * (ymax - ymin), xmin * 1.5, ymin - 0.2 * (ymax - ymin)
Picture1.Line (xmax, ymax + 0.2 * (ymax - ymin))-(xmax, ymin - 0.2 * (ymax - ymin)), vbBlue
ElseIf ymax = ymin Then
Picture1.Scale (xmin - 0.2 * (xmax - xmin), ymax * 1.5)-(xmax + 0.2 * (xmax - xmin), ymin * 0.5)
zuobiaozhou xmin - 0.2 * (xmax - xmin), ymax * 1.5, xmax + 0.2 * (xmax - xmin), ymin * 0.5
Picture1.Line (xmin - 0.2 * (xmax - xmin), ymax)-(xmax + 0.2 * (xmax - xmin), ymax), vbBlue
Else
Picture1.Scale (xmin - 0.2 * (xmax - xmin), ymax + 0.2 * (ymax - ymin))-(xmax + 0.2 * (xmax - xmin), ymin - 0.2 * (ymax - ymin))
zuobiaozhou xmin - 0.2 * (xmax - xmin), ymax + 0.2 * (ymax - ymin), xmax + 0.2 * (xmax - xmin), ymin - 0.2 * (ymax - ymin)
k = (xyh - (xh * yh) / cnt) / (xph - xh ^ 2 / cnt)
b = yh / cnt - k * xh / cnt
Picture1.Line (xmin - 0.2 * (xmax - xmin), k * (xmin - 0.2 * (xmax - xmin)) + b)-(xmax + 0.2 * (xmax - xmin), k * (xmax + 0.2 * (xmax - xmin)) + b), vbBlue
End If
Picture1.DrawWidth = 5
For i = 0 To cnt - 1
Picture1.PSet (x(i), y(i)), vbRed
Next
Text1.SetFocus
End Sub
Private Sub Form_Activate()
Text1.SetFocus
End Sub
Private Sub Form_Load()
Text1.Text = ""
Text1.ToolTipText = "横纵坐标间以乘号*分隔，各点间以除号/分隔。例如：100*100/200*200"
Command1.Caption = "绘图"
Picture1.AutoRedraw = True
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If Not (IsNumeric(Chr(KeyAscii)) Or KeyAscii = 8 Or KeyAscii = 42 Or KeyAscii = 45 Or KeyAscii = 46 Or KeyAscii = 47) Then KeyAscii = 0
End Sub
Function zuobiaozhou(ByVal x1 As Single, y1 As Single, x2 As Single, y2 As Single)
For i = x1 + (x2 - x1) / 5 To x2 Step (x2 - x1) / 5
Picture1.Line (i, y2 + 100 * (y1 - y2) / Picture1.Height)-(i, y2)
Picture1.CurrentX = i - 250 * (x2 - x1) / Picture1.Width
Picture1.CurrentY = y2 + 350 * (y1 - y2) / Picture1.Height
Picture1.Print i
Next
For i = y2 + (y1 - y2) / 5 To y1 Step (y1 - y2) / 5
Picture1.Line (x1, i)-(x1 + 100 * (x2 - x1) / Picture1.Width, i)
Picture1.CurrentX = x1 + 150 * (x2 - x1) / Picture1.Width
Picture1.CurrentY = i + 80 * (y1 - y2) / Picture1.Height
Picture1.Print i
Next
End Function
用VB编写，根据六组坐标数据能自动拟合一条直线，并且显示在窗体中，包括表达式
不考虑厘米和毫米的转换，
添加PictureBox控件，假设X一列的Text控件是 名为Text1（0 to 5）的控件数组，
Y一列数是 名为Text2（0~5）的控件数组：
Private Sub Command1_Click()
'注：最小二乘法拟合y=ax+b直线的系数a,b分别为：
'设A=∑xi^2,B=∑xi,C=∑yixi,D=∑yi，则方程化为：
'Aa BB = C
'Ba nb = D
'解出a , b得:
'a = (Cn - BD) / (An - BB)
'b = (AD - CB) / (An - BB)
Dim minX, maxX, minY, maxY As Single '用来设置PictureBox控件的坐标Scale
Dim aa As Single, bb As Single
Dim A, B, C, D
n = 6 '初始化数据
A = 0: B = 0: C = 0: D = 0
minX = Val(Text1(0).Text): maxX = minX
minY = Val(Text2(0).Text): maxY = minY
For i = 0 To 5
A = A + Val(Text1(i).Text) ^ 2
B = B + Val(Text1(i).Text)
C = C + Val(Text1(i).Text) * Val(Text2(i).Text)
D = D + Val(Text2(i).Text)
If Val(Text1(i).Text) minX Then minX = Val(Text1(i).Text)
If Val(Text1(i).Text) maxX Then maxX = Val(Text1(i).Text)
If Val(Text2(i).Text) minY Then minY = Val(Text2(i).Text)
If Val(Text2(i).Text) maxY Then maxY = Val(Text2(i).Text)
Next i
aa = (n * C - B * D) / (n * A - B * B)
bb = (A * D - C * B) / (n * A - B * B)
'设置PictureBox坐标，并画直线及6个点：
With Picture1
.ScaleMode = 0
.ScaleWidth = (maxX - minX) * 1.4
.ScaleHeight = -(maxY - minY) * 1.4
.ScaleLeft = minX - (maxX - minX) / 5
.ScaleTop = maxY + (maxY - minY) / 5
End With
Picture1.Line (minX, aa * minX + bb)-(maxX, aa * maxX + bb)
For i = 0 To 5
Picture1.Circle (Val(Text1(i).Text), Val(Text2(i).Text)), (maxX - minX) / 100, RGB(255, 0, 0)
Next i
Picture1.CurrentX = Picture1.ScaleLeft: Picture1.CurrentY = Picture1.ScaleTop
Picture1.Print "y=" aa "*x + " bb
End Sub
本文标题：vb.net做直线拟合 直线拟合小程序
URL分享：http://mswzjz.cn/article/doeohop.html