͸

详细介绍Ｍ８两版间通讯

      Top             =   720
      Width           =   975
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   5880
      Top             =   1080
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   0   'False
      RThreshold      =   1
      BaudRate        =   19200
   End
End
Attribute VB_Name = "Ctrl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private ADC_channel As String * 1
Private DAC_channel As String * 1
Private intVol As Integer
Private intStrType As Integer
Private PortValue As Byte

Private SavePath As String
Private MeasTime(1 To 20) As Date, Mega8(1 To 20) As Currency, Agilent(1 To 20) As Currency
Private Halt As Boolean
Private FSO As FileSystemObject
'定义3组数组，用来记录20组测试数据

Private Sub Check1_Click()
If Check1.Value = Checked Then
  MSComm1.Output = "L" & vbCrLf
  Else
  MSComm1.Output = "P" & vbCrLf
End If
intStrType = 0
End Sub

Private Sub Check2_Click(Index As Integer)

If Check2(Index).Value = Checked Then
  PortValue = PortValue + 2 ^ Index
  Else
  PortValue = PortValue - 2 ^ Index
End If
MSComm1.Output = Chr(PortValue)
End Sub

Private Sub Command1_Click()
Me.Cls
End Sub

Private Sub Command2_Click()
MSComm1.Output = "M" & ADC_channel & vbCrLf
intStrType = 1
End Sub

Private Sub Command3_Click()
Dim strTemp As String
Dim RealVal As Integer
RealVal = 4095 * Text1.Text / 4.968
strTemp = "O" & DAC_channel & " " & Format$(RealVal, "0000")
MSComm1.Output = strTemp
End Sub

Private Sub Command4_Click()
With MultimeterCtrol
If .Visible = True Then
  .Hide
  Else
  .Show
End If
End With
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
Dim strTemp As String * 1
If KeyAscii = 32 Then
  Me.Cls
End If
'strTemp = Chr$(KeyAscii)
'MSComm1.Output = strTemp
End Sub

Private Sub Form_Load()
MultimeterCtrol.Hide
With MSComm1
  .CommPort = 1
  .Settings = "19200,n,8,1"
  .PortOpen = True
End With
ADC_channel = "0"
DAC_channel = "0"
Set FSO = New FileSystemObject
Set FSO = CreateObject("Scripting.FileSystemObject")
End Sub

Private Sub Form_Unload(Cancel As Integer)
Unload MultimeterCtrol
MSComm1.PortOpen = False
Set FSO = Nothing
End Sub

Private Sub MSComm1_OnComm()
Dim strTemp As String, charTemp As String * 1
Dim intVal As Integer
On Error GoTo errLine:
Delay 300
strTemp = MSComm1.Input
If intStrType = 1 Then
  strTemp = Left$(strTemp, 4)
  intVal = CInt(strTemp)
  Me.Print Format$(5 * strTemp / 1024, "0.000") & "V"
  Me.Print
  Else
  Me.Print strTemp
End If
Exit Sub
errLine:
Select Case Err.Number
  Case Else
  Me.Print "故障-" & Err.Number
End Select
End Sub

Private Sub Option1_Click(Index As Integer)
ADC_channel = CStr(Index)
End Sub

Private Sub Option2_Click(Index As Integer)
DAC_channel = CStr(Index)
End Sub

Private Sub Option3_Click(Index As Integer)

If Index = 0 Then
  MSComm1.Output = "R" & vbCrLf
  Frame3.Enabled = True
  Frame3.BorderStyle = 0
  Frame4.Enabled = False
  Frame4.BorderStyle = 1
  Else
  'PortValue = &H80
  MSComm1.Output = "S" & vbCrLf
  Frame3.Enabled = False
  Frame3.BorderStyle = 1
  Frame4.Enabled = True
  Frame4.BorderStyle = 0
  Delay 200
  'MSComm1.Output = Chr(PortValue)
End If
End Sub

Private Sub Option4_Click(Index As Integer)
Dim i As Integer
If Index = 0 Then
  For i = 0 To 7
    Check2(i).Value = Checked
  Next
  Else
  For i = 0 To 7
    Check2(i).Value = Unchecked
  Next
End If
MSComm1.Output = Chr(PortValue)
End Sub
'_________________新

Private Sub Command5_Click(Index As Integer)

Dim strTemp As String
Dim RealVal As Currency 'PWM输出电压
Dim currTemp As Currency '万用表测量电压
Dim i As Integer, RelayTime As Long
Select Case Index
  Case 0 '进行测试
  CreateFile
  Command5(0).Enabled = False
  Command5(1).Enabled = True
  Do
    Me.Cls
    RealVal = 0.65
    For i = 1 To 20
      Do
        DoEvents
        If Me.Visible = False Then
          End
          Exit Sub
        End If
      Loop Until Halt = False
      MeasTime(i) = Now
      RealVal = RealVal + 0.15
      Mega8(i) = RealVal
      strTemp = "O" & DAC_channel & " " & Format$(4095 * RealVal / 4.968, "0000")
      MSComm1.Output = strTemp
      Delay 300
      currTemp = 万用表.读取测试数据
      Agilent(i) = currTemp
      Me.Print MeasTime(i) & vbTab & Mega8(i) & vbTab & Agilent(i) & vbCrLf
    Next
    SaveData SavePath
    For i = 1 To 20 * 60
      Delay 1000, False
      If GetInputState Then
        DoEvents
      End If
      If Me.Visible = False Then
        End
        Exit Sub
      End If
    Next
  Loop
  Case 1 '暂停测试或者恢复继续测试
  If Halt = True Then
    Command5(1).Caption = "暂停"
    Halt = False
    Else
    Command5(1).Caption = "继续"
    Halt = True
  End If
End Select
End Sub

Private Sub CreateFile()
Dim strTemp As String
' 设置“CancelError”为 True
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
' 设置标志
CommonDialog1.Flags = cdlOFNHideReadOnly
' 设置过滤器
CommonDialog1.Filter = "Text Files(*.txt)|*.txt"
' 指定缺省的过滤器
CommonDialog1.FilterIndex = 1
' 显示“打开”对话框
CommonDialog1.ShowSave
' 显示选定文件的名字
strTemp = CommonDialog1.FileName
'MsgBox strTemp
SavePath = strTemp
FSO.CreateTextFile strTemp
Exit Sub
ErrHandler:
' 用户按了“取消”按钮
End Sub
Private Sub SaveData(FilePath As String)

Dim TxtFile As File, TxtStream As TextStream ' _
                                            定义文件系统对象，文件对象，文本流对象
Dim strTemp As String, i As Integer
'On Error GoTo errLine:

Set TxtFile = FSO.GetFile(FilePath) '对文本对象进行赋值
Set TxtStream = TxtFile.OpenAsTextStream(ForAppending) '重定义文本流变量为写入方式

For i = 1 To 20
  strTemp = strTemp & MeasTime(i) & vbTab & Mega8(i) & vbTab & Agilent(i) & vbCrLf
Next
TxtStream.Write strTemp
TxtStream.Close '关闭文本流对象
Set TxtStream = Nothing
Set TxtFile = Nothing '卸载文本对象
Exit Sub
errLine:
Select Case Err.Number
  Case Else
  MsgBox ""
  Resume
End Select
End Sub