main_frm.frm

模拟的示波器

            End If
            wave_num = number
            Call wave_back(20 * zoom)
            Call wave_draw(wave_num)
       End If
    .RThreshold = 1
End Select
End With
End Sub

Private Sub confirm_Click()
Dim port As Integer         '' 定义通信口
Dim baud As String          '' 定义波特率
Dim parity As String        '' 定义奇偶校验
Dim data_bit  As String     '' 定义数据位
Dim stop_bit As String      '' 定义停止位

If (comm.PortOpen = True) Then
   a1 = MsgBox("通信中不可更改设置！", , "数字存储示波器")
   com_pic.Visible = False
   Exit Sub
End If
Select Case comm_port.ListIndex
       Case 0: port = 1
       Case 1: port = 2
       Case 2: port = 3
       Case 3: port = 4
       Case Else: port = 1
End Select

Select Case comm_baud.ListIndex
       Case 0: baud = "300"
       Case 1: baud = "600"
       Case 2: baud = "1200"
       Case 3: baud = "2400"
       Case 4: baud = "4800"
       Case 5: baud = "9600"
       Case 6: baud = "19200"
       Case 7: baud = "38400"
       Case 8: baud = "43000"
       Case 9: baud = "56000"
       Case 10: baud = "57600"
       Case 11: baud = "115200"
       Case Else: baud = "9600"
End Select

Select Case comm_data.ListIndex
       Case 0: data_bit = "8"
       Case 1: data_bit = "7"
       Case 2: data_bit = "6"
       Case Else: data_bit = "8"
End Select

Select Case comm_stop.ListIndex
       Case 0: stop_bit = "1"
       Case 1: stop_bit = "2"
       Case Else: stop_bit = "1"
End Select

Select Case comm_parity.ListIndex
       Case 0: parity = "N"
       Case 1: parity = "N"
       Case 2: parity = "N'"
       Case Else: parity = "N"
End Select

comm.Settings = baud & "," & parity & "," & data_bit & "," & stop_bit
comm.CommPort = port

com_pic.Visible = False
End Sub
'************ 波形拉宽程序 ********************
Private Sub enlarge_Click()
wave_pic.ScaleWidth = wave_pic.ScaleWidth - 20
Call wave_back(zoom * 20)
Call wave_draw(wave_num)
End Sub
'************ 形成实验报告 ********************
Private Sub excel_Click()
 'Dim xlchart As Chart
         Set xl = CreateObject("Excel.Application")
         xl.Visible = True
         xl.Workbooks.Add
         xl.Range("a1").Value = 1
         xl.Range("a2").Value = 2
         xl.Range("a3").Value = 3
         xl.Range("a4").Formula = "=sum(a1:a3)"
         xl.Range("A1").CurrentRegion.Select
         'Set xlchart = xl.Charts.Add()
         'xlchart.Type = xl3DColumn
         'xlchart.ChartType = xlPyramidCol

End Sub

'************ 退出程序 ***********************'
Private Sub exit_sys_Click()
comm.PortOpen = False
End
End Sub

'*********** 界面初始化 ***************'
Private Sub Interface_Init()

com_pic.Visible = False
'*********** 变量初始化 ***********
zoom = 1           '' 缩放倍数
sing_squ = 0       '' 信号频率
samp_squ = 0       '' 采样频率
sing_unit = "Hz"   '' 信号频率单位
samp_unit = "Hz"   '' 采样频率单位
lamp_flag = False  '' 串口指示灯状态
lamp.BackColor = &H80000008 '' 串口指示灯颜色初始化
add_label.Visible = False   '' 隐藏添加标签菜单
x_line.Y1 = 0: x_line.Y2 = 0
y_line.X1 = 0: y_line.X2 = 0
rece_quantity.Caption = number

