⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 modmain.bas

📁 Some mathematical functions
💻 BAS
字号:
Attribute VB_Name = "modMain"
'****************************************************************************
'* AD9850 and AD9851 Evaluation Software for Windows 95/98/Me and NT/2000   *
'****************************************************************************
'* Revision    Date    Description                                          *  *
'* 2.1      12/02/2000 Added compatability with Windows NT/2000             *
'* 2.1      01/02/2001 Fixed bug which caused the software to calculate the *
'*                     tunning word improperly when the PLL is enabled      *
'* 2.11     05/04/2001 Fixed bug which manual frequency update mode didn't  *
'*                     work and removed the FUD before loading data into the*
'*                     AD9850 or AD9851.                                    *
'*                     Also fixed the pll being turned off when switching   *
'*                     from Parallel to Serial communication mode.          *
'* 2.2      11/21/2002 Added Windows XP compatability.                      *
'* 2.3      04/17/2003 Added regional compatability for France, Finland...  *
'****************************************************************************

Public AD9850EvalBd As cls9850EVBD
Global Const TWBits = 32
Public LocaleInfo As adiLocaleInfo
Public iDecSep As Integer
Public sDecSep As String
Public TunningWord As Variant
Public DevName As String

Public Type ProductParms
    Product As String
    SoftwareRev As String
    MaxClockFreq As Double
    MinClockFreq As Double
End Type

Public ProdParams As ProductParms

Public Sub Main()
    Dim CmdArgs() As String
    Dim SearchHwnd As Long
    Dim SearchCaption As String
    Dim cntr As Integer
    
    'Get the command line arguments
    CmdArgs() = Split(Command$, " ")
    
    'Check to see if any arguments were passed
    If ElementExists(CmdArgs(), 0) Then
        'Load the Device  Parameters
        Select Case UCase(CmdArgs(0))
            Case "AD9850":
                DevName = "AD9850PP"
                ProdParams.Product = "AD9850"
                ProdParams.MaxClockFreq = 125
                ProdParams.MinClockFreq = 1
            Case "AD9851":
                DevName = "AD9851PP"
                ProdParams.Product = "AD9851"
                ProdParams.MaxClockFreq = 180
                ProdParams.MinClockFreq = 1
            Case Else
                DevName = "AD9850PP"
                ProdParams.Product = "AD9850"
                ProdParams.MaxClockFreq = 125
                ProdParams.MinClockFreq = 1
        End Select
    Else
        DevName = "AD9850PP"
        ProdParams.Product = "AD9850"
        ProdParams.MaxClockFreq = 125
        ProdParams.MinClockFreq = 1
    End If
    'Setup the software
    If App.Revision = 0 Then
        ProdParams.SoftwareRev = App.Major & "." & App.Minor
    Else
        If InStr(1, App.Revision, "0") Then
            ProdParams.SoftwareRev = App.Major & "." & App.Minor & "." & Left(App.Revision, InStr(1, App.Revision, "0") - 1)
        Else
            ProdParams.SoftwareRev = App.Major & "." & App.Minor & App.Revision
        End If
    End If
    
    For cntr = 0 To 1
        'Test for debug mode
        If ElementExists(CmdArgs(), cntr) Then
            If UCase(CmdArgs(cntr)) = "-DEBUG" Then
                'Put the software in debug mode
                frmMain.mnuView.Visible = True
            End If
        End If
    Next cntr
    
    SearchCaption = ProdParams.Product & " Evaluation Software Rev " & App.Major & "." & App.Minor
'        MsgBox "Prevous instance found - Window Caption = " & frmMain.Caption & " Search Caption = " & SearchCaption
    SearchHwnd = FindWindow("ThunderRT6FormDC", SearchCaption)
    'See if there is already a window open for the product
    If App.PrevInstance Or SearchHwnd <> 0 Then
'       MsgBox "Found Window"
        'If minimized, open the window and make it the active window
        If IsIconic(SearchHwnd) Then
            OpenIcon (SearchHwnd)
            SetForegroundWindow (SearchHwnd)
        Else 'else make it the active window
            SetForegroundWindow (SearchHwnd)
        End If
        'Exit the program now
        End
    End If
    
    'Get locale information
    Set LocaleInfo = New adiLocaleInfo
    sDecSep = LocaleInfo.GetLocaleInfo(adiDecimalSep)
    iDecSep = Asc(sDecSep)
    Set LocaleInfo = Nothing
    
    'Load the LPT Selection Menu
    Load frmLPTSelect

    'Load the main form
    Load frmMain
    'Set the main forms Caption in its title bar
    frmMain.Caption = ProdParams.Product & " Evaluation Software Rev " & ProdParams.SoftwareRev

    'Load the debug form
    Load frmDebug

    'Setup the evalboard class
    Set AD9850EvalBd = frmMain.EvBd

    'Reset the main form
    frmMain.ResetForm
    
    'Select LPT1 initially
    Call frmLPTSelect.LPTSelectDialog("Select a LPT Port", "Select the LPT Port that the AD9850 evaluation" & vbCrLf & "board is connected to.", False, 1)

    'Set the app title
    App.Title = ProdParams.Product & " Evaluation Software"
    If ProdParams.Product = "AD9850" Then
        'Hide the pll enable control
        frmMain.apbPLL.Visible = False
    End If
    If ProdParams.Product = "AD9851" Then
        'Set the tooltip text for the external clock box
        frmMain.txtExtClockFreq.ToolTipText = "External Clock must be <= 180 MHz"
        frmMain.txtIntClockFreq.ToolTipText = "Internal Clock must be <= 180 MHz"
        frmMain.cmdReset.ToolTipText = "Resets the AD9851"
        frmMain.apbSleepMode.ToolTipText = "When checked the AD9851 is put into sleep mode"
        frmMain.apbPLL.Visible = True
    End If
    
    'Show the main form
    frmMain.Show

    'Show the detect port connection window
    frmCheckPorts.Show 1

End Sub


Public Sub ExitGracefully()
    'Trash the AD9850 Eval Board object
    Set AD9850EvalBd = Nothing
    Set frmMain.EvBd = Nothing

    Unload frmDebug
    Unload frmMain

    'Unload the lptselection menu
    Unload frmLPTSelect
End Sub

'This function will calculate the decimal value of a tunning word given
'the CarrierFreq, Sysclock and NumberOfBits to generate.
Public Function CalculateDecTuningWord(ByVal CarrierFreq As Double, _
           ByVal SysClock As Double, ByVal NumberOfBits As Integer) _
           As Variant
    
    Dim TunningWord As Variant
    
    '96 Bits is all we can do
    If NumberOfBits > 96 Then
        'Raise an error
        Err.Raise 5, , "Invalid Parameter: NumberOfBits can't exceed 96"
    End If
    
'    If CarrierFreq > SysClock * 0.2 Then
'        Err.Raise 5, , "Invalid Parameter: CarrierFreq must be 20% or less SysClock"
'    End If
    
    'Calculate the tunning word
    'If the user chose the same carrier frequency as the system clock then
    'fudge and subtract one so the tunning word will fit in the register
'    If CarrierFreq >= SysClock Then
'        TunningWord = (2 ^ NumberOfBits) - 1
'    Else
        TunningWord = CDec((CarrierFreq / SysClock) * (2 ^ NumberOfBits))
'    End If
    
    'If the tunning word is 0.999999999999999 then round up to 1
    'to get the first code right
    
    If TunningWord = 0.999999999999999 Then
        TunningWord = CDec(1)
    End If
    
    'Return the decimal value of the tunning word
    CalculateDecTuningWord = TunningWord
    
End Function

Public Function DecTW2CarrierFreq(ByVal DecTW As Variant, ByVal NumTWBits As Integer, ByVal SysClock As Double) As Variant
    'Calculate the carrier frequency
    DecTW2CarrierFreq = CDec((DecTW / (2 ^ NumTWBits)) * SysClock)
End Function

'This function will detect the parallel port connection
'the DUT should be reset before using this function or it may fail
'On return:
'   If successfull the correct the LPT will be selected function will
'   return true.
'   If unsuccessfull the LPT1 will be selected and the function will
'   return false.
Public Function DetectConnection() As Boolean
    Dim cntr As Integer
    
    cntr = 0
        
    'Show the find evalbrd window
    frmChkConctn.Show , frmCheckPorts
    frmChkConctn.Refresh
    
    'Loop
    Do
        'Check the current LPT port to see if it is connected to an eval board
        If CheckConnection(cntr) Then
            'Return true because the connection has been found
            DetectConnection = True
            'Update Status bar
            With frmMain.stbStatus.Panels(1)
                .Picture = frmMain.imgLptConnect(1).Picture
                .ToolTipText = "Eval Board Found on LPT" & frmLPTSelect.lstLPTPorts.ListIndex + 1
            End With
            'Exit the do loop
            Exit Do
        Else
            'Update Status bar
            With frmMain.stbStatus.Panels(1)
                .Picture = frmMain.imgLptConnect(0).Picture
                .ToolTipText = "Eval Board Not Found"
            End With
        End If
        
        'Increment the counter
        cntr = cntr + 1
        'Check to see if we should stop the loop
        If cntr > frmLPTSelect.LPTGetPortCount() Then
            'Return true because the connection has been found
            DetectConnection = False
            'Reselect the LPT1
            frmLPTSelect.LPTSelectPort (0)
            'Exit the do loop
            Exit Do
        End If
    Loop
       
    'Show the find evalbrd window
    Unload frmChkConctn
    
    'End the function all information has been found
End Function

'This function will check the connection specified by lptnum and return
'true if the eval board was detected otherwize returning false
Public Function CheckConnection(Optional ByVal LPTNum As Variant) As Boolean
    Dim RegVal As String

    'Display the check connection form
    If frmChkConctn.Visible = False Then
        'Show the find evalbrd window
        frmChkConctn.Show , frmMain
        frmChkConctn.Refresh
    End If
    
    If Not IsMissing(LPTNum) Then
        'Select the new LPT port
        frmLPTSelect.LPTSelectPort (LPTNum)
    End If
    
    'Set the reset pin high
    AD9850EvalBd.Reset = abvHigh
    
    'Show the animation
    frmChkConctn.AnimateSendRecv
    
    'Check to see if we can read back the Reset Pin value through the Check Signal
    If AD9850EvalBd.Check = abvHigh Then
        'Set the Reset Pin low again
        AD9850EvalBd.Reset = abvLow
        If AD9850EvalBd.Check = abvLow Then
            'Return true
            CheckConnection = True
        End If
    Else
        'Return true
        CheckConnection = False
    End If

End Function

'Tests to see if an element exists
Public Function ElementExists(TestArray() As String, ByVal Element As Integer) As Boolean
    Dim TestVal As Variant
    On Error GoTo ErrHandler
            
    TestVal = TestArray(Element)
    ElementExists = True
    
    'Exit the function before the error handler
    Exit Function
'Error handler
ErrHandler:
    ElementExists = False
End Function
'Formats a string for displaying in a output frequency
Public Function FormatOutFreq(ByRef FreqVal As Variant) As String
    If FreqVal >= 100 Then
        FormatOutFreq = Format(FreqVal, "000.000000000")
    ElseIf OutFreqVal >= 10 Then
        FormatOutFreq = Format(FreqVal, "00.000000000")
    Else
        FormatOutFreq = Format(FreqVal, "0.000000000")
    End If
End Function
Public Function GetClosestOutFreq(ByVal OFStr As String) As String
    Dim LowVal As String
    Dim HiVal As String
    Dim Dummy As Variant
    Dim HiDiff As Double
    Dim LowDiff As Double
    
    'Calculate the tunning word value for the input string
    Dummy = DecFix(CalculateDecTuningWord(OFStr, CDbl(frmMain.txtIntClockFreq.Text), TWBits))
    
    'Calculate the output frequency for the current tunning word
    LowVal = DecTW2CarrierFreq(Dummy, TWBits, CDbl(frmMain.txtIntClockFreq.Text))
    
    'Calculate the next availiable output frequency
    HiVal = DecTW2CarrierFreq(Dummy + 1, TWBits, CDbl(frmMain.txtIntClockFreq.Text))

    'Get the difference between the input value and calculated values
    HiDiff = CDbl(HiVal) - CDbl(OFStr)
    LowDiff = CDbl(OFStr) - CDbl(LowVal)

    'Return the closest value
    If LowDiff < HiDiff Then
        GetClosestOutFreq = LowVal
    Else
        GetClosestOutFreq = HiVal
    End If
    
End Function


Public Sub SetupToolTips()
                
            
    'Set the tooltip text for the external clock box
    frmMain.txtExtClockFreq.ToolTipText = "External Clock must be <= 180 MHz"
    frmMain.txtIntClockFreq.ToolTipText = "Internal Clock must be <= 180 MHz"
    frmMain.cmdReset.ToolTipText = "Resets the AD9851"
    frmMain.apbSleepMode.ToolTipText = "When checked the AD9851 is put into sleep mode"
    frmMain.apbPLL.Visible = True

End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -