逐点比较法直线插补代码VB

VB界面：
直线插补和圆弧插补的程序代码：
Dim x1%, y1%, x2%, y2%, p!
Dim Di As Integer
Const PI = 3.14159
Private Sub cmdShow_Click()
x1 = Val(Text1(0)): y1 = Val(Text1(1)) x2 = Val(Text1(2)): y2 = Val(Text1(3)) pic.Cls
axis pic
p = Val(Combo1.Text)
cmdShow.Enabled = False
If Option1.Value Then
pic.Circle (x1, y1), 0.1, vbBlack
pic.Circle (x2, y2), 0.1, vbBlack
zhixian pic, x1, y1, x2, y2
ElseIf Option2.Value Then
pic.Circle (x1, y1), 0.1, vbBlack
pic.Circle (x2, y2), 0.1, vbBlack
If x1 ^ 2 + y1 ^ 2 = x2 ^ 2 + y2 ^ 2 Then
yuanhu pic, x1, y1, x2, y2
Else
MsgBox "ERROR！请重新输入！", vbCritical End If
End If
cmdShow.Enabled = True
End Sub
Private Sub zhixian(obj As Object, xi%, yi%, xj%, yj%) Dim x!, y!
f = 0
x = xi: y = yi
obj.Line (xi, yi)-(xj, yj), vbBlack
obj.CurrentX = x
obj.CurrentY = y
n = (Abs(xj - xi) + Abs(yj - yi)) / p
While n <> 0
If f >= 0 Then
If xj <> xi Then
x = x + (xj - xi) / Abs(xj - xi) * p
Else
y = y + (yj - yi) / Abs(yj - yi) * p
End If
f = f - Abs(yj - yi)
Else
If yj <> yi Then
y = y + (yj - yi) / Abs(yj - yi) * p
End If
f = f + Abs(xj - xi)
End If
obj.Line -(x, y), vbRed
n = n - 1
DoEvents
For i = 1 To 2000000 * p
Next i
Wend
End Sub
Private Sub Form_Load()
If App.PrevInstance Then End
Combo1.Text = Combo1.List(6)
pic.Height = 460
pic.Width = 460
pic.Scale (-12, 12)-(12, -12)
axis pic
End Sub
Private Sub axis(obj As Object)
obj.Line (-obj.ScaleWidth / 2 + 0.5, 0)-(obj.ScaleWidth / 2 - 0.5, 0) obj.Line -(obj.ScaleWidth / 2 - 1, 0.2)
obj.Line (obj.ScaleWidth / 2 - 0.5, 0)-(obj.ScaleWidth / 2 - 1, -0.2) obj.Line (0, obj.ScaleHeight / 2 + 0.5)-(0, -obj.ScaleHeight / 2 - 0.5) obj.Line -(-0.2, -obj.ScaleHeight / 2 - 1)
obj.Line (0, -obj.ScaleHeight / 2 - 0.5)-(0.2, -obj.ScaleHeight / 2 - 1) obj.Font.Size = 9
For cx = -10 To 10 Step 1
obj.Line (cx, 0)-(cx, 0.2)
If cx <> 0 Then
obj.CurrentX = cx - 0.3
obj.CurrentY = -0.2
obj.Print cx
End If
Next
For cy = -10 To 10 Step 1
obj.Line (0, cy)-(0.2, cy)
If cy <> 0 Then
obj.CurrentX = -0.8
obj.CurrentY = cy + 0.2
obj.Print cy
End If
Next
obj.CurrentX = -0.5
obj.CurrentY = -0.2
obj.Font.Size = 9
obj.Print "O"
End Sub
Private Sub yuanhu(obj As Object, xi%, yi%, xj%, yj%)
n = Abs(xj - xi) + Abs(yj - yi): n = n / p
f = 0
r = Sqr(xi ^ 2 + yi ^ 2)
If xi <> 0 Then
startP = Atn(yi / xi)
Else
startP = PI / 2
End If
If xj <> 0 Then
endP = Atn(yj / xj)
Else
endP = PI / 2
End If
If xi <= xj Then
Di = -1
obj.Circle (0, 0), r, vbBlack, endP, startP
Else
Di = 1
obj.Circle (0, 0), r, vbBlack, startP, endP
End If
obj.CurrentX = xi
obj.CurrentY = yi
x = xi: y = yi
While n <> 0
If f * Di > 0 Then
f = f - 2 * x * Di + p
x = x - p * Di
ElseIf f * Di < 0 Then
f = f + 2 * y * Di + p
y = y + p * Di
ElseIf f * Di = 0 Then
If Di = 1 Then
f = f + 2 * y * Di + p
y = y + p
Else
f = f - 2 * x * Di + p
x = x - p * Di
End If
End If
n = n - 1
obj.Line -(x, y), vbRed
DoEvents
For i = 1 To 2000000 * p
Next i
Wend
End Sub
Private Sub Text1_Change(Index As Integer)
If Abs(Val(Text1(Index).Text)) > 10 Then
MsgBox "输入数值过大，屏幕内不能完全显示！"
Text1(Index).Text = ""
End If
If Left(Text1(Index), 1) = "0" And Len(Text1(Index)) = 2 Then
Text1(Index) = Right(Text1(Index), 1)
End If
If Right(Text1(Index), 1) = "-" And Len(Text1(Index)) = 2 Then Text1(Index) = Left(Text1(Index), 1)
End If
End Sub
Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer) If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 45 _ And KeyAscii <> 8 Then
KeyAscii = 0
End If
End Sub
演示效果：。