aboutdialog.vb

一个界面很好的iRadio收音机 一个界面很好的iRadio收音机

                    Environment.OSVersion.ServicePack.ToString()
            End If
            lblFramework.Text = "NET Framework" & " Version " & _
                GetFrameworkShortVersion()
            If GetFrameworkServicePack() <> "" Or GetFrameworkServicePack() = "0" Then
                lblFramework.Text = lblFramework.Text _
                    & " Service Pack " & GetFrameworkServicePack()
            End If

        Catch ex As System.Exception
            ' This catch will trap any unexpected error.
            MessageBox.Show(ex.Message.ToString, AssemblyTitle, _
                MessageBoxButtons.OK, MessageBoxIcon.Error)
            Throw
        End Try

    End Sub

#End Region

#Region " pnlHeader Mouse Events - Move Form "

    ''' <summary>
    ''' Responds to the left mouse button down on pnlHeader.
    ''' For each movement, the form is moved correspondingly.
    ''' </summary>
    Private Sub pnlHeader_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) Handles pnlHeader.MouseDown

        ' If the left mouse is pressed, release form for movement
        If e.Button = Windows.Forms.MouseButtons.Left Then
            ReleaseCapture()
            SendMessage(Handle, WM_NCLBUTTONDOWN, CType(HTCAPTION, UIntPtr), CType(0, UIntPtr))
        End If
    End Sub

#End Region

#Region " Select Title Font "

    ''' <summary>
    ''' Draw the title on the about box header using a method that measures the size of the text
    ''' and adjusts the font size accordingly.
    ''' </summary>
    ''' <param name="e"> This must be passed to the DrawText method. </param>
    Private Sub lblTitle_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles lblTitle.Paint
        lblTitle.Font = SelectFont(e, AssemblyTitle)
        lblTitle.Height = lblTitle.Font.Height
        lblTitle.Top = CInt(picApplication.Top + Math.Round(picApplication.Height / 2) - Math.Round(lblTitle.Height / 2))
    End Sub

    ''' <summary>
    ''' This method selects the font for the title header label.
    ''' It adjusts the font size to fit the label size.
    ''' </summary>
    ''' <param name="e"> This was passed from the paint event of the title header label. </param>
    ''' <remarks> This code is a modification of a sample in the Visual Studio 2005 documentation. </remarks>
    Private Function SelectFont(ByVal e As PaintEventArgs, ByVal Text As String) As Font
        ' Declare strings to render on the form.
        Dim stringToMeasure As String = Text
        Dim defaultFont As Font = New Font("Verdana", 9, FontStyle.Bold)
        Dim fontSelected As Boolean = False
        Dim i As Integer

        ' Declare fonts
        Dim font() As Font = { _
            New Font("Verdana", 16, FontStyle.Bold), _
            New Font("Verdana", 14, FontStyle.Bold), _
            New Font("Verdana", 12, FontStyle.Bold), _
            New Font("Verdana", 10, FontStyle.Bold), _
            New Font("Verdana", 9, FontStyle.Bold), _
            New Font("Verdana", 8, FontStyle.Bold)}

        ' Set TextFormatFlags to no padding so strings are drawn together.
        Dim flags As TextFormatFlags = TextFormatFlags.NoPadding

        ' Declare a proposed size.
        Dim proposedSize As Size = New Size(lblTitle.Width, lblTitle.Height)

        ' Measure each string with its font and NoPadding value.
        For i = 0 To UBound(font) - 1
            Dim size As Size = TextRenderer.MeasureText(e.Graphics, stringToMeasure, font(i), proposedSize, flags)

            If size.Width <= lblTitle.Width - 10 Then
                fontSelected = True
                Exit For
            End If
        Next

        ' Error trap in case no font is selected
        If fontSelected = False Then
            Return defaultFont
        Else
            Return font(i)
        End If

    End Function

#End Region

#Region " Link Labels "

    ''' <summary>
    ''' EULA (End User License Agreements) used with this about box should be in pdf format.
    ''' This method first check for the existance of the EULA.pdf file, if it is not found,
    ''' an error message is displayed. It could have been deleted or the developer made a mistake
    ''' in the installation program.
    ''' 
    ''' Next the method tries to open the EULA.pdf file by using it's file association with
    ''' with Adobe Reader or Adobe Acrobat. If this fails a message is displayed offering to
    ''' open the user's browser to the Abobe web site. If the user decline, the method ends.
    ''' 
    ''' If an error occurs accessing the Adobe web site, another error message is displayed
    ''' asking the user to check their browser settings and internet connection.
    ''' </summary>
    Private Sub llbEULA_LinkClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles llbEULA.LinkClicked

        If File.Exists(My.Application.Info.DirectoryPath & "\EULA.pdf") Then
            Try
                ' Now display EULA
                Dim startInfo As New _
                    ProcessStartInfo(My.Application.Info.DirectoryPath & "\EULA.pdf")
                startInfo.WindowStyle = ProcessWindowStyle.Normal
                Process.Start(startInfo)
            Catch ex As FileNotFoundException
                ' cannot open file: offer to open browser to Adobe site
                MessageBox.Show("The EULA.pdf file cannot be opened. It appears that Adobe Reader is not" & _
                    "installed on your computer. Do you want to download it now?", _
                    AssemblyTitle, MessageBoxButtons.YesNo, MessageBoxIcon.Question)
                ' open brower if user answers yes, otherwise exit sub.
                If DialogResult = Windows.Forms.DialogResult.Yes Then
                    Try
                        ' open browser to Adobe site.
                        Dim startInfo As New _
                            ProcessStartInfo("http://www.adobe.com/products/acrobat/readstep2.html")
                        Process.Start(startInfo)
                    Catch exc As Net.WebException
                        ' an error occurred
                        MessageBox.Show("The Adobe web site could not be reached. You may want to check " & _
                            "your Internet connection or your browser settings. If you prefer to download " & _
                            "Adobe reader manually, the URL is below." & vbCrLf & vbCrLf & _
                            "http://www.adobe.com/products/acrobat/readstep2.html", AssemblyTitle, _
                            MessageBoxButtons.OK, MessageBoxIcon.Stop)
                    End Try
                Else
                    Exit Sub
                End If
            End Try
        Else
            ' cannot find file
            MessageBox.Show("The EULA.pdf file cannot be found.", AssemblyTitle, _
                MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
        End If

    End Sub

    ''' <summary>
    ''' This method attempts to open an installed email application to send an email to me for technical
    ''' support. If this fails for some reason, or no email application is installed, an error message is
    ''' displayed.
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    ''' <remarks> I usually make this label invisible on freeware and submitted projects because I don't
    ''' want to get a lot of email from confused users. Also, this can easily be modified to point to a
    ''' web site.
    ''' </remarks>
    Private Sub llbSuport_LinkClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles llbSupport.LinkClicked

        Try
            ' Now send email
            Dim startInfo As New ProcessStartInfo("mailto:[e-mail]")
            startInfo.WindowStyle = ProcessWindowStyle.Normal
            Process.Start(startInfo)
        Catch
            ' cannot find email application
            MessageBox.Show("An email application cannot be found.", AssemblyTitle, _
                MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
            Throw
        End Try

    End Sub

#End Region

#Region " Get NET Framework Information "

    ''' <summary>
    ''' This function returns the short version (i.e., 2.0) of the .NET Framework
    ''' the application is running on.
    ''' </summary>
    ''' <returns> Short version as a String. </returns>
    Private Shared Function GetFrameworkShortVersion() As String

        Try
            Return Microsoft.VisualBasic.Left(Environment.Version.ToString, 3)
        Catch ex As NullReferenceException
            Return ""
        End Try

    End Function

    ''' <summary>
    ''' This function returns the service level of the .NET Framework the application is running
    ''' under. This information is only available in the registry.
    ''' </summary>
    ''' <returns> Service Pack as a String. </returns>
    ''' <remarks> If there is no service pack, and empty string is returned.
    ''' Also, no attempt is made to collect information for .NET Framework versions prior to 2.0. </remarks>
    Private Shared Function GetFrameworkServicePack() As String
        Dim strFrameworkMajorVersion As String = Environment.Version.Major.ToString
        Dim strFrameworkMinorVersion As String = Environment.Version.Minor.ToString
        Dim strFrameworkVersion As String = "v" & strFrameworkMajorVersion & "." & _
            strFrameworkMinorVersion & "." & Environment.Version.Build.ToString
        Dim rk As RegistryKey
        Dim strTemp As String

        Try
            ' try each registry key to determine the version, build, and service pack
            If strFrameworkMajorVersion.Trim = "2" And strFrameworkMinorVersion.Trim = "0" Then
                rk = Registry.LocalMachine.OpenSubKey("SOFTWARE\Microsoft\NET Framework Setup\NDP\" & strFrameworkVersion)
                strTemp = rk.GetValue("SP").ToString
                If strTemp <> "0" Then
                    Return strTemp
                Else
                    Return String.Empty
                End If
                rk.Close()
            Else
                Return String.Empty
            End If
        Catch ex As NullReferenceException
            Return String.Empty
        End Try

    End Function

#End Region

#Region " Get User Information "

    ''' <summary>
    ''' This function returns the Customer Organization which is stored in the registry.
    ''' </summary>
    ''' <returns> Customer Organization as String. </returns>
    ''' <remarks> This information is stored in different places on Win32 operating system, i.e., 
    ''' Windows 98 and Windows Me than on Win32NT operating systems, i.e., Windows 2000, Windows XP,
    ''' Windows Server 2003, and Windows Vista.</remarks>
    Private Shared Function GetUserCustomerOrganization() As String

        Try
            Select Case My.Computer.Info.OSPlatform
                Case "Win32"
                    Dim rk As RegistryKey

                    rk = Registry.LocalMachine.OpenSubKey("Software\Microsoft\Windows\CurrentVersion", False)
                    Return rk.GetValue("RegisteredOrganization").ToString
                    rk.Close()

                Case "Win32NT"
                    Dim rk As RegistryKey

                    rk = Registry.LocalMachine.OpenSubKey("Software\Microsoft\Windows NT\CurrentVersion", False)
                    Return rk.GetValue("RegisteredOrganization").ToString
                    rk.Close()

                Case Else
                    Return "Unknown"
            End Select
        Catch ex As NullReferenceException
            Return "Unknown"
        End Try

    End Function

    ''' <summary>
    ''' This function returns the Customer Name which is stored in the registry.
    ''' </summary>
    ''' <returns> Customer Name as String. </returns>
    ''' <remarks> This information is stored in different places on Win32 operating system, i.e., 
    ''' Windows 98 and Windows Me than on Win32NT operating systems, i.e., Windows 2000, Windows XP,
    ''' Windows Server 2003, and Windows Vista.</remarks>
    Private Shared Function GetUserCustomerName() As String

        Try
            Select Case My.Computer.Info.OSPlatform
                Case "Win32"
                    Dim rk As RegistryKey

                    rk = Registry.LocalMachine.OpenSubKey("Software\Microsoft\Windows\CurrentVersion", False)
                    Return rk.GetValue("RegisteredOwner").ToString
                    rk.Close()

                Case "Win32NT"
                    Dim rk As RegistryKey