3569a.cls

Rs232串口通信专题范例,Vusual Basic,Mscomm,PCOMMPRO

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "HP3569a"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'有关噪音计的类别用私有变数宣告
'这个类别中的属性名称几乎与3569的面板设定相同
'一般在同一种类型设定完之後应再以Act的方法，通知系统作出
'相对应的动作;才是真正的设定完成。
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
Private c_ComPort As MSComm
Private c_Mode As Integer
Private c_TRGSRC As Integer
Private c_TRGRepeat As Integer
Private c_TRGAccept As Integer
Private c_TRGDelay As Single
Private c_TRGEventDur As Single
Private c_TRGAutoSave As Integer
Private c_TRGSlope As Integer
Private c_TRGLevel As Integer
Private c_TRGBand As Integer
Private c_Range1 As Integer
Private c_Range2 As Integer
Private c_CH1Unit As Integer
Private c_CH1EU As Single
Private c_CH1Couple As Integer
Private c_CH1Weight As Integer
Private c_CH2Unit As Integer
Private c_Att As Integer
Private c_CH2EU As Single
Private c_MicPol As Integer
Private c_CH2Couple As Integer
Private c_OctaveChan As Integer
Private c_OctaveMode As Integer
Private c_OctaveStartFreq As Integer
Private c_OctaveStopFreq As Integer
Private c_SNDFormat As Integer
Private c_SNDStyle As Integer
Private c_AVGHold As Integer
Private c_AVGMode As Integer
Private c_AVGIntTime As Single
Private c_AVGTimeStp As Single
Private c_AVGMeasDur As Single
Private c_AVGCount As Integer
Private c_AVGTimeCon As Single
Private c_AVGExceedan As Integer
Private c_AVGL As Single
Private c_AVGHistInt As Single
Private c_AVGImpulse As Integer
Private c_AVGIncrUpd As Integer
Private c_TraceA As Integer
Private c_TraceB As Integer
Sub AVGAct()
'设定完Sound的Average 参数後，需要再执行此副程式才能确实指定给3569
'SNDAvgHold c_AVGHold
''SNDAvgMode c_AVGMode
'SNDAvgOption c_AVGExceedan, c_AVGL, c_AVGHistInt, c_AVGImpulse, c_AVGIncrUpd
SNDAvgTime c_AVGIntTime, c_AVGTimeStp, c_AVGMeasDur, c_AVGCount, c_AVGTimeCon
End Sub


Property Get AVGCount() As Integer
AVGCount = c_AVGCount
End Property
Property Get SNDAtt() As Integer
SNDAtt = c_Att
End Property
Property Let SNDAtt(m_Value As Integer)
c_Att = m_Value
End Property
Property Let AVGCount(m_Count As Integer)
c_AVGCount = m_Count
End Property
Property Get AVGExceedan() As Integer
AVGExceedan = c_AVGExceedan
End Property

Property Let AVGExceedan(m_Exceedan As Integer)
c_AVGExceedan = m_Exceedan
End Property
Property Get AVGHistInt() As Single
AVGHistInt = c_AVGHistInt
End Property
Property Let AVGHistInt(m_HistInt As Single)
c_AVGHistInt = m_HistInt
End Property

Property Get AVGHold() As Integer
AVGHold = c_AVGHold
End Property

Property Get AVGImpulse() As Integer
AVGImpulse = c_AVGImpulse
End Property
Property Let AVGImpulse(m_Impulse As Integer)
c_AVGImpulse = m_Impulse
End Property
Property Get AVGIncrUpd() As Integer
AVGIncrUpd = c_AVGIncrUpd
End Property

Property Let AVGIncrUpd(m_IncrUpd As Integer)
c_AVGIncrUpd = m_IncrUpd
End Property
Property Get AVGIntTime() As Single
AVGIntTime = c_AVGIntTime
End Property
Property Let AVGIntTime(m_Time As Single)
c_AVGIntTime = m_Time
End Property
Property Get AVGL() As Single
AVGL = c_AVGL
End Property
Property Let AVGL(m_L As Single)
c_AVGL = m_L
End Property
Property Get AVGMeasDur() As Single
AVGMeasDur = c_AVGMeasDur
End Property
Property Let AVGMeasDur(m_MeasDur As Single)
c_AVGMeasDur = m_MeasDur
End Property
Property Get AVGMode() As Integer
AVGMode = c_AVGMode
End Property

Property Get AVGTimeCon() As Single
AVGTimeCon = c_AVGTimeCon
End Property
Property Let AVGTimeCon(m_TimeCon As Single)
c_AVGTimeCon = m_TimeCon
End Property
Property Get AVGTimeStp() As Single
AVGTimeStp = c_AVGTimeStp
End Property
Property Let AVGTimeStp(m_Stp As Single)
c_AVGTimeStp = m_Stp
End Property
Sub DataSetup()
SNDDataSet c_TraceA, c_TraceB
End Sub

