📄 prgcontrolfrm.frm
字号:
VERSION 5.00
Begin VB.Form PrgControlFrm
BorderStyle = 0 'None
Caption = "程序控制"
ClientHeight = 7200
ClientLeft = 0
ClientTop = 0
ClientWidth = 9600
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
ScaleHeight = 7200
ScaleWidth = 9600
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
Begin VB.Timer Timer_Beep
Enabled = 0 'False
Interval = 10
Left = 8340
Top = 4620
End
Begin VB.Frame Frame1
Caption = "手动"
Height = 1335
Left = 1740
TabIndex = 8
Top = 5100
Width = 6255
Begin VB.CommandButton stopCmd
Caption = "停止切割"
Enabled = 0 'False
Height = 435
Left = 4260
TabIndex = 11
Top = 540
Width = 1575
End
Begin VB.CommandButton GoOnCmd
Caption = "继续切割"
Enabled = 0 'False
Height = 435
Left = 2280
TabIndex = 10
Top = 540
Width = 1695
End
Begin VB.CommandButton StopGoOnCmd
Caption = "暂停"
Enabled = 0 'False
Height = 435
Left = 300
TabIndex = 9
Top = 540
Width = 1755
End
End
Begin VB.PictureBox Picture1
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3015
Left = 1680
ScaleHeight = 2955
ScaleWidth = 6255
TabIndex = 2
Top = 1680
Width = 6315
Begin VB.CommandButton BeginCmd
Caption = "开始切割"
Height = 435
Left = 120
TabIndex = 12
Top = 2400
Width = 1455
End
Begin VB.CommandButton pGoOnCmd
Caption = "程序继续"
Enabled = 0 'False
Height = 495
Left = 4560
TabIndex = 7
Top = 2400
Width = 1635
End
Begin VB.Label LblYPos
Caption = "0"
BeginProperty Font
Name = "宋体"
Size = 26.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 555
Left = 1740
TabIndex = 6
Top = 1560
Width = 3915
End
Begin VB.Label aaa
Caption = "Y="
BeginProperty Font
Name = "宋体"
Size = 26.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 495
Left = 1020
TabIndex = 5
Top = 1560
Width = 675
End
Begin VB.Label LblXPos
Caption = "0"
BeginProperty Font
Name = "宋体"
Size = 26.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 555
Left = 1740
TabIndex = 4
Top = 720
Width = 4155
End
Begin VB.Label Label2
Caption = "X="
BeginProperty Font
Name = "宋体"
Size = 26.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 555
Left = 1020
TabIndex = 3
Top = 720
Width = 795
End
End
Begin VB.Timer Timer
Enabled = 0 'False
Left = 8760
Top = 1800
End
Begin VB.Timer YTimer
Enabled = 0 'False
Left = 8760
Top = 2460
End
Begin VB.Timer XTimer
Enabled = 0 'False
Left = 8820
Top = 3180
End
Begin VB.CommandButton BackCmd
Caption = "返回(Alt+Back)"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 7740
TabIndex = 0
Top = 6660
Width = 1695
End
Begin VB.Label Label1
BackColor = &H8000000B&
Caption = "数控切割控制系统"
BeginProperty Font
Name = "隶书"
Size = 24
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 615
Left = 2580
TabIndex = 1
Top = 780
Width = 4095
End
End
Attribute VB_Name = "PrgControlFrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim iDirection As Integer '1--前(y+),2--后(y-),3--左(x-),4--右(x+)
Dim iTag As Integer
Dim dx, dy As Double
Dim tx, ty, inc1, inc2, d, curx, cury, dX01, dY01 As Long
Dim XY As Double
Dim Dxy As Double
Dim ShowMsg As Boolean
Dim xPos, yPos As Double
Dim xCount, yCount As Long
Dim xStartCount, yStartCount As Long
Dim Shape As Integer '1 -- 直线，2 -- 圆
Dim OldPx, OldPy As Long
Dim DirectX, DirectY As Boolean
Dim bijiaoX2, bijiaoY2 As Long
Dim CircleGoOn As Boolean
Dim bDrawCircle As Boolean
Dim Ax0, Ay0 As Double
'Dim StopNow As Boolean
Private Sub BackCmd_Click()
Unload Me
MainFrm.Show vbModal
End Sub
Private Sub BackCmd_KeyDown(KeyCode As Integer, Shift As Integer)
Call Process_Key(KeyCode, Shift)
End Sub
Private Sub BeginCmd_Click()
StopGoOnCmd.Enabled = True
GoOnCmd.Enabled = False
stopCmd.Enabled = True
BeginCmd.Enabled = False
Call BeginCut
End Sub
Private Sub Form_Activate()
' Dim Mystr As String
' Dim bAccess_File As Boolean
'
' iDirection = 0
'
' DirectX = False
' DirectY = False
'
' xPos = 0
' yPos = 0
'
' xStartCount = 0
' yStartCount = 0
'
' CircleGoOn = False
' bDrawCircle = False
'' StopNow = False
'' M = 1
' Close #1
' Open ProgramFileName For Input As #1
' Do While Not EOF(1)
' Input #1, Mystr
'
' If (M = 0) Then
' PrgFileLineNumber = PrgFileLineNumber + 1
' End If
'
' PrgFileLineNumber = PrgFileLineNumber + 1
'
' bAccess_File = DivideLine(Mystr)
'
' If Not bAccess_File Then
' Close #1
' PrgFileLineNumber = 0
' MsgBox "代码文件有错1", vbInformation, "提示"
' Unload Me
' MainFrm.Show vbModal
' End If
'
' If (G0 = 1) Then '直线
' dX01 = X1
' dY01 = Y1
' bAccess_File = SendLineSignal(X0, Y0, X1, Y1)
' Else
' SendCircleSignal
' I = 0
' J = 0
' R = 0
' End If
'
' If Not bAccess_File Then
' Close #1
' PrgFileLineNumber = 0
' MsgBox "代码文件有错2", vbInformation, "提示"
' Unload Me
' MainFrm.Show vbModal
'' Else
'' X0 = X1
'' Y0 = Y1
' End If
'
' If (M = 0) Then
' pGoOnCmd.Enabled = True
' Close #1
' Exit Sub
' End If
'
' If (M = 2) Then
' pGoOnCmd.Enabled = False
' Exit Do
' End If
'
' Loop
' Close #1
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Call Process_Key(KeyCode, Shift)
End Sub
Private Sub Process_Key(KeyCode As Integer, Shift As Integer)
If (KeyCode = vbKeyBack) And (Shift = 4) Then
Call BackCmd_Click
End If
End Sub
Private Sub Form_Load()
' Dim Mystr As String
' Dim bAccess_File As Boolean
'
' iDirection = 0
'
' xPos = 0
' yPos = 0
'
' Open ProgramFileName For Input As #1
' Do While Not EOF(1)
' Input #1, Mystr
'
' PrgFileLineNumber = PrgFileLineNumber + 1
'
' bAccess_File = DivideLine(Mystr)
'
' If Not bAccess_File Then
' Close #1
' PrgFileLineNumber = 0
' MsgBox "代码文件有错1", vbInformation, "提示"
' Unload Me
' MainFrm.Show vbModal
' End If
'
' If (G0 = 1) Then '直线
' bAccess_File = SendLineSignal(X0, Y0, X1, Y1)
' Else
' SendCircleSignal
' I = 0
' J = 0
' R = 0
' End If
'
' If Not bAccess_File Then
' Close #1
' PrgFileLineNumber = 0
' MsgBox "代码文件有错2", vbInformation, "提示"
' Unload Me
' MainFrm.Show vbModal
' Else
' X0 = X1
' Y0 = Y1
' End If
'
' If (M = 0) Then
' pGoOnCmd.Enabled = True
' Close #1
' Exit Sub
' End If
'
' If (M = 2) Then
' pGoOnCmd.Enabled = False
' Exit Do
' End If
'
' Loop
' Close #1
End Sub
'Public Sub SendLineSignal(dFx As Double, dFy As Double)
' Dim xInterval As Integer
' Dim yInterval As Integer
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -