frmdaclin.frm

AD9954源码

         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H0000FF00&
         Height          =   285
         Left            =   120
         Locked          =   -1  'True
         TabIndex        =   17
         Top             =   600
         Width           =   5175
      End
      Begin VB.CommandButton cmdCancelTest 
         Caption         =   "Cancel Test"
         Enabled         =   0   'False
         Height          =   375
         Left            =   120
         TabIndex        =   12
         Top             =   1320
         Width           =   1455
      End
      Begin VB.CommandButton cmdMeasureDMM 
         Caption         =   "Run The Test"
         Enabled         =   0   'False
         Height          =   375
         Left            =   120
         TabIndex        =   3
         Top             =   960
         Width           =   1455
      End
      Begin VB.Label lblDataLogFile 
         Caption         =   "Datalog File:"
         Height          =   255
         Left            =   120
         TabIndex        =   18
         Top             =   360
         Width           =   975
      End
      Begin VB.Label lblDACCodeStatus 
         BackColor       =   &H00000000&
         BorderStyle     =   1  'Fixed Single
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H0000FF00&
         Height          =   285
         Left            =   2520
         TabIndex        =   14
         Top             =   960
         UseMnemonic     =   0   'False
         Width           =   855
      End
      Begin VB.Label lblCurDACCode 
         Caption         =   "DAC Code:"
         Height          =   255
         Left            =   1680
         TabIndex        =   13
         Top             =   960
         Width           =   855
      End
      Begin VB.Label lblVolts 
         Caption         =   "Volts"
         Height          =   255
         Left            =   4680
         TabIndex        =   11
         Top             =   1440
         Width           =   495
      End
      Begin VB.Label lblDMMMeasurement 
         BackColor       =   &H00000000&
         BorderStyle     =   1  'Fixed Single
         Caption         =   "Voltage = "
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H0000FF00&
         Height          =   375
         Left            =   1680
         TabIndex        =   4
         Top             =   1320
         UseMnemonic     =   0   'False
         Width           =   2895
      End
   End
   Begin VB.Frame fraShutdown 
      Caption         =   "Shutdown GPIB"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   855
      Left            =   120
      TabIndex        =   0
      Top             =   4440
      Width           =   1695
      Begin VB.CommandButton cmdShutdownDMM 
         Caption         =   "Shutdown DMM"
         Enabled         =   0   'False
         Height          =   375
         Left            =   120
         TabIndex        =   1
         Top             =   360
         Width           =   1455
      End
   End
End
Attribute VB_Name = "frmDACLin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ReadBuff As String
Dim vmHp34401A_1 As Integer
Dim DMM1Fnd As Integer
Dim filename As String
Dim CancelTest As Boolean

'Loads the DAC code into the AD9858
Private Sub SetDACCode(ByVal DACCode As Integer)
    Dim sRegVal As String
    'Make sure that the DAC code is a valid value
    If DACCode > 0 And DACCode < 1023 Then
        'Build the ODh Register Value
        sRegVal = "0000" & cbaseDec2Bin(DACCode, 10) & cbaseDec2Bin(DACCode, 10)
        'Set the register map value in the register map form
        frmRegisterMap.sSetSerialRegVal &HD, sRegVal
        'Update the controls on the test register form
        frmSelfTests.RefreshControls
        'Load the data into the AD9858 Eval Board
        EvalBoard.LoadData &HD, frmRegisterMap.sGetSerialRegVal(&HD)
    End If
End Sub


Private Sub cmdBrowseForDatalogFolder_Click()
    Dim RetPath As String
    
    'Show the browse for folder dialog box
    RetPath = BrowseForFolder(Me.hWnd, "Select the datalog folder.", txtDataLogPath.Text)
    
    'Show the browse for folder dialog box
    If RetPath <> "" Then
        txtDataLogPath.Text = RetPath
    End If
End Sub

Private Sub cmdCancelTest_Click()
    'Set the flag to cancel the test
    CancelTest = True
End Sub

Private Sub CmdGraph_Click()
    frmLinearity_graph.Show
End Sub

Private Sub cmdMeasureDMM_Click()
    Dim fHandle As Integer
    Dim cntr As Integer
    Dim filename As String
    Dim raw_data(1024) As Double
    Dim dnl_data(1024) As Double
    Dim inl_data(1024) As Double
    Dim ideal_lsb As Double
    Dim compute_dnl_code As Integer
    Dim compute_inl_code As Integer
    Dim Row As Integer
    Dim Max_codes As Integer
    Dim gain As Double
    Dim INL_max As Double
    Dim INL_min As Double
    Dim DNL_max As Double
    Dim DNL_min As Double
    
    
    'Generate a file name based on todays date and ID provided
    filename = txtDataLogID.Text & "_" & Month(Now()) & "_" & Day(Now()) & "_" & Year(Now()) & "_" & Hour(Now()) & "_" & Minute(Now()) & "_" & Second(Now())
    
    'Display the data log filename
    txtDatalogFile.Text = filename
    
    'Get a free file handle
    fHandle = FreeFile(1)
    Max_codes = 1023
    'Open a file name
    Open txtDataLogPath.Text & "\" & filename & ".txt" For Output As #fHandle
    
    Write #fHandle, "Code, DAC Output"
        
    'Put the part in DAC Test mode
    frmRegisterMap.sSetSerialRegVal &HC, "0000000000000001"
    frmSelfTests.RefreshControls
    'Load the data from the register map
    EvalBoard.LoadData &HC, frmRegisterMap.sGetSerialRegVal(&HC)
    
    'Run the test loop
    For cntr = 0 To Max_codes
                
        'Set the DAC Code
        SetDACCode cntr
        'Read the output value back through the DMM
        
        'Take a measurment and store it in ReadBuff
        Call ibwrt(vmHp34401A_1, "?")
        'CALL gpib.enter(VM, a$)
        ReadBuff = Space$(64)
        Call ibrd(vmHp34401A_1, ReadBuff)
        
        'Clean up the readback value
        ReadBuff = Left(ReadBuff, InStr(1, ReadBuff, vbCrLf) - 1)
        
        'Display the measurements
        lblDACCodeStatus.Caption = cntr
        lblDACCodeStatus.Refresh
        lblDMMMeasurement.Caption = "Voltage = " & ReadBuff
        lblDMMMeasurement.Refresh
        
        'Let the os do its thing
        DoEvents
        
        'Store the value in the datalog file & raw_data array
        Write #fHandle, cntr & "," & ReadBuff
        raw_data(cntr) = CDbl(Left(ReadBuff, InStr(1, ReadBuff, ",") - 1))
        
        'If the user wants to cancel then do it
        If CancelTest Then
            'Reset the flag
            CancelTest = False
            Exit For
        End If
    Next cntr
    
    'Close the datalog file
    Close #fHandle
    
    
    'Compute DNL
    ideal_lsb = (raw_data(Max_codes) - raw_data(0)) / Max_codes
    For compute_dnl_code = 0 To (Max_codes - 1)
        dnl_data(compute_dnl_code) = ((raw_data(compute_dnl_code + 1) - raw_data(compute_dnl_code)) - ideal_lsb) / ideal_lsb
    Next compute_dnl_code
    
    
    
    'Compute INL
    inl_data(0) = dnl_data(0)
    For compute_inl_code = 1 To (Max_codes - 1)
        inl_data(compute_inl_code) = inl_data(compute_inl_code - 1) + dnl_data(compute_inl_code)
    Next compute_inl_code
    
    
    
    With frmLinearity_graph.MSChart1
      ' Displays a 2d chart with 2 columns and 1022 rows
      ' data. Column1 = DNL, Column2  = INL
      .chartType = VtChChartType2dLine
      .ColumnCount = 2
      .RowCount = (Max_codes - 2)
      
         For Row = 1 To (Max_codes - 2)
            .Column = 1
            .Row = Row
            .Data = dnl_data(Row)
         Next Row
      
        For Row = 1 To (Max_codes - 2)
            .Column = 2
            .Row = Row
            .Data = inl_data(Row)
            .RowLabel = Row
         Next Row
      
      
      
      ' Use the chart as the backdrop of the legend.
      .ShowLegend = True
      .Column = 1
      .ColumnLabel = "DNL"
      .Column = 2
      .ColumnLabel = "INL"
      
      .EditPaste
   End With
    'Compute Test Results
    gain = raw_data(1023) - raw_data(0)
    INL_min = inl_data(0)
    For cntr = 1 To 1022
        If inl_data(cntr) < INL_min Then INL_min = inl_data(cntr)
        If inl_data(cntr) > INL_max Then INL_max = inl_data(cntr)
        If dnl_data(cntr) < DNL_min Then DNL_min = dnl_data(cntr)
        If dnl_data(cntr) > DNL_max Then DNL_max = dnl_data(cntr)
    Next cntr
    
    'Display the test results to the sreen
    lblGain_Result.Caption = gain
    lblINL_low_result.Caption = INL_min
    lblINL_high_result.Caption = INL_max
    lblDNL_low_result.Caption = DNL_min
    lblDNL_high_result.Caption = DNL_max
    
    
End Sub

Private Sub cmdSetupDMM1_Click()
    
    On Error GoTo ErrorHandler:
    'Setup the DVM
'    Call ibfind("VMETER", VM)     'find the instrument that was set up in
'   Find first voltmeter
    ibdev 0, 1, 0, TT300ms, 1, 0, vmHp34401A_1
    ibln vmHp34401A_1, 1, 0, DMM1Fnd
    'Send it the command to emmulate the Fluke 8840a
    Call ibwrt(vmHp34401A_1, "L3")
    'Using Fluke 8840 commands to drive the HP34401'
    ibwrt vmHp34401A_1, "F1 R0 S1 T0 Y1"

    Select Case DMM1Fnd
        Case 0
            lblDMMStatus.Caption = "Couldn't find DMM!"
            cmdMeasureDMM.Enabled = False
            cmdShutdownDMM.Enabled = False
            cmdCancelTest.Enabled = False
            
        Case 1
            cmdMeasureDMM.Enabled = True
            cmdShutdownDMM.Enabled = True
            lblDMMStatus.Caption = "DMM Found and initialized!"
            cmdCancelTest.Enabled = True
            cmdSetupDMM1.Enabled = False
        
        Case -1
            lblDMMStatus.Caption = "GPIB Not Installed!!!"
            cmdMeasureDMM.Enabled = False
            cmdShutdownDMM.Enabled = False
            cmdCancelTest.Enabled = False
            
    End Select
    If DMM1Fnd = 0 Then
    Else
    End If
    Exit Sub
    
ErrorHandler:
    If Err.Number = 48 And Err.Description = "File not found: Gpib-32.dll" Then
        lblDMMStatus.Caption = Not GPIB
        DMM1Fnd = -1
    Else
        MsgBox "Error Number: " & Err.Number & vbCrLf & Err.Description, vbCritical, "Error"
    End If
    Resume Next
    
End Sub

Private Sub cmdShutdownDMM_Click()
    'Return the DMM to HP34401A language set
    Call ibwrt(vmHp34401A_1, "L1")
    'Take the devices back to local mode
    ibloc vmHp34401A_1
    'Close the GPIB connection
    ibonl vmHp34401A_1, 0

    'Give the current status of the Multimeter
    lblDMMStatus.Caption = "DMM Shutdown"
    
    'ReEnable the initialize DMM button
    cmdSetupDMM1.Enabled = True
End Sub

Private Sub dlbDrive_Change()
    flbDataLogLocation.Path = dlbDrive.Drive
End Sub

Private Sub Form_Load()
    'Setup the drive list box
    txtDataLogPath.Text = App.Path
    Me.Top = 2000
    Me.Left = 2000
    'Initialize the Read buffer with all spaces
    ReadBuff = Space(64)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    
    If vmHp34401A_1 <> 0 Then
        'Return the DMM to HP34401A language set
        Call ibwrt(vmHp34401A_1, "L1")
        'Take the device back to local mode
        ibloc vmHp34401A_1
        'Close the GPIB connection
        ibonl vmHp34401A_1, 0
    
        'Give the current status of the Multimeter
        lblDMMStatus.Caption = "DMM Shutdown"
    End If
End Sub

Private Sub MSChart1_OLEStartDrag(Data As MSChart20Lib.DataObject, AllowedEffects As Long)
With MSChart1
      ' Displays a 2d chart with 1023 columns and 10000 rows
      ' data.
      .chartType = VtChChartType2dLine
      .ColumnCount = 8
      .RowCount = 8
      For Column = 1 To 8
         For Row = 1 To 8
            .Column = Column
            .Row = Row
            .Data = Row * 10
         Next Row
      Next Column
      ' Use the chart as the backdrop of the legend.
      .ShowLegend = True
      .SelectPart VtChPartTypePlot, index1, index2, _
      index3, index4
      .EditCopy
      .SelectPart VtChPartTypeLegend, index1, _
      index2, index3, index4
      .EditPaste
   End With

End Sub

Private Sub txtDataLogID_Change()
    txtDatalogFile.Text = txtDataLogID.Text & ".txt"
End Sub