📄 datdsp.bas

📁 通过GPIB接口读取频谱仪的测试曲线
💻 BAS
📖 第 1 页 / 共 3 页
字号:
            CrntDspObj.CurrentX = LocX
            CrntDspObj.CurrentY = CrntLoc
            CrntDspObj.Print "方向性系数:" & OnePoint(Gx!) & "(dB)"
            
        End If
        If PreRbefSW% Then
            If Not (PreRbef%) Then
                GetFBR CenAgl&, FBRAglAre%, FBR
                PreRbef% = -1
            End If
            CrntLoc = CrntLoc + 288
            CrntDspObj.CurrentX = LocX
            CrntDspObj.CurrentY = CrntLoc
            CrntDspObj.Print "前后比:"
            
        End If
        
    End If
End Sub

Function OnePoint$(X As Single)
    TempStr = Str(X)
    L% = InStr(1, TempStr, ".")
    If L% > 0 Then
        OnePoint$ = Mid$(TempStr, 1, L% + 1)
    Else
        OnePoint$ = TempStr
    End If
End Function

Sub PREDRAW(CenAgl&, AglAre&, TopLvl%, BtmLvl%, LblLvl%)

    CrntVW.W1 = 0
    CrntVW.W2 = AglAre&
    CrntVW.W3 = BtmLvl%
    CrntVW.W4 = TopLvl%
    PVW CrntVW
    
 ' ChangePen 3
  PLINE 0, TopLvl% - LblLvl%, AglAre, TopLvl% - LblLvl%

  CrntLoc& = CenAgl& - AglAre& / 2 - 1
  If CrntLoc& < 0 Then CrntLoc& = CrntLoc& + MaxAgl&
  I = 0
  Do
    CrntLoc& = IncAgl&(CrntLoc&)
    I = I + 1
    TempLvl% = Lvl%(CrntLoc&)
  Loop Until TempLvl% <> NoLvl
 ' ChangePen 2
  PMOVE I, TempLvl%
  Do
    CrntLoc& = IncAgl&(CrntLoc&)
    I = I + 1
    TempLvl% = Lvl%(CrntLoc&)
    If TempLvl% <> NoLvl Then
      PDRAW I, TempLvl%
      ' = Str$(TempLvl%)
    End If
  Loop Until I >= AglAre&
 ' ChangePen 0
End Sub

Sub PLINE(LftX, BtmY, RgtX, TopY)
    
    TempLX = XE(LftX)
    TempBY = YE(BtmY)
    TempRX = XE(RgtX)
    TempTY = YE(TopY)
    CrntDspObj.Line (TempLX, TempBY)-(TempRX, TempTY)
    
End Sub
Sub ChangePen(n As Integer)
   If PrntMod Then
        CrntDspObj.DrawWidth = 8
   Else
    CrntDspObj.DrawWidth = 2
   End If
    CrntDspObj.ForeColor = RGB(n, 0, 0)
End Sub
Sub PMOVE(X, Y)
    CrntDspObj.PSet (XE(X), YE(Y))
End Sub
Sub PDRAW(X, Y)
    TempX = XE(X)
    TempY = YE(Y)
    CrntDspObj.Line -(TempX, TempY)
End Sub
Function XE(X) As Long
    Dim XX As Long
  XX = Int(CrntVW.A8 * X + CrntVW.B8)
  If XX > CrntVW.V2 Then
    XX = CrntVW.V2
  ElseIf XX < CrntVW.V1 Then
    XX = CrntVW.V1
  End If
  XE = XX
End Function

Function YE(Y) As Long
    Dim YY As Long
  YY = Int(CrntVW.A9 * Y + CrntVW.B9)
  If YY < CrntVW.V4 Then
    YY = CrntVW.V4
  ElseIf YY > CrntVW.V3 Then
    YY = CrntVW.V3
  End If
  YE = YY

End Function

Sub ReadFil(FilePath As String)

    Dim fso As New FileSystemObject
    Dim tf As TextStream
    Dim I As Long

    src$ = "": Rec$ = "": Dat$ = "": Tim$ = "": Freq$ = ""
    MaxI& = 0
    MIL% = 32767

    On Error GoTo EndReadDGDF
    Set tf = fso.OpenTextFile(FilePath, ForReading, False, TristateFalse)

  ML% = -32768
  L$ = tf.ReadLine
  If Left$(L$, 6) = "Source" Then
    src$ = Mid$(L$, InStr(L$, ":") + 1)
    L$ = tf.ReadLine
    Rec$ = Mid$(L$, InStr(L$, ":") + 1)
    
    L$ = tf.ReadLine
    Dat$ = Mid$(L$, InStr(L$, ":") + 1)
    
    L$ = tf.ReadLine
    Tim$ = Mid$(L$, InStr(L$, ":") + 1)
    
    L$ = tf.ReadLine
    Freq$ = Mid$(L$, InStr(L$, ":") + 1)
    
    L$ = tf.ReadLine
    MaxAgl& = Val(Mid$(L$, InStr(L$, ":") + 1))
    
    L$ = tf.ReadLine
    SpfyAgl& = Val(Mid$(L$, InStr(L$, ":") + 1))
    For M& = 0 To MaxAgl&
      Lvl%(M&) = NoLvl
    Next M&

    Do While Not (tf.AtEndOfStream)
        D$ = tf.ReadLine
        M& = InStr(D$, ",")
        If M& = 0 Then GoTo EndReadDGDF
        I& = Val(Left$(D$, M& - 1))
        If I& > MaxI& Then
            MaxI& = I&
        End If
        Lvl%(I&) = Val(Mid$(D$, M& + 1))
        
        If Lvl%(I&) > ML% Then
           ML% = Lvl%(I&)
        MaxLvlAgl& = I&
        ElseIf Lvl%(I&) < MIL% Then
            MIL% = Lvl%(I&)
        End If
      Loop
    tf.Close
    FilSta% = -1
    MaxLvl% = ML%
    MinLvl% = MIL%

    agl1& = MaxLvlAgl&
    Agl2& = agl1&
    Do
        PreAgl& = Agl2&
        Do
            Agl2& = Agl2& + 1: If Agl2& > MaxAgl& Then Agl2& = 0
        Loop Until Lvl%(Agl2&) <> NoLvl
    Loop Until Lvl%(Agl2&) <> ML%
    MaxLvlAgl& = (agl1& + PreAgl&) / 2
    
    Exit Sub
   
End If                                           '
EndReadDGDF:
  MsgBox "文件错误"
  FilSta% = 0
  tf.Close
End Sub

Sub WrtToFil(FilePath As String)
   Dim fso As New FileSystemObject
    Dim tf As TextStream
    Dim I As Long

'    On Error GoTo EndWriteDGDF
    
    Set tf = fso.CreateTextFile(FilePath)
    src$ = CrntSrc$
    tf.WriteLine "Source:" & src$
    Rec$ = CrntRec$
    tf.WriteLine "Receiver:" & Rec$
    tf.WriteLine "Date:" & Date$
    tf.WriteLine "Time:" & Time$
    tf.WriteLine "Frequncy:" & CenFrq$
    tf.WriteLine "MaxAngle:" & MaxAgl&
    tf.WriteLine "Specify angle:" & SpfyAgl&

    For I = 0 To MaxAgl&
      If Lvl%(I) <> NoLvl Then
        tf.WriteLine Str(I) & "," & Str(Lvl%(I))
      End If
    Next I
    tf.Close

End Sub

Function DecAgl&(ByVal Agl&)
  
  InAgl& = Agl& - 1
  If InAgl& < 0 Then InAgl& = MaxAgl& + InAgl& + 1
  DecAgl& = InAgl&

End Function
Function IncAgl&(ByVal Agl&)
   
  InAgl& = Agl& + 1
  If InAgl& > MaxAgl& Then InAgl& = InAgl& - MaxAgl& - 1
  IncAgl& = InAgl&
  
End Function
Sub InitPolarCyd()

    If Not (PrntMod) Then
        CrntDspObj.Cls
    End If
'    CrntDspObj.CurrentX = 50
'    CrntDspObj.CurrentY = CrntDspObj.Height / 3
'    CrntDspObj.ForeColor = RGB(0, 0, 0)
'    CrntDspObj.Print "  幅度"
'    CrntDspObj.Print "(dB/Div)"
'    Dy = (CrntVW.V4 - CrntVW.V3) / 10

    If Abs(CrntVW.V2 - CrntVW.V1) > Abs(CrntVW.V3 - CrntVW.V4) Then
        TempR = Abs(CrntVW.V3 - CrntVW.V4) / 2
    Else
        TempR = Abs(CrntVW.V2 - CrntVW.V1) / 2
    End If
    CenHrz = (CrntVW.V2 + CrntVW.V1) / 2
    CenVtl = (CrntVW.V3 + CrntVW.V4) / 2
    TempV1 = CenHrz - TempR
    TempV2 = CenHrz + TempR
    TempV3 = CenVtl + TempR
    TempV4 = CenVtl - TempR
    CrntVW.V1 = TempV1
    CrntVW.V2 = TempV2
    CrntVW.V3 = TempV3
    CrntVW.V4 = TempV4
    CrntDspObj.ForeColor = RGB(0, 127, 0)
    If PrntMod Then
        CrntDspObj.DrawWidth = 4
    Else
        CrntDspObj.DrawWidth = 1
    End If
    CdtRds = TempR / 10
    For I% = 1 To 10
       CrntDspObj.Circle (CenHrz, CenVtl), CdtRds * I%
    Next I%

    For I% = 0 To 170 Step 10
        CrntDspObj.Line (CenHrz - TempR * Cos(I% * 0.017453), CenVtl - TempR * Sin(I% * 0.017453))-(CenHrz + TempR * Cos(I% * 0.017453), CenVtl + TempR * Sin(I% * 0.017453))
    Next I%
    CrntDspObj.Line (CrntVW.V1, CrntVW.V3)-(CrntVW.V2, CrntVW.V3)
    CrntDspObj.Line -(CrntVW.V2, CrntVW.V4)
    CrntDspObj.Line -(CrntVW.V1, CrntVW.V4)
    CrntDspObj.Line -(CrntVW.V1, CrntVW.V3)
    
    
    TempScl% = AmpDspArea% / 10
    AmpSclStr$ = "幅度刻度：" & Str$(TempScl%) & "dB/Div"
    
    CrntDspObj.CurrentX = (CrntVW.V1 + CrntVW.V2) / 2 - 25 * LenB(AmpSclStr$)
    CrntDspObj.CurrentY = CrntVW.V3 + 300
    CrntDspObj.ForeColor = RGB(0, 0, 0)
    CrntDspObj.Print AmpSclStr$
End Sub

Sub PPOLDIS(CenAgl&, AmpAre%)
'    InitPolarCyd
 ' If Abs(CrntVW.V2 - CrntVW.V1) > Abs(CrntVW.V3 - CrntVW.V4) Then
 '    TempRV = Abs(CrntVW.V3 - CrntVW.V4)
 ' Else
 '   TempRV = Abs(CrntVW.V2 - CrntVW.V1)
 ' End If
 ' TempV1 = (CrntVW.V2 + CrntVW.V1) / 2 - TempRV / 2
 ' TempV2 = TempV1 + TempRV
 ' TempV3 = (CrntVW.V3 + CrntVW.V4) / 2 + TempRV / 2
 ' TempV4 = TempV3 - TempRV
 ' CrntVW.V1 = TempV1
 ' CrntVW.V2 = TempV2
 ' CrntVW.V3 = TempV3
 ' CrntVW.V4 = TempV4
 
  AA = 100 * AmpAre%
  
  'PWINDOW -AA, -AA, AA, AA
  
    CrntVW.W1 = -AA
    CrntVW.W2 = AA
    CrntVW.W3 = -AA
    CrntVW.W4 = AA
  
  
  
  PVW CrntVW
    If PrntMod Then
        CrntDspObj.DrawWidth = 4
    Else
        CrntDspObj.DrawWidth = 1
    End If
    CrntDspObj.ForeColor = RGB(0, 128, 0)
  'ChangePen 1
  CenX = 0: CenY = 0
'  For I% = 0 To 4
'    PCIRCLE CenX, CenY, AA - I% * AA / 5
'  Next I%
'  PLINE -AA, 0, AA, 0
'  PLINE 0, -AA, 0, AA
'  PLINE -AA * 0.5, -AA * 0.866, 0.5 * AA, 0.866 * AA
'  PLINE -0.866 * AA, -0.5 * AA, 0.866 * AA, 0.5 * AA
'  PLINE -AA * 0.5, AA * 0.866, 0.5 * AA, -0.866 * AA
'  PLINE 0.866 * AA, -0.5 * AA, -0.866 * AA, 0.5 * AA
'  For I% = 0 To 30 Step 10
'    PLINE -AA * Cos(I% * 0.017453), -AA * Sin(I% * 0.017453), AA * Cos(I% * 0.017453), AA * Sin(I% * 0.017453)
'  Next I%
  
'  For I% = 0 To 360 Step 10
'    PLINE 0, 0, AA * Cos(I% * 0.017453), AA * Sin(I% * 0.017453)
'  Next I%
'  For I% = 160 To 180 Step 10
'    PLINE AA * Cos(I% * 0.017453), AA * Sin(I% * 0.017453), 0, 0
'  Next I%

'  PBOX -AA, -AA, AA, AA
'    For I% = 1 To 10
'        PCIRCLE CenX, CenY, AA * I% / 10
'    Next I%

  CrntDspObj.ForeColor = RGB(0, 255, 0)
  PCIRCLE CenX, CenY, AA - 300
  
  ChangePen 255
  
  CrntAgl& = CenAgl& + MaxAgl& / 2
  If CrntAgl& > MaxAgl& Then CrntAgl& = CrntAgl& - MaxAgl&
  J& = 0
  While Lvl%(CrntAgl&) = NoLvl
    CrntAgl& = DecAgl&(CrntAgl&)
    J& = J& + 1
    If J& > MaxAgl& Then Exit Sub
  Wend
  AC# = 6.283185307 / MaxAgl&
  Agl# = (J& - MaxAgl& / 4) * AC#

  L% = AA + Lvl%(CrntAgl&) - MaxLvl%
  If L% < 0 Then L% = 0
  X = L% * Cos(Agl#)
  Y = L% * Sin(Agl#)
'  ChangePen 2
  PMOVE X, Y
  For Ii& = J& + 1 To MaxAgl&
   CrntAgl& = DecAgl&(CrntAgl&)
   CrntLvl% = Lvl%(CrntAgl&)
   If CrntLvl% <> NoLvl Then
     Agl# = (Ii& - MaxAgl& / 4) * AC#
     L% = AA + CrntLvl% - MaxLvl%
     If L% < 0 Then L% = 0
     X = L% * Cos(Agl#)
     Y = L% * Sin(Agl#)
     PDRAW X, Y
   End If
  Next Ii&

End Sub

Sub PCIRCLE(X, Y, R)
    CrntDspObj.Circle (XE(X), YE(Y)), (XE(R) - XE(0))
 ' PMOVE X, Y
 ' If PrntPlt% Then
 '   LPRINT "CI" + Str$(Val(XE$(R)) - Val(XE$(0)))
 ' Else
 '   SEND PltAddr, "CI" + Str$(Val(XE$(R)) - Val(XE$(0)))
 ' End If
End Sub
Sub PBOX(LftX, BtmY, RgtX, TopY)
  PMOVE LftX, BtmY
  PDRAW RgtX, BtmY
  PDRAW RgtX, TopY
  PDRAW LftX, TopY
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -