vb.net做直線擬合 直線擬合小程序

VB.Net中畫直線問(wèn)題

不想整個(gè)重畫，最好用單色的背景，例如黑色，線條是白色的

創(chuàng)新互聯(lián)建站主要從事網(wǎng)站設(shè)計(jì)制作、網(wǎng)站建設(shè)、網(wǎng)頁(yè)設(shè)計(jì)、企業(yè)做網(wǎng)站、公司建網(wǎng)站等業(yè)務(wù)。立足成都服務(wù)詔安,10年網(wǎng)站建設(shè)經(jīng)驗(yàn),價(jià)格優(yōu)惠、服務(wù)專業(yè),歡迎來(lái)電咨詢建站服務(wù):18982081108

用變量把線條的內(nèi)容備份

當(dāng)想改變線條的位置或者長(zhǎng)度之前，先用存下來(lái)的變量以黑色重畫一次，覆蓋原來(lái)的白色線條

然后再畫新的白色線條，這種重畫方法比較節(jié)省資源

假如需要用花哨的背景或者圖片當(dāng)背景，也可以用局部重回的方式。

代碼就不提供了，只提供思路。

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 "單點(diǎn)無(wú)法擬合"

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 = "橫縱坐標(biāo)間以乘號(hào)*分隔，各點(diǎn)間以除號(hào)/分隔。例如：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編寫，根據(jù)六組坐標(biāo)數(shù)據(jù)能自動(dòng)擬合一條直線，并且顯示在窗體中，包括表達(dá)式

不考慮厘米和毫米的轉(zhuǎn)換，

添加PictureBox控件，假設(shè)X一列的Text控件是 名為Text1（0 to 5）的控件數(shù)組，

Y一列數(shù)是 ?名為Text2（0~5）的控件數(shù)組：

Private?Sub?Command1_Click()

'注：最小二乘法擬合y=ax+b直線的系數(shù)a,b分別為：

'設(shè)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?????'用來(lái)設(shè)置PictureBox控件的坐標(biāo)Scale

Dim?aa?As?Single,?bb?As?Single

Dim?A,?B,?C,?D

n?=?6???????'初始化數(shù)據(jù)

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)

'設(shè)置PictureBox坐標(biāo)，并畫直線及6個(gè)點(diǎn)：

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

新聞標(biāo)題：vb.net做直線擬合 直線擬合小程序
文章起源：http://www.muchs.cn/article8/doeohop.html

成都網(wǎng)站建設(shè)公司_創(chuàng)新互聯(lián)，為您提供動(dòng)態(tài)網(wǎng)站、手機(jī)網(wǎng)站建設(shè)、做網(wǎng)站、建站公司、關(guān)鍵詞優(yōu)化、網(wǎng)站設(shè)計(jì)

廣告

聲明：本網(wǎng)站發(fā)布的內(nèi)容（圖片、視頻和文字）以用戶投稿、用戶轉(zhuǎn)載內(nèi)容為主，如果涉及侵權(quán)請(qǐng)盡快告知，我們將會(huì)在第一時(shí)間刪除。文章觀點(diǎn)不代表本網(wǎng)站立場(chǎng)，如需處理請(qǐng)聯(lián)系客服。電話：028-86922220；郵箱：631063699@qq.com。內(nèi)容未經(jīng)允許不得轉(zhuǎn)載，或轉(zhuǎn)載時(shí)需注明來(lái)源： 創(chuàng)新互聯(lián)