📄 frmtycj.frm
字号:
BorderColor = &H8000000C&
X1 = 5040
X2 = 5040
Y1 = 2160
Y2 = 3000
End
Begin VB.Line Line20
X1 = 5160
X2 = 5160
Y1 = 2160
Y2 = 3000
End
Begin VB.Line Line11
BorderColor = &H8000000C&
X1 = 1800
X2 = 5160
Y1 = 2160
Y2 = 2160
End
Begin VB.Line Line4
BorderColor = &H00000040&
X1 = 1800
X2 = 5160
Y1 = 2160
Y2 = 2160
End
Begin VB.Line Line17
BorderColor = &H8000000C&
X1 = 1800
X2 = 5160
Y1 = 1800
Y2 = 1800
End
Begin VB.Label LabBxsc
BackColor = &H80000012&
Caption = " 波形输出"
ForeColor = &H0000FF00&
Height = 255
Left = 2640
TabIndex = 3
Top = 1200
Width = 1575
End
Begin VB.Line Line16
BorderColor = &H00400040&
X1 = 1800
X2 = 5160
Y1 = 1200
Y2 = 1200
End
Begin VB.Line Line15
BorderColor = &H8000000C&
X1 = 1800
X2 = 5160
Y1 = 1320
Y2 = 1320
End
Begin VB.Line Line13
BorderColor = &H8000000C&
X1 = 1800
X2 = 5160
Y1 = 1320
Y2 = 1320
End
Begin VB.Line Line12
BorderColor = &H8000000C&
X1 = 0
X2 = 3360
Y1 = 480
Y2 = 480
End
Begin VB.Line Line9
X1 = 0
X2 = 600
Y1 = 480
Y2 = 480
End
Begin VB.Line Line8
BorderColor = &H00400040&
X1 = 240
X2 = 1800
Y1 = 360
Y2 = 360
End
Begin VB.Line Line7
X1 = 120
X2 = 5160
Y1 = 0
Y2 = 0
End
Begin VB.Line Line6
BorderColor = &H00808080&
X1 = 0
X2 = 5160
Y1 = 1080
Y2 = 1080
End
Begin VB.Label Label4
BackColor = &H80000007&
Caption = "************************************************************************************"
ForeColor = &H00808080&
Height = 135
Left = 2040
TabIndex = 0
Top = 120
Width = 3135
End
Begin VB.Line Line5
BorderColor = &H00808080&
X1 = 1920
X2 = 5160
Y1 = 360
Y2 = 360
End
Begin VB.Line Line1
BorderColor = &H8000000C&
X1 = 0
X2 = 4560
Y1 = 120
Y2 = 120
End
End
Attribute VB_Name = "frmTycjmain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub CmbCxk_click() '选择串行口
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
Else
End If
On Error GoTo err:
Select Case CmbCxk.Text
Case "COM1"
MSComm1.CommPort = 1
Case "COM2"
MSComm1.CommPort = 2
Case "COM3"
MSComm1.CommPort = 3
End Select
Debug.Print MSComm1.CommPort
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
Else
End If
MSComm1.InputLen = 1
MSComm1.RThreshold = 1
Exit Sub
err:
MsgBox err.Description
End Sub
Private Sub CmdEwgn_Click()
FrmCj.Show
Unload Me
End Sub
Private Sub CmdFb_Click() '方波
Dim sendFb(3) As Byte
If TxtZf.Text = "" Or TxtPl.Text = "" Then '应增加数据条件
MsgBox "请输入完整数据"
Else
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
sendFb(0) = 1
sendFb(1) = Val(CmbTd.Text)
sendFb(2) = Val(TxtZf.Text)
sendFb(3) = Int(Val(TxtPl.Text) * 256 / 2.5)
MSComm1.Output = sendFb()
Debug.Print sendFb(0)
Debug.Print sendFb(1)
Debug.Print sendFb(2)
Debug.Print sendFb(3)
Else
sendFb(0) = 1
sendFb(1) = Val(CmbTd.Text)
sendFb(2) = Val(TxtZf.Text)
sendFb(3) = Int(Val(TxtPl.Text) * 256 / 2.5)
MSComm1.Output = sendFb()
Debug.Print sendFb(0)
Debug.Print sendFb(1)
Debug.Print sendFb(2)
Debug.Print sendFb(3)
End If
CmdZxb.Enabled = False
CmdJyb.Enabled = False
CmdXhtz.Enabled = True
End If
End Sub
Private Sub CmdHelp_Click() '帮助
FrmHelp.Show
End Sub
Private Sub CmdJyb_Click() '阶跃信号
Dim sendJy(3) As Byte
If TxtZf.Text = "" Then '应增加数据条件
MsgBox "请输入数据"
Else
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
sendJy(0) = 3
sendJy(1) = Val(CmbTd.Text)
sendJy(2) = Val(TxtZf.Text)
sendJy(3) = 40
MSComm1.Output = sendJy()
Debug.Print sendJy(0)
Debug.Print sendJy(1)
Debug.Print sendJy(2)
Debug.Print sendJy(3)
Else
sendJy(0) = 3
sendJy(1) = Val(CmbTd.Text)
sendJy(2) = Val(TxtZf.Text)
sendJy(3) = 40
MSComm1.Output = sendJy()
Debug.Print sendJy(0)
Debug.Print sendJy(1)
Debug.Print sendJy(2)
Debug.Print sendJy(3)
End If
CmdZxb.Enabled = False
CmdFb.Enabled = False
CmdXhtz.Enabled = True
End If
End Sub
Private Sub CmdScxh_Click() '输出信号功能选择
On Error GoTo err:
MSComm1.InputLen = 1
MSComm1.RThreshold = 1
Dim i(0) As Byte
If CmbCxk.Text = "" Then
MsgBox "请选择串行口!"
Else
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
i(0) = 31
MSComm1.Output = i()
Else
i(0) = 31
MSComm1.Output = i()
End If
End If
Exit Sub
err:
MsgBox err.Description
End Sub
Private Sub CmdSjcj_Click() '数据采集功能选择
On Error GoTo err:
Dim i(0) As Byte
If CmbCxk.Text = "" Then
MsgBox "请选择串行口!"
Else
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
i(0) = 32
MSComm1.Output = i()
Else
i(0) = 32
MSComm1.Output = i()
End If
'Unload Me
' FrmCjcl.Show
End If
Exit Sub
err:
MsgBox err.Description
End Sub
Private Sub CmdXhtz_Click() '输出信号停止
Dim i(0) As Byte
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
i(0) = 1
MSComm1.Output = i()
Else
i(0) = 1
MSComm1.Output = i()
End If
CmdZxb.Enabled = True
CmdFb.Enabled = True
CmdJyb.Enabled = True
End Sub
Private Sub CmdZxb_Click() '正弦波
Dim sendZx(3) As Byte
If TxtZf.Text = "" Or TxtPl.Text = "" Then '应增加数据条件
MsgBox "请输入数据"
Else
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
sendZx(0) = 2
sendZx(1) = Val(CmbTd.Text)
sendZx(2) = Val(TxtZf.Text)
sendZx(3) = Int(Val(TxtPl.Text) * 256 / 2.5)
MSComm1.Output = sendZx()
Debug.Print sendZx(0)
Debug.Print sendZx(1)
Debug.Print sendZx(2)
Debug.Print sendZx(3)
Else
sendZx(0) = 2
sendZx(1) = Val(CmbTd.Text)
sendZx(2) = Val(TxtZf.Text)
sendZx(3) = Int(Val(TxtPl.Text) * 256 / 2.5)
MSComm1.Output = sendZx()
Debug.Print sendZx(0)
Debug.Print sendZx(1)
Debug.Print sendZx(2)
Debug.Print sendZx(3)
End If
CmdFb.Enabled = False
CmdJyb.Enabled = False
CmdXhtz.Enabled = True
End If
End Sub
Private Sub Form_Load()
frmTycjmain.Show
CmbCxk.SetFocus
Labshow.Left = PicHelp.Width
LoadMakeunuse
Login
End Sub
Private Sub Form_Unload(Cancel As Integer)
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
End Sub
Private Sub MSComm1_OnComm()
Dim re() As Byte
Dim re1(1) As Byte
re() = MSComm1.Input
re1(0) = re(0)
Debug.Print re1(0)
Select Case re1(0)
Case 31
MSComm1.PortOpen = False
LoadMakeuse
Case 32
MSComm1.PortOpen = False
FrmCjcl.Show
End Select
End Sub
Private Sub Timshow_Timer() '显示系统时间
Labtime.Caption = " " & Str(Date) & "--" & Str(Time)
End Sub
Private Sub LoadMakeunuse() '登录后按钮可用性控制
CmdZxb.Enabled = False
CmdFb.Enabled = False
CmdJyb.Enabled = False
PicHelp.Enabled = False
CmbTd.Enabled = False
TxtZf.Enabled = False
TxtPl.Enabled = False
LabBxsc.Enabled = False
LabCssd.Enabled = False
Labshow.Enabled = False
LabTZP.Enabled = False
TimMov.Enabled = False
CmdXhtz.Enabled = False
End Sub
Private Sub Timmov_Timer() '提示信息动态显示
If Labshow.Left >= -3100 Then
Labshow.Left = Labshow.Left - 20
Else
Labshow.Left = PicHelp.Width
End If
End Sub
Private Sub LoadMakeuse() '按钮可用性控制
CmdZxb.Enabled = True
CmdFb.Enabled = True
CmdJyb.Enabled = True
PicHelp.Enabled = True
CmbTd.Enabled = True
TxtZf.Enabled = True
TxtPl.Enabled = True
LabBxsc.Enabled = True
LabCssd.Enabled = True
Labshow.Enabled = True
LabTZP.Enabled = True
TimMov.Enabled = True
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -