📄 frmmain.frm
字号:
Top = 840
Width = 720
End
Begin VB.Label Label9
AutoSize = -1 'True
BackColor = &H00000000&
Caption = "今天是："
ForeColor = &H0000FF00&
Height = 180
Left = 240
TabIndex = 54
Top = 480
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
BackColor = &H00000000&
Caption = "单击这里选择加工文件："
ForeColor = &H0080FFFF&
Height = 180
Left = -74760
TabIndex = 53
Top = 600
Width = 1980
End
Begin VB.Label Label4
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Height = 1710
Left = 20
TabIndex = 51
Top = 320
Width = 6120
End
Begin VB.Label Label3
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Height = 1705
Left = -74980
TabIndex = 50
Top = 320
Width = 6115
End
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'遥杆
Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim myJoy As JOYINFOEX
Dim Tstart As Long
Dim Tend As Long
Dim Tx As Long
Dim r&
Dim NCCSwitch As Long
'*************************************************************
'选项卡
Const TAB_O = 1 '
Const TAB_S = 2 '
Const LINE_MAX_AXES_NUM = 2 '轴数X,Y,Z三轴,0-2
Dim CurTab As Byte '记录当前选项卡
Dim Param_File As String
Dim DXFFileName As String
Dim CUTFileName As String
'*************************************************************
'运动控制参数
Dim timer As Long
Dim debugFlag As Long
'*************************************************************
'运动控制参数
Const ch1 = 1
Const ch2 = 2
Const ch3 = 3
Dim step As Long
Dim pos1 As Long
Dim pos2 As Long
Dim center1 As Long
Dim center2 As Long
Dim angle As Double
Dim BLowSpeed As Double '梯形速度低速速度
Dim BHighSpeed As Double '梯形速度高速速度
Dim BAccel As Double '加速度
Dim pFactor(2) As Long
Dim processFlag As Boolean
'*************************************************************
'图形框参数
Dim lCenterX As Long
Dim lCenterY As Long
Dim lLastPosX As Long
Dim lLastPosY As Long
'*************************************************************
'调床参数
Dim ProcessBeginPoint(2) As Long
'##########################################################################
'保存所有参数
Private Function SaveParamToDisk() As Long
Dim i As Long
Dim j As Long
On Error GoTo ErrFlag
Open Param_File For Output As #1
'*************************************
'工艺参数
Print #1, cutterWidth
Print #1, swapOneTime
Print #1, swapTwoTimes
Print #1, swapThreeTimes
Print #1, cutOneTime
Print #1, cutTwoTimes
Print #1, processFactorSelect
'*************************************
'统计参数
Print #1, FilePath
'*************************************
'基本设置
For i = 0 To 2
For j = 0 To 2
Print #1, ProcessFactor(i, j)
Next j
Next i
Print #1, gFactor
Print #1, SpaceHight
Print #1, Buttom
Print #1, BackSpace
For i = 0 To 1
Print #1, SwapFactor(i)
Next i
'*************************************
'调床参数
For i = 0 To 2
Print #1, ProcessBeginPoint(i)
Next i
'*************************************
'速度参数
For i = 0 To 1
Print #1, UpdownMoveSpeedNode(i)
Print #1, FindPointSpeedNode(i)
Next i
For i = 0 To 2
Print #1, UpdownMoveSpeed(i, 0)
Print #1, UpdownMoveSpeed(i, 1)
Print #1, UpdownMoveSpeed(i, 2)
Print #1, FindPointSpeed(i, 0)
Print #1, FindPointSpeed(i, 1)
Print #1, FindPointSpeed(i, 2)
Print #1, AdjustSpeed(i, 0)
Print #1, AdjustSpeed(i, 1)
Print #1, AdjustSpeed(i, 2)
Next i
For i = 0 To 4
Print #1, CutArcSpeedNode_radius(i)
Next i
For i = 0 To 16
Print #1, CutLineSpeedNode(i)
Print #1, CutArcSpeedNode(i)
Print #1, WashLineSpeedNode(i)
Next i
For i = 0 To 17
Print #1, CutLineSpeed(i, 0)
Print #1, CutLineSpeed(i, 1)
Print #1, CutLineSpeed(i, 2)
Print #1, CutArcSpeed(i, 0)
Print #1, CutArcSpeed(i, 1)
Print #1, CutArcSpeed(i, 2)
Print #1, WashLineSpeed(i, 0)
Print #1, WashLineSpeed(i, 1)
Print #1, WashLineSpeed(i, 2)
Next i
Close 1
cmdSave_Click '保存加工统计参数
SaveParamToDisk = 0
Exit Function
ErrFlag:
Close 1
MsgBox "参数文件保存错误，本次运行期间修改的参数将无法保存！" & Chr(10) & Chr(13) _
& "可能是以下原因造成：" & Chr(10) & Chr(13) _
& " 1）当前目录下文件参数文件 CONFIG.DAT 被标记为只读，请去掉只读属性再试。" & Chr(10) & Chr(13) _
& " 2）当前目录下文件参数文件 CONFIG.DAT 被数据不完整，请删除该文件后以缺省参数启动。", vbOKOnly + vbInformation
SaveParamToDisk = -1
End Function
'##########################################################################
'加载所有参数
Public Function LoadParamFromDisk() As Long
Dim i As Long
Dim j As Long
On Error GoTo ErrFlag
Open Param_File For Input As #1
'*************************************
'工艺参数
Input #1, cutterWidth
Input #1, swapOneTime
Input #1, swapTwoTimes
Input #1, swapThreeTimes
Input #1, cutOneTime
Input #1, cutTwoTimes
Input #1, processFactorSelect
'*************************************
'统计参数
Line Input #1, FilePath
'*************************************
'基本设置
For i = 0 To 2
For j = 0 To 2
Input #1, ProcessFactor(i, j)
Next j
Next i
Input #1, gFactor
Input #1, SpaceHight
Input #1, Buttom
Input #1, BackSpace
For i = 0 To 1
Input #1, SwapFactor(i)
Next i
'*************************************
'调床参数
For i = 0 To 2
Input #1, ProcessBeginPoint(i)
Next i
'*************************************
'速度参数
For i = 0 To 1
Input #1, UpdownMoveSpeedNode(i)
Input #1, FindPointSpeedNode(i)
Next i
For i = 0 To 2
Input #1, UpdownMoveSpeed(i, 0)
Input #1, UpdownMoveSpeed(i, 1)
Input #1, UpdownMoveSpeed(i, 2)
Input #1, FindPointSpeed(i, 0)
Input #1, FindPointSpeed(i, 1)
Input #1, FindPointSpeed(i, 2)
Input #1, AdjustSpeed(i, 0)
Input #1, AdjustSpeed(i, 1)
Input #1, AdjustSpeed(i, 2)
Next i
For i = 0 To 4
Input #1, CutArcSpeedNode_radius(i)
Next i
For i = 0 To 16
Input #1, CutLineSpeedNode(i)
Input #1, CutArcSpeedNode(i)
Input #1, WashLineSpeedNode(i)
Next i
For i = 0 To 17
Input #1, CutLineSpeed(i, 0)
Input #1, CutLineSpeed(i, 1)
Input #1, CutLineSpeed(i, 2)
Input #1, CutArcSpeed(i, 0)
Input #1, CutArcSpeed(i, 1)
Input #1, CutArcSpeed(i, 2)
Input #1, WashLineSpeed(i, 0)
Input #1, WashLineSpeed(i, 1)
Input #1, WashLineSpeed(i, 2)
Next i
Close 1
LoadParamFromDisk = 0
Exit Function
ErrFlag:
Close 1
MsgBox "参数文件加载错误，系统将采用缺省参数！" & Chr(10) & Chr(13) _
& "可能是以下原因造成：" & Chr(10) & Chr(13) _
& " 1）这是您安装后的第一次运行，还没有生成参数文件。当退出程序下次重新起动后将不会出现这样的提示。" & Chr(10) & Chr(13) _
& " 2）若每次起动程序都出现这样的提示，则可能是当前目录下参数文件 CONFIG.DAT 数据不完整或已经损坏，请删除该文件后以缺省参数启动。", vbOKOnly + vbInformation
LoadParamFromDisk = -1
End Function
'##########################################################################
'根据所加载的参数设置主界面
Private Sub SetInterfaceByParam()
Dim i As Long
If Right$(FilePath, 3) = "dxf" Then
FrameProcessing.Enabled = True
Else
FrameProcessing.Enabled = False
End If
''''''''''''''''''''''''''''''''''''''''
'工艺框参数
txtCutterWidth.Text = cutterWidth
If swapOneTime = 1 Then
optSwapOneTime.Value = True
End If
If swapTwoTimes = 1 Then
optSwapTwoTimes.Value = True
End If
If swapThreeTimes = 1 Then
optSwapThreeTimes.Value = True
End If
If cutOneTime = 1 Then
optCutOneTime.Value = True
End If
If cutTwoTimes = 1 Then
optCutTwoTimes.Value = True
End If
OptProcessFactor(processFactorSelect).Value = True
''''''''''''''''''''''''''''''''''''''''
'统计框参数
lblFilePath.Caption = FilePath
''''''''''''''''''''''''''''''''''''''''
'提示框
lblMsg.Caption = "准备就绪"
End Sub
Private Sub ClearGraphic()
picGraphic.Cls
lCenterX = picGraphic.Width / 2 - 2900
lCenterY = picGraphic.Height / 2 + 2800
End Sub
Public Sub MoveToP(X As Double, Y As Double)
picGraphic.PSet (X * gFactor + lCenterX, (-Y) * gFactor + lCenterY)
lLastPosX = X * gFactor + lCenterX
lLastPosY = (-Y) * gFactor + lCenterY
End Sub
Public Sub LineToP(X As Long, Y As Long)
picGraphic.Line (lLastPosX, lLastPosY)-(X * gFactor + lCenterX, (-Y) * gFactor + lCenterY)
lLastPosX = (X) * gFactor + lCenterX
lLastPosY = (-Y) * gFactor + lCenterY
End Sub
Private Sub cmdLocated_Click()
Dim i As Long
On Error Resume Next
Frame1.Visible = False
For i = 0 To 2
reset_pos i + 1
Next i
End Sub
Private Sub cmdOpen_Click()
OpenFileToProcess
End Sub
Private Sub cmdNCC_Click()
If NCCSwitch = 1 Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -