multimeter34401a.cls

详细介绍Ｍ８两版间通讯

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "MultiMeter34401A"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Public Enum 万用表功能名称
    电压测量 = 1
    电流测量 = 2
    电阻测量 = 3
End Enum

'保持属性值的局部变量
Private mvar测试类型 As 万用表功能名称 '局部复制
Private mvar设备ID As String '局部复制
'保持属性值的局部变量
Private mvar端口 As MSComm '局部复制
'保持属性值的局部变量
Private mvar远程控制 As Boolean '局部复制
'保持属性值的局部变量
Private mvar采样数 As Byte '局部复制
Public Property Let 采样数(ByVal Samples As Byte)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.采样数 = 5
Dim strTemp As String
strTemp = CStr(Samples)
strTemp = "SAMP:COUN " & strTemp & vbCrLf
mvar采样数 = Samples
mvar端口.Output = strTemp & vbCrLf
End Property

Public Property Get 采样数() As Byte
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.采样数
采样数 = mvar采样数
End Property

Public Property Let 远程控制(ByVal RemoteCtrol As Boolean)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.远程控制 = 5
Dim strTemp As String
If RemoteCtrol = True Then
  strTemp = "REM"
  Else
  strTemp = "LOC"
End If
mvar端口.Output = "SYST:" & strTemp & vbCrLf
mvar远程控制 = RemoteCtrol
End Property


Public Property Get 远程控制() As Boolean
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.远程控制
    Set 远程控制 = mvar远程控制
End Property

Public Property Set 端口(ByRef Port As MSComm)
'向属性指派对象时使用，位于 Set 语句的左边。
'Syntax: Set x.端口 = Form1
Set mvar端口 = Port
With mvar端口
    .PortOpen = True
    .Output = "*RST;*CLS" & vbCrLf
End With
End Property
'Public Property Get 端口() As MSComm
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.端口
'    Set 端口 = mvar端口
'End Property

Public Function 读取测试数据() As Single
Dim strOutput As String, strData As String
Dim intLen As Integer
Dim sngTemp() As Single, sngValue As Single, sngMax As Single, sngMin As Single
Dim i As Integer
With mvar端口
  .Output = "READ?" & vbCrLf
  Delay 200 + 400 * 采样数
  strOutput = .Input
End With
intLen = Len(strOutput)
If intLen = 0 Then
  MsgBox "数据读取错误!" & vbCrLf _
       & "请手工清除故障后重新读取.", vbCritical + vbOKOnly, "读取错误"
  读取测试数据 = 0#
  Exit Function
End If
If mvar采样数 = 1 Then
  intLen = intLen - 2
  strOutput = Left$(strOutput, intLen)
  sngValue = CSng(strOutput)
  Else
  intLen = intLen - 1
  strOutput = Left$(strOutput, intLen)
  '预置数组中最大值和最小值
  sngMax = -3E+38
  sngMin = 3E+38
  '重建数组来记录n个采样数据
  ReDim sngTemp(1 To mvar采样数)
  For i = 1 To mvar采样数
    intLen = intLen - 1
    strOutput = Left$(strOutput, intLen)
    strData = Right$(strOutput, 15)
    sngTemp(i) = CSng(strData)
    sngValue = sngValue + sngTemp(i)
    If sngTemp(i) > sngMax Then
      sngMax = sngTemp(i)
    End If
    If sngTemp(i) < sngMin Then
      sngMin = sngTemp(i)
    End If
    intLen = intLen - 15
    strOutput = Left$(strOutput, intLen)
  Next
  sngValue = sngValue - sngMin - sngMax
  sngValue = sngValue / (mvar采样数 - 2)
End If
读取测试数据 = sngValue
End Function
'定义方法,清除在操作过程中出现的错误
Public Function 故障清除() As String
Dim TempStr As String
With mvar端口
  .Output = "SYST:ERR?" & vbCrLf
  Delay 400
  TempStr = .Input
End With
If Not TempStr = "" Then
  TempStr = Left$(TempStr, Len(TempStr) - 2)
End If
故障清除 = TempStr
End Function
'Public Property Let 设备ID(ByVal vData As String)'设备ID为只读属性，由万用表本身MCU提供
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.设备ID = 5
'    mvar设备ID = vData
'End Property
Public Property Get 设备ID() As String
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.设备ID
Dim strTemp As String
With mvar端口
  .Output = "*IDN?" & vbCrLf
  Delay 500
  strTemp = .Input
End With
strTemp = Left$(strTemp, Len(strTemp) - 2)
mvar设备ID = strTemp
设备ID = mvar设备ID
End Property



Public Property Let 测试类型(ByVal FuncType As 万用表功能名称)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.测试类型 = 5
Dim strTemp As String
Select Case FuncType
  Case 电压测量
  strTemp = ":VOLT:DC "
  Case 电流测量
  strTemp = ":CURR:DC "
  Case 电阻测量
  strTemp = ":RES "
End Select
strTemp = "CONF" & strTemp & vbCrLf
mvar端口.Output = strTemp
mvar测试类型 = FuncType
End Property


Public Property Get 测试类型() As 万用表功能名称
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.测试类型
    测试类型 = mvar测试类型
End Property

Private Sub Class_Initialize()
mvar采样数 = 1
End Sub

Private Sub Class_Terminate()
mvar端口.Output = "*RST;*CLS" & vbCrLf
mvar端口.PortOpen = False
Set mvar端口 = Nothing
Exit Sub
errLine:
Select Case Err.Number
Case 8012
  MsgBox "程序以外终止" & vbCrLf & "设备已经提前关闭"
  Set mvar端口 = Nothing
  Exit Sub
  Case Else
  MsgBox "出现如下错误:" & Err.Number & vbCrLf & "-----程序即将退出"
  Set mvar端口 = Nothing
End Select
End Sub