dgp.frm

通过GPIB接口读取频谱仪的测试曲线

   Begin VB.Frame frmTest 
      Caption         =   "测试控制："
      Height          =   3375
      Left            =   360
      TabIndex        =   0
      Top             =   240
      Width           =   3015
      Begin VB.CommandButton cmdStanBy 
         Caption         =   "仪器预置"
         Height          =   375
         Left            =   1920
         TabIndex        =   66
         Top             =   840
         Width           =   975
      End
      Begin VB.CommandButton cmdMan 
         Caption         =   "手动"
         Height          =   375
         Left            =   1920
         TabIndex        =   65
         Top             =   1200
         Width           =   975
      End
      Begin VB.CommandButton cmdSyn 
         Caption         =   "同步方式"
         Height          =   375
         Left            =   1920
         TabIndex        =   64
         Top             =   2280
         Width           =   975
      End
      Begin VB.CommandButton cmdRestore 
         Caption         =   "恢复"
         Height          =   375
         Left            =   1920
         TabIndex        =   63
         Top             =   1920
         Width           =   975
      End
      Begin VB.CommandButton cmdQuit 
         Caption         =   "退出"
         Height          =   375
         Left            =   1920
         TabIndex        =   51
         Top             =   2640
         Width           =   975
      End
      Begin VB.CommandButton cmdStop 
         Caption         =   "中止"
         Height          =   375
         Left            =   1920
         TabIndex        =   50
         Top             =   1560
         Width           =   975
      End
      Begin VB.TextBox txtAntiCoun 
         Height          =   375
         Left            =   120
         TabIndex        =   24
         Text            =   "30"
         Top             =   2640
         Width           =   1575
      End
      Begin VB.TextBox txtCrntFrq 
         Height          =   405
         Left            =   120
         TabIndex        =   5
         Text            =   "1000"
         Top             =   840
         Width           =   1575
      End
      Begin VB.CommandButton cmdBgnTst 
         Caption         =   "自动"
         Height          =   375
         Left            =   1920
         TabIndex        =   3
         Top             =   480
         Width           =   975
      End
      Begin VB.TextBox txtScnTim 
         Height          =   405
         Left            =   120
         TabIndex        =   2
         Text            =   "30"
         Top             =   1680
         Width           =   1575
      End
      Begin VB.Label lblAntiCoun 
         Caption         =   "测试倒计时（秒）："
         Height          =   375
         Left            =   120
         TabIndex        =   23
         Top             =   2400
         Width           =   1815
      End
      Begin VB.Label lblCrntFrq 
         Caption         =   "当前频率(MHz)："
         Height          =   255
         Left            =   120
         TabIndex        =   4
         Top             =   600
         Width           =   1455
      End
      Begin VB.Label lblScnTim 
         Caption         =   "扫描时间设置(S):"
         Height          =   255
         Left            =   120
         TabIndex        =   1
         Top             =   1440
         Width           =   1575
      End
   End
End
Attribute VB_Name = "formDirGpcPro"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public VBWmod%, RBWmod%, ATTmod%, RfrLvlMod%

Dim RcvModNo%, SrcModNo%, ReceAddr, ReceMode As Integer
Dim ReceNo As Integer
Dim CrntAre%, PreAre%
Dim CrntAzimAngl, CrntPitcAngl As Long
Dim PitcSpecAngl, AzimSpecAngl As Long


Dim BegeSpins, CrntSpins As Integer
Dim BegeAngl As Long
Dim EndAngl As Long

Dim TestSpinSpee As Integer
Dim ScanPeri, BegeTime As Double
Dim BreakMark As Boolean
Dim ScanAngls As Integer
Dim AglAreI, AglAreII, AglAreIII As Integer
Dim BegaTest As String
Dim ap As Long
Dim TestOK As Boolean
Dim SynTim As Single
Dim CrtRcv As Integer
Dim RetuStri As String * 32768
Dim ac As Long
 Sub Test()
    Dim TempAngl, TempAngl2 As Long
    TestOK = False
 '   BegeSpins = CrntSpins
 '   BegeAngl = CrntAzimAngl
'    TranMess "TI C"
    SendCmd BegaTest
    TempCmdStr$ = "TR " & txtInstAddr.Text
    TranMess TempCmdStr$
    delay SynTim
    BegeTime = Timer
'    TempAngl = CrntAzimAngl
'    If Abs(BegeAngl - TempAngl) > AzimSpinSta.MaxAgl / 2 Then
'        TempAngl2 = (AzimSpinSta.MaxAgl + BegeAngl + TempAngl) / 2
'        If TempAngl2 > AzimSpinSta.MaxAgl Then
'            BegeAngl = TempAngl2 - AzimSpinSta.MaxAgl
'        End If
'    Else
'        BegeAngl = (TempAngl + BegeAngl) / 2
'    End If
   TranMess "TI C"
    BegeSpins = CrntSpins
    BegeAngl = CrntAzimAngl
    
    txtSweeBegeAngl.Text = Str$(360 * AnglVsSpec(BegeAngl) / AzimSpinSta.MaxAgl)
    
'    ScnPeri = Val(txtScnTim.Text)
    While Timer - BegeTime < ScanPeri - 1
        DoEvents
        If BreakMark Then
            AzimStop
            Exit Sub
        End If
    Wend
    Do
        DoEvents
        If BreakMark Then
            AzimStop
            Exit Sub
        End If
        TranMess "TI"
        EndAngl = CrntAzimAngl
        EndSpins = CrntSpins
        RetuMess CrntTime$
        RetuTime = Val(CrntTime$)
    Loop Until RetuTime >= ScanPeri
    
    ScanAngls = AzimSpinSta.MaxAgl * (EndSpins - BegeSpins) + (EndAngl - BegeAngl)
    If ScanAngls < 0 Then
        ScanAngls = ScanAngls - 1
    Else
        ScanAngls = ScanAngls + 1
    End If
    AzimStop
    txtSweeEndAngl.Text = Str$(360 * AnglVsSpec(EndAngl) / AzimSpinSta.MaxAgl)
    TestOK = True
End Sub
Private Sub cmdBgnTst_Click()
    Dim TempAngl, TempAngl2 As Long
    cmdBgnTst.Enabled = False
    cmdBgnTst.BackColor = RGB(255, 0, 0)
    BreakMark = False
    TestOK = False
    If CrntSpins < 0 Then
        AzimSpinCloc
    Else
        AzimSpinUnti
    End If
    MSComm1.PortOpen = False
    MSComm1.PortOpen = True
    TranMess "ONL 0"
    TranMess "ONL 1"
    InstToStandBy           'The Instrument is set To Stand by
    txtSweeBegeAngl.Text = ""
    txtSweeEndAngl.Text = ""
    delay 2
    
    'Get origen angle
    Test
    If BreakMark Then
        cmdBgnTst.BackColor = &H8000000F
        cmdBgnTst.Enabled = True
        Exit Sub
    End If
    GetTestData
        cmdBgnTst.BackColor = &H8000000F
        cmdBgnTst.Enabled = True
    
End Sub

Private Sub cmdExit_Click()
    AzimStop
    End
End Sub

Sub InstToStandBy()
    Dim bl As Boolean
   Select Case ReceMode
   Case 0 'hp856x
    TranCmd$ = "CF " & txtCrntFrq.Text & "Mz"
    SendCmd TranCmd$
    TranCmd$ = "SP 0 HZ;AT " & txtATT.Text & "DB; ST " & txtScnTim.Text & "S;"
    SendCmd TranCmd$
    TranCmd$ = "RB " & txtRBW.Text & "HZ;VB " & txtVBW.Text & "HZ;RL " & "DB"
    SendCmd TranCmd$
    TranCmd$ = "ST?"
    SendCmd TranCmd$
    Enter2 RtnDat$, bl
    TempSP% = Fix(10 * Val(RtnDat$))
    ScanPeri = TempSP% / 10
    txtScnTim.Text = Str$(ScanPeri)
    BegaTest = "TS"
    SynTim = 0.25
   Case 1 'hp859x
    TranCmd$ = "CF " & txtCrntFrq.Text & "Mz"
    SendCmd TranCmd$
    TranCmd$ = "SP 0 HZ;AT " & txtATT.Text & "DB; ST " & txtScnTim.Text & "S;"
    SendCmd TranCmd$
    TranCmd$ = "RB " & txtRBW.Text & "HZ;VB " & txtVBW.Text & "HZ;RL " & "DB"
    SendCmd TranCmd$
    TranCmd$ = "ST?"
    SendCmd TranCmd$
    Enter2 RtnDat$, bl
     TempSP% = Fix(10 * Val(RtnDat$))
    ScanPeri = TempSP% / 10
    txtScnTim.Text = Str$(ScanPeri)
    BegaTest = "TS"
    SynTim = 0.25
   Case 2
   
   Case 3 'hp87xx
    TranCmd$ = "POWE " & txtPower.Text & "DB;POIN " & txtSampNumb.Text & ";IFBW " & txtRBW.Text & "HZ"
    SendCmd TranCmd$
    TranCmd$ = "REFV " & txtRL.Text & "DB; REFP " & txtRP.Text
    SendCmd TranCmd$
    TranCmd$ = "CWFREQ " & txtCrntFrq.Text & "MHZ;SWET " & txtScnTim.Text & "S;"
    SendCmd TranCmd$
    TranCmd$ = "S21;POIN?"
    SendCmd TranCmd$
    Enter2 RtnDat$, bl
    RcvPnts% = Val(RtnDat$)
    txtSampNumb.Text = Str$(RcvPnts%)
    TranCmd$ = "SWET?"
    SendCmd TranCmd$
    Enter2 RtnDat$, bl
    TempSP% = Fix(10 * Val(RtnDat$))
    ScanPeri = TempSP% / 10
    txtScnTim.Text = Str$(ScanPeri)
    BegaTest = "SING"
    SynTim = 0.1
   Case 4 'MS26xx
    TranCmd$ = "CF " & txtCrntFrq.Text & "MZ"
    SendCmd TranCmd$
    TranCmd$ = "SP 0HZ;AT " & txtATT.Text & "DB;ST " & txtScnTim.Text & "S"
    SendCmd TranCmd$
    TranCmd$ = "RB " & txtRBW.Text & "HZ;RL " & txtRL.Text & "DB"
    SendCmd TranCmd$
    TranCmd$ = "ST?"
    SendCmd TranCmd$
    Enter2 RtnDat$, bl
     TempSP% = Fix(Val(RtnDat$) / 100000#)
    ScanPeri = TempSP% / 10
    txtScnTim.Text = Str$(ScanPeri)
    BegaTest = "TS"
    SynTim = 0.25
   
   Case 5 'MS37xx
   Case Else
    End Select
End Sub


Sub HP85xx(RetStr$)
    '    scl = 10
        
        CrntPos% = 0
        For I% = 0 To RcvPnts% - 2
          NxtPos% = InStr(CrntPos% + 1, RetStr$, ",")
          L% = NxtPos% - CrntPos% - 1
          CrntVlu$ = Mid$(RetStr$, CrntPos% + 1, L%)
          Rbuf(I%) = Val(CrntVlu$)
          CrntPos% = NxtPos%
        Next I%
  '       NxtPos% = InStr(CrntPos% + 1, RetStr$, "]")
  '        L% = NxtPos% - CrntPos% - 1
        CrntVlu$ = Mid$(RetStr$, CrntPos% + 1)
        Rbuf(RcvPnts% - 1) = Val(CrntVlu$)

End Sub

Sub HP87xx(RetStr$)
    '    scl = 10
         CrntPos% = 0
        CrntPos% = 0
        For I% = 0 To RcvPnts% - 2
          NxtPos% = InStr(CrntPos% + 1, RetStr$, ",")
          L% = NxtPos% - CrntPos% - 1
          CrntVlu$ = Mid$(RetStr$, CrntPos% + 1, L%)
          Rbuf(I%) = Val(CrntVlu$)
          CrntPos% = NxtPos%
        Next I%
  '       NxtPos% = InStr(CrntPos% + 1, RetStr$, "]")
  '        L% = NxtPos% - CrntPos% - 1
        CrntVlu$ = Mid$(RetStr$, CrntPos% + 1)
        Rbuf(RcvPnts% - 1) = Val(CrntVlu$)

End Sub
Sub MS26xx(RetStr$)
    '    scl = 10
         CrntPos% = 0
        CrntPos% = 0
        For I% = 0 To RcvPnts% - 2
          NxtPos% = InStr(CrntPos% + 1, RetStr$, ",")
          L% = NxtPos% - CrntPos% - 1
          If L% < 0 Then Exit Sub
          CrntVlu$ = Mid$(RetStr$, CrntPos% + 1, L%)
          Rbuf(I%) = Val(CrntVlu$) / 100
          CrntPos% = NxtPos%
        Next I%
  '       NxtPos% = InStr(CrntPos% + 1, RetStr$, "]")
  '        L% = NxtPos% - CrntPos% - 1
        CrntVlu$ = Mid$(RetStr$, CrntPos% + 1)
        Rbuf(RcvPnts% - 1) = Val(CrntVlu$) / 100

End Sub

Sub SA7270Ana(RetStr$)

        scl = 10
         CrntPos% = 0
        CrntPos% = InStr(1, RetStr$, "[")
        For I% = 0 To RcvPnts% - 2
          NxtPos% = InStr(CrntPos% + 1, RetStr$, ",")
          L% = NxtPos% - CrntPos% - 1
          CrntVlu$ = Mid$(RetStr$, CrntPos% + 1, L%)
          Rbuf(I%) = (Val(CrntVlu$) - 3600) * scl * 8 / 3600
          CrntPos% = NxtPos%
        Next I%
         NxtPos% = InStr(CrntPos% + 1, RetStr$, "]")
          L% = NxtPos% - CrntPos% - 1
        CrntVlu$ = Mid$(RetStr$, CrntPos% + 1, L%)
        Rbuf(RcvPnts% - 1) = (Val(CrntVlu$) - 3600) * scl * 8 / 3600
        

End Sub

Sub R3762BHana(RetStr$)