3569a.cls

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

'Trigger U Accept Condition Check
Position = InStr(Buf, SNDAccept) + Len(SNDAccept)
TempStr = Mid(Buf, Position, 4)
Select Case UCase(Trim(TempStr))
Case "OFF"
  Info(4) = 0
Case "ON"
  Info(4) = 1
End Select
'Trigger Point Slope Condition Check
Position = InStr(Buf, SNDSlope) + Len(SNDSlope)
TempStr = Mid(Buf, Position, 4)
Select Case UCase(Trim(TempStr))
Case "NEGA"
  Info(5) = 0
Case "POSI"
  Info(5) = 1
End Select
'Trigger Option Condition Check
Position = InStr(Buf, SNDAutoSave) + Len(SNDAutoSave)
TempStr = Mid(Buf, Position, 4)
Select Case UCase(Trim(TempStr))
Case "OFF"
  Info(6) = 0
Case "ON"
  Info(6) = 1
End Select
'Avg Exceedan Check
Position = InStr(Buf, SNDExceedan) + Len(SNDExceedan)
TempStr = Mid(Buf, Position, 4)
Select Case UCase(Trim(TempStr))
Case "OFF"
  Info(7) = 0
Case "ON"
  Info(7) = 1
End Select
'Avg Incr Upd Check
Position = InStr(Buf, SNDIncrUpd) + Len(SNDIncrUpd)
TempStr = Mid(Buf, Position, 4)
Select Case UCase(Trim(TempStr))
Case "OFF"
  Info(8) = 0
Case "ON"
  Info(8) = 1
End Select
'Avg Impulse Check
Position = InStr(Buf, SNDImpulse) + Len(SNDImpulse)
TempStr = Mid(Buf, Position, 4)
Select Case UCase(Trim(TempStr))
Case "OFF"
  Info(9) = 0
Case "ON"
  Info(9) = 1
End Select

End Sub


Private Sub SNDTriggerOption(AutoSave As Integer)
Dim Count%, Info%(12)
Dim PreNo%, TimeCount&
c_ComPort.Output = TriggerKey
TimeDelay 500
c_ComPort.Output = FirstLeftItem + RightKey + RightKey + RightKey + FirstUpItem
'Options Setup
Count = 0
TimeCount = 1000
Do
   StatusInfo Info(), TimeCount
   c_ComPort.Output = TriggerKey
   If Info(6) = AutoSave Then
     Exit Do
   Else
     c_ComPort.Output = EnterKey
     TimeDelay 1000
     If PreNo <> Info(6) Then Count = Count + 1
   End If
   PreNo = Info(6)
   If Count > 5 Then TimeCount = TimeCount + 100
Loop Until Count > 10
If Count > 10 Then
  MsgBox "AutoSave 的设定出现逾时，请更改延迟时间!"
End If

End Sub

Private Sub SNDTriggerPoint(Slope As Integer, Level As Integer, Band As Integer)
Dim Count%, Info%(12)
Dim PreNo%, TimeCount&
c_ComPort.Output = TriggerKey
TimeDelay 500
c_ComPort.Output = FirstLeftItem + RightKey + RightKey + FirstUpItem
'Slope Setup
Count = 0
TimeCount = 1000
Do
   StatusInfo Info(), TimeCount
   c_ComPort.Output = TriggerKey
   If Info(5) = Slope Then
     Exit Do
   Else
     c_ComPort.Output = EnterKey
     TimeDelay 1000
     If PreNo <> Info(5) Then Count = Count + 1
   End If
   PreNo = Info(5)
   If Count > 5 Then TimeCount = TimeCount + 100
Loop Until Count > 10
If Count > 10 Then
  MsgBox "Slope 的设定出现逾时，请更改延迟时间!"
End If
'dB Level Setup
c_ComPort.Output = DownKey
TimeDelay 500
c_ComPort.Output = Str(Level) + EnterKey
TimeDelay 500
'Band Num Setup
c_ComPort.Output = DownKey
TimeDelay 500
c_ComPort.Output = Str(Band) + EnterKey
End Sub


Private Sub SNDInput1(Unit As Integer, EU As Single, Couple As Integer, Weight As Integer, Pol As Integer)
'设定第一个波道
'Unit:Y轴的单位。0:Volts,1:Pa,2:g,3:in/s,4:m/s,5:in,6:m,7:lbf,8:kgf,
' 9:psi,10:EU
'EU:灵敏度(Volts/EU),需输入单精度的值
'Couple:藕合型态,0:Mic,1:Bnc dc ,2:Bnc ac,3:Bnc ICP
'Weight:加权型态,0:A,1:C,2:Flat,3:Lin
Dim Info(12) As Integer, Count%, PreNo%
Dim TimeCount&
c_ComPort.Output = InputKey
TimeDelay 50
c_ComPort.Output = FirstLeftItem + RightKey + RightKey + FirstUpItem
Count = 0
TimeCount = 1000
TimeDelay 1000
'设定Volts/EU
c_ComPort.Output = DownKey
c_ComPort.Output = Str(EU) + EnterKey
TimeDelay 1000
'设定Couple Type
'PreNo = -1
'Count = 0
c_ComPort.Output = DownKey
TimeCount = 2000
'设定Weight Type
PreNo = -1
Count = 0
c_ComPort.Output = DownKey
TimeCount = 1000
c_ComPort.Output = EnterKey
TimeDelay 100
c_ComPort.Output = EnterKey
'Mic Pol设定
TimeDelay 200
c_ComPort.Output = FirstLeftItem + RightKey + RightKey + RightKey
TimeDelay 500
c_ComPort.Output = RightKey + RightKey + RightKey + FirstUpItem
While Pol > 0
  c_ComPort.Output = DownKey
  Pol = Pol - 1
  TimeDelay 100
Wend
End Sub

Private Sub Range12(ByVal RangeNo1 As Integer, ByVal RangeNo2 As Integer)
'设定Range1的范围
'RangeNo的意义如下:
'0:Auto,1:5V,2:2V,3:1V,4:500mv,5:200mv,6:100mv
'7:50mv,8:20mv,9:10mv,10:5mv
'若INput1的Unit为Pa,则Range1从Auto,140dB~50dB,每10dB降一级
c_ComPort.Output = InputKey
TimeDelay 50
c_ComPort.Output = FirstLeftItem + FirstUpItem
While RangeNo1 > 0
  c_ComPort.Output = DownKey
  RangeNo1 = RangeNo1 - 1
  TimeDelay 100
Wend
''c_ComPort.Output = RightKey + FirstUpItem
''While RangeNo2 > 0
''  c_ComPort.Output = DownKey
''  RangeNo2 = RangeNo2 - 1
''  TimeDelay 100
''Wend
End Sub

Private Sub SNDInput2(Unit As Integer, EU As Single, Couple As Integer)
'噪音量测时设定第二个波道
'Unit:Y轴的单位。0:Volts,1:Pa,2:g,3:in/s,4:m/s,5:in,6:m,7:lbf,8:kgf,
' 9:psi,10:EU
'EU:灵敏度(Volts/EU),需输入单精度的值
'Couple:藕合型态,0:Mic,1:Bnc dc ,2:Bnc ac,3:Bnc ICP
'Pol : Mic Pol Setup
Dim Info(12) As Integer, Count%, PreNo%, TimeCount&
c_ComPort.Output = InputKey
TimeDelay 50
c_ComPort.Output = FirstLeftItem + RightKey + RightKey + RightKey + FirstUpItem
Count = 0
PreNo = -1
TimeCount = 1000
Do
   SetupInfo Info(), TimeCount
   If Info(8) = Unit Then
     Exit Do
   Else
     c_ComPort.Output = EnterKey
     TimeDelay 400
     If PreNo <> Info(8) Then Count = Count + 1
   End If
   PreNo = Info(8)
   If Count > 5 Then TimeCount = TimeCount + 1000
Loop Until Count > 10
If Count > 10 Then
  MsgBox "Ch2 Unit 的设定出现逾时，请更改延迟时间!"
End If
TimeDelay 1000
'设定Volts/EU
c_ComPort.Output = DownKey
c_ComPort.Output = Str(EU) + EnterKey
TimeDelay 1000
'设定Couple Type
PreNo = -1
Count = 0
c_ComPort.Output = DownKey
TimeCount = 1000
Do
   StatusInfo Info(), TimeCount
   c_ComPort.Output = InputKey
   If Info(1) = Couple Then
     Exit Do
   Else
     c_ComPort.Output = EnterKey
     TimeDelay 1000
     If PreNo <> Info(1) Then Count = Count + 1
   End If
  PreNo = Info(1)
  If Count > 5 Then TimeCount = TimeCount + 1000
Loop Until Count > 10
If Count > 10 Then
  MsgBox "Couple 的设定出现逾时，请更改延迟时间!"
End If

End Sub

Private Sub SetupInfo(Info() As Integer, TimeCount As Long)
Dim Buf$, I%
'读出设定讯息，并将结果放入Info阵列中
'第8个为波道1的Unit(Index=7)
'第9个为波道2的Unit(Index=8)
c_ComPort.InputLen = 0
Buf = c_ComPort.Input
c_ComPort.Output = SetupPara
TimeDelay TimeCount
c_ComPort.InputLen = 0
Buf = Trim(c_ComPort.Input)
Buf = Right(Buf, Len(Buf) - 1)
For I = 0 To 10
   Info(I) = Val(Left(Buf, InStr(Buf, ",") - 1))
   Buf = Right(Buf, Len(Buf) - InStr(Buf, ","))
Next
End Sub

Private Sub SNDFreq(Chan As Integer, Mode As Integer, StartFreq As Integer, StopFreq As Integer)
'选择Octave的解析度
'Chan:Channel No. (1 or 2)
'Mode 0:1/3 Octave
'Mode 1:1/1 Octave
'StartFreq:启始频率，索引由0~12，请参考HP3569A的顺序
'StopFreq:终止频率，索引由0~12，请参考HP3569A的顺序
Dim PreValue%, TempDir$
Dim DefStop%, DefStart%
c_ComPort.Output = FreqKey
c_ComPort.Output = FirstLeftItem + FirstUpItem
Select Case Chan
Case 1
  c_ComPort.Output = FirstUpItem
Case 2
  c_ComPort.Output = FirstUpItem + DownKey
End Select
TimeDelay 500
c_ComPort.Output = RightKey + FirstUpItem
Select Case Mode
Case 0
  c_ComPort.Output = FirstUpItem
Case 1
  c_ComPort.Output = DownKey
End Select
'设定终止频率
TimeDelay 500
DefStop = 12
If StopFreq > DefStop Then
  TempDir = DownKey
Else
  TempDir = UpKey
End If
PreValue = Abs(StopFreq - DefStop)
c_ComPort.Output = RightKey + RightKey
While PreValue > 0
   c_ComPort.Output = TempDir
   PreValue = PreValue - 1
   TimeDelay 100
Wend
'设定启始频率
TimeDelay 1500
DefStart = 4
If StartFreq > DefStart Then
  TempDir = DownKey
Else
  TempDir = UpKey
End If
PreValue = Abs(StartFreq - DefStart)
c_ComPort.Output = LeftKey
While PreValue > 0
   c_ComPort.Output = TempDir
   PreValue = PreValue - 1
   TimeDelay 100
Wend
End Sub

Private Sub SNDFormatSetting(m_Format As Integer, m_Style As Integer)
'Sound Format Setting Sub
'm_Format--0:A above B,1:A only ,2:B only,3:A front B
'4:A+B(dB),5:A-B(dB),6:A+B(Lin),7:A-B(Lin),8:Slice
'm_Style--0:Trace,1:Freq Tabl,2:Ampl Tabl
c_ComPort.Output = FormatKey
TimeDelay 100
c_ComPort.Output = FirstLeftItem + FirstUpItem
TimeDelay 100
Do
  If m_Format = 0 Then Exit Do
  c_ComPort.Output = DownKey
  m_Format = m_Format - 1
  TimeDelay 100
