form1.frm

这是卫星通信方向图测量软件 采用了VB编程

Dim length As Long
'Const length = 40000
Const leng = 20000
'Dim Data(3) As Integer
Dim shi(leng) As Single
Dim shu(leng) As Single
Dim Data(1) As Double
Dim num As Integer
Dim defrm As Long             'Session to Def  ault Resource Manager
Dim interval As Long
Dim vi As Long
Dim T1_i As Integer           'used in timer1
Dim T1_buf(10) As String * 256 'used in timer1
Dim T1_mka As Single
Dim T1_mkf As String * 256
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '申明过程
Private Function PrintWord1(X, Y, Word As String)
    With Picture1
    .CurrentX = X
    .CurrentY = Y
    .ForeColor = QBColor(8)
    End With
    Picture1.Print Word
End Function
Private Function PrintWord2(X, Y, Word As String)
    With Picture2
    .CurrentX = X
    .CurrentY = Y
    .ForeColor = QBColor(8)
    End With
    Picture2.Print Word
End Function
Private Function PrintWord3(X, Y, Word As String)
    With Picture3
    .CurrentX = X
    .CurrentY = Y
    .ForeColor = QBColor(8)
    End With
    Picture3.Print Word
End Function
Public Sub picinit1() '采集波形
    Const length = 20000
    AutoRedraw = True
    Show
    Dim t As Integer
    Dim i As Single
    Picture1.Scale (0, 2.5)-(length, 0)
    Picture1.Line (50, 0.01)-(length - 1000, 0.01)
    t = PrintWord1(length - 1000, 0.2, "采样点数")
    Picture1.Line (0, 0)-(0, 2.5)
    Picture1.Print "电压值"
    Picture1.CurrentX = 0: Picture1.CurrentY = 0.01
    Picture1.Print "0"
    For i = 0 To 2.5 Step 0.5
        Picture1.Line (0, i)-(length, i)
        t = PrintWord1(0, i, Str(i))
    Next i
    For i = 0 To length Step length / 20
    Picture1.Line (i, 0)-(i, 3)
        t = PrintWord1(i, 0.1, Str(i))
    Next i
End Sub
Public Sub picinit3() '天线方向图波形
    Const length = 20000
    AutoRedraw = True
    Show
    Dim t As Integer
    Dim i As Single
    Picture3.ForeColor = QBColor(8)
    Picture3.Scale (0, -30)-(length, -120)
    Picture3.Line (0, -120)-(length, -120)
    t = PrintWord3(length - 500, -115, "角度")
    Picture3.Line (0, -115)-(0, -30)
    Picture3.Print "电平值"
'Picture1.CurrentX = 0: Picture1.CurrentY = 0.01
'Picture1.Print "0"
    For i = -120 To -30 Step 10
        Picture3.Line (0, i)-(length, i)
        t = PrintWord3(0, i, Str(i))
    Next i
    For i = 0 To length Step length / 20
        Picture3.Line (i, -30)-(i, -120)
        t = PrintWord3(i, -117, Str(-90 + i / 50))
    Next i
End Sub
Public Sub tabnit1() '采集数据表格
    Dim i As Integer
    Const length = 20000
    Grid1.Cols = 2
    Grid1.Rows = length + 1
    Grid1.ColWidth(0) = 700
    Grid1.ColWidth(1) = 950
    Grid1.Col = 0
    For i = 1 To 10000 Step 1
       Grid1.Row = i
       Grid1.Text = "" + Str$(i)
    Next i
    Grid1.Row = 0
    Grid1.Col = 0: Grid1.Text = "序号"
    Grid1.Col = 1: Grid1.Text = "电压值"
    Grid1.TopRow = 1
    Grid1.LeftCol = 1
    
  End Sub
Public Sub tabnit2() '数据处理数据表格
    Dim i As Integer
    Const length = 500
    Grid2.Cols = 2
    Grid2.Rows = 500 + 1
    Grid2.ColWidth(0) = 700
    Grid2.ColWidth(1) = 950
    Grid2.Col = 0
    For i = 1 To 500 Step 1
       Grid2.Row = i
       Grid2.Text = "" + Str$(i)
    Next i
    Grid2.Row = 0
    Grid2.Col = 0: Grid2.Text = "序号"
    Grid2.Col = 1: Grid2.Text = "电压值"
    Grid2.TopRow = 1
    Grid2.LeftCol = 1
End Sub
Public Sub tabnit3() '方向图表格
    Dim i As Integer
    Const length = 15000
    Grid3.Cols = 2
    Grid3.Rows = length + 1
    Grid3.ColWidth(0) = 700
    Grid3.ColWidth(1) = 950
    Grid3.Col = 0
    For i = 1 To 15000 Step 1
       Grid3.Row = i
       Grid3.Text = "" + Str$(i)
    Next i
    Grid3.Row = 0
    Grid3.Col = 0: Grid3.Text = "序号"
    Grid3.Col = 1: Grid3.Text = "电压值"
    Grid3.TopRow = 1
    Grid3.LeftCol = 1
End Sub

Sub cal()
    Dim max As Single
    Dim min As Single
    On Error GoTo hh
    max = shu(0): min = max
    For i = 0 To UBound(shu)
        If shu(i) > max Then max = shu(i)
        If shu(i) < min Then min = shu(i)
    Next i
    Text4.Text = Format$(max, "0.00000")
    Text5.Text = Format$(min, "0.00000")
    max = max * 1.1
    
hh:  Exit Sub
  
End Sub
Private Sub Command19_Click()
    Dim wd As Object
    On Error Resume Next
    Set wd = CreateObject("Word.Application") '注意这一段中word的使用
    wd.Visible = True
    wd.Documents.Add
    Clipboard.clear
    Clipboard.SetData Picture1.Image, 8 '这里的8代表与设备无关的位图 (DIB)
    'Clipboard.SetData Picture1.Picture, 8
    wd.Selection.Paste
    Clipboard.clear
    wd.ActiveDocument.Paragraphs.Last.Range.Font.Size = 11
    Clipboard.SetText Chr(13) + Chr(10) + Label12.Caption
    wd.Selection.Paste
    wd.PrintPreview = True
End Sub

Private Sub Command21_Click()
     Form2.Show
End Sub

Private Sub Command7_Click()
     'Call tabnit
     Dim FFTOrder As Integer, TNo As Long
     Dim Data() As Single, vData As Variant
     Dim FFTResult() As COMPLEX
     Dim i As Long
     vData = Split(Text6.Text, ",")
     'vData = Split(Text2.Text)
     ReDim Data(0 To UBound(vData) - 1)
     ReDim FFTResult(0 To UBound(vData) - 1)
     For i = 0 To UBound(Data)
        Data(i) = CSng(vData(i))
     Next i
     TNo = UBound(Data) - LBound(Data) + 1
     FFTOrder = Int(Log(TNo) / Log(2) + 0.001)
      If 2 ^ FFTOrder <> TNo Then
        MsgBox "时间长度错误,必须是2的次方数!"
        Exit Sub
    End If
    FFT2R Data(), FFTResult(), FFTOrder
    For i = 0 To UBound(FFTResult)
        Text7.Text = Text7.Text & Format(FFTResult(i).Real, "0.000000") & "," & Format(FFTResult(i).Cmpx, "0.000000") & "i" & vbCrLf
        'Grid3.Col = 1: Grid3.Row = i + 1
        'Grid3.Text = Format$(FFTResult(i).Real, "0.000000")
        'Grid3.Col = 2: Grid3.Row = i + 1
        'Grid3.Text = Format$(FFTResult(i).Cmpx, "0.000000")
    Next i
'    If FFTResult(i).Real <> 0 And i < 20 Then
       
      '  i = i + 1
   ' End If
    Picture3.Scale (0, 3)-(UBound(FFTResult), 0)
    For i = 0 To UBound(FFTResult) - 1
       Picture3.Line (i, Sqr(FFTResult(i).Real ^ 2 + FFTResult(i).Cmpx ^ 2))-(i + 1, Sqr(FFTResult(i + 1).Real ^ 2 + FFTResult(i + 1).Cmpx ^ 2))
    Next i
End Sub

Private Sub Command8_Click()
    Call viOpenDefaultRM(defrm)
    Call viOpen(defrm, "GPIB0::18::INSTR", 0, 0, vi)
    Call viVPrintf(vi, "ip" + Chr$(10), 0)
    Sleep (200)
End Sub

Private Sub Command9_Click()
    Call viVPrintf(vi, "mkpk" + Chr(10), 0)
    Sleep (500)
    Text15.Enabled = True
    Text16.Enabled = True
    Text15.Text = ""
    Text16.Text = ""
    T1_i = 0
    Timer1.Enabled = True
End Sub
Private Sub Command10_Click()
    Call viVPrintf(vi, "mkcf" + Chr(10), 0)
    Sleep (500)
    Text15.Enabled = True
    Text16.Enabled = True
    Text15.Text = ""
    Text16.Text = ""
    T1_i = 0
    Timer1.Enabled = True
End Sub
Private Sub Command18_Click()
    Timer1.Enabled = False
    Text15.Text = ""
    Text16.Text = ""
    Call viClose(vi)
    Call viClose(defrm)
End Sub
Private Sub Command11_Click()
    Call viVPrintf(vi, "CF " + Text8.Text + Combo1.Text + Chr(10), 0)
End Sub

Private Sub Command12_Click()
    Call viVPrintf(vi, "SP " + Text9.Text + Combo2.Text + Chr(10), 0)
End Sub

Private Sub Command13_Click()
    Call viVPrintf(vi, "RB " + Text10.Text + Combo3.Text + Chr(10), 0)
End Sub

Private Sub Command14_Click()
    Call viVPrintf(vi, "VB " + Text11.Text + Combo4.Text + Chr(10), 0)
End Sub

Private Sub Command16_Click()
    Call viVPrintf(vi, "RL " + Text13.Text + Combo5.Text + Chr(10), 0)
End Sub

Private Sub Command15_Click()
    Call viVPrintf(vi, "ST " + Text12.Text + Combo6.Text + Chr(10), 0)
End Sub
Private Sub Command17_Click()
    Call viVPrintf(vi, "LF " + Text14.Text + Combo6.Text + Chr(10), 0)
End Sub



Private Sub Timer2_Timer()  '用来显示mk point的电平变化
    Call viVPrintf(vi, "mka?" + Chr(10), 0)
    Call viVScanf(vi, "%t", T1_buf(T1_i))
    T1_i = T1_i + 1
    If (T1_i >= 10) Then
        T1_i = 0
        T1_mka = Val(T1_buf(0)) + Val(T1_buf(1)) + Val(T1_buf(2)) + Val(T1_buf(3)) + Val(T1_buf(4)) + Val(T1_buf(5)) + Val(T1_buf(6)) + Val(T1_buf(7)) + Val(T1_buf(8)) + Val(T1_buf(9))
        T1_mka = 0.1 * T1_mka
        Text15.Text = T1_mka
        Call viVPrintf(vi, "mkf?" + Chr(10), 0)
        Call viVScanf(vi, "%t", T1_mkf)
        Text16.Text = Val(T1_mkf)
    End If
End Sub
Private Sub Form_Load() '串口初始化
    MSComm1.CommPort = 4
    MSComm1.Settings = "38400,n,8,1"
  ' MSComm1.InputMode = comInputModeBinary
    MSComm1.InputMode = 1
    MSComm1.RThreshold = 1
    MSComm1.InputLen = 1 '读取缓冲区的两个字符，
    MSComm1.InBufferCount = 0
    MSComm1.PortOpen = True
    Const length = 20000
     Call tabnit1
    'Call picinit1
    'Call picinit3
    Timer1.Enabled = False
    Label2.Caption = Format(Now, "yyyy-mm-dd-hh-mm-ss")
    Label12.Caption = Format(Now, "yyyy-mm-dd-hh-mm-ss")
End Sub

Private Sub MSComm1_OnComm() '采集程序
    Dim Buffer As Variant
    Dim buf As String
    Select Case MSComm1.CommEvent
    Case comEvReceive
    If flag = 0 Then
        Buffer = MSComm1.Input
        Data(0) = Buffer(0)
        flag = 1
    Else
        Buffer = MSComm1.Input
        Data(1) = Buffer(0)
' For i = LBound(buffer) To UBound(buffer)
       ' For i = 0 To 1
'Text3.Text = Text3.Text + Hex(buffer(i)) + Chr(32)

'Text3.Text = Text3.Text + Hex(buffer(i)) + Chr(32)
       ' Data(i) = buffer(i)
        'Next i
        Text1.Text = num
        shi(num) = Data(0) + Data(1) * 16 * 16
        shu(num) = shi(num) * 2.5 / 65536
'Text1.Text = Text1.Text + Hex(buffer(i)) + Chr(32)
'shi = Data(0) + Data(1) * 16 * 16
        Text2.Text = shu(num)
        If shu(num) <> 0 Then
            Grid1.Col = 1
            Grid1.Row = num + 1
            Grid1.Text = Format$(shu(num), "0.00000")
            num = num + 1
            flag = 0
'buf = Hex(buffer)
        End If
'Text1.Text = buf
'buffer = MSComm1.Input

'buffer = 0
    End If
    Case comEvSend
    End Select
    'Call cal
    'Loop
End Sub
Private Sub Command1_Click()
    flag = 0
    'Timer1.Enabled = True
    Dim kaishi As String
    kaishi = "F"
    MSComm1.Output = kaishi
End Sub

Private Sub Command2_Click()
    Timer1.Enabled