frmmain.frm

用电脑作示波器

   Begin VB.Timer tmrDelay 
      Enabled         =   0   'False
      Left            =   3360
      Top             =   0
   End
   Begin VB.Label Label7 
      Caption         =   "as fast as possible"
      Height          =   255
      Left            =   8040
      TabIndex        =   39
      Top             =   240
      Width           =   1575
   End
   Begin VB.Label Label6 
      Caption         =   "with a period of"
      Height          =   255
      Left            =   8040
      TabIndex        =   35
      Top             =   720
      Width           =   1215
   End
   Begin VB.Label lblDeltaV 
      Caption         =   "0"
      Height          =   255
      Left            =   60
      TabIndex        =   10
      Top             =   540
      Width           =   2955
   End
   Begin VB.Label lblDeltaH 
      Caption         =   "0"
      Height          =   255
      Left            =   3180
      TabIndex        =   9
      Top             =   540
      Width           =   2955
   End
   Begin VB.Label lblConnect 
      Height          =   255
      Left            =   1320
      TabIndex        =   1
      Top             =   120
      Width           =   1695
   End
   Begin VB.Label Label1 
      Alignment       =   1  'Right Justify
      Caption         =   "USB Device:"
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   1095
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim dataArray As Variant
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal Color As Long) As Byte
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)

Dim periodTimer As clsTimer
Dim theBigBuffer As String

Dim msCalibrationConst As Double
Dim wholeTime As Double
Dim continuousReadIndex As Integer

Dim REX() 'REX[ ] holds the real part of the frequency domain
Dim IMX() 'IMX[ ] holds the imaginary part of the frequency domain
Dim outputArray() As Long

Dim running As Boolean
Dim crcOK As Boolean
Dim useCRC As Boolean
Option Explicit

Private Sub Form_Load()
    frmMain.Show
    tmrDelay.Enabled = False
    
    ReDim dataArray(512) As Integer
    Set periodTimer = New clsTimer
    
    timerCheckConnection_Timer
    
    scrollVLine1.Max = UBound(dataArray)
    scrollVLine2.Max = UBound(dataArray)
    
    msCalibrationConst = 0.125
    wholeTime = msCalibrationConst * UBound(dataArray)
    running = True
    useCRC = True
    continuousReadIndex = 0
    txtArraySize.Text = "512"
    
    txtArraySize_Change
    chkUseCRC_Click
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim Result As Long
    
    Result = CloseHandle(HIDHandle)
    Result = CloseHandle(ReadHandle)
End Sub

Private Sub chkContinuous_Click()
    Dim i As Integer

    If chkContinuous.Value = 1 Then
        For i = 0 To 512 - 1
            DoEvents
            dataArray(i) = 0
        Next
        cmdGetADCData.Enabled = False
        cmdGetADCDataUSMS.Enabled = False
        txtGetADCms.Enabled = False
        timerContinuous.Enabled = True
    Else
        cmdGetADCData.Enabled = True
        cmdGetADCDataUSMS.Enabled = True
        txtGetADCms.Enabled = True
        timerContinuous.Enabled = False
    End If
End Sub

Private Sub chkUseCRC_Click()
    If chkUseCRC.Value = 0 Then
        txtByte(0).Text = "11"
        useCRC = False
        cmdOnce_Click
    Else
        txtByte(0).Text = "10"
        useCRC = True
        cmdOnce_Click
    End If
End Sub

Private Sub cmdOnce_Click()
    Dim x As Integer
    Dim theCRC As Byte
    
    If Not MyDeviceDetected Then
        MyDeviceDetected = FindTheHid
    End If
    If MyDeviceDetected Then
        OutputReportData(0) = Val(txtByte(0).Text)
        OutputReportData(1) = Val(txtByte(1).Text)
        OutputReportData(2) = Val(txtByte(2).Text)
        OutputReportData(3) = Val(txtByte(3).Text)
        OutputReportData(4) = Val(txtByte(4).Text)
        OutputReportData(5) = Val(txtByte(5).Text)
        OutputReportData(6) = Val(txtByte(6).Text)
        OutputReportData(7) = Val(txtByte(7).Text)
    
        Call ReadAndWriteToDevice
        lblReadData = Str$(ReadBuffer(1)) & "," & Str$(ReadBuffer(2)) & "," & Str$(ReadBuffer(3)) & "," & Str$(ReadBuffer(4)) & "," & Str$(ReadBuffer(5)) & "," & Str$(ReadBuffer(6)) & "," & Str$(ReadBuffer(7)) & "," & Str$(ReadBuffer(8))
        If useCRC Then
            theCRC = calc_CRC(0, ReadBuffer(1))
            theCRC = calc_CRC(theCRC, ReadBuffer(2))
            theCRC = calc_CRC(theCRC, ReadBuffer(3))
            theCRC = calc_CRC(theCRC, ReadBuffer(4))
            theCRC = calc_CRC(theCRC, ReadBuffer(5))
            theCRC = calc_CRC(theCRC, ReadBuffer(6))
            theCRC = calc_CRC(theCRC, ReadBuffer(7))
            If theCRC = ReadBuffer(8) Then
                lblReadData = lblReadData & " CRC OK"
                crcOK = True
            Else
                lblReadData = lblReadData & " CRC BAD"
                crcOK = False
            End If
        End If
    End If
End Sub

Private Sub cmdGetData_Click()
    Dim i As Integer
    
    If chkPauseRedraw.Value = False And running And MyDeviceDetected Then
        For i = 0 To 512 - 1
            DoEvents
            txtByte(0).Text = "2"   'usbReadRam
            txtByte(1).Text = Str(Int(i / 256))
            txtByte(2).Text = Str(i - Int(i / 256) * 256)
            cmdOnce_Click
            dataArray(i) = Val(ReadBuffer(5))
        Next
        
        debugData
    End If
End Sub

Private Sub cmdGetADCData_Click()
    Dim i As Integer
    
    If chkPauseRedraw.Value = False And running And MyDeviceDetected Then
        txtByte(0).Text = "5"       'usbReadADCnTimes
        txtByte(1).Text = "2"       'For 512 samples
        txtByte(2).Text = "0"       'For 512 samples
        cmdOnce_Click
        
        For i = 0 To 512 - 1
            DoEvents
            txtByte(0).Text = "2"   'usbReadRam
            txtByte(1).Text = Str(Int(i / 256))
            txtByte(2).Text = Str(i - Int(i / 256) * 256)
            cmdOnce_Click
            dataArray(i) = Val(ReadBuffer(5))
        Next
        
        debugData
        
        txtByte(0).Text = "6"       'usbReadADCPeriod
        cmdOnce_Click
        msCalibrationConst = ((ReadBuffer(3) * 256 + ReadBuffer(4)) * 1 / 1500) / UBound(dataArray)
        wholeTime = msCalibrationConst * UBound(dataArray)
    End If
End Sub

Private Sub cmdGetADCDataUSMS_Click()
    Dim i As Integer
    
    If optionUSMS(1).Value = True Then
        If Val(txtGetADCms.Text) < 1 Then
            txtGetADCms.Text = 1
        ElseIf Val(txtGetADCms.Text) > 65535 Then
            txtGetADCms.Text = 65535
        End If
    Else
        If Val(txtGetADCms.Text) < 250 Then
            txtGetADCms.Text = 250
        ElseIf Val(txtGetADCms.Text) > 65535 Then
            txtGetADCms.Text = 65535
        End If
    End If
    
    If chkPauseRedraw.Value = False And running And MyDeviceDetected Then
        If optionUSMS(1).Value = True Then
            txtByte(0).Text = "7"   'usbReadADCnTimesMS
        Else
            txtByte(0).Text = "12"  'usbReadADCnTimesUS
        End If
        txtByte(1).Text = "2"       'For 512 samples
        txtByte(2).Text = "0"       'For 512 samples
        txtByte(3).Text = Str(Int(Int(txtGetADCms.Text) / 256))       'With period in ms
        txtByte(4).Text = Str(Int(txtGetADCms.Text) - (Int(Int(txtGetADCms.Text) / 256) * 256))
        cmdOnce_Click
        
        For i = 0 To 512 - 1
            DoEvents
            txtByte(0).Text = "2"   'usbReadRam
            txtByte(1).Text = Str(Int(i / 256))
            txtByte(2).Text = Str(i - Int(i / 256) * 256)
            cmdOnce_Click
            dataArray(i) = Val(ReadBuffer(5))
        Next
        
        debugData
        
        If optionUSMS(1).Value = True Then
            msCalibrationConst = Int(txtGetADCms.Text) * 512 / UBound(dataArray)
            wholeTime = msCalibrationConst * UBound(dataArray)
        Else
            msCalibrationConst = Int(txtGetADCms.Text) * 512 / 1000 / UBound(dataArray)
            wholeTime = msCalibrationConst * UBound(dataArray)
        End If
    End If
End Sub

Public Function drawArray()
    Dim theX, theY, oldX, oldY, i As Integer
    Dim theXMult, theYMult As Double

    Picture1.Cls
    
    theXMult = Picture1.ScaleWidth / UBound(dataArray)
    theYMult = Picture1.ScaleHeight / 265
    
    Picture1.ForeColor = RGB(50, 50, 50)
    Picture1.Line (0, Picture1.ScaleHeight - theYMult * 51)-(Picture1.ScaleWidth, Picture1.ScaleHeight - theYMult * 51)
    Picture1.Line (0, Picture1.ScaleHeight - theYMult * 102)-(Picture1.ScaleWidth, Picture1.ScaleHeight - theYMult * 102)
    Picture1.Line (0, Picture1.ScaleHeight - theYMult * 154)-(Picture1.ScaleWidth, Picture1.ScaleHeight - theYMult * 154)
    Picture1.Line (0, Picture1.ScaleHeight - theYMult * 205)-(Picture1.ScaleWidth, Picture1.ScaleHeight - theYMult * 205)
    Picture1.Line (0, Picture1.ScaleHeight - theYMult * 255)-(Picture1.ScaleWidth, Picture1.ScaleHeight - theYMult * 255)
    Picture1.ForeColor = RGB(0, 255, 0)
    
    oldX = 0
    oldY = Picture1.ScaleHeight - theYMult * dataArray(0)

    For i = 0 To UBound(dataArray) - 1
        theX = theXMult * i
        theY = Picture1.ScaleHeight - theYMult * dataArray(i)
        Picture1.Line (oldX, oldY)-(theXMult * i, Picture1.ScaleHeight - theYMult * dataArray(i))
        oldX = theX
        oldY = theY
    Next
    If (Abs(scrollVLine1.Value - scrollVLine2.Value) * msCalibrationConst) > 0 Then
        lblDeltaV.Caption = Format(Abs(scrollVLine1.Value - scrollVLine2.Value) * msCalibrationConst, "###,###.000" & "ms") & " (" & Format(1 / (Abs(scrollVLine1.Value - scrollVLine2.Value) * msCalibrationConst / 1000), "###,###.000" & "Hz") & ")"
    Else
        lblDeltaV.Caption = Format(Abs(scrollVLine1.Value - scrollVLine2.Value) * msCalibrationConst, "###,###.000" & "ms")
    End If

    Picture1.ForeColor = RGB(100, 100, 255)
    Picture1.Line (theXMult * scrollVLine1.Value, 0)-(theXMult * scrollVLine1.Value, Picture1.ScaleHeight)
    Picture1.Line (theXMult * scrollVLine2.Value, 0)-(theXMult * scrollVLine2.Value, Picture1.ScaleHeight)
    
    Picture1.ForeColor = RGB(255, 100, 100)
    Picture1.Line (0, Picture1.ScaleHeight - theYMult * scrollHLine1.Value)-(Picture1.ScaleWidth, Picture1.ScaleHeight - theYMult * scrollHLine1.Value)
    Picture1.Line (0, Picture1.ScaleHeight - theYMult * scrollHLine2.Value)-(Picture1.ScaleWidth, Picture1.ScaleHeight - theYMult * scrollHLine2.Value)
    lblDeltaH.Caption = Format(Abs(scrollHLine1.Value - scrollHLine2.Value) * (5 / 255), "0.00" & "V")
End Function

Public Sub doDFT()
    Dim cnt, N, k, i As Integer
    On Error Resume Next
    DoEvents
    
    'THE DISCRETE FOURIER TRANSFORM
    'copyright