📄 form1.frm
字号:
VERSION 5.00
Begin VB.Form Form1
AutoRedraw = -1 'True
BorderStyle = 1 'Fixed Single
Caption = "插补"
ClientHeight = 7545
ClientLeft = 90
ClientTop = 480
ClientWidth = 9630
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 503
ScaleMode = 3 'Pixel
ScaleWidth = 642
StartUpPosition = 2 '屏幕中心
Begin VB.Frame Frame5
Height = 975
Left = 7320
TabIndex = 15
Top = 4080
Width = 2175
Begin VB.Line Line5
BorderColor = &H000000FF&
X1 = 120
X2 = 1080
Y1 = 360
Y2 = 360
End
Begin VB.Line Line6
BorderColor = &H00FF0000&
X1 = 120
X2 = 1080
Y1 = 720
Y2 = 720
End
Begin VB.Label Label2
Caption = "插补路线"
Height = 255
Left = 1200
TabIndex = 17
Top = 240
Width = 855
End
Begin VB.Label Label3
Caption = "理想路线"
Height = 255
Left = 1200
TabIndex = 16
Top = 600
Width = 855
End
End
Begin VB.Frame Frame4
Caption = "插补选择"
Height = 735
Left = 7320
TabIndex = 5
Top = 3240
Width = 2175
Begin VB.OptionButton Option2
Caption = "圆弧"
Height = 180
Left = 1200
TabIndex = 7
Top = 360
Width = 735
End
Begin VB.OptionButton Option1
Caption = "直线"
Height = 180
Left = 240
TabIndex = 6
Top = 360
Value = -1 'True
Width = 855
End
End
Begin VB.ComboBox Combo1
Height = 300
Left = 8400
Style = 2 'Dropdown List
TabIndex = 13
Top = 5280
Width = 1095
End
Begin VB.PictureBox pic
AutoRedraw = -1 'True
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
FillStyle = 0 'Solid
Height = 6495
Left = 120
ScaleHeight = 433
ScaleMode = 3 'Pixel
ScaleWidth = 465
TabIndex = 9
Top = 720
Width = 6975
End
Begin VB.Frame Frame3
Height = 2415
Left = 7320
TabIndex = 1
Top = 720
Width = 2175
Begin VB.Frame Frame2
Caption = "终点坐标"
Height = 855
Left = 120
TabIndex = 4
Top = 1320
Width = 1935
Begin VB.TextBox Text1
Height = 375
Index = 3
Left = 1080
MaxLength = 2
TabIndex = 12
Text = "0"
Top = 360
Width = 615
End
Begin VB.TextBox Text1
Height = 375
Index = 2
Left = 120
MaxLength = 2
TabIndex = 11
Text = "0"
Top = 360
Width = 615
End
End
Begin VB.Frame Frame1
Caption = "起点坐标"
Height = 855
Left = 120
TabIndex = 2
Top = 240
Width = 1935
Begin VB.TextBox Text1
Height = 375
Index = 1
Left = 1080
MaxLength = 2
TabIndex = 10
Text = "0"
Top = 360
Width = 615
End
Begin VB.TextBox Text1
Height = 375
Index = 0
Left = 120
MaxLength = 2
TabIndex = 3
Text = "0"
Top = 360
Width = 615
End
End
End
Begin VB.CommandButton cmdShow
Caption = "开始演示"
Height = 375
Left = 7800
TabIndex = 0
Top = 6720
Width = 1095
End
Begin VB.Label Label4
Caption = "脉冲当量："
Height = 255
Left = 7320
TabIndex = 14
Top = 5280
Width = 1095
End
Begin VB.Label Label1
Caption = "逐点比较插补法演示程序"
BeginProperty Font
Name = "宋体"
Size = 18
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1920
TabIndex = 8
Top = 240
Visible = 0 'False
Width = 3975
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Option Explicit
'起点坐标，终点坐标，脉冲当量
Dim x1%, y1%, x2%, y2%, p!
Dim my_step
Dim Di As Integer '-1为顺时针，1为逆时针
Const PI = 3.14159
Private Sub cmdShow_Click()
If Text1(0) <> "" And Text1(1) <> "" And _
Text1(2) <> "" And Text1(3) <> "" Then
x1 = Val(Text1(0)) '获取起点x,y值
y1 = Val(Text1(1))
x2 = Val(Text1(2)) '获取终点x,y值
y2 = Val(Text1(3))
Else
MsgBox "输入坐标不完整!"
Exit Sub
End If
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
chabu_l 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
chabu_c1 pic, x1, y1, x2, y2
Else
MsgBox "输入坐标错误！请重新输入！", vbCritical
End If
End If
cmdShow.Enabled = True
End Sub
Private Sub chabu_l(obj As Object, x0%, y0%, xe%, ye%) '直线插补函数
Dim x!, y!
f = 0
x = x0: y = y0
obj.Line (x0, y0)-(xe, ye), vbBlue
obj.CurrentX = x
obj.CurrentY = y
n = (Abs(xe - x0) + Abs(ye - y0)) / p '总步数
While n <> 0
If f >= 0 Then
If xe <> x0 Then
x = x + Sgn(xe - x0) * p
Else 'xe=0时，应该先向y轴运动
y = y + Sgn(ye - y0) * p
End If
f = f - Abs(ye - y0)
Else
If ye <> y0 Then
y = y + Sgn(ye - y0) * p
End If
f = f + Abs(xe - x0)
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.AddItem "0.01"
Combo1.AddItem "0.02"
Combo1.AddItem "0.05"
Combo1.AddItem "0.1"
Combo1.AddItem "0.2"
Combo1.AddItem "0.5"
Combo1.AddItem "1"
Show
st = "逐点比较插补法演示程序"
'9 = Val(Text2.Text) '获取x，y轴坐标最大值
'9 = Val(Text3.Text)
'my_step = Val(Text2.Text) '获取刻度增长大小
Me.Font.Size = 24
x = (Me.ScaleWidth - Me.TextWidth(st)) / 2
y = 10 '(pic.Top - Me.TextWidth(St)) / 2
Randomize
For i = 1 To 10
CurrentX = x: CurrentY = y
Me.ForeColor = Rnd * 65535
Print st
x = x + 0.6
y = y + 0.4
Next i
Combo1.Text = Combo1.List(5)
pic.Height = 450
pic.Width = 450
pic.Scale (-10, 10)-(10, -10)
axis pic '画坐标轴
End Sub
'**********************************************************************
Private Sub axis(obj As Object)
'画x轴
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)
'画y轴
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 = -9 To 9 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 = -9 To 9 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 = 12
obj.Print "O" '坐标原点
End Sub
'*********************************************************************
Private Sub chabu_c1(obj As Object, x0%, y0%, xe%, ye%)
'第一象限圆弧插补
n = Abs(xe - x0) + Abs(ye - y0): n = n / p '总步数
f = 0
r = Sqr(x0 ^ 2 + y0 ^ 2)
If x0 <> 0 Then
startP = Atn(y0 / x0)
Else
startP = PI / 2
End If
If xe <> 0 Then
endP = Atn(ye / xe)
Else
endP = PI / 2
End If
If x0 <= xe Then
Di = -1 '顺时针
obj.Circle (0, 0), r, vbBlue, endP, startP
Else
Di = 1
obj.Circle (0, 0), r, vbBlue, startP, endP
End If
obj.CurrentX = x0
obj.CurrentY = y0
x = x0: y = y0
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)) > 9 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_Click(Index As Integer)
'Text1(Index).SelStart = 0
'Text1(Index).SelLength = Len(Text1(Index))
'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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -