dgp.frm

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

End Sub

Sub delay(DlyTim)
   Dim StartTim As Single
   StartTim = Timer
   While Timer - StartTim < DlyTim
   DoEvents
   Wend
End Sub


Private Sub cmdMan_Click()
    Dim TempAngl, TempAngl2 As Long
    BreakMark = False
    TestOK = False
    MSComm1.PortOpen = False
    MSComm1.PortOpen = True
    TranMess "ONL 0"
    TranMess "ONL 1"
'    InstToStandBy           'The Instrument is set To Stand by
    txtSweeBegeAngl.Text = ""
    txtSweeEndAngl.Text = ""
 
    
    'Get origen angle
    Test
    If BreakMark Then Exit Sub
    GetTestData
End Sub
Sub GetTestData()
Dim ap As Long
'    If Not TestOK Then Exit Sub
    GetTrace
     ML% = -32767
    MIL% = 32767
    For I = 0 To AzimSpinSta.MaxAgl
        Lvl%(I) = NoLvl
    Next I
    For I = 0 To RcvPnts% - 1
        If Abs(Rbuf(I)) < 300 Then
            ap = AnglVsScanPoin(I)
            Lvl%(ap) = Fix(100 * Rbuf(I))
            If Lvl%(ap) > ML% Then
            ML% = Lvl%(ap)
            MaxLvlAgl& = ap
            ElseIf Lvl%(ap) < MIL% Then
                MIL% = Lvl%(ap)
            End If
        End If
    Next I
    MaxLvl% = ML%
    MinLvl% = MIL%

    MEAS% = -1
'    MaxAgl& = 360# / MeasAglArea! * RcvPnts% - 1
    SpfyAgl& = AzimSpecAngl
'    For I = RcvPnts% To MaxAgl& + 1
'        Lvl%(I) = NoLvl
'    Next I
    LobWid% = 0
    SidLobLvl% = 0
    DirGain% = 0
    PreRbef% = 0
    DGreDraw

End Sub
Private Sub cmdQuit_Click()
    SendServoCmd "RU"
    SendPitcCmd "RU"
    
    End
End Sub

Private Sub cmdRestore_Click()

    GetTestData

End Sub

Private Sub cmdStanBy_Click()
    InstToStandBy           'The Instrument is set To Stand by
End Sub

Private Sub cmdStop_Click()
    TranMess "IFC"
    TranMess "ONL 0"
    TranMess "ONL 1"
    AzimStop
    
    BreakMark = True
End Sub

Private Sub MSCommSerVo_OnComm()
    Dim InChr As String * 1
    Static TempAglStr  As String
    Dim ClnLoc, TailLoc As Integer
    Dim TempAgl As Long
    Dim MarkStr As String
    Select Case MSCommSerVo.CommEvent
        
      Case comEvReceive   ' 收到 RThreshold # of chars.
            While MSCommSerVo.InBufferCount > 0
            InChr = MSCommSerVo.Input
            TempAglStr = TempAglStr & Chr$(AscB(InChr))
            If AscB(InChr) = 10 Then
                TailLoc = InStr(1, TempAglStr, "/", vbTextCompare)
                If TailLoc > 0 Then
                    TempAgl& = Val(Mid$(TempAglStr, 1, TailLoc - 1))
                    MarkStr = Mid$(TempAglStr, TailLoc, 6)
                    If MarkStr = "/MBRC0" Then
                        If TempAgl& <= AzimSpinSta.MaxAgl Then
                            CrntAzimAngl = TempAgl&

                            AglVld = True
                            If CrntAzimAngl < AglAreI Then
                                CrntAre = 0
                            ElseIf CrntAzimAngl >= AglAreI And CrntAzimAngl < AglAreII Then
                                CrntAre = 1
                            ElseIf CrntAzimAngl >= AglAreII And CrntAzimAngl < AglAreIII Then
                                CrntAre = 2
                            Else
                                CrntAre = 3
                            End If
'                            If GetAglEnb Then
'                               StarAgl = RecAgl
'                               GetAglEnb = False
'                            End If
                        End If
                    ElseIf MarkStr = "/MBRC1" Then
                        If TempAgl& <= PitcSpinSta.MaxAgl Then
                            CrntPitcAngl = TempAgl
