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