?? form1.frm
字號(hào):
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, "采樣點(diǎn)數(shù)")
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() '采集數(shù)據(jù)表格
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 = "序號(hào)"
Grid1.Col = 1: Grid1.Text = "電壓值"
Grid1.TopRow = 1
Grid1.LeftCol = 1
End Sub
Public Sub tabnit2() '數(shù)據(jù)處理數(shù)據(jù)表格
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 = "序號(hào)"
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 = "序號(hào)"
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代表與設(shè)備無關(guān)的位圖 (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 "時(shí)間長(zhǎng)度錯(cuò)誤,必須是2的次方數(shù)!"
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 '讀取緩沖區(qū)的兩個(gè)字符,
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
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -