frmabout.frm

AD9954源码

        ShellOpenEx = False
    End If
End Function


Private Sub cmdSysInfo_Click()
  Call StartSysInfo
End Sub

Private Sub cmdOK_Click()
  Unload Me
End Sub

Private Sub Form_Load()

    'Create an instance of the adilocaleinfo class
    Set MyLocInfo = New adiLocaleInfo
    
    Me.Caption = "About " & App.Title
    'lblVersion.Caption = "Ver " & App.Major & "." & App.Minor & "." & App.Revision
    If App.Revision = 0 Then
        lblTitle.Caption = App.Title & " " & "Version " & App.Major & "." & App.Minor
    Else
        lblTitle.Caption = App.Title & " " & "Version " & App.Major & "." & App.Minor & "." & App.Revision 'Left(App.Revision, InStr(1, App.Revision, "0") - 1)
    End If
    lblCopyright.Caption = App.LegalCopyright
    lblCountrySet.Caption = " " & MyLocInfo.GetLocaleInfo(adiCountry)

    'Destruct the instance of the adilocaleinfo class
    Set MyLocInfo = Nothing
    
    'Make the form modeless
    Call MakeFormModeless(Me, mdiMain.hWnd)
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    'Store the keys if the alt key is pressed
    If Shift = 6 Then 'Check for the Control + Alt key combo
        If KeyCode = vbKeyControl Or KeyCode = vbKeyMenu Then
'            'Clear the string because the control and alt keys were just
'            'pressed and the user wants to enter a new password
            strPWEntry = ""
        ElseIf KeyCode >= 65 And KeyCode <= 90 Then
'            'Store the key in a string
            strPWEntry = strPWEntry + Chr(KeyCode)
        End If
    End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    'Check for the menu key code
    If KeyCode = vbKeyControl Or KeyCode = vbKeyMenu Then
        'Insert password checking here
        #If conIncFrm Then
        If strPWEntry = frm.PW Then
'            'Set the program into engineering mode
'            SetEngMode True
            'frm.Visible = True
            frm.Show
            
        End If
        #End If
        
        Select Case UCase(strPWEntry)
            Case "ADIFULLENGMODE"
                SetEngMode 1
            Case "ADIFAMODE"
                SetEngMode 2
            Case "DEBUGMODE"
                SetEngMode 3
            Case "NORMALMODE"
                SetEngMode 0
        End Select

                
        'Set the engineering mode
'        If strPWEntry = "ADIFULLENGMODE" Then
'            mdiMain.SetEngMode 1
'        End If
'
'        If strPWEntry = "ENGMODE" Then
'            mdiMain.SetEngMode 2
'        End If
'
'        If strPWEntry = "DEBUGMODE" Then
'            mdiMain.SetEngMode 3
'        End If
'
'        If strPWEntry = "NORMALMODE" Then
'            mdiMain.SetEngMode 0
'        End If
'
'        If sKeyString = FullEngModePswd Then
'            'Set the program into engineering mode
'            SetFullEngMode True
'        End If
        
    End If
End Sub

'Modified version of "StartSysInfo" subroutine that simply
'checks to see if sysinfo is available.
Public Function IsSysInfoAvail() As Boolean
    On Error GoTo SysInfoErr
  
    Dim rc As Long
    Dim SysInfoPath As String
    
    ' Try To Get System Info Program Path\Name From Registry...
    If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
    ' Try To Get System Info Program Path Only From Registry...
    ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
        ' Validate Existance Of Known 32 Bit File Version
        If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
            SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
            
        ' Error - File Can Not Be Found...
        Else
            GoTo SysInfoErr
        End If
    ' Error - Registry Entry Can Not Be Found...
    Else
        GoTo SysInfoErr
    End If
    
    'Return true
    IsSysInfoAvail = True
    
    Exit Function
SysInfoErr:
    'Return false
    IsSysInfoAvail = False
End Function

Public Sub StartSysInfo()
    On Error GoTo SysInfoErr
  
    Dim rc As Long
    Dim SysInfoPath As String
    
    ' Try To Get System Info Program Path\Name From Registry...
    If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
    ' Try To Get System Info Program Path Only From Registry...
    ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
        ' Validate Existance Of Known 32 Bit File Version
        If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
            SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
            
        ' Error - File Can Not Be Found...
        Else
            GoTo SysInfoErr
        End If
    ' Error - Registry Entry Can Not Be Found...
    Else
        GoTo SysInfoErr
    End If
    
    Call Shell(SysInfoPath, vbNormalFocus)
    
    Exit Sub
SysInfoErr:
    MsgBox "System Information Is Unavailable At This Time", vbOKOnly
End Sub

Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
    Dim i As Long                                           ' Loop Counter
    Dim rc As Long                                          ' Return Code
    Dim hKey As Long                                        ' Handle To An Open Registry Key
    Dim hDepth As Long                                      '
    Dim KeyValType As Long                                  ' Data Type Of A Registry Key
    Dim tmpVal As String                                    ' Tempory Storage For A Registry Key Value
    Dim KeyValSize As Long                                  ' Size Of Registry Key Variable
    '------------------------------------------------------------
    ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
    '------------------------------------------------------------
    rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key
    
    If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Error...
    
    tmpVal = String$(1024, 0)                             ' Allocate Variable Space
    KeyValSize = 1024                                       ' Mark Variable Size
    
    '------------------------------------------------------------
    ' Retrieve Registry Key Value...
    '------------------------------------------------------------
    rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
                         KeyValType, tmpVal, KeyValSize)    ' Get/Create Key Value
                        
    If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Errors
    
    If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then           ' Win95 Adds Null Terminated String...
        tmpVal = Left(tmpVal, KeyValSize - 1)               ' Null Found, Extract From String
    Else                                                    ' WinNT Does NOT Null Terminate String...
        tmpVal = Left(tmpVal, KeyValSize)                   ' Null Not Found, Extract String Only
    End If
    '------------------------------------------------------------
    ' Determine Key Value Type For Conversion...
    '------------------------------------------------------------
    Select Case KeyValType                                  ' Search Data Types...
    Case REG_SZ                                             ' String Registry Key Data Type
        KeyVal = tmpVal                                     ' Copy String Value
    Case REG_DWORD                                          ' Double Word Registry Key Data Type
        For i = Len(tmpVal) To 1 Step -1                    ' Convert Each Bit
            KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))   ' Build Value Char. By Char.
        Next
        KeyVal = Format$("&h" + KeyVal)                     ' Convert Double Word To String
    End Select
    
    GetKeyValue = True                                      ' Return Success
    rc = RegCloseKey(hKey)                                  ' Close Registry Key
    Exit Function                                           ' Exit
    
GetKeyError:      ' Cleanup After An Error Has Occured...
    KeyVal = ""                                             ' Set Return Val To Empty String
    GetKeyValue = False                                     ' Return Failure
    rc = RegCloseKey(hKey)                                  ' Close Registry Key
End Function

Private Sub lblDDSWeb_Click()
    'Open a browser window to the Analog Devices home page
    If ShellOpenEx(lblDDSWeb.Caption, "", "", 1) = False Then
        MsgBox "No web browser found.", vbApplicationModal + vbCritical + vbOKOnly, "Couldn't connect to the Web!!!"
    End If
End Sub