Property Let TraceA(m_Value As Integer)
c_TraceA = m_Value
End Property

Property Get TraceA() As Integer
TraceA = c_TraceA
End Property
Property Let Range1(m_Value As Integer)
c_Range1 = m_Value
End Property

Property Get Range1() As Integer
Range1 = c_Range1
End Property

Property Let Range2(m_Value As Integer)
c_Range2 = m_Value
End Property

Property Get Range2() As Integer
Range2 = c_Range2
End Property


Private Sub SNDAvgMode(Mode As Integer)
'Mode--0:Linear,1:Expo
TimeDelay 2000
c_ComPort.Output = AvgKey
c_ComPort.Output = FirstLeftItem + FirstUpItem
If Mode = 0 Then Exit Sub
c_ComPort.Output = DownKey
TimeDelay 1000
End Sub

Property Let AVGMode(m_Mode As Integer)
c_AVGMode = m_Mode
End Property
Private Sub SNDAvgHold(Mode As Integer)
'Mode--0:Hold off,1:hold Max,2:Hold Min
c_ComPort.Output = AvgKey
c_ComPort.Output = FirstLeftItem + RightKey + RightKey + FirstUpItem
Select Case Mode
Case 0
  Exit Sub
Case 1
  c_ComPort.Output = DownKey
Case 2
  c_ComPort.Output = DownKey
  TimeDelay 300
  c_ComPort.Output = DownKey
End Select
End Sub

Property Let AVGHold(m_Hold As Integer)
c_AVGHold = m_Hold
End Property
Private Sub SNDAvgOption(Value1 As Integer, Value2 As Single, Value3 As Single, Value4 As Integer, Value5 As Integer)
'Value1--0:off,1:on,exceedan
'Value4--0:off,1:on,impulse
'Value5--0:off,1:on,incr upd
Dim Count%, PreNo%
Dim Info%(12), TimeCount&
Dim Buf$, CharNo%, CompNo%
c_ComPort.Output = AvgKey
TimeDelay 1000
c_ComPort.Output = FirstLeftItem + RightKey + RightKey + RightKey + FirstUpItem
Count = 0
TimeCount = 1000
Buf = c_ComPort.Input
Do
  Buf = ""
  c_ComPort.Output = GetStatus
  TimeDelay 1000
  Buf = c_ComPort.Input
  TimeDelay 1000
  CharNo = InStr(1, Buf, "Exceed")
  Buf = Mid(Buf, CharNo + 50, 3)
  If UCase(Right(Trim(Buf), 1)) = "N" Then
    CompNo = 1
  Else
    CompNo = 0
  End If
  c_ComPort.Output = EnterKey
Loop Until Value1 = CompNo
c_ComPort.Output = DownKey
c_ComPort.Output = Str(Value2) + EnterKey
TimeDelay 300
c_ComPort.Output = DownKey
c_ComPort.Output = Str(Value3) + EnterKey
TimeDelay 300
c_ComPort.Output = DownKey
Count = 0
TimeCount = 1000
TimeCount = 1000
Buf = c_ComPort.Input
Do
  Buf = ""
  c_ComPort.Output = GetStatus
  TimeDelay 1000
  Buf = c_ComPort.Input
  TimeDelay 1000
  CharNo = InStr(1, Buf, "Impul")
  Buf = Mid(Buf, CharNo + 49, 3)
  If UCase(Right(Trim(Buf), 1)) = "N" Then
    CompNo = 1
  Else
    CompNo = 0
  End If
  c_ComPort.Output = EnterKey
Loop Until Value4 = CompNo
c_ComPort.Output = DownKey
Count = 0
TimeCount = 1000
TimeCount = 1000
Buf = c_ComPort.Input
Do
  Buf = ""
  c_ComPort.Output = GetStatus
  TimeDelay 1000
  Buf = c_ComPort.Input
  TimeDelay 1000
  CharNo = InStr(1, Buf, "Incr")
  Buf = Mid(Buf, CharNo + 49, 3)
  If UCase(Right(Trim(Buf), 1)) = "N" Then
    CompNo = 1
  Else
    CompNo = 0
  End If
  c_ComPort.Output = EnterKey
Loop Until Value5 = CompNo
End Sub

Private Sub SNDAvgTime(Value1 As Single, Value2 As Single, Value3 As Single, Value4 As Integer, Value5 As Single)
c_ComPort.Output = AvgKey
c_ComPort.Output = FirstLeftItem + RightKey + FirstUpItem
TimeDelay 200
TimeDelay 200
c_ComPort.Output = DownKey
TimeDelay 200
c_ComPort.Output = DownKey
c_ComPort.Output = DownKey
c_ComPort.Output = Str(Value4) + EnterKey
TimeDelay 200
c_ComPort.Output = DownKey
c_ComPort.Output = Str(Value5) + EnterKey
End Sub

Sub SNDData(DataNo As Integer, Data() As Single)
SNDDataDump DataNo, Data()
End Sub

Private Sub SNDDataDump(DataNo%, m_YData() As Single)
'c_ComPort:Com Port No.
'm_YData:Y axis data
Dim Buf$, Position%
Dim I%, TempSNG!, Count%
''Trace dump process
c_ComPort.InputLen = 0
Buf = ""
Do
  TimeDelay 20
  Buf = Buf + Trim(c_ComPort.Input)
Loop Until InStr(1, Buf, "w") > 0
Buf = ""
c_ComPort.Output = TraceDump
Do
  DoEvents
Loop Until c_ComPort.InBufferCount > 490
TimeDelay 50
Buf = Trim(c_ComPort.Input)
Count = 0
I = 0
Do
  I = InStr(I + 1, Buf, "E")
  If I > 0 Then Count = Count + 1
Loop Until I = 0
If Count < 35 Then
  Buf = Buf + Trim(c_ComPort.Input)
End If
Position = InStr(Buf, "J")
Buf = Mid(Buf, Position + 1, Len(Buf) - Position)
DataNo = Val(Mid(Buf, 1, 2))
Buf = Mid(Buf, 4, Len(Buf) - 3)
For I = 0 To DataNo - 2
   Position = InStr(Buf, ",")
   TempSNG = Val(Mid(Buf, 1, Position - 1))
   If TempSNG < 0.0000001 Then
     m_YData(I) = -20
   Else
     m_YData(I) = TempSNG
   End If
   Buf = Right(Buf, Len(Buf) - Position)
Next
   TempSNG = Val(Buf)
   If TempSNG < 0.0000001 Then TempSNG = -20
   m_YData(DataNo - 1) = TempSNG
End Sub
Function DataDump() As Single
Dim Buf$, Value#
c_ComPort.InputLen = 0
Buf = c_ComPort.Input
c_ComPort.Output = "K"
Do
  DoEvents
Loop Until c_ComPort.InBufferCount > 3
TimeDelay 50
Buf = c_ComPort.Input
Buf = Right(Buf, Len(Buf) - 1)
Value = Val(Buf)
If Value < 0.0000001 Then Value = 0#
DataDump = Value
End Function

'property let AVGHold
Property Get CH2Couple() As Integer
CH2Couple = c_CH2Couple
End Property

Property Get CH1Couple() As Integer
CH1Couple = c_CH1Couple
End Property

Property Get CH1Unit() As Integer
CH1Unit = c_CH1Unit
End Property

Property Let CH1Unit(m_Unit As Integer)
c_CH1Unit = m_Unit
End Property
     
Property Get CH2Unit() As Integer
CH2Unit = c_CH2Unit
End Property

Property Let CH2Unit(m_Unit As Integer)
c_CH2Unit = m_Unit
End Property

Property Get CH1EU() As Single
CH1EU = c_CH1EU
End Property

Property Let CH1EU(m_EU As Single)
c_CH1EU = m_EU
End Property
     
Property Get CH2EU() As Single
CH2EU = c_CH2EU
End Property

Property Let CH2EU(m_EU As Single)
c_CH2EU = m_EU
End Property
              

Property Let CH1Couple(m_Couple As Integer)
c_CH1Couple = m_Couple
End Property
     
Property Let CH2Couple(m_Couple As Integer)
c_CH2Couple = m_Couple
End Property


Property Get CH1Weight() As Integer
CH1Weight = c_CH1Weight
End Property

Property Let CH1Weight(m_Weight As Integer)
c_CH1Weight = m_Weight
End Property
     


Private Sub SNDDataSet(m_TraceA As Integer, m_TraceB As Integer)
'Data Format Setup
'
c_ComPort.Output = DataKey
TimeDelay 200
c_ComPort.Output = FirstLeftItem + FirstUpItem
Do
  If m_TraceA = 0 Then Exit Do
  c_ComPort.Output = DownKey
  m_TraceA = m_TraceA - 1
  TimeDelay 100
Loop
TimeDelay 200
'Set Trace B Data Type
c_ComPort.Output = RightKey + UpKey
Do
  If m_TraceB = 0 Then Exit Do
  c_ComPort.Output = DownKey
  m_TraceB = m_TraceB - 1
  TimeDelay 100
Loop

End Sub

Property Get SNDFreqChan() As Integer
SNDChan = c_OctaveChan
End Property
Property Let SNDFreqChan(m_Chan As Integer)
c_OctaveChan = m_Chan
End Property
Property Get SNDFormat() As Integer
SNDFormat = c_SNDFormat
End Property

Property Let SNDFormat(m_Format As Integer)
c_SNDFormat = m_Format
End Property
Sub SNDFormatAct()
'设定完Sound的Formt 参数後，需要再执行此副程式才能确实指定给3569
SNDFormatSetting c_SNDFormat, c_SNDStyle
End Sub

Sub SNDFreqAct()
SNDFreq c_OctaveChan, c_OctaveMode, c_OctaveStartFreq, c_OctaveStopFreq
End Sub

Sub SNDInputAct()
'设定完Sound的Input 参数後，需要再执行此副程式才能确实指定给3569
Range12 c_Range1, c_Range2
SNDInput1 c_CH1Unit, c_CH1EU, c_CH1Couple, c_CH1Weight, c_MicPol
Att c_Att
'SNDInput2 c_CH2Unit, c_CH2EU, c_CH2Couple
End Sub

Property Get SNDOctaveMode() As Integer
SNDOctaveMode = c_OctaveMode
End Property
Property Get SNDMicPol() As Integer
SNDMicPol = c_Pol
End Property
Property Let SNDMicPol(m_Value As Integer)
c_MicPol = m_Value
End Property
Property Let SNDOctaveMode(m_Mode As Integer)
c_OctaveMode = m_Mode
End Property
Property Get SNDStartFreq() As Integer
SNDStartFreq = c_OctaveStartFreq
End Property

Property Let SNDStartFreq(m_StartFreq As Integer)
c_OctaveStartFreq = m_StartFreq
End Property

Property Get SNDStopFreq() As Integer
SNDStopFreq = c_OctaveStopFreq
End Property

Property Let SNDStopFreq(m_StopFreq As Integer)
c_OctaveStopFreq = m_StopFreq
End Property
Property Get SNDStyle() As Integer
SNDStyle = c_SNDStyle
End Property


Property Let SNDStyle(m_Style As Integer)
c_SNDStyle = m_Style
End Property
Sub Start()
Start_3569
End Sub

Private Sub Start_3569()
'启动分析仪
c_ComPort.Output = StartKey

End Sub

Private Sub StatusInfo(Info() As Integer, TimeCount As Long)
'将Status传回，用以判断设定是否正确
'info 中的阵列意义如下:
'0:Channel 1 Couple
'1:Channel 2 Couple
'2:Weight
'3:Repeat
'4:Accept
'5:Slope
'6:Autosave
'7:Exceedan
'8:Incr Upd
'9:Impulse
'10:Preview
Dim Buf$, Position%
Dim WordLen%, TempStr$
'c_ComPort.Output = FreqKey
'TimeDelay 2000
c_ComPort.Output = ShowStatus
TimeDelay 1000
c_ComPort.InputLen = 0
Buf = c_ComPort.Input
Buf = ""
c_ComPort.Output = GetStatus
TimeDelay TimeCount
'将状态传回
Buf = UCase(c_ComPort.Input)
Position = InStr(Buf, SCH1Couple) + Len(SCH1Couple)
TempStr = Mid(Buf, Position, 7)
Select Case UCase(Trim(TempStr))
Case "MIC"
  Info(0) = 0
Case "BNC DC"
  Info(0) = 1
Case "BNC AC"
  Info(0) = 2
Case "BNC ICP"
  Info(0) = 3
End Select
Position = InStr(Buf, SCH1Couple) + Len(SCH1Couple)
TempStr = Mid(Buf, Position, 7)
Select Case UCase(Trim(TempStr))
Case "MIC"
  Info(1) = 0
Case "BNC DC"
  Info(1) = 1
Case "BNC AC"
  Info(1) = 2
Case "BNC ICP"
  Info(1) = 3
End Select
Position = InStr(Buf, Ch12Weight) + Len(Ch12Weight)
TempStr = Mid(Buf, Position, 7)
Select Case UCase(Trim(TempStr))
Case "A"
  Info(2) = 0
Case "C"
  Info(2) = 1
Case "FLAT"
  Info(2) = 2
Case "LIN"
  Info(2) = 3
End Select
'Trigger Repeat Condition Check
Position = InStr(Buf, SNDRepeat) + Len(SNDRepeat)
TempStr = Mid(Buf, Position, 4)
Select Case UCase(Trim(TempStr))
Case "OFF"
  Info(3) = 0
Case "ON"
  Info(3) = 1
End Select