'********** 串初始化 *************************'
With comm
     .CommPort = 1
     .Settings = "9600,n,8,1"
     .InBufferSize = 1024
     .OutBufferSize = 1024
     .InputMode = comInputModeBinary
     .InBufferCount = 0
     .OutBufferCount = 0
     .SThreshold = 1
     .InputLen = 1
     .RThreshold = 1
End With

'********** 波形窗口坐标系初始化 **************'
With wave_pic
    .BackColor = vbBlack
    .ScaleTop = 300
    .ScaleHeight = -600
    .ScaleLeft = 0
    .ScaleWidth = 800
End With

'********** 坐标标签初始化 ********************'
Cordinate.Caption = ""
Cordinate.BackStyle = 0

'********* 频率显示初始化 ********************'
mess_sing.BackStyle = 0
mess_samp.BackStyle = 0
mess_sing.Caption = sing_squ
mess_samp.Caption = samp_squ



End Sub


Private Sub Form_Activate()

wave_pic_Paint

End Sub

Private Sub Form_Load()
Interface_Init  '' 调用界面初始化过程

End Sub



'*********** 波形向下移动程序 ***************'
Private Sub move_down_Click()
wave_pic.ScaleTop = wave_pic.ScaleTop + 20
Call wave_back(zoom * 20)
Call wave_draw(wave_num)
End Sub
'*********** 波形向左移动程序 ***************'
Private Sub move_left_Click()
wave_pic.ScaleLeft = wave_pic.ScaleLeft + 20
Call wave_back(zoom * 20)
Call wave_draw(wave_num)
End Sub
'****************************** 波形背景子过程 **************************‘
Public Sub wave_back(ByVal step_x As Integer)
wave_pic.Cls

For i = -4000 To 4000 Step step_x
    wave_pic.Line (i, -5000)-(i, 5000), RGB(0, 100, 0)
Next i

For i = -3000 To 3000 Step step_x
    wave_pic.Line (-8000, i)-(8000, i), RGB(0, 100, 0)
Next i

wave_pic.Line (-8000, 0)-(8000, 0), RGB(100, 230, 0)
'wave_pic.Line (400, -300)-(400, 300), RGB(100, 230, 0)

End Sub
'*************************** 波形绘制子过程 ***************************** '
Private Sub wave_draw(ByVal wav_num As Integer)

For i = 0 To wav_num Step 1
   wave_pic.Line (i * zoom, wave_y(i) * zoom)-((i + 1) * zoom, wave_y(i + 1) * zoom), RGB(255, 255, 255)
Next i

End Sub
'*********** 波形向右移动程序 ***************'
Private Sub move_right_Click()
wave_pic.ScaleLeft = wave_pic.ScaleLeft - 20
Call wave_back(zoom * 20)
Call wave_draw(wave_num)
End Sub
'*********** 波形向上移动程序 ***************'
Private Sub move_up_Click()
wave_pic.ScaleTop = wave_pic.ScaleTop - 20
Call wave_back(zoom * 20)
Call wave_draw(wave_num)
End Sub

Private Sub open_comm_Click()
lamp_flag = Not lamp_flag
If (lamp_flag = True) Then
    If (comm.PortOpen = False) Then
       comm.PortOpen = True
        lamp.BackColor = vbYellow
        open_comm.Caption = "关闭串口"
    End If
    
Else
   lamp.BackColor = &H80000008
   open_comm.Caption = "打开串口"
   comm.PortOpen = False
End If
End Sub
'**************** 打开文件程序 ***********'
Private Sub open_file_Click()
Dim i As Integer
'**************** 文件控件初始化 ***********'
With file_dialog
     .DialogTitle = "打开波形文件"
     .InitDir = "c:\"
     .FileName = ""
     .Filter = "(*.txt)"
     .ShowOpen
End With

If (file_dialog.FileName = "") Then Exit Sub  '' 判断文件名是否为空
Open file_dialog.FileName For Input As #1     '' 打开文件

'*************** 读取文件中数据 ************'
Input #1, sing_squ
Input #1, sing_unit
Input #1, samp_squ
Input #1, samp_unit

Do While 1
   Input #1, wave_y(i)
   If (wave_y(i) = 800) Then Exit Do
   i = i + 1
Loop
wave_num = i - 1
wave_y(i) = 0
Close #1 '************************************ 关闭文件

Call wave_back(zoom * 20) '******************* 调用背景程序
Call wave_draw(wave_num)  '******************* 调用波形绘制程序

End Sub

Private Sub save_file_Click()
With file_dialog
     .FileName = ""
     .Filter = "文档文件(*.txt)|*.txt"
     .ShowSave
End With

If (file_dialog.FileName = "") Then Exit Sub '' 判断文件名是否为空

Open file_dialog.FileName For Output As #1   '' 打开文件

Print #1, sing_squ   '************************* 写信号频率值
Print #1, sing_unit  '************************* 写信号频率单位
Print #1, samp_squ   '************************* 写采样频率值
Print #1, samp_unit  '************************* 写采样频率单位

Print #1, receive.Text   '********************* 将数据写入文件
Print #1, "800"          '********************* 添加结束标志
Close #1

End Sub


Private Sub wave_pic_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim x_cor As Single
Dim y_cor As Single
Dim x_unit As String
Dim y_unit As String
Dim temp As Single

'*********使坐标标签可见************'
Cordinate.Visible = True

'********在坐标标签上显示X值及Y值****************'
If (samp_squ = 0) Then
   x_cor = X / zoom
Else
   x_cor = X / samp_squ / zoom
End If

If (x_cor > 1) Then
    x_unit = "秒"
ElseIf (x_cor > 0.001) Then
    x_cor = X * 1000 / samp_squ / zoom
    x_unit = "毫秒"
Else
    x_cor = x_cor * 1000000
    x_unit = "微秒"
End If
Cordinate.Caption = "X：" & x_cor & " " & x_unit & vbCrLf & "Y：" & Y / zoom

'****根据X、Y值，设置坐标标签的位置*********'
If (Y < wave_pic.ScaleTop * 0.23 And X > wave_pic.ScaleWidth * 0.8) Then
   Cordinate.Left = X - wave_pic.ScaleWidth * 0.2
   Cordinate.Top = Y + 60
ElseIf (Y < wave_pic.ScaleTop * 0.23) Then
   Cordinate.Left = X + wave_pic.ScaleWidth * 0.03
   Cordinate.Top = Y + 60
ElseIf (X > wave_pic.ScaleWidth * 0.8) Then
   Cordinate.Left = X - wave_pic.ScaleWidth * 0.2
   Cordinate.Top = Y - 10
Else
Cordinate.Left = X + wave_pic.ScaleWidth * 0.03
Cordinate.Top = Y - 10
End If
'*********************************************'

'wave_pic.Line (0, Y)-(800, Y), RGB(100, 230, 0)
'wave_pic.Line (X, -300)-(X, 300), RGB(100, 230, 0)
'**************** 可移动参考线  ****************************'
x_line.Visible = True
y_line.Visible = True

x_line.Y1 = Y: x_line.Y2 = Y
y_line.X1 = X: y_line.X2 = X

End Sub

Private Sub wave_pic_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
   PopupMenu add_label
End If
End Sub

Private Sub wave_pic_Paint()

Call wave_back(zoom * 20)
Call wave_draw(wave_num)

End Sub

Private Sub wave_show_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'如果鼠标移出波形显示窗口，则将坐标显示标签隐藏
Cordinate.Visible = False
x_line.Visible = False
y_line.Visible = False
End Sub
'************ 缩小子过程 ***********'
Private Sub zoom_in_Click()
If (zoom <= 60) Then zoom = zoom + 1
Call wave_back(zoom * 20)
Call wave_draw(wave_num)
End Sub
'************* 放大子过程 ***********'
Private Sub zoom_out_Click()
If (zoom > 1) Then zoom = zoom - 1
Call wave_back(zoom * 20)
Call wave_draw(wave_num)

End Sub