'                            txtCrntPitcAngl.Text = Str$(CrntPitcAngl * 360 / PitcSpinSta.MaxAgl)
                        End If
                    End If
                End If
                TempAglStr = ""
                AglVld = True
            End If
           Wend

      Case Else
'        MSCommSerVo.Output = "MBRC0:SA/" & Chr$(13) & Chr$(10)
'        MSCommSerVo.Output = "MBRC1:SA/" & Chr$(13) & Chr$(10)
'        MSCommSerVo.PortOpen = False
        MSCommSerVo.InBufferCount = 0
'        MSCommSerVo.PortOpen = True
    
    End Select
        
End Sub

Sub GetTrace()
    Dim bf As Long
'    Dim buf(600) As Single
    Dim RtnStr As String * 450
    Dim RtnLog As String * 16
    Dim I As Integer
    Dim bl As Boolean
    MSComm1.PortOpen = False
    MSComm1.PortOpen = True
    MSComm1.InBufferCount = 0
  '  TranMess "ONL 0"
  '  TranMess "ONL 1"
    RtnStr = ""
    Select Case ReceMode
    Case 0
        RcvPnts% = 601
         CmdStr$ = "O3;TA"
         SendCmd CmdStr$
         delay 0.1
'         Enter RtnStr, 0, ReceNo
'        ibrda ReceNo, RtnStr
        iread ReceNo, RtnStr, 25 * 601, 1, 0
        HP85xx RtnStr
'         numargs1 = ivscanf(ReceNo, "%,601f", BUF(0))
'         RcvPnts% = 601
    Case 1
        RcvPnts% = 401
         CmdStr$ = "O3;TA"
         SendCmd CmdStr$
         delay 0.1
'         Enter RtnStr, 0, ReceNo
'        ibrda ReceNo, RtnStr
        iread ReceNo, RtnStr, 25 * 401, 1, 0
        HP85xx RtnStr
        
    Case 3
'        CmdStr$ = "POIN?;"
'        SendCmd CmdStr$
'        Enter RtnStr, 0, ReceNo
'        RcvPnts% = Val(RtnStr)
        CmdStr$ = "FORM4;OUTPFORM"
        SendCmd CmdStr$
'        Enter RtnStr, 0, ReceNo
'        ibrda ReceNo, RtnStr
        iread ReceNo, RtnStr, 52, 1, 0
        CrntVlu$ = Mid$(RtnStr, 1, 24)
        Rbuf(0) = Val(CrntVlu$)
        For I% = 1 To RcvPnts% - 1
'          Enter RtnStr, 1, ReceNo
          iread ReceNo, RtnStr, 52, 1, 0
'          NxtPos% = InStr(CrntPos% + 1, RetStr$, ",")
'          L% = NxtPos% - CrntPos% - 1
          CrntVlu$ = Mid$(RtnStr, 1, 24)
          Rbuf(I%) = Val(CrntVlu$)
        Next
        
    Case 4 'MS268x
         RcvPnts% = 1001
'         For I% = 0 To RcvPnts% - 1
'            CmdStr$ = "XMT? " & I% & ",1"
'            SendCmd CmdStr$
'            Enter2 RtnStr, ReceNo, bl
'            If bl Then
'                Rbuf(I%) = Val(RtnStr) / 100
'            End If
'        Next I%
            CmdStr$ = "XMT? 0," & Str$(RcvPnts%)
            SendCmd CmdStr$
'            ibrda ReceNo, RetuStri
            iread ReceNo, RetuStri, 32767, 1, 0
'            Enter2 RtnStr, bl
            If Not (ibsta And EERR) Then
'            If bl Then
                MS26xx RetuStri
'                Rbuf(I%) = Val(RtnStr) / 100
            End If
'       R3762BHana RtnStr
    Case 5 'MS37XX
    End Select
   ' ibloc ReceNo
    igpibllo ReceNo
'RtnLoc ReceNo
    

End Sub

Sub RetuMess(R$)
  Dim TempStr As String
  Dim TempChr As String
  Dim StartTim As Single
  Dim TempInt As Integer
    StartTim = Timer
    TempChr = ""
    TempStr = ""
    While TempChr <> ChrB$(10)
        If MSComm1.InBufferCount > 0 Then
            TempChr = MSComm1.Input
            TempStr = TempStr & Chr$(AscB(TempChr))
            StartTim = Timer
        ElseIf Timer > StartTim + 10 Then
            R$ = ""
           Exit Sub
        End If
     Wend
     R$ = TempStr
End Sub

Sub Enter2(RtnDat$, bl As Boolean)
  Dim TempStr As String
  Dim TempChr As String
  Dim StartTim As Single
  Dim TempInt As Integer
 '    TempStr = "ENTER" & Addr%
'    MSComm1.Output = "ENTER " & addr%
'    CRLF
'    StartTim = Timer
'    TempChr = ""
'    TempStr = ""
'    While TempChr <> ChrB$(10)
'        If MSComm1.InBufferCount > 0 Then
'            TempChr = MSComm1.Input
'            TempStr = TempStr & Chr$(AscB(TempChr))
'            StartTim = Timer
'        ElseIf Timer > StartTim + 5 Then
'            CommErroProc
'            bl = False
'            RtnDat$ = TempStr
'            RtnDat$ = ""
'           Exit Sub
'        End If
'     Wend
'     RtnDat$ = TempStr
'     bl = True
     
'    ibrda ReceNo, RetuStri
    iread ReceNo, RetuStri, 32767, 0, 0
    
 '   If (ibsta And EERR) Then
 '       bl = False
  '      RtnDat$ = ""
 '   Else
   '     bl = True
   '     RtnDat$ = RetuStri
   ' End If

     
End Sub

Sub CommErroProc()

    MSComm1.PortOpen = False
    MSComm1.PortOpen = True
    CRLF
    MSComm1.Output = "INIT"
    CRLF
    While MSComm1.InBufferCount > 0
        TempChr = MSComm1.Input
    Wend
End Sub

Function AnglVsScanPoin(CrntPoin)
    Dim AnglPoin As Long
        AnglPoin = BegeAngl + Int(CrntPoin * ScanAngls / RcvPnts%)
        If AnglPoin < 0 Then
            AnglPoin = AzimSpinSta.MaxAgl + AnglPoin
            If AnglPoin < 0 Then
                AnglPoin = AzimSpinSta.MaxAgl + AnglPoin
            End If
        ElseIf AnglPoin > AzimSpinSta.MaxAgl Then
            AnglPoin = AnglPoin - AzimSpinSta.MaxAgl
            If AnglPoin > AzimSpinSta.MaxAgl Then
                AnglPoin = AnglPoin - AzimSpinSta.MaxAgl
            End If
        End If
        
    AnglVsScanPoin = AnglPoin
End Function

Private Sub Form_Load()
'   ReceNo = iopen(RcvAddr)
'   SrcNo% = iopen(SrcAddr)
'   itimeout ReceNo, 5000
    ReceAddr = Val(txtInstAddr.Text)
'    SrcNo% = 19
    MSComm1.PortOpen = True
   MeasSwpTim! = 20
   MeasAglArea! = 360
   RfrAglTim! = 0
   SrcModNo% = 0
   ReceMode = 3
   AglAreI = AzimSpinSta.MaxAgl / 4
   AglAreII = 2 * AglAreI
   AglAreIII = 3 * AglAreI
   PitcSpecAngl = 1237
   ReceNo = iopen("gpib0," & txtInstAddr.Text)
   itimeout ReceNo, 5000
  '  ibdev 0, ReceAddr, 0, T3s, 1, 0, ReceNo
'   SendServoCmd "?A"
'   SendPitcCmd "?A"

End Sub

Private Sub OptSpec_Click(Index As Integer)

    ReceMode = Index
    Select Case Index
    Case 0  'HP856x
      txtPower.Enabled = False
      txtSampNumb.Text = 601
      txtVBW.Enabled = True
      txtRP.Enabled = False
      txtATT.Enabled = True
      
    Case 1 'HP859X
      txtPower.Enabled = False
      txtSampNumb.Text = 401
      txtVBW.Enabled = True
      txtRP.Enabled = False
      txtATT.Enabled = True
    
    Case 2 'Other...
        
    Case 3 'HP87XX
        txtPower.Enabled = True
        txtVBW.Enabled = False
        txtRP.Enabled = True
        txtATT.Enabled = False
    
    Case 4 'ms26xx
      txtPower.Enabled = False
 '     txtSampNumb.Text = 601
      txtVBW.Enabled = True
      txtRP.Enabled = False
      txtATT.Enabled = True
    
    Case 5 'ms37xx
        txtPower.Enabled = True
        txtVBW.Enabled = False