Loop
TimeDelay 700
c_ComPort.Output = RightKey + RightKey + RightKey + FirstUpItem
Do
  If m_Style = 0 Then Exit Do
  c_ComPort.Output = DownKey
  m_Style = m_Style - 1
  TimeDelay 100
Loop
End Sub

Sub SNDTRGAct()
'Trigger各项的值设定之後必须执行此副程式才能将设定值写入3569
'执行真正的Sound Trigger Setup的动作
'TRGSRC c_TRGSRC
SNDTriggerMode c_TRGRepeat, c_TRGAccept, c_TRGDelay, c_TRGEventDur
'SNDTriggerOption c_TRGAutoSave
'SNDTriggerPoint c_TRGSlope, c_TRGLevel, c_TRGBand
End Sub

Function Test() As Integer
'提供外界测试3569是否正常
'阵列0为厂商名，阵列1为型号，阵列2为序号
'阵列3为软体版次。
'传回值False表有误，True为正常
Dim RetStr(3) As String
Test = Test_3569(RetStr())
End Function
Function StatusNow() As Integer
Dim I%, Buf$
Dim Count%
Count = 0
c_ComPort.InputLen = 0
Buf = c_ComPort.Input
TimeDelay 10
c_ComPort.Output = "N"
Do
  DoEvents
Loop Until c_ComPort.InBufferCount > 100
TimeDelay 100
Buf = c_ComPort.Input
If InStr(60, Buf, "P") > 80 Then Count = Count + 1
If InStr(1, Buf, "OVER") > 80 Then Count = Count + 2
If InStr(1, Buf, "BATT") > 80 Then Count = Count + 4
StatusNow = Count
End Function
Private Function Test_3569(RetStr() As String) As Integer
'用於测试3569是否正常，须传入准备接收的字
'串阵列，阵列0为厂商名，阵列1为型号，阵列2为序号
'阵列3为软体版次。
'传回值False表有误，True为正常
Dim I%, Buf$, j&
c_ComPort.InputLen = 0
Buf = c_ComPort.Input
Buf = ""
c_ComPort.Output = SystemInfo
j = GetTickCount()
Do
  DoEvents
Loop Until (GetTickCount() - j) > 100
c_ComPort.InputLen = 0
Buf = c_ComPort.Input
If Len(Buf) < 10 Then
  Test_3569 = False
  Exit Function
End If
Test_3569 = True
End Function

Property Let TraceB(m_Value As Integer)
c_TraceB = m_Value
End Property


Property Get TraceB() As Integer
TraceB = c_TraceB
End Property

Property Get TriggerAutoSave() As Integer
TriggerAutoSave = c_TRGAutoSave
End Property

Property Let TriggerAutoSave(m_AutoSave As Integer)
c_TRGAutoSave = m_AutoSave
End Property
Private Sub TRGSRC(m_Source As Integer)
'Source--0:FreeRun,1:Ch1 Level,2:Ch2 Level,3:Ch1 Event,4:Ch2 Event,5:External,6:Ext Start,7:Ext Gate
c_ComPort.Output = TriggerKey
TimeDelay 500
c_ComPort.Output = FirstLeftItem + FirstUpItem
While m_Source > 0
  c_ComPort.Output = DownKey
  m_Source = m_Source - 1
  TimeDelay 100
Wend

End Sub


Property Get ComPort() As MSComm
Set ComPort = c_ComPort
End Property

Property Let ComPort(m_Port As MSComm)
    Set c_ComPort = m_Port  ' Assign Pen to object.
End Property

Function Init()
'提供外界呼叫3569的初始化
 Init = Initial_3569A()
End Function

 Property Get Mode() As Integer
Mode = c_Mode
End Property

Property Let Mode(m_Mode As Integer)
'提供外界设定模式
'选择量测模式:0--Octave,1--Narrow
c_Mode = m_Mode
SelectMode c_Mode
End Property
Private Sub SelectMode(Mode As Integer)
'选择量测模式:0--Octave,1--Narrow
c_ComPort.Output = InstKey
Select Case Mode
Case Octave_Mode
  c_ComPort.Output = FirstLeftItem + FirstUpItem
Case Narrow_Mode
  c_ComPort.Output = FirstLeftItem + FirstUpItem + DownKey + DownKey
Case Else
   MsgBox "所选的模式有误!"
End Select
c_ComPort.Output = EnterKey
WaitMsg "模式状态程式载中，请稍候…", 12
End Sub


Private Function Initial_3569A()
'这个副程式只给类别使用，不对外开放
'将HP3560作初化的动作
'所有的RS-232设定工作请先完成(如通讯协定、通讯埠号码…)

Dim I
c_ComPort.InputLen = 0
I = c_ComPort.Input
c_ComPort.Output = "ZrE"
TimeDelay 100
Initial_3569A = UCase(Left(c_ComPort.Input, 3)) <> "ZRE"
End Function
Sub PortOpen()
If Not c_ComPort.PortOpen Then
  c_ComPort.PortOpen = True
End If

End Sub

Property Get TriggerAccept() As Integer
TriggerAccept = c_TRGAccept
End Property

Property Let TriggerAccept(m_Accept As Integer)
c_TRGAccept = m_Accept
End Property
Property Get TriggerBand() As Integer
TriggerBand = c_TRGBand
End Property

Property Let TriggerBand(m_Band As Integer)
c_TRGBand = m_Band
End Property

Property Let TriggerDelay(m_Delay As Single)
c_Delay = m_Delay
End Property
Property Let TriggerEventDur(m_Single As Single)
c_TRGEventDur = m_Single
End Property

Property Get TriggerLevel() As Integer
TriggerLevel = c_TRGLevel
End Property

Property Let TriggerLevel(m_Level As Integer)
c_TRGLevel = m_Level
End Property
 Property Get TriggerRepeat() As Integer
TriggerRepeat = c_TRGRepeat
End Property

Property Let TriggerRepeat(m_Repeat As Integer)
'设定Repeat
c_TRGRepeat = m_Repeat
End Property
 
Property Get TriggerSlope() As Integer
TriggerSlope = c_TRGSlope
End Property
Property Let TriggerSlope(m_Slope As Integer)
c_TRGSlope = m_Slope
End Property
Property Get TriggerSRC() As Integer
TriggerSRC = c_TRGSRC
End Property

Property Let TriggerSRC(m_Source As Integer)
c_TRGSRC = m_Source
End Property
Private Sub Att(m_Value As Integer)
'设定Attenuate的大小
'0:0dB,1:5dB,2:10dB,3:15dB,4:20dB,5:25dB,6:30dB
c_ComPort.Output = InputKey
TimeDelay 500
c_ComPort.Output = FirstLeftItem + RightKey + RightKey + RightKey
TimeDelay 500
c_ComPort.Output = RightKey + RightKey + FirstUpItem
While m_Value > 0
  c_ComPort.Output = DownKey
  TimeDelay 100
  m_Value = m_Value - 1
Wend

End Sub


Private Sub SNDTriggerMode(Repeat As Integer, Accept As Integer, Delay As Single, EventDur As Single)
'Repeat--0:off,1:On
'Accept--0:off,1:On
'Delay--Input Single Value
'EvntDur--Input Single Value
Dim Count%, Info%(12), PreNo%, TimeCount&
c_ComPort.Output = TriggerKey
TimeDelay 500
c_ComPort.Output = FirstLeftItem + RightKey + FirstUpItem
c_ComPort.Output = EnterKey
TimeDelay 1000
End Sub

 Property Get TriggerDelay() As Single
TriggerDelay = c_TRGDelay
End Property

Private Sub WaitMsg(m_Msg As String, WaitSec As Integer)
Dim j1&, j2&
WaitForm.Show 0
WaitForm.waitpanel.Caption = Trim(m_Msg)
j1 = 0: j2 = 0
I = GetTickCount()
Do
  DoEvents
 j1 = CInt((GetTickCount() - I) / 1000)
  If j1 - j2 >= 1 Then
     WaitForm.percentpanel.Value = j1 * 100 / WaitSec
    j2 = CInt((GetTickCount() - I) / 1000)
  End If
Loop Until ((GetTickCount() - I) / 1000) >= WaitSec
Unload WaitForm

End Sub