📄 frmm.frm
字号:
Width = 855
End
Begin VB.Label axeslbl
BackStyle = 0 'Transparent
Caption = "轴号"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 375
Left = 240
TabIndex = 12
Top = 360
Width = 615
End
Begin VB.Label distancelbl
BackStyle = 0 'Transparent
Caption = "移动距离"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 495
Left = 0
TabIndex = 7
Top = 1800
Width = 1335
End
Begin VB.Label positionlbl
BackStyle = 0 'Transparent
Caption = "位置："
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 495
Left = 3240
TabIndex = 16
Top = 480
Width = 1095
End
End
Begin VB.Frame f2
BackColor = &H00FFFFC0&
Caption = "数据操作"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 3255
Left = 0
TabIndex = 8
Top = 0
Width = 9735
Begin VB.Timer needtimer
Interval = 500
Left = 4200
Top = 240
End
Begin VB.Timer timeshowdata
Interval = 500
Left = 7440
Top = 240
End
Begin VB.CommandButton pathcmd
Caption = "文件名"
BeginProperty Font
Name = "宋体"
Size = 15.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 4920
TabIndex = 19
Top = 2640
Width = 2055
End
Begin VB.Timer checklimit
Enabled = 0 'False
Interval = 200
Left = 9120
Top = 1680
End
Begin VB.CommandButton piccmd
Caption = "显示图像"
BeginProperty Font
Name = "宋体"
Size = 15.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 7200
TabIndex = 9
Top = 2640
Width = 2055
End
Begin VB.Label alllbl
Alignment = 2 'Center
BackColor = &H00C0FFC0&
BeginProperty Font
Name = "宋体"
Size = 26.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 1515
Left = 480
TabIndex = 11
Top = 840
Width = 8700
End
Begin VB.Label alltelllbl
Appearance = 0 'Flat
BackColor = &H00FFFFC0&
BackStyle = 0 'Transparent
Caption = "数据显示"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 615
Left = 360
TabIndex = 10
Top = 480
Width = 1215
End
End
End
Attribute VB_Name = "frmm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim axesnum As Long
Dim dis As Long
Dim firstspeed As Long
Dim maxadmit As Long
Dim void As Long
Private Sub needtimer_Timer()
If i >= 10 Then
If Abs(Val(all(i)) - Val(all(i - 10))) < maxadmit Then
need(j) = all(i)
j = j + 1
If c < bunumber Then
con_pmove axesnum, bulenth
c = c + 1
Else
End If
Else
End If
Else
End If
End Sub
Private Sub paracmd_Click()
para.Show
End Sub
Private Sub checklimit_Timer()
Dim flaglimit As Long
flaglimit = check_limit(axesnum)
If flaglimit = 1 Then
sudden_stop (axesnum)
MsgBox "已到达正向限位开关位置！", vbOKOnly, "安全提示"
checklimit.Enabled = False
End If
If flaglimit = -1 Then
sudden_stop (axesnum)
MsgBox "已到达负向限位开关位置！", vbOKOnly, "安全提示"
checklimit.Enabled = False
End If
End Sub
Private Sub commonspeedcmd_Click()
commonspeedcmd.Enabled = False
GetParam
void = set_conspeed(axesnum, firstspeed)
con_pmove axesnum, dis
commonspeedcmd.Enabled = True
End Sub
Private Sub pathcmd_Click()
path.Show
End Sub
Private Sub timeshowdata_Timer()
Dim pos As Long
get_abs_pos axesnum, pos '读取位置
positionshowlbl.Caption = pos '显示位置
End Sub
Private Sub zerocmd_Click() '清零
reset_pos axesnum
End Sub
Private Sub resetcmd_Click()
GetParam
void = set_conspeed(axesnum, firstspeed)
con_pmove axesnum, -bulenth * bunumber
c = 0
i = 1
j = 1
checklimit = True
End Sub
Private Sub strsettingcmd_Click() '设置参数
strsetting.Show
strsetting.t1.Text = Str(intport)
strsetting.t2.Text = strset
End Sub
Private Sub startcmd_Click() '常速
stopcmd.Enabled = True
startcmd.Enabled = False
Open strneedtxtpath For Append As #1
Print #1, "l" & " " & "D " & "k"
Print #1, "0" & " " & "0 " & "0"
Close #1
checklimit = True
GetParam
void = set_conspeed(axesnum, firstspeed)
con_pmove axesnum, bulenth
c = 1
End Sub
'******************************************
'读取用户设置的运动参数
Private Sub GetParam()
axesnum = Val(axestxt.Text) '轴号
firstspeed = Val(firstspeedtxt.Text) '常速
bulenth = Val(bulenthtxt.Text)
bunumber = Val(bunumbertxt.Text)
dis = Val(distxt.Text) '移动距离
maxadmit = Val(maxadmittxt.Text)
set_conspeed axesnum, firstspeed '设置常速运动参数
End Sub
Private Function SetBoard() As Integer
Dim Rtn As Integer
Rtn = auto_set() '对板卡进行自动设置
If Rtn <= 0 Then '若自动设置错误则返回0
SetBoard = -1
Exit Function
End If
Rtn = init_board
If Rtn < 0 Then
SetBoard = -2
Exit Function
End If
SetBoard = 0
End Function
Private Sub stopcmd_Click() '急停
void = sudden_stop(axesnum)
checklimit = False
End Sub
Private Sub Form_Load() '初始化设置
stopcmd.Enabled = False
checklimit = True
If SetBoard < 0 Then
MsgBox "初始化错误！", vbOKOnly, "MPC07演示 错误信息"
End If
void = init_board()
void = set_outmode(1, 1, 1)
void = set_outmode(2, 1, 1)
void = set_outmode(3, 1, 1)
void = set_outmode(4, 1, 1)
c = 0
i = 1
j = 1
need(0) = 0
all(0) = 0
blnreceiveflag = False
intreceivelen = 0
intport = 1
strset = "9600,n,8,1"
frmm.mm.InBufferSize = 1024
If Not frmm.mm.PortOpen Then
frmm.mm.CommPort = intport
frmm.mm.Settings = strset
frmm.mm.PortOpen = True
End If
frmm.mm.PortOpen = False
End Sub
Private Sub piccmd_Click() '画图像
curve.Show
realtimecurve.Show
End Sub
Private Sub receiveallcmd_Click() '开始接收、停止接收设置
If blnreceiveflag Then
If Not blnreceiveflag Then
frmm.mm.PortOpen = False
End If
frmm.receiveallcmd.Caption = "开始接收"
alllbl.Caption = ""
Else
If Not frmm.mm.PortOpen Then
frmm.mm.CommPort = intport
frmm.mm.Settings = strset
frmm.mm.PortOpen = True
End If
frmm.mm.InputLen = 9
frmm.mm.InputMode = comInputModeText
frmm.mm.RThreshold = 9
frmm.receiveallcmd.Caption = "停止接收"
End If
blnreceiveflag = Not blnreceiveflag
End Sub
Private Sub mm_OnComm() '串口取数据
Select Case frmm.mm.CommEvent
Case comEvReceive
If blnreceiveflag Then
If Not frmm.mm.PortOpen Then
frmm.mm.CommPort = intport
frmm.mm.Settings = strset
frmm.mm.PortOpen = True
Else
End If
frmm.mm.InputMode = comInputModeText
alllbl.Caption = frmm.mm.Input
all(i) = alllbl.Caption
Open stralltxtpath For Append As #1
Print #1, all(i)
Close #1
i = i + 1
If Not blnreceiveflag Then
frmm.mm.PortOpen = False
Else
End If
Else
End If
End Select
End Sub
Private Sub realtimecurvesub()
End Sub
Private Sub curvesub()
End Sub
Private Sub exitcmd_Click() '退出程序
End
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -