elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Arreglado, de nuevo, el registro del warzone (wargame) de EHN


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP) (Moderador: kub0x)
| | | |-+  Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
0 Usuarios y 3 Visitantes están viendo este tema.
Páginas: 1 ... 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 [45] 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 Ir Abajo Respuesta Imprimir
Autor Tema: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)  (Leído 529,046 veces)
Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.874



Ver Perfil
Re: Librería de Snippets !! (Compartan aquí sus snippets)
« Respuesta #440 en: 19 Octubre 2014, 19:55 pm »

Como actualizar el estado del explorador de Windows después de un cambio en el sistema.

Código
  1.    ' Refresh Windows Explorer
  2.    ' ( by Elektro )
  3.    '
  4.    ' Instructions:
  5.    ' 1. Add a reference to "Microsoft Shell And Controls Automation"
  6.    '
  7.    ' Usage Examples:
  8.    ' RefreshWindowsExplorer()
  9.  
  10.    ''' <summary>
  11.    ''' Refreshes all the Windows Explorer instances.
  12.    ''' </summary>
  13.    Private Sub RefreshWindowsExplorer()
  14.  
  15.        ' Indicates the Windows Explorer localized names.
  16.        Dim allowedWindowNames As String() =
  17.            {
  18.                "Windows Explorer",
  19.                "Explorador de archivos"
  20.            }
  21.  
  22.        ' Shell interface instance.
  23.        Dim shell As New Shell32.Shell
  24.  
  25.        ' Refresh the Windows Explorer instances asynchronouslly.
  26.        Threading.Tasks.Task.Factory.StartNew(Sub()
  27.  
  28.                                                  For i As Integer = 0I To (shell.Windows.Count() - 1I)
  29.  
  30.                                                      Dim window As Object = shell.Windows(i)
  31.  
  32.                                                      If allowedWindowNames.Contains(window.Name()) Then
  33.                                                          window.Refresh()
  34.                                                      End If
  35.  
  36.                                                  Next i
  37.  
  38.                                              End Sub)
  39.    End Sub


Ejemplo de uso:

Código
  1.    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
  2.  
  3.        ' Show checkboxes
  4.        My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced",
  5.                                      "AutoCheckSelect", 1, Microsoft.Win32.RegistryValueKind.DWord)
  6.  
  7.        RefreshWindowsExplorer()
  8.  
  9.    End Sub


En línea



Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.874



Ver Perfil
Re: Librería de Snippets !! (Compartan aquí sus snippets)
« Respuesta #441 en: 2 Noviembre 2014, 09:29 am »

Un ayudante para el manejo del CRC-32

Lo he cosmetizado un poco, el código original lo pueden encontrar en http://nmdt.codeplex.com/

Código
  1. #Region " Usage Examples "
  2.  
  3. ' Usage Examples:
  4. ' MsgBox(Crc32.Calculate("C:\File"))
  5. ' MsgBox(Convert.ToString(Crc32.Calculate("C:\File"), 16).ToUpper)
  6.  
  7. #End Region
  8.  
  9. #Region " Imports "
  10.  
  11. Imports System.IO
  12.  
  13. #End Region
  14.  
  15. #Region "CRC-32"
  16.  
  17. ''' <summary>
  18. ''' ISO 3309 CRC-32 Calculator.
  19. ''' </summary>
  20. Public NotInheritable Class Crc32
  21.  
  22. #Region " Variables "
  23.  
  24.    ''' <summary>
  25.    ''' The CRC-32 polynomial.
  26.    ''' </summary>
  27.    Private Shared ReadOnly CRC32Poly As UInteger = &HEDB88320UI
  28.  
  29.    ''' <summary>
  30.    ''' The CRC32 table.
  31.    ''' </summary>
  32.    Private Shared Crc32Table(0UI To 255UI) As UInteger
  33.  
  34. #End Region
  35.  
  36. #Region " Constructors "
  37.  
  38.    ''' <summary>
  39.    ''' Prevents a default instance of the <see cref="Crc32"/> class from being created.
  40.    ''' </summary>
  41.    Private Sub New()
  42.    End Sub
  43.  
  44.    ''' <summary>
  45.    ''' Initialize the CRC table from the polynomial.
  46.    ''' </summary>
  47.    Shared Sub New()
  48.  
  49.        Dim i As UInteger
  50.        Dim j As UInteger
  51.        Dim l As UInteger
  52.  
  53.        For i = 0 To 255
  54.  
  55.            j = i
  56.  
  57.            For l = 0 To 7
  58.  
  59.                If (j And 1) Then
  60.                    j = ((j >> 1) Xor CRC32Poly)
  61.                Else
  62.                    j >>= 1
  63.                End If
  64.  
  65.            Next l
  66.  
  67.            Crc32Table(i) = j
  68.  
  69.        Next i
  70.  
  71.    End Sub
  72.  
  73. #End Region
  74.  
  75. #Region " Public Methods "
  76.  
  77.    ''' <summary>
  78.    ''' Validates a file against an input CRC.
  79.    ''' </summary>
  80.    ''' <param name="fileName">Filename of the file to validate.</param>
  81.    ''' <param name="inputCrc">The CRC value against which the validation should occur.</param>
  82.    ''' <returns>True if the input CRC matches the calculated CRC of the data.</returns>
  83.    Public Shared Function Validate(ByVal fileName As String,
  84.                                    ByVal inputCrc As UInteger) As Boolean
  85.  
  86.        Return Calculate(fileName) = inputCrc
  87.  
  88.    End Function
  89.  
  90.    ''' <summary>
  91.    ''' Validates a byte array against an input CRC.
  92.    ''' </summary>
  93.    ''' <param name="data">The byte array to validate.</param>
  94.    ''' <param name="inputCrc">The CRC value against which the validation should occur.</param>
  95.    ''' <returns>True if the input CRC matches the calculated CRC of the data.</returns>
  96.    Public Shared Function Validate(ByVal data() As Byte,
  97.                                    ByVal inputCrc As UInteger) As Boolean
  98.  
  99.        Return Calculate(data) = inputCrc
  100.  
  101.    End Function
  102.  
  103.    ''' <summary>
  104.    ''' Calculate the CRC-32 of a file.
  105.    ''' </summary>
  106.    ''' <param name="fileName">Filename of the file to calculate.</param>
  107.    ''' <param name="bufflen">Specify the size, in bytes, of the read buffer to be used (default is 1k).</param>
  108.    ''' <returns>A 32-bit unsigned integer representing the calculated CRC.</returns>
  109.    ''' <exception cref="System.IO.FileNotFoundException">fileName could not be found.</exception>
  110.    Public Shared Function Calculate(ByVal fileName As String,
  111.                                     Optional ByVal bufflen As Integer = 1024) As UInteger
  112.  
  113.        If (Not File.Exists(fileName)) Then
  114.            Throw New FileNotFoundException(fileName & " could not be found.")
  115.            Return 0
  116.        End If
  117.  
  118.        Return Calculate(New FileStream(fileName, FileMode.Open, FileAccess.Read, FileShare.Read), bufflen)
  119.  
  120.    End Function
  121.  
  122.    ''' <summary>
  123.    ''' Calculate the CRC-32 of an array of bytes.
  124.    ''' </summary>
  125.    ''' <param name="data">Byte array containing the bytes to calculate.</param>
  126.    ''' <param name="startIndex">Specifies the starting index to begin the calculation (default is 0).</param>
  127.    ''' <param name="length">Specify the length of the byte array to check (default is -1, or all bytes).</param>
  128.    ''' <param name="crc">Input CRC value for ongoing calculations (default is FFFFFFFFh).</param>
  129.    ''' <returns>A 32-bit unsigned integer representing the calculated CRC.</returns>
  130.    ''' <exception cref="System.ArgumentNullException">data;data cannot be equal to null.</exception>
  131.    ''' <exception cref="System.ArgumentOutOfRangeException">length;length must be -1 or a positive number.</exception>
  132.    Public Shared Function Calculate(ByVal data() As Byte,
  133.                                     Optional ByVal startIndex As Integer = 0I,
  134.                                     Optional ByVal length As Integer = -1I,
  135.                                     Optional ByVal crc As UInteger = &HFFFFFFFFUI) As UInteger
  136.  
  137.        If data Is Nothing Then
  138.            Throw New ArgumentNullException("data", "data cannot be equal to null.")
  139.        End If
  140.  
  141.        If length = -1 Then
  142.            length = data.Length - startIndex
  143.        End If
  144.  
  145.        If length <= 0 Then
  146.            Throw New ArgumentOutOfRangeException("length", "length must be -1 or a positive number.")
  147.        End If
  148.  
  149.        Dim j As Integer
  150.        Dim c As Integer = length - 1
  151.  
  152.        For j = startIndex To c
  153.            crc = Crc32Table((crc Xor data(j)) And &HFF) Xor (crc >> 8)
  154.        Next j
  155.  
  156.        Calculate = crc Xor &HFFFFFFFFUI
  157.  
  158.    End Function
  159.  
  160.    ''' <summary>
  161.    ''' Calculate the CRC-32 of a Stream.
  162.    ''' </summary>
  163.    ''' <param name="stream">The Stream to calculate.</param>
  164.    ''' <param name="bufflen">Specify the size, in bytes, of the read buffer to be used (default is 1k).</param>
  165.    ''' <param name="closeStream">if set to <c>true</c> the stream gets closed after CRC-32 is calculated.</param>
  166.    ''' <returns>A 32-bit unsigned integer representing the calculated CRC.</returns>
  167.    Public Shared Function Calculate(ByVal stream As Stream,
  168.                                     Optional ByVal bufflen As Integer = 1024I,
  169.                                     Optional ByVal closeStream As Boolean = True) As UInteger
  170.  
  171.        '' our working marshal buffer will be 1k, this is a good compromise between eating up memory and efficiency.
  172.        Dim blen As Integer = bufflen
  173.        Dim crc As UInteger = &HFFFFFFFFUI
  174.  
  175.        Dim b() As Byte
  176.  
  177.        Dim i As Long
  178.        Dim l As Long = stream.Length
  179.        Dim c As Long = l - 1
  180.  
  181.        Dim e As Integer
  182.        Dim j As Integer
  183.  
  184.        ReDim b(blen - 1)
  185.  
  186.        For i = 0 To c Step blen
  187.  
  188.            e = CInt(l - i)
  189.  
  190.            If e > blen Then
  191.                e = blen
  192.            End If
  193.  
  194.            If (stream.Position <> i) Then
  195.                stream.Seek(i, SeekOrigin.Begin)
  196.            End If
  197.  
  198.            stream.Read(b, 0, e)
  199.  
  200.            e -= 1
  201.  
  202.            For j = 0 To e
  203.                crc = Crc32Table((crc Xor b(j)) And &HFF) Xor (crc >> 8)
  204.            Next j
  205.  
  206.        Next i
  207.  
  208.        If (closeStream) Then
  209.            stream.Close()
  210.        End If
  211.  
  212.        Calculate = crc Xor &HFFFFFFFFUI
  213.  
  214.    End Function
  215.  
  216. #End Region
  217.  
  218. End Class
  219.  
  220. #End Region


En línea



Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.874



Ver Perfil
Re: Librería de Snippets !! (Compartan aquí sus snippets)
« Respuesta #442 en: 30 Noviembre 2014, 01:42 am »

Una actualización de este ayudante para "renombrar" o capitalizar un String, dándole el formato deseado.

Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 29-November-2014
  4. ' ***********************************************************************
  5. ' <copyright file="StringRenamer.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Option Statements "
  11.  
  12. Option Explicit On
  13. Option Strict On
  14. Option Infer Off
  15.  
  16. #End Region
  17.  
  18. #Region " Usage Examples "
  19.  
  20. ' MsgBox(StringRenamer.Rename("Hello World!", StringRenamer.FormatCase.Upper))
  21. ' MsgBox(StringRenamer.Rename("Hello World!", StringRenamer.FormatCase.Upper, "\s+", "-", System.Text.RegularExpressions.RegexOptions.None))
  22.  
  23. #End Region
  24.  
  25. #Region " Imports "
  26.  
  27. Imports System.Text
  28. Imports System.Text.RegularExpressions
  29. Imports System.Globalization
  30.  
  31. #End Region
  32.  
  33. #Region " String Renamer "
  34.  
  35. ''' <summary>
  36. ''' Renames a string.
  37. ''' </summary>
  38. Public NotInheritable Class StringRenamer
  39.  
  40. #Region " Enumerations "
  41.  
  42.    ''' <summary>
  43.    ''' Specifies a string format case.
  44.    ''' </summary>
  45.    Public Enum FormatCase As Integer
  46.  
  47.        ''' <summary>
  48.        ''' LowerCase
  49.        '''
  50.        ''' [Example]
  51.        ''' Input : ABCDEF
  52.        ''' Output: abcdef
  53.        ''' </summary>
  54.        Lower = &H0
  55.  
  56.        ''' <summary>
  57.        ''' UpperCase.
  58.        '''
  59.        ''' [Example]
  60.        ''' Input : abcdef
  61.        ''' Output: ABCDEF
  62.        ''' </summary>
  63.        Upper = &H1
  64.  
  65.        ''' <summary>
  66.        ''' TitleCase.
  67.        '''
  68.        ''' [Example]
  69.        ''' Input : abcdef
  70.        ''' Output: Abcdef
  71.        ''' </summary>
  72.        Title = &H2
  73.  
  74.        ''' <summary>
  75.        ''' WordCase.
  76.        '''
  77.        ''' [Example]
  78.        ''' Input : abc def
  79.        ''' Output: Abc Def
  80.        ''' </summary>
  81.        Word = &H3
  82.  
  83.        ''' <summary>
  84.        ''' CamelCase (With first letter to LowerCase).
  85.        '''
  86.        ''' [Example]
  87.        ''' Input : ABC DEF
  88.        ''' Output: abcDef
  89.        ''' </summary>
  90.        CamelLower = &H4
  91.  
  92.        ''' <summary>
  93.        ''' CamelCase (With first letter to UpperCase).
  94.        '''
  95.        ''' [Example]
  96.        ''' Input : ABC DEF
  97.        ''' Output: AbcDef
  98.        ''' </summary>
  99.        CamelUpper = &H5
  100.  
  101.        ''' <summary>
  102.        ''' MixedCase (With first letter to LowerCase).
  103.        '''
  104.        ''' [Example]
  105.        ''' Input : ab cd ef
  106.        ''' Output: aB Cd eF
  107.        ''' </summary>
  108.        MixedTitleLower = &H6
  109.  
  110.        ''' <summary>
  111.        ''' MixedCase (With first letter to UpperCase).
  112.        '''
  113.        ''' [Example]
  114.        ''' Input : ab cd ef
  115.        ''' Output: Ab cD Ef
  116.        ''' </summary>
  117.        MixedTitleUpper = &H7
  118.  
  119.        ''' <summary>
  120.        ''' MixedCase (With first letter of each word to LowerCase).
  121.        '''
  122.        ''' [Example]
  123.        ''' Input : ab cd ef
  124.        ''' Output: aB cD eF
  125.        ''' </summary>
  126.        MixedWordLower = &H8
  127.  
  128.        ''' <summary>
  129.        ''' MixedCase (With first letter of each word to UpperCase).
  130.        '''
  131.        ''' [Example]
  132.        ''' Input : ab cd ef
  133.        ''' Output: Ab Cd Ef
  134.        ''' </summary>
  135.        MixedWordUpper = &H9
  136.  
  137.        ''' <summary>
  138.        ''' ToggleCase.
  139.        '''
  140.        ''' [Example]
  141.        ''' Input : abc def ghi
  142.        ''' Output: aBC dEF gHI
  143.        ''' </summary>
  144.        Toggle = &H10
  145.  
  146.        ''' <summary>
  147.        ''' Duplicates the characters.
  148.        '''
  149.        ''' [Example]
  150.        ''' Input : Hello World!
  151.        ''' Output: HHeelllloo  WWoorrlldd!!
  152.        ''' </summary>
  153.        Duplicated = &H11
  154.  
  155.        ''' <summary>
  156.        ''' Inverts the characters.
  157.        '''
  158.        ''' [Example]
  159.        ''' Input : Hello World!
  160.        ''' Output: hELLO wORLD!
  161.        ''' </summary>
  162.        Inverted = &H12
  163.  
  164.    End Enum
  165.  
  166. #End Region
  167.  
  168. #Region " Publix Methods "
  169.  
  170. #End Region
  171.  
  172.    ''' <summary>
  173.    ''' Renames a string to the specified StringCase.
  174.    ''' </summary>
  175.    ''' <param name="str">The string to rename.</param>
  176.    ''' <param name="fCase">The format case.</param>
  177.    ''' <returns>The renamed string.</returns>
  178.    Public Shared Function Rename(ByVal str As String,
  179.                                  ByVal fCase As FormatCase) As String
  180.  
  181.        Select Case fCase
  182.  
  183.            Case FormatCase.Lower
  184.                Return str.ToLower
  185.  
  186.            Case FormatCase.Upper
  187.                Return str.ToUpper
  188.  
  189.            Case FormatCase.Title
  190.                Return Char.ToUpper(str.First) & str.Substring(1).ToLower
  191.  
  192.            Case FormatCase.Word
  193.                Return CultureInfo.InvariantCulture.TextInfo.ToTitleCase(str.ToLower)
  194.  
  195.            Case FormatCase.CamelLower
  196.                Return Char.ToLower(str.First) &
  197.                       CultureInfo.InvariantCulture.TextInfo.ToTitleCase(str.ToLower).
  198.                       Replace(" "c, String.Empty).
  199.                       Substring(1)
  200.  
  201.            Case FormatCase.CamelUpper
  202.                Return Char.ToUpper(str.First) &
  203.                       CultureInfo.InvariantCulture.TextInfo.ToTitleCase(str.ToLower).
  204.                       Replace(" "c, String.Empty).
  205.                       Substring(1)
  206.  
  207.            Case FormatCase.MixedTitleLower
  208.                Dim sb As New StringBuilder
  209.                For i As Integer = 0 To (str.Length - 1) Step 2
  210.                    If Not (i + 1) >= str.Length Then
  211.                        sb.Append(Char.ToLower(str(i)) & Char.ToUpper(str(i + 1)))
  212.                    Else
  213.                        sb.Append(Char.ToLower(str(i)))
  214.                    End If
  215.                Next i
  216.                Return sb.ToString
  217.  
  218.            Case FormatCase.MixedTitleUpper
  219.                Dim sb As New StringBuilder
  220.                For i As Integer = 0 To (str.Length - 1) Step 2
  221.                    If Not (i + 1) >= str.Length Then
  222.                        sb.Append(Char.ToUpper(str(i)) & Char.ToLower(str(i + 1)))
  223.                    Else
  224.                        sb.Append(Char.ToUpper(str(i)))
  225.                    End If
  226.                Next i
  227.                Return sb.ToString
  228.  
  229.            Case FormatCase.MixedWordLower
  230.                Dim sb As New StringBuilder
  231.                For Each token As String In str.Split
  232.                    sb.Append(StringRenamer.Rename(token, FormatCase.MixedTitleLower) & " ")
  233.                Next token
  234.                Return sb.ToString
  235.  
  236.            Case FormatCase.MixedWordUpper
  237.                Dim sb As New StringBuilder
  238.                For Each token As String In str.Split
  239.                    sb.Append(StringRenamer.Rename(token, FormatCase.MixedTitleUpper) & " ")
  240.                Next token
  241.                Return sb.ToString
  242.  
  243.            Case FormatCase.Toggle
  244.                Dim sb As New StringBuilder
  245.                For Each token As String In str.Split
  246.                    sb.Append(Char.ToLower(token.First) & token.Substring(1).ToUpper & " ")
  247.                Next token
  248.                Return sb.ToString
  249.  
  250.            Case FormatCase.Duplicated
  251.                Dim sb As New StringBuilder
  252.                For Each c As Char In str
  253.                    sb.Append(New String(c, 2))
  254.                Next c
  255.                Return sb.ToString
  256.  
  257.            Case FormatCase.Inverted
  258.                Dim sb As New StringBuilder
  259.                For Each c As Char In str
  260.                    sb.Append(If(Char.IsLower(c),
  261.                                 Char.ToUpper(c),
  262.                                 Char.ToLower(c)))
  263.                Next c
  264.                Return sb.ToString
  265.  
  266.            Case Else
  267.                Return str
  268.  
  269.        End Select
  270.  
  271.    End Function
  272.  
  273.    ''' <summary>
  274.    ''' Rename a string to the specified StringCase,
  275.    ''' Also finds and replaces text after the string is renamed.
  276.    ''' </summary>
  277.    ''' <param name="str">The string to rename.</param>
  278.    ''' <param name="fCase">The format case.</param>
  279.    ''' <param name="FindWhat">The RegEx pattern to match.</param>
  280.    ''' <param name="ReplaceWith">The replacement string.</param>
  281.    ''' <param name="regexOptions">The RegEx options.</param>
  282.    ''' <returns>The renamed string.</returns>
  283.    Public Shared Function Rename(ByVal str As String,
  284.                                  ByVal fCase As FormatCase,
  285.                                  ByVal findWhat As String,
  286.                                  ByVal replaceWith As String,
  287.                                  ByVal regexOptions As RegexOptions) As String
  288.  
  289.        Return Regex.Replace(StringRenamer.Rename(str, fCase),
  290.                             findWhat,
  291.                             replaceWith,
  292.                             regexOptions)
  293.  
  294.    End Function
  295.  
  296. End Class
  297.  
  298. #End Region



Ejemplo de como filtrar las extensiones mostradas en un FolderView control, de la librería shell mega pack: http://www.ssware.com/fldrview.htm



Código
  1.        ''' <summary>
  2.        ''' Handles the AfterExpand event of the FolderView1 control.
  3.        ''' </summary>
  4.        ''' <param name="sender">The source of the event.</param>
  5.        ''' <param name="e">The <see cref="FolderViewEventArgs"/> instance containing the event data.</param>
  6.        Private Sub FolderView1_AfterExpand(ByVal sender As Object, ByVal e As FolderViewEventArgs) _
  7.        Handles FolderView1.AfterExpand
  8.  
  9.            ' This event occurs when node is expanded.
  10.  
  11.            If e.Node.HasExpandedOnce Then
  12.                Exit Sub
  13.            End If
  14.  
  15.            Me.FilterNodeFiles(folderView:=DirectCast(sender, FolderView),
  16.                               allowedExtensions:=".mp3".ToLower.Split)
  17.  
  18.        End Sub
  19.  
  20.        ''' <summary>
  21.        ''' Handles the BeforeNodeSort event of the FolderView1 control.
  22.        ''' </summary>
  23.        ''' <param name="sender">The source of the event.</param>
  24.        ''' <param name="e">The <see cref="BeforeNodeSortEventArgs"/> instance containing the event data.</param>
  25.        Private Sub FolderView1_BeforeNodeSort(sender As Object, e As BeforeNodeSortEventArgs) _
  26.        Handles FolderView1.BeforeNodeSort
  27.  
  28.            ' This event occurs when a file is created/moved/pasted inside a node.
  29.  
  30.            Me.FilterNodeFiles(folderView:=DirectCast(sender, FolderView),
  31.                               allowedExtensions:=".mp3".ToLower.Split)
  32.  
  33.        End Sub
  34.  
  35.        ''' <summary>
  36.        ''' Filters the files that can be shown in the TreeNodes of a <see cref="FolderView"/>.
  37.        ''' </summary>
  38.        ''' <param name="folderView">The <see cref="FolderView"/>.</param>
  39.        ''' <param name="allowedExtensions">The allowed file extensions.</param>
  40.        Private Sub FilterNodeFiles(ByVal folderView As FolderView, ByVal allowedExtensions() As String)
  41.  
  42.            For Each node As FOVTreeNode In folderView.Nodes.Cast(Of FOVTreeNode).Reverse
  43.  
  44.                If Not (node.IsFolder) _
  45.                AndAlso Not (allowedExtensions.Contains(IO.Path.GetExtension(node.Text).ToLower)) Then
  46.  
  47.                    node.Delete()
  48.  
  49.                End If
  50.  
  51.            Next node
  52.  
  53.        End Sub
  54.  



Una actualización de este ayudante de la librería TagLibSharp, para la edición de metadats de archivos de audio, ese wrapper está orientado al manejo de archivos MP3 solamente.

Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 29-Novembder-2014
  4. ' ***********************************************************************
  5. ' <copyright file="TagLibSharp Helper.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. 'Dim tagger As New TagLibSharpHelper
  13. 'tagger.LoadFile("C:\Users\Administrador\Desktop\1.mp3")
  14.  
  15. 'Dim sb As New System.Text.StringBuilder
  16. 'With sb
  17. '    .AppendLine(String.Format("Is Corrupt?: {0}", tagger.IsCorrupt))
  18. '    .AppendLine(String.Format("Is Writeable?: {0}", tagger.IsWriteable))
  19. '    .AppendLine()
  20. '    .AppendLine(String.Format("Tags: {0}", tagger.GetTags))
  21. '    .AppendLine()
  22. '    .AppendLine(String.Format("Title: {0}", tagger.GetTitle))
  23. '    .AppendLine(String.Format("Artist: {0}", tagger.GetArtist))
  24. '    .AppendLine(String.Format("Album: {0}", tagger.GetAlbum))
  25. '    .AppendLine(String.Format("Genre: {0}", tagger.GetGenre))
  26. '    .AppendLine(String.Format("Year: {0}", tagger.GetYear))
  27. 'End With
  28. 'MessageBox.Show(sb.ToString)
  29.  
  30. 'tagger.RemoveTag(TagLib.TagTypes.Id3v1 Or TagLib.TagTypes.Id3v2) ' Removes ID3v1 + ID3v2 Tags
  31.  
  32. 'tagger.SetTag(Sub(x As TagLib.File) x.Tag.Title = "Title Test")
  33.  
  34. 'tagger.SetTags({Sub(x As TagLib.File) x.Tag.Title = "Title Test",
  35. '                Sub(x As TagLib.File) x.Tag.Performers = {"My Artist"}})
  36.  
  37. #End Region
  38.  
  39. #Region " Option Statements "
  40.  
  41. Option Strict On
  42. Option Explicit On
  43. Option Infer Off
  44.  
  45. #End Region
  46.  
  47. #Region " Imports "
  48.  
  49. Imports TagLib
  50.  
  51. #End Region
  52.  
  53. #Region " TagLibSharp Helper "
  54.  
  55. Public NotInheritable Class TagLibSharpHelper
  56.  
  57. #Region " Properties "
  58.  
  59.    ''' <summary>
  60.    ''' Gets or sets the <see cref="TagLib.File"/> object.
  61.    ''' </summary>
  62.    ''' <value>The <see cref="TagLib.File"/> object.</value>
  63.    Private Property TagFile As TagLib.File
  64.  
  65.    Public ReadOnly Property CurrentFile As String
  66.        Get
  67.            Return Me.TagFile.Name
  68.        End Get
  69.    End Property
  70.  
  71. #End Region
  72.  
  73. #Region " Constructors "
  74.  
  75.    ''' <summary>
  76.    ''' Initializes a new instance of the <see cref="TagLibSharpHelper"/> class.
  77.    ''' </summary>
  78.    Public Sub New()
  79.    End Sub
  80.  
  81.    ''' <summary>
  82.    ''' Initializes a new instance of the <see cref="TagLibSharpHelper" /> class.
  83.    ''' </summary>
  84.    ''' <param name="file">The file to load.</param>
  85.    Public Sub New(ByVal file As String)
  86.        Me.LoadFile(file)
  87.    End Sub
  88.  
  89. #End Region
  90.  
  91. #Region " Public Methods "
  92.  
  93.    ''' <summary>
  94.    ''' Instances a file.
  95.    ''' </summary>
  96.    ''' <param name="file">The file to load.</param>
  97.    Public Sub LoadFile(ByVal file As String)
  98.  
  99.        Try
  100.            Me.TagFile = TagLib.File.Create(file)
  101.  
  102.        Catch ex As CorruptFileException
  103.            Throw
  104.  
  105.        Catch ex As UnsupportedFormatException
  106.            Throw
  107.  
  108.        Catch ex As Exception
  109.            Throw
  110.  
  111.        End Try
  112.  
  113.    End Sub
  114.  
  115.    ''' <summary>
  116.    ''' Determines whether the current file is possibly corrupted.
  117.    ''' </summary>
  118.    Public Function IsCorrupt() As Boolean
  119.  
  120.        Me.CheckTagFile()
  121.        Return Me.TagFile.PossiblyCorrupt
  122.  
  123.    End Function
  124.  
  125.    ''' <summary>
  126.    ''' Determines whether the current file can be written.
  127.    ''' </summary>
  128.    Public Function IsWriteable() As Boolean
  129.  
  130.        Me.CheckTagFile()
  131.        Return Me.TagFile.Writeable
  132.  
  133.    End Function
  134.  
  135.    ''' <summary>
  136.    ''' Get TagTypes of file.
  137.    ''' </summary>
  138.    Public Function GetTags() As String
  139.  
  140.        Me.CheckTagFile()
  141.        Return Me.TagFile.TagTypesOnDisk.ToString
  142.  
  143.    End Function
  144.  
  145.    ''' <summary>
  146.    ''' Gets the Title tag of the current file.
  147.    ''' </summary>
  148.    Public Function GetTitle() As String
  149.  
  150.        Me.CheckTagFile()
  151.        Return Me.TagFile.Tag.Title
  152.  
  153.    End Function
  154.  
  155.    ''' <summary>
  156.    ''' Gets the Artist tag of the current file.
  157.    ''' </summary>
  158.    Public Function GetArtist() As String
  159.  
  160.        Me.CheckTagFile()
  161.  
  162.        If Me.TagFile.Tag.Performers.Count <> 0 Then
  163.            Return Me.TagFile.Tag.Performers(0)
  164.  
  165.        Else
  166.            Return String.Empty
  167.  
  168.        End If
  169.  
  170.    End Function
  171.  
  172.    ''' <summary>
  173.    ''' Gets the Album tag of the current file.
  174.    ''' </summary>
  175.    Public Function GetAlbum() As String
  176.  
  177.        Me.CheckTagFile()
  178.        Return Me.TagFile.Tag.Album
  179.  
  180.    End Function
  181.  
  182.    ''' <summary>
  183.    ''' Gets the Genre tag of the current file.
  184.    ''' </summary>
  185.    Public Function GetGenre() As String
  186.  
  187.        Me.CheckTagFile()
  188.        If Me.TagFile.Tag.Genres.Count <> 0 Then
  189.            Return Me.TagFile.Tag.Genres(0)
  190.  
  191.        Else
  192.            Return String.Empty
  193.  
  194.        End If
  195.  
  196.    End Function
  197.  
  198.    ''' <summary>
  199.    ''' Gets the Year tag of the current file.
  200.    ''' </summary>
  201.    Public Function GetYear() As String
  202.  
  203.        Me.CheckTagFile()
  204.        Return Me.TagFile.Tag.Year.ToString
  205.  
  206.    End Function
  207.  
  208.    ''' <summary>
  209.    ''' Sets a Tag field.
  210.    ''' </summary>
  211.    Public Sub SetTag(ByVal fieldSetter As Action(Of TagLib.File))
  212.  
  213.        Me.CheckTagFile()
  214.        If Not Me.IsCorrupt AndAlso Me.IsWriteable Then
  215.  
  216.            Try
  217.                fieldSetter(TagFile)
  218.  
  219.            Catch ex As Exception
  220.                Throw
  221.  
  222.            End Try
  223.  
  224.            Me.SaveFile()
  225.  
  226.        End If
  227.  
  228.    End Sub
  229.  
  230.    ''' <summary>
  231.    ''' Sets multiple Tag fields.
  232.    ''' </summary>
  233.    Public Sub SetTags(ByVal fieldSetter() As Action(Of TagLib.File))
  234.  
  235.        Me.CheckTagFile()
  236.        If Not Me.IsCorrupt AndAlso Me.IsWriteable Then
  237.  
  238.            For Each field As Action(Of TagLib.File) In fieldSetter
  239.  
  240.                Try
  241.                    field(TagFile)
  242.  
  243.                Catch ex As Exception
  244.                    Throw
  245.  
  246.                End Try
  247.  
  248.            Next field
  249.  
  250.            Me.SaveFile()
  251.  
  252.        End If
  253.  
  254.    End Sub
  255.  
  256.    ''' <summary>
  257.    ''' Remove a Tag from the current file.
  258.    ''' </summary>
  259.    ''' <param name="tagTypes">The tag types to remove from file.</param>
  260.    Public Sub RemoveTag(ByVal tagTypes As TagTypes)
  261.  
  262.        Me.CheckTagFile()
  263.        If Not Me.IsCorrupt AndAlso Me.IsWriteable Then
  264.  
  265.            Try
  266.                Me.TagFile.RemoveTags(tagTypes)
  267.  
  268.            Catch ex As Exception
  269.                Throw
  270.  
  271.            End Try
  272.  
  273.            Me.SaveFile()
  274.  
  275.        End If
  276.  
  277.    End Sub
  278.  
  279. #End Region
  280.  
  281. #Region " Private Methods "
  282.  
  283.    ''' <summary>
  284.    ''' Saves the current file.
  285.    ''' </summary>
  286.    Private Sub SaveFile()
  287.  
  288.        Me.CheckTagFile()
  289.  
  290.        Try
  291.            Me.TagFile.Save()
  292.  
  293.        Catch ex As Exception
  294.            Throw
  295.  
  296.        End Try
  297.  
  298.    End Sub
  299.  
  300.    ''' <summary>
  301.    ''' Checks whether a <see cref="TagLib.File"/> object is loaded.
  302.    ''' </summary>
  303.    Private Sub CheckTagFile()
  304.  
  305.        If Me.TagFile Is Nothing Then
  306.  
  307.            Throw New Exception("Any file is loaded.")
  308.  
  309.        End If
  310.  
  311.    End Sub
  312.  
  313. #End Region
  314.  
  315. End Class
  316.  
  317. #End Region
  318.  



Ejemplo (...un poco cutre por el momento) de cmo utilizar un KryptonSeparator, del set de controles Krypton: http://www.componentfactory.com/toolkit_utilitycontrols.php



Código
  1.        ''' <summary>
  2.        ''' Handles the SplitterMoving event of the KryptonSeparator1 control.
  3.        ''' </summary>
  4.        ''' <param name="sender">The source of the event.</param>
  5.        ''' <param name="e">The <see cref="SplitterCancelEventArgs"/> instance containing the event data.</param>
  6.        Private Sub KryptonSeparator1_SplitterMoving(ByVal sender As Object, ByVal e As SplitterCancelEventArgs) _
  7.        Handles KryptonSeparator1.SplitterMoving
  8.  
  9.            Dim separator As KryptonSeparator = DirectCast(sender, KryptonSeparator)
  10.            Dim leftCtrl As Control = Me.ListBox1
  11.            Dim rightCtrl As Control = Me.ListBox2
  12.  
  13.            If (e.MouseCursorX > 0) _
  14.            AndAlso Not ((rightCtrl.Size.Width - e.MouseCursorX) < rightCtrl.MinimumSize.Width) Then
  15.  
  16.                separator.Location = New Point(separator.Location.X + e.MouseCursorX, separator.Location.Y)
  17.                leftCtrl.Width += e.MouseCursorX
  18.                rightCtrl.Width -= e.MouseCursorX
  19.                rightCtrl.Left = separator.Right
  20.  
  21.            ElseIf (e.MouseCursorX < 0) _
  22.            AndAlso Not ((leftCtrl.Size.Width + e.MouseCursorX - separator.Width) < leftCtrl.MinimumSize.Width) Then
  23.  
  24.                separator.Location = New Point(separator.Location.X - separator.Width, separator.Location.Y)
  25.                leftCtrl.Width -= separator.Width
  26.                rightCtrl.Width += separator.Width
  27.                rightCtrl.Left = separator.Right
  28.  
  29.            End If
  30.  
  31.        End Sub
  32.  
En línea



Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.874



Ver Perfil
Re: Librería de Snippets !! (Compartan aquí sus snippets)
« Respuesta #443 en: 30 Noviembre 2014, 01:44 am »

Ejemplo de cómo utilizar la librería SharpShell para crear una shell-extensión, un menú contextual para nuestra aplicación: https://sharpshell.codeplex.com



La imagen de arriba no hace referencia al siguiente ejemplo, mi menú tiene la siguiente estructura:

Código:
· Título
         (Sub-menu)
         · Run
         · Open Files...

Código
  1. #Region " Option Statements "
  2.  
  3. Option Strict On
  4. Option Explicit On
  5. Option Infer Off
  6.  
  7. #End Region
  8.  
  9. #Region " Imports "
  10.  
  11. Imports SharpShell.Attributes
  12. Imports SharpShell.SharpContextMenu
  13. Imports System.IO
  14. Imports System.Runtime.InteropServices
  15. Imports System.Text
  16. Imports System.Windows.Forms
  17. Imports System.ComponentModel
  18.  
  19. #End Region
  20.  
  21. #Region " MyAppContextMenu "
  22.  
  23. ''' <summary>
  24. ''' The Application Context Menu Extension.
  25. ''' </summary>
  26. <ComVisible(True)>
  27. <COMServerAssociation(AssociationType.ClassOfExtension, ".ext")>
  28. Public Class MyAppContextMenu : Inherits SharpContextMenu
  29.  
  30. #Region " Objects "
  31.  
  32.    ''' <summary>
  33.    ''' Contains the application information.
  34.    ''' </summary>
  35.    Private ReadOnly application As New AppInfo With
  36.            {
  37.                .Title = "Menu Title",
  38.                .Filename = "Application Filename",
  39.                .Directory = My.Application.Info.DirectoryPath
  40.            }
  41.  
  42. #End Region
  43.  
  44. #Region " Types "
  45.  
  46.    ''' <summary>
  47.    ''' Contains information about an application.
  48.    ''' This class cannot be inherited.
  49.    ''' </summary>
  50.    Protected NotInheritable Class AppInfo
  51.  
  52.        ''' <summary>
  53.        ''' Gets or sets the application title.
  54.        ''' </summary>
  55.        ''' <value>The application title.</value>
  56.        Protected Friend Property Title As String
  57.  
  58.        ''' <summary>
  59.        ''' Gets or sets the application filename.
  60.        ''' </summary>
  61.        ''' <value>The application filename.</value>
  62.        Protected Friend Property Filename As String
  63.  
  64.        ''' <summary>
  65.        ''' Gets or sets the application working directory.
  66.        ''' </summary>
  67.        ''' <value>The application working directory.</value>
  68.        Protected Friend Property Directory As String
  69.  
  70.        ''' <summary>
  71.        ''' Gets the full qualified application path.
  72.        ''' </summary>
  73.        ''' <value>The full qualified application path.</value>
  74.        Protected Friend ReadOnly Property FullPath As String
  75.            Get
  76.                Return Path.Combine(Me.Directory, Me.Filename, ".exe")
  77.            End Get
  78.        End Property
  79.  
  80.    End Class
  81.  
  82. #End Region
  83.  
  84. #Region " SharpShell Methods "
  85.  
  86.    ''' <summary>
  87.    ''' Determines whether this instance can a shell context show menu, given the specified selected file list.
  88.    ''' </summary>
  89.    ''' <returns>
  90.    ''' <c>true</c> if this instance should show a shell context menu for the specified file list; otherwise, <c>false</c>.
  91.    ''' </returns>
  92.    Protected Overrides Function CanShowMenu() As Boolean
  93.  
  94.        Return True
  95.  
  96.    End Function
  97.  
  98.    ''' <summary>
  99.    ''' Creates the context menu.
  100.    ''' </summary>
  101.    ''' <returns>The context menu for the shell context menu.</returns>
  102.    Protected Overrides Function CreateMenu() As ContextMenuStrip
  103.  
  104.        ' Create the menu strip.
  105.        Dim menu As New ContextMenuStrip()
  106.  
  107.        ' Create the main item, this is used to show our application title.
  108.        Dim itemTitle As New ToolStripMenuItem() With
  109.            {
  110.                .Text = Me.application.Title,
  111.                .Image = My.Resources.TitleIcon
  112.            }
  113.  
  114.        ' Create a 'Run' item.
  115.        Dim itemRun As New ToolStripMenuItem() With
  116.            {
  117.                .Text = "Run",
  118.                .Image = My.Resources.RunIcon
  119.            }
  120.  
  121.        ' Create a 'Open file' item.
  122.        Dim itemOpenFile As New ToolStripMenuItem() With
  123.            {
  124.                .Text = "Open file...",
  125.                .Image = My.Resources.OpenFileIcon
  126.            }
  127.  
  128.        ' Create a 'Open files' item.
  129.        Dim itemOpenFiles As New ToolStripMenuItem() With
  130.            {
  131.                .Text = "Open files...",
  132.                .Image = My.Resources.OpenFileIcon
  133.            }
  134.  
  135.        ' Add the main item into the context menu.
  136.        menu.Items.Add(itemTitle)
  137.  
  138.        ' Add the 'Run' sub-item into the 'itemTitle' item.
  139.        itemTitle.DropDownItems.Add(itemRun)
  140.  
  141.        ' Add the 'Open file' or 'Open files' sub-item into the 'itemTitle' item.
  142.        ' Depending on the amount of selected files.
  143.        itemTitle.DropDownItems.Add(If(Me.SelectedItemPaths.Count = 1, itemOpenFile, itemOpenFiles))
  144.  
  145.        ' Suscribe to events.
  146.        AddHandler itemRun.Click, AddressOf ItemRun_Click
  147.        AddHandler itemOpenFile.Click, AddressOf ItemOpenFile_Click
  148.        AddHandler itemOpenFiles.Click, AddressOf ItemOpenFiles_Click
  149.  
  150.        ' Return the menu.
  151.        Return menu
  152.  
  153.    End Function
  154.  
  155. #End Region
  156.  
  157. #Region " Application Methods "
  158.  
  159.    ''' <summary>
  160.    ''' Runs the specified application.
  161.    ''' </summary>
  162.    ''' <param name="fileName">The name of an application file to run in the process.</param>
  163.    ''' <param name="arguments">Command-line arguments to pass when starting the process.</param>
  164.    Private Sub RunApp(ByVal fileName As String,
  165.                       Optional ByVal arguments As String = "")
  166.  
  167.        Try
  168.            Process.Start(fileName, arguments)
  169.  
  170.        Catch ex As FileNotFoundException
  171.            ' Do something.
  172.  
  173.        Catch ex As InvalidOperationException
  174.            ' Do something.
  175.  
  176.        Catch ex As Win32Exception
  177.            ' Dim errorCode As Integer = Marshal.GetLastWin32Error()
  178.            ' Do something.
  179.  
  180.        Catch ex As Exception
  181.            ' Do something.
  182.  
  183.        End Try
  184.  
  185.    End Sub
  186.  
  187.    ''' <summary>
  188.    ''' Opens the given file in the specified application.
  189.    ''' </summary>
  190.    ''' <param name="appPath">The application filepath to run.</param>
  191.    ''' <param name="filepath">The filepath to send to the application arguments.</param>
  192.    ''' <param name="stringFormat">The string format used to format the filepath.</param>
  193.    Private Sub OpenFile(ByVal appPath As String,
  194.                         ByVal filepath As String,
  195.                         Optional ByVal stringFormat As String = """{0}""")
  196.  
  197.        Me.RunApp(appPath, String.Format(stringFormat, filepath))
  198.  
  199.    End Sub
  200.  
  201.    ''' <summary>
  202.    ''' Opens the given files in the specified application.
  203.    ''' </summary>
  204.    ''' <param name="appPath">The application filepath to run.</param>
  205.    ''' <param name="filepaths">The filepaths to send to the application arguments.</param>
  206.    ''' <param name="stringFormat">The string format used to join the filepaths.</param>
  207.    Private Sub OpenFiles(ByVal appPath As String,
  208.                          ByVal filepaths As IEnumerable(Of String),
  209.                          Optional ByVal stringFormat As String = """{0}"" ")
  210.  
  211.        Me.RunApp(fileName:=appPath,
  212.                  arguments:=Me.JoinFilePaths(filepaths, stringFormat))
  213.  
  214.    End Sub
  215.  
  216.    ''' <summary>
  217.    ''' Joins the selected filepaths in a single line, filepaths are closed with double-quotes and separated by a space.
  218.    ''' eg: "File1" "File2" "File3"
  219.    ''' </summary>
  220.    ''' <param name="filepaths">The filepaths to join.</param>
  221.    ''' <param name="joinFormat">The string format used to join the filepaths.</param>
  222.    ''' <returns>The joined and formatted filepaths.</returns>
  223.    Private Function JoinFilePaths(ByVal filepaths As IEnumerable(Of String),
  224.                                   ByVal joinFormat As String) As String
  225.  
  226.        Dim sb As New StringBuilder()
  227.  
  228.        For Each filePath As String In filepaths
  229.            sb.Append(String.Format(joinFormat, filePath))
  230.        Next filePath
  231.  
  232.        Return sb.ToString
  233.  
  234.    End Function
  235.  
  236. #End Region
  237.  
  238. #Region " Event Handlers "
  239.  
  240.    ''' <summary>
  241.    ''' Handles the Click event of the ItemRun menu item.
  242.    ''' </summary>
  243.    ''' <param name="sender">The source of the event.</param>
  244.    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  245.    Private Sub ItemRun_Click(ByVal sender As Object, ByVal e As EventArgs)
  246.  
  247.        Me.RunApp(fileName:=Me.application.FullPath)
  248.  
  249.    End Sub
  250.  
  251.    ''' <summary>
  252.    ''' Handles the Click event of the ItemOpenFile menu item.
  253.    ''' </summary>
  254.    ''' <param name="sender">The source of the event.</param>
  255.    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  256.    Private Sub ItemOpenFile_Click(ByVal sender As Object, ByVal e As EventArgs)
  257.  
  258.        Me.OpenFile(appPath:=Me.application.FullPath,
  259.                    filepath:=Me.SelectedItemPaths.First)
  260.  
  261.    End Sub
  262.  
  263.    ''' <summary>
  264.    ''' Handles the Click event of the ItemOpenFiles menu item.
  265.    ''' </summary>
  266.    ''' <param name="sender">The source of the event.</param>
  267.    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  268.    Private Sub ItemOpenFiles_Click(ByVal sender As Object, ByVal e As EventArgs)
  269.  
  270.        Me.OpenFiles(appPath:=Me.application.FullPath,
  271.                     filepaths:=Me.SelectedItemPaths)
  272.  
  273.    End Sub
  274.  
  275. #End Region
  276.  
  277. End Class
  278.  
  279. #End Region
  280.  

« Última modificación: 30 Noviembre 2014, 01:48 am por Eleкtro » En línea



Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.874



Ver Perfil
Re: Librería de Snippets !! (Compartan aquí sus snippets)
« Respuesta #444 en: 30 Noviembre 2014, 01:48 am »

Una versión actualizada de mi MessageBox personalizado, cuyas funciones adicionales son la de aparecer centrado en el Form, o cambiar la fuente de texto (aunque dicha característica está algo improvisada)

Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 27-November-2014
  4. ' ***********************************************************************
  5. ' <copyright file="CenteredMessageBox.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. 'Using New CenteredMessageBox(ownerForm:=Me,
  13. '                             textFont:=New Font("Lucida Console", Font.SizeInPoints, FontStyle.Italic),
  14. '                             timeOut:=2500)
  15. '
  16. '    MessageBox.Show("Text", "Title", MessageBoxButtons.OK, MessageBoxIcon.Information)
  17. '
  18. 'End Using
  19.  
  20. #End Region
  21.  
  22. #Region " Option Statements "
  23.  
  24. Option Explicit On
  25. Option Strict On
  26. Option Infer Off
  27.  
  28. #End Region
  29.  
  30. #Region " Imports "
  31.  
  32. Imports System.Drawing
  33. Imports System.Runtime.InteropServices
  34. Imports System.Text
  35. Imports System.Windows.Forms
  36. Imports System.ComponentModel
  37.  
  38. #End Region
  39.  
  40. #Region " Centered MessageBox "
  41.  
  42. ''' <summary>
  43. ''' A customized <see cref="MessageBox"/>.
  44. ''' This class cannot be inherited.
  45. ''' </summary>
  46. Friend NotInheritable Class CenteredMessageBox : Implements IDisposable
  47.  
  48. #Region " Properties "
  49.  
  50.    ''' <summary>
  51.    ''' Gets the messagebox main window handle (hwnd).
  52.    ''' </summary>
  53.    ''' <value>The messagebox main window handle (hwnd).</value>
  54.    Friend ReadOnly Property MessageBoxWindowHandle As IntPtr
  55.        Get
  56.            Return Me.messageBoxWindowHandle1
  57.        End Get
  58.    End Property
  59.    ''' <summary>
  60.    ''' The messagebox main window handle (hwnd).
  61.    ''' </summary>
  62.    Private messageBoxWindowHandle1 As IntPtr
  63.  
  64.    ''' <summary>
  65.    ''' Gets the owner <see cref="Form"/> to center the <see cref="CenteredMessageBox"/>.
  66.    ''' </summary>
  67.    ''' <value>The owner <see cref="Form"/> to center the <see cref="CenteredMessageBox"/>.</value>
  68.    Friend ReadOnly Property OwnerForm As Form
  69.        Get
  70.            Return Me.ownerForm1
  71.        End Get
  72.    End Property
  73.    ''' <summary>
  74.    ''' The owner <see cref="Form"/> to center the <see cref="CenteredMessageBox"/>
  75.    ''' </summary>
  76.    Private ownerForm1 As Form
  77.  
  78.    ''' <summary>
  79.    ''' Gets the <see cref="Font"/> used to display the <see cref="CenteredMessageBox"/> text.
  80.    ''' </summary>
  81.    ''' <value>The <see cref="Font"/> used to display the <see cref="CenteredMessageBox"/> text.</value>
  82.    Friend ReadOnly Property Font As Font
  83.        Get
  84.            Return Me.font1
  85.        End Get
  86.    End Property
  87.    ''' <summary>
  88.    ''' The <see cref="Font"/> used to display the <see cref="CenteredMessageBox"/> text.
  89.    ''' </summary>
  90.    Private ReadOnly font1 As Font
  91.  
  92.    ''' <summary>
  93.    ''' Gets the time interval to auto-close this <see cref="CenteredMessageBox"/>, in milliseconds.
  94.    ''' Default value is '0', which means Infinite.
  95.    ''' </summary>
  96.    Friend ReadOnly Property TimeOut As Integer
  97.        Get
  98.            Return Me.timeOut1
  99.        End Get
  100.    End Property
  101.    ''' <summary>
  102.    ''' The time interval to auto-close this <see cref="CenteredMessageBox"/>, in milliseconds.
  103.    ''' Default value is '0', which means Infinite.
  104.    ''' </summary>
  105.    Private ReadOnly timeOut1 As Integer = 0
  106.  
  107. #End Region
  108.  
  109. #Region " Objects "
  110.  
  111.    ''' <summary>
  112.    ''' A <see cref="Windows.Forms.Timer"/> that keeps track of <see cref="TimeOut"/> value to close this <see cref="CenteredMessageBox"/>.
  113.    ''' </summary>
  114.    Private WithEvents timeoutTimer As Timer
  115.  
  116.    ''' <summary>
  117.    ''' Keeps track of the current amount of tries to find this <see cref="CenteredMessageBox"/> dialog.
  118.    ''' </summary>
  119.    Private tries As Integer
  120.  
  121. #End Region
  122.  
  123. #Region " P/Invoke "
  124.  
  125.    ''' <summary>
  126.    ''' Platform Invocation methods (P/Invoke), access unmanaged code.
  127.    ''' This class does not suppress stack walks for unmanaged code permission.
  128.    ''' <see cref="System.Security.SuppressUnmanagedCodeSecurityAttribute"/>  must not be applied to this class.
  129.    ''' This class is for methods that can be used anywhere because a stack walk will be performed.
  130.    ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/ms182161.aspx
  131.    ''' </summary>
  132.    Protected NotInheritable Class NativeMethods
  133.  
  134. #Region " Functions "
  135.  
  136.        ''' <summary>
  137.        ''' Retrieves the thread identifier of the calling thread.
  138.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms683183%28v=vs.85%29.aspx
  139.        ''' </summary>
  140.        ''' <returns>The thread identifier of the calling thread.</returns>
  141.        <DllImport("kernel32.dll", SetLastError:=False)>
  142.        Protected Friend Shared Function GetCurrentThreadId() As Integer
  143.        End Function
  144.  
  145.        ''' <summary>
  146.        ''' Enumerates all nonchild windows associated with a thread by passing the handle to each window,
  147.        ''' in turn, to an application-defined callback function.
  148.        ''' <see cref="EnumThreadWindows"/> continues until the last window is enumerated or the callback function returns <c>false</c>.
  149.        ''' To enumerate child windows of a particular window, use the EnumChildWindows function.
  150.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633495%28v=vs.85%29.aspx
  151.        ''' </summary>
  152.        ''' <param name="dwThreadId">The identifier of the thread whose windows are to be enumerated.</param>
  153.        ''' <param name="lpfn">A pointer to an application-defined callback function.</param>
  154.        ''' <param name="lParam">An application-defined value to be passed to the callback function.</param>
  155.        ''' <returns>
  156.        ''' <c>true</c> if the callback function returns <c>true</c> for all windows in the thread specified by dwThreadId parameter.
  157.        ''' <c>false</c> if the callback function returns <c>false</c> on any enumerated window,
  158.        ''' or if there are no windows found in the thread specified by dwThreadId parameter.</returns>
  159.        <DllImport("user32.dll", SetLastError:=False)>
  160.        Protected Friend Shared Function EnumThreadWindows(
  161.                      ByVal dwThreadId As Integer,
  162.                      ByVal lpfn As NativeMethods.EnumThreadWndProc,
  163.                      ByVal lParam As IntPtr
  164.            ) As <MarshalAs(UnmanagedType.Bool)> Boolean
  165.        End Function
  166.  
  167.        ''' <summary>
  168.        ''' Retrieves the name of the class to which the specified window belongs.
  169.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633582%28v=vs.85%29.aspx
  170.        ''' </summary>
  171.        ''' <param name="hWnd">A handle to the window and, indirectly, the class to which the window belongs.</param>
  172.        ''' <param name="buffer">The class name string.</param>
  173.        ''' <param name="buflen">
  174.        ''' The length of the lpClassName buffer, in characters.
  175.        ''' The buffer must be large enough to include the terminating null character;
  176.        ''' otherwise, the class name string is truncated to nMaxCount-1 characters.
  177.        ''' </param>
  178.        ''' <returns>
  179.        ''' If the function succeeds, the return value is the number of characters copied to the buffer,
  180.        ''' not including the terminating null character.
  181.        ''' If the function fails, the return value is 0.
  182.        ''' </returns>
  183.        <DllImport("user32.dll", SetLastError:=False, CharSet:=CharSet.Auto)>
  184.        Protected Friend Shared Function GetClassName(
  185.                      ByVal hWnd As IntPtr,
  186.                      ByVal buffer As StringBuilder,
  187.                      ByVal buflen As Integer
  188.            ) As Integer
  189.        End Function
  190.  
  191.        ''' <summary>
  192.        ''' Retrieves a handle to a control in the specified dialog box.
  193.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms645481%28v=vs.85%29.aspx
  194.        ''' </summary>
  195.        ''' <param name="hWnd">A handle to the dialog box that contains the control.</param>
  196.        ''' <param name="item">The identifier of the control to be retrieved.</param>
  197.        ''' <returns>
  198.        ''' If the function succeeds, the return value is the window handle of the specified control.
  199.        ''' If the function fails, the return value is <see cref="IntPtr.Zero"/>,
  200.        ''' indicating an invalid dialog box handle or a nonexistent control
  201.        ''' </returns>
  202.        <DllImport("user32.dll", SetLastError:=False)>
  203.        Protected Friend Shared Function GetDlgItem(
  204.                      ByVal hWnd As IntPtr,
  205.                      ByVal item As Integer
  206.            ) As IntPtr
  207.        End Function
  208.  
  209.        ''' <summary>
  210.        ''' Retrieves the dimensions of the bounding rectangle of the specified window.
  211.        ''' The dimensions are given in screen coordinates that are relative to the upper-left corner of the screen.
  212.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633519%28v=vs.85%29.aspx
  213.        ''' </summary>
  214.        ''' <param name="hWnd">A handle to the window.</param>
  215.        ''' <param name="rc">
  216.        ''' A pointer to a <see cref="RECT"/> structure that receives the screen coordinates of
  217.        ''' the upper-left and lower-right corners of the window.
  218.        ''' </param>
  219.        ''' <returns><c>true</c> if the function succeeds, <c>false</c> otherwise.</returns>
  220.        <DllImport("user32.dll", SetLastError:=False)>
  221.        Protected Friend Shared Function GetWindowRect(
  222.                      ByVal hWnd As IntPtr,
  223.                      ByRef rc As Rect
  224.            ) As <MarshalAs(UnmanagedType.Bool)> Boolean
  225.        End Function
  226.  
  227.        ''' <summary>
  228.        ''' Destroys the specified window.
  229.        ''' The function sends WM_DESTROY and WM_NCDESTROY messages to the window to deactivate it and remove the keyboard focus from it.
  230.        ''' The function also destroys the window's menu, flushes the thread message queue, destroys timers, removes clipboard ownership,
  231.        ''' and breaks the clipboard viewer chain (if the window is at the top of the viewer chain).
  232.        ''' If the specified window is a parent or owner window,
  233.        ''' DestroyWindow automatically destroys the associated child or owned windows when it destroys the parent or owner window.
  234.        ''' The function first destroys child or owned windows, and then it destroys the parent or owner window.
  235.        ''' DestroyWindow also destroys modeless dialog boxes created by the CreateDialog function.
  236.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms632682%28v=vs.85%29.aspx
  237.        ''' </summary>
  238.        ''' <param name="hwnd">Handle to the window to be destroyed.</param>
  239.        ''' <returns><c>true</c> if the function succeeds, <c>false</c> otherwise.</returns>
  240.        <DllImport("user32.dll", SetLastError:=False)>
  241.        Protected Friend Shared Function DestroyWindow(
  242.                      ByVal hwnd As IntPtr
  243.            ) As <MarshalAs(UnmanagedType.Bool)> Boolean
  244.        End Function
  245.  
  246.        ''' <summary>
  247.        ''' Changes the position and dimensions of the specified window.
  248.        ''' For a top-level window, the position and dimensions are relative to the upper-left corner of the screen.
  249.        ''' For a child window, they are relative to the upper-left corner of the parent window's client area.
  250.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633534%28v=vs.85%29.aspx
  251.        ''' </summary>
  252.        ''' <param name="hWnd">A handle to the window.</param>
  253.        ''' <param name="x">The new position of the left side of the window.</param>
  254.        ''' <param name="y">The new position of the top of the window.</param>
  255.        ''' <param name="width">The new width of the window.</param>
  256.        ''' <param name="height">The new height of the window.</param>
  257.        ''' <param name="repaint">
  258.        ''' Indicates whether the window is to be repainted.
  259.        ''' If this parameter is TRUE, the window receives a message.
  260.        ''' If the parameter is FALSE, no repainting of any kind occurs.
  261.        ''' This applies to the client area, the nonclient area (including the title bar and scroll bars),
  262.        ''' and any part of the parent window uncovered as a result of moving a child window.
  263.        ''' </param>
  264.        ''' <returns><c>true</c> if the function succeeds, <c>false</c> otherwise.</returns>
  265.        <DllImport("user32.dll", SetLastError:=False)>
  266.        Protected Friend Shared Function MoveWindow(
  267.                      ByVal hWnd As IntPtr,
  268.                      ByVal x As Integer,
  269.                      ByVal y As Integer,
  270.                      ByVal width As Integer,
  271.                      ByVal height As Integer,
  272.                      ByVal repaint As Boolean
  273.            ) As <MarshalAs(UnmanagedType.Bool)> Boolean
  274.        End Function
  275.  
  276.        ''' <summary>
  277.        ''' Changes the size, position, and Z order of a child, pop-up, or top-level window.
  278.        ''' These windows are ordered according to their appearance on the screen.
  279.        ''' The topmost window receives the highest rank and is the first window in the Z order.
  280.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633545%28v=vs.85%29.aspx
  281.        ''' </summary>
  282.        ''' <param name="hWnd">A handle to the window.</param>
  283.        ''' <param name="hWndInsertAfter">A handle to the window to precede the positioned window in the Z order.</param>
  284.        ''' <param name="x">The new position of the left side of the window, in client coordinates.</param>
  285.        ''' <param name="y">The new position of the top of the window, in client coordinates.</param>
  286.        ''' <param name="cx">The new width of the window, in pixels.</param>
  287.        ''' <param name="cy">The new height of the window, in pixels.</param>
  288.        ''' <param name="uFlags">The window sizing and positioning flags.</param>
  289.        ''' <returns><c>true</c> if the function succeeds, <c>false</c> otherwise.</returns>
  290.        <DllImport("user32.dll", SetLastError:=True)> _
  291.        Protected Friend Shared Function SetWindowPos(
  292.                      ByVal hWnd As IntPtr,
  293.                      ByVal hWndInsertAfter As IntPtr,
  294.                      ByVal x As Integer,
  295.                      ByVal y As Integer,
  296.                      ByVal cx As Integer,
  297.                      ByVal cy As Integer,
  298.                      ByVal uFlags As SetWindowPosFlags
  299.            ) As <MarshalAs(UnmanagedType.Bool)> Boolean
  300.        End Function
  301.  
  302.        ''' <summary>
  303.        ''' Sends the specified message to a window or windows.
  304.        ''' The <see cref="SendMessage"/> function calls the window procedure for the specified window and
  305.        ''' does not return until the window procedure has processed the message.
  306.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms644950%28v=vs.85%29.aspx
  307.        ''' </summary>
  308.        ''' <param name="hWnd">A handle to the window whose window procedure will receive the message.</param>
  309.        ''' <param name="msg">The windows message to be sent.</param>
  310.        ''' <param name="wParam">Additional message-specific information.</param>
  311.        ''' <param name="lParam">Additional message-specific information.</param>
  312.        ''' <returns>The result of the message processing; it depends on the message sent.</returns>
  313.        <DllImport("user32.dll", SetLastError:=False)>
  314.        Protected Friend Shared Function SendMessage(
  315.                      ByVal hWnd As IntPtr,
  316.                      ByVal msg As WindowsMessages,
  317.                      ByVal wParam As IntPtr,
  318.                      ByVal lParam As IntPtr
  319.            ) As IntPtr
  320.        End Function
  321.  
  322. #End Region
  323.  
  324. #Region " Callbacks "
  325.  
  326.        ''' <summary>
  327.        ''' An application-defined callback function used with the <see cref="EnumThreadWindows"/> function.
  328.        ''' It receives the window handles associated with a thread.
  329.        ''' The WNDENUMPROC type defines a pointer to this callback function.
  330.        ''' <see cref="EnumThreadWndProc"/> is a placeholder for the application-defined function name
  331.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633496%28v=vs.85%29.aspx
  332.        ''' </summary>
  333.        ''' <param name="hWnd">A handle to a window associated with the thread specified in the <see cref="EnumThreadWindows"/> function.</param>
  334.        ''' <param name="lParam">The application-defined value given in the <see cref="EnumThreadWindows"/> function.</param>
  335.        ''' <returns>
  336.        ''' To continue enumeration, the callback function must return <c>true</c>;
  337.        ''' To stop enumeration, it must return <c>false</c>.
  338.        ''' </returns>
  339.        Protected Friend Delegate Function EnumThreadWndProc(
  340.                  ByVal hWnd As IntPtr,
  341.                  ByVal lParam As IntPtr
  342.        ) As Boolean
  343.  
  344. #End Region
  345.  
  346. #Region " Enumerations "
  347.  
  348.        ''' <summary>
  349.        ''' Specifies a System-Defined Message.
  350.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms644927%28v=vs.85%29.aspx#system_defined
  351.        ''' </summary>
  352.        <Description("Enum used for 'SendMessage' function.")>
  353.        Protected Friend Enum WindowsMessages As Integer
  354.  
  355.            ' **************************************
  356.            ' NOTE:
  357.            ' This enumeration is partially defined.
  358.            ' **************************************
  359.  
  360.            ''' <summary>
  361.            ''' Sets the font that a control is to use when drawing text.
  362.            ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms632642%28v=vs.85%29.aspx
  363.            ''' </summary>
  364.            WM_SETFONT = &H30
  365.  
  366.            ''' <summary>
  367.            ''' Retrieves the font with which the control is currently drawing its text.
  368.            ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms632624%28v=vs.85%29.aspx
  369.            ''' </summary>
  370.            WM_GETFONT = &H31
  371.  
  372.        End Enum
  373.  
  374.        ''' <summary>
  375.        ''' Specifies the window sizing and positioning flags.
  376.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633545%28v=vs.85%29.aspx
  377.        ''' </summary>
  378.        <FlagsAttribute>
  379.        <Description("Enum used for 'SetWindowPos' function.")>
  380.        Protected Friend Enum SetWindowPosFlags As UInteger
  381.  
  382.            ' **************************************
  383.            ' NOTE:
  384.            ' This enumeration is partially defined.
  385.            ' **************************************
  386.  
  387.            ''' <summary>
  388.            ''' Indicates any flag.
  389.            ''' </summary>
  390.            None = &H0UI
  391.  
  392.        End Enum
  393.  
  394. #End Region
  395.  
  396. #Region " Structures "
  397.  
  398.        ''' <summary>
  399.        ''' Defines the coordinates of the upper-left and lower-right corners of a rectangle.
  400.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/dd162897%28v=vs.85%29.aspx
  401.        ''' </summary>
  402.        <Description("Structure used for 'GetWindowRect' function.")>
  403.        Protected Friend Structure Rect
  404.  
  405.            ''' <summary>
  406.            ''' The x-coordinate of the upper-left corner of the rectangle.
  407.            ''' </summary>
  408.            Friend Left As Integer
  409.  
  410.            ''' <summary>
  411.            ''' The y-coordinate of the upper-left corner of the rectangle.
  412.            ''' </summary>
  413.            Friend Top As Integer
  414.  
  415.            ''' <summary>
  416.            ''' The x-coordinate of the lower-right corner of the rectangle.
  417.            ''' </summary>
  418.            Friend Right As Integer
  419.  
  420.            ''' <summary>
  421.            ''' The y-coordinate of the lower-right corner of the rectangle.
  422.            ''' </summary>
  423.            Friend Bottom As Integer
  424.  
  425.        End Structure
  426.  
  427. #End Region
  428.  
  429.    End Class
  430.  
  431. #End Region
  432.  
  433. #Region " Constructors "
  434.  
  435.    ''' <summary>
  436.    ''' Initializes a new instance of the <see cref="CenteredMessageBox"/> class.
  437.    ''' </summary>
  438.    ''' <param name="ownerForm">The form that owns this <see cref="CenteredMessageBox"/>.</param>
  439.    ''' <param name="TextFont">The <see cref="Font"/> used to display the text of this <see cref="CenteredMessageBox"/>.</param>
  440.    ''' <param name="TimeOut">
  441.    ''' The time interval to auto-close this <see cref="CenteredMessageBox"/>, in milliseconds;
  442.    ''' Default value is '0', which means Infinite.
  443.    ''' </param>
  444.    Public Sub New(ByVal ownerForm As Form,
  445.                   Optional textFont As Font = Nothing,
  446.                   Optional timeOut As Integer = 0I)
  447.  
  448.        Me.ownerForm1 = ownerForm
  449.        Me.font1 = textFont
  450.        Me.timeOut1 = timeOut
  451.        Me.ownerForm1.BeginInvoke(New MethodInvoker(AddressOf Me.FindDialog))
  452.  
  453.    End Sub
  454.  
  455.    ''' <summary>
  456.    ''' Prevents a default instance of the <see cref="CenteredMessageBox"/> class from being created.
  457.    ''' </summary>
  458.    Private Sub New()
  459.    End Sub
  460.  
  461. #End Region
  462.  
  463. #Region " Private Methods "
  464.  
  465.    ''' <summary>
  466.    ''' Finds the <see cref="CenteredMessageBox"/> dialog window.
  467.    ''' </summary>
  468.    Private Sub FindDialog()
  469.  
  470.        ' Enumerate windows to find the message box
  471.        If Me.tries < 0 Then
  472.            Return
  473.        End If
  474.  
  475.        Dim callback As New NativeMethods.EnumThreadWndProc(AddressOf Me.CheckWindow)
  476.  
  477.        If NativeMethods.EnumThreadWindows(NativeMethods.GetCurrentThreadId(), callback, IntPtr.Zero) Then
  478.  
  479.            If Threading.Interlocked.Increment(Me.tries) < 10 Then
  480.                Me.ownerForm1.BeginInvoke(New MethodInvoker(AddressOf Me.FindDialog))
  481.            End If
  482.  
  483.        End If
  484.  
  485.        If Me.timeOut1 > 0 Then
  486.  
  487.            Me.timeoutTimer = New Timer With
  488.                              {
  489.                                  .Interval = Me.timeOut1,
  490.                                  .Enabled = True
  491.                              }
  492.  
  493.            Me.timeoutTimer.Start()
  494.  
  495.        End If
  496.  
  497.    End Sub
  498.  
  499.    ''' <summary>
  500.    ''' Checks whether the specified window is our <see cref="CenteredMessageBox"/> dialog.
  501.    ''' </summary>
  502.    ''' <param name="hWnd">A handle to the window to check.</param>
  503.    ''' <param name="lParam">The application-defined value given in the <see cref="NativeMethods.EnumThreadWindows"/> function.</param>
  504.    ''' <returns>
  505.    ''' <c>true</c> the specified window is our <see cref="CenteredMessageBox"/> dialog, <c>false</c> otherwise.
  506.    ''' </returns>
  507.    Private Function CheckWindow(ByVal hWnd As IntPtr,
  508.                                 ByVal lParam As IntPtr) As Boolean
  509.  
  510.        ' Checks if <hWnd> is a dialog
  511.        Dim sb As New StringBuilder(260)
  512.        NativeMethods.GetClassName(hWnd, sb, sb.Capacity)
  513.        If sb.ToString() <> "#32770" Then
  514.            Return True
  515.        End If
  516.  
  517.        ' Get the control that displays the text.
  518.        Dim hText As IntPtr = NativeMethods.GetDlgItem(hWnd, &HFFFFI)
  519.        Me.messageBoxWindowHandle1 = hWnd
  520.  
  521.        ' Get the dialog Rect.
  522.        Dim frmRect As New Rectangle(Me.ownerForm1.Location, Me.ownerForm1.Size)
  523.        Dim dlgRect As NativeMethods.Rect
  524.        NativeMethods.GetWindowRect(hWnd, dlgRect)
  525.  
  526.        ' Set the custom Font (if any).
  527.        If hText <> IntPtr.Zero Then
  528.  
  529.            Me.SetFont(font:=Me.font1,
  530.                       hwnd:=hText,
  531.                       rect:=frmRect)
  532.  
  533.        End If
  534.  
  535.        ' Center the dialog window in the specified Form.
  536.        Me.CenterDialog(hwnd:=hWnd,
  537.                        dialogRect:=dlgRect,
  538.                        formRect:=frmRect)
  539.  
  540.        ' Stop the EnumThreadWndProc callback by sending False.
  541.        Return False
  542.  
  543.    End Function
  544.  
  545.    ''' <summary>
  546.    ''' Sets the font of this <see cref="CenteredMessageBox"/> window.
  547.    ''' </summary>
  548.    ''' <param name="font">The <see cref="Font"/> used to display the <see cref="CenteredMessageBox"/> text.</param>
  549.    ''' <param name="hwnd">A handle to the <see cref="CenteredMessageBox"/> window.</param>
  550.    ''' <param name="rect">A <see cref="Rectangle"/> to positionate the text.</param>
  551.    Private Sub SetFont(ByVal font As Font,
  552.                        ByVal hwnd As IntPtr,
  553.                        ByVal rect As Rectangle)
  554.  
  555.        Select Case font IsNot Nothing
  556.  
  557.            Case True
  558.                ' Set the text position.
  559.                NativeMethods.SetWindowPos(hWnd:=hwnd,
  560.                                           hWndInsertAfter:=IntPtr.Zero,
  561.                                           x:=65,
  562.                                           y:=35,
  563.                                           cx:=rect.Width,
  564.                                           cy:=font.Height,
  565.                                           uFlags:=NativeMethods.SetWindowPosFlags.None)
  566.  
  567.                ' Set the new font.
  568.                NativeMethods.SendMessage(hWnd:=hwnd,
  569.                                          msg:=NativeMethods.WindowsMessages.WM_SETFONT,
  570.                                          wParam:=font.ToHfont,
  571.                                          lParam:=New IntPtr(1))
  572.  
  573.            Case Else
  574.                ' Do Nothing.
  575.  
  576.                ' Get the dialog font.
  577.                ' dim fnt as Font = Font.FromHfont(NativeMethods.SendMessage(hWnd:=hwnd,
  578.                '                                                            msg:=NativeMethods.WindowsMessages.WM_GETFONT,
  579.                '                                                            wParam:=IntPtr.Zero,
  580.                '                                                            lParam:=IntPtr.Zero))
  581.  
  582.        End Select
  583.  
  584.    End Sub
  585.  
  586.    ''' <summary>
  587.    ''' Centers the <see cref="CenteredMessageBox"/> dialog in the specified <see cref="Form"/>.
  588.    ''' </summary>
  589.    ''' <param name="hwnd">A handle to the <see cref="CenteredMessageBox"/> window.</param>
  590.    ''' <param name="dialogRect">The dialog <see cref="NativeMethods.Rect"/> structure.</param>
  591.    ''' <param name="formRect">The form <see cref="Rectangle"/> structure.</param>
  592.    Private Sub CenterDialog(ByVal hwnd As IntPtr,
  593.                             ByVal dialogRect As NativeMethods.Rect,
  594.                             ByVal formRect As Rectangle)
  595.  
  596.        ' Resize and positionate the messagebox window.
  597.        NativeMethods.MoveWindow(hwnd,
  598.                                 x:=formRect.Left + (formRect.Width - dialogRect.Right + dialogRect.Left) \ 2I,
  599.                                 y:=formRect.Top + (formRect.Height - dialogRect.Bottom + dialogRect.Top) \ 2I,
  600.                                 width:=(dialogRect.Right - dialogRect.Left),
  601.                                 height:=(dialogRect.Bottom - dialogRect.Top),
  602.                                 repaint:=True)
  603.  
  604.    End Sub
  605.  
  606. #End Region
  607.  
  608. #Region " Event Handlers "
  609.  
  610.    ''' <summary>
  611.    ''' Handles the Tick event of the TimeoutTimer control.
  612.    ''' </summary>
  613.    ''' <param name="sender">The source of the event.</param>
  614.    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  615.    Private Sub TimeoutTimer_Tick(ByVal sender As Object, ByVal e As EventArgs) _
  616.    Handles timeoutTimer.Tick
  617.  
  618.        NativeMethods.DestroyWindow(Me.messageBoxWindowHandle1)
  619.        Me.Dispose()
  620.  
  621.    End Sub
  622.  
  623. #End Region
  624.  
  625. #Region " IDisposable "
  626.  
  627.    ''' <summary>
  628.    ''' To detect redundant calls when disposing.
  629.    ''' </summary>
  630.    Private isDisposed As Boolean = False
  631.  
  632.    ''' <summary>
  633.    ''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.
  634.    ''' </summary>
  635.    Public Sub Dispose() Implements IDisposable.Dispose
  636.  
  637.        Me.Dispose(isDisposing:=True)
  638.        GC.SuppressFinalize(obj:=Me)
  639.  
  640.    End Sub
  641.  
  642.    ''' <summary>
  643.    ''' Releases unmanaged and - optionally - managed resources.
  644.    ''' </summary>
  645.    ''' <param name="IsDisposing">
  646.    ''' <c>true</c> to release both managed and unmanaged resources;
  647.    ''' <c>false</c> to release only unmanaged resources.
  648.    ''' </param>
  649.    Protected Sub Dispose(ByVal isDisposing As Boolean)
  650.  
  651.        If Not Me.isDisposed Then
  652.  
  653.            If isDisposing Then
  654.  
  655.                Me.tries = -1
  656.                Me.ownerForm1 = Nothing
  657.  
  658.                If Me.font1 IsNot Nothing Then
  659.                    Me.font1.Dispose()
  660.                End If
  661.  
  662.            End If
  663.  
  664.        End If
  665.  
  666.        Me.isDisposed = True
  667.  
  668.    End Sub
  669.  
  670. #End Region
  671.  
  672. End Class
  673.  
  674. #End Region
« Última modificación: 30 Noviembre 2014, 02:38 am por Eleкtro » En línea



Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.874



Ver Perfil
Re: Librería de Snippets !! (Compartan aquí sus snippets)
« Respuesta #445 en: 30 Noviembre 2014, 01:53 am »

Ejemplo de cómo añadir en tiempo de ejecución la característica Drag (arrastrar) en un control, para arrastrarlo por la UI.

Código
  1. ' ***********************************************************************
  2. ' Author           : Elektro
  3. ' Last Modified On : 11-10-2014
  4. ' ***********************************************************************
  5. ' <copyright file="ControlDragger.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. 'Public Class Form1
  13. '
  14. '    Private Dragger As ControlDragger = ControlDragger.Empty
  15. '
  16. '    Private Sub InitializeDrag()
  17. '        Me.Dragger = New ControlDragger(Button1)
  18. '        Me.Dragger.Cursor = Cursors.SizeAll
  19. '        Me.Dragger.Enabled = True
  20. '    End Sub
  21. '
  22. '    Private Sub AlternateDrag()
  23. '        Dragger.Enabled = Not Dragger.Enabled
  24. '    End Sub
  25. '
  26. '    Private Sub FinishDrag()
  27. '        Dragger.Dispose()
  28. '    End Sub
  29. '
  30. '    Private Sub Test() Handles MyBase.Shown
  31. '        Me.InitializeDrag()
  32. '    End Sub
  33. '
  34. 'End Class
  35.  
  36. #End Region
  37.  
  38. #Region " Imports "
  39.  
  40. Imports System.ComponentModel
  41.  
  42. #End Region
  43.  
  44. #Region " Control Dragger "
  45.  
  46. ''' <summary>
  47. ''' Enable or disable drag at runtime on a <see cref="Control"/>.
  48. ''' </summary>
  49. Friend NotInheritable Class ControlDragger : Implements IDisposable
  50.  
  51. #Region " Properties "
  52.  
  53.    ''' <summary>
  54.    ''' Gets the associated <see cref="Control"/> used to perform draggable operations.
  55.    ''' </summary>
  56.    ''' <value>The control.</value>
  57.    <EditorBrowsable(EditorBrowsableState.Always)>
  58.    <Description("The associated Control used to perform draggable operations.")>
  59.    Friend ReadOnly Property Control As Control
  60.        Get
  61.            Return Me._ctrl
  62.        End Get
  63.    End Property
  64.    ''' <summary>
  65.    ''' The associated <see cref="Control"/> used to perform draggable operations.
  66.    ''' </summary>
  67.    Private WithEvents _ctrl As Control = Nothing
  68.  
  69.    ''' <summary>
  70.    ''' Represents a <see cref="T:ControlDragger"/> instance that is <c>Nothing</c>.
  71.    ''' </summary>
  72.    ''' <value><c>Nothing</c></value>
  73.    <EditorBrowsable(EditorBrowsableState.Always)>
  74.    <Description("Represents a ControlDragger instance that is Nothing.")>
  75.    Public Shared ReadOnly Property Empty As ControlDragger
  76.        Get
  77.            Return Nothing
  78.        End Get
  79.    End Property
  80.  
  81.    ''' <summary>
  82.    ''' Gets or sets a value indicating whether drag is enabled on the associated <see cref="Control"/>.
  83.    ''' </summary>
  84.    ''' <value><c>true</c> if drag is enabled; otherwise, <c>false</c>.</value>
  85.    <EditorBrowsable(EditorBrowsableState.Always)>
  86.    <Description("A value indicating whether drag is enabled on the associated control.")>
  87.    Friend Property Enabled As Boolean = True
  88.  
  89.    ''' <summary>
  90.    ''' Gets or sets the <see cref="Cursor"/> used to drag the associated <see cref="Control"/>.
  91.    ''' </summary>
  92.    ''' <value>The <see cref="Cursor"/>.</value>
  93.    <EditorBrowsable(EditorBrowsableState.Always)>
  94.    <Description("The Cursor used to drag the associated Control")>
  95.    Friend Property Cursor As Cursor = Cursors.SizeAll
  96.  
  97.    ''' <summary>
  98.    ''' A <see cref="T:ControlDragger"/> instance instance containing the draggable information of the associated <see cref="Control"/>.
  99.    ''' </summary>
  100.    ''' <value>The draggable information.</value>
  101.    <EditorBrowsable(EditorBrowsableState.Never)>
  102.    <Description("A ControlDragger instance instance containing the draggable information of the associated Control.")>
  103.    Private Property DragInfo As ControlDragger = ControlDragger.Empty
  104.  
  105.    ''' <summary>
  106.    ''' Gets or sets the initial mouse coordinates, normally <see cref="Control.MousePosition"/>.
  107.    ''' </summary>
  108.    ''' <value>The initial mouse coordinates.</value>
  109.    <EditorBrowsable(EditorBrowsableState.Never)>
  110.    <Description("The initial mouse coordinates, normally 'Control.MousePosition'")>
  111.    Private Property InitialMouseCoords As Point = Point.Empty
  112.  
  113.    ''' <summary>
  114.    ''' Gets or sets the initial <see cref="Control"/> location, normally <see cref="Control.Location"/>.
  115.    ''' </summary>
  116.    ''' <value>The initial location.</value>
  117.    <EditorBrowsable(EditorBrowsableState.Never)>
  118.    <Description("The initial Control location, normally 'Control.Location'")>
  119.    Private Property InitialLocation As Point = Point.Empty
  120.  
  121.    ''' <summary>
  122.    ''' Gets or sets the old control's cursor to restore it after dragging.
  123.    ''' </summary>
  124.    ''' <value>The old control's cursor.</value>
  125.    <EditorBrowsable(EditorBrowsableState.Never)>
  126.    <Description("The old control's cursor to restore it after dragging.")>
  127.    Private Property oldCursor As Cursor = Nothing
  128.  
  129. #End Region
  130.  
  131. #Region " Constructors "
  132.  
  133.    ''' <summary>
  134.    ''' Prevents a default instance of the <see cref="ControlDragger"/> class from being created.
  135.    ''' </summary>
  136.    Private Sub New()
  137.    End Sub
  138.  
  139.    ''' <summary>
  140.    ''' Initializes a new instance of the <see cref="ControlDragger"/> class.
  141.    ''' </summary>
  142.    ''' <param name="ctrl">The <see cref="Control"/> used to perform draggable operations.</param>
  143.    Public Sub New(ByVal ctrl As Control)
  144.  
  145.        Me._ctrl = ctrl
  146.  
  147.    End Sub
  148.  
  149.    ''' <summary>
  150.    ''' Initializes a new instance of the <see cref="ControlDragger"/> class.
  151.    ''' </summary>
  152.    ''' <param name="mouseCoordinates">The current mouse coordinates.</param>
  153.    ''' <param name="location">The current location.</param>
  154.    Private Sub New(ByVal mouseCoordinates As Point, ByVal location As Point)
  155.  
  156.        Me.InitialMouseCoords = mouseCoordinates
  157.        Me.InitialLocation = location
  158.  
  159.    End Sub
  160.  
  161. #End Region
  162.  
  163. #Region " Private Methods "
  164.  
  165.    ''' <summary>
  166.    ''' Return the new location.
  167.    ''' </summary>
  168.    ''' <param name="mouseCoordinates">The current mouse coordinates.</param>
  169.    ''' <returns>The new location.</returns>
  170.    Private Function GetNewLocation(ByVal mouseCoordinates As Point) As Point
  171.  
  172.        Return New Point(InitialLocation.X + (mouseCoordinates.X - InitialMouseCoords.X),
  173.                         InitialLocation.Y + (mouseCoordinates.Y - InitialMouseCoords.Y))
  174.  
  175.    End Function
  176.  
  177. #End Region
  178.  
  179. #Region " Hidden Methods "
  180.  
  181.    ''' <summary>
  182.    ''' Serves as a hash function for a particular type.
  183.    ''' </summary>
  184.    <EditorBrowsable(EditorBrowsableState.Never)>
  185.    Public Shadows Sub GetHashCode()
  186.    End Sub
  187.  
  188.    ''' <summary>
  189.    ''' Gets the System.Type of the current instance.
  190.    ''' </summary>
  191.    ''' <returns>The exact runtime type of the current instance.</returns>
  192.    <EditorBrowsable(EditorBrowsableState.Never)>
  193.    Public Shadows Function [GetType]()
  194.        Return Me.GetType
  195.    End Function
  196.  
  197.    ''' <summary>
  198.    ''' Determines whether the specified System.Object instances are considered equal.
  199.    ''' </summary>
  200.    <EditorBrowsable(EditorBrowsableState.Never)>
  201.    Public Shadows Sub Equals()
  202.    End Sub
  203.  
  204.    ''' <summary>
  205.    ''' Determines whether the specified System.Object instances are the same instance.
  206.    ''' </summary>
  207.    <EditorBrowsable(EditorBrowsableState.Never)>
  208.    Private Shadows Sub ReferenceEquals()
  209.    End Sub
  210.  
  211.    ''' <summary>
  212.    ''' Returns a String that represents the current object.
  213.    ''' </summary>
  214.    <EditorBrowsable(EditorBrowsableState.Never)>
  215.    Public Shadows Sub ToString()
  216.    End Sub
  217.  
  218. #End Region
  219.  
  220. #Region " Event Handlers "
  221.  
  222.    ''' <summary>
  223.    ''' Handles the MouseEnter event of the control.
  224.    ''' </summary>
  225.    ''' <param name="sender">The source of the event.</param>
  226.    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  227.    Private Sub ctrl_MouseEnter(ByVal sender As Object, ByVal e As EventArgs) _
  228.    Handles _ctrl.MouseEnter
  229.  
  230.        Me.oldCursor = Me._ctrl.Cursor
  231.  
  232.        If Me.Enabled Then
  233.  
  234.            Me._ctrl.Cursor = Me.Cursor
  235.            Me._ctrl.BringToFront()
  236.  
  237.        End If
  238.  
  239.    End Sub
  240.  
  241.    ''' <summary>
  242.    ''' Handles the MouseLeave event of the control.
  243.    ''' </summary>
  244.    ''' <param name="sender">The source of the event.</param>
  245.    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  246.    Private Sub ctrl_MouseLeave(ByVal sender As Object, ByVal e As EventArgs) _
  247.    Handles _ctrl.MouseLeave
  248.  
  249.        Me._ctrl.Cursor = Me.oldCursor
  250.  
  251.    End Sub
  252.  
  253.    ''' <summary>
  254.    ''' Handles the MouseDown event of the control.
  255.    ''' </summary>
  256.    ''' <param name="sender">The source of the event.</param>
  257.    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
  258.    Private Sub ctrl_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) _
  259.    Handles _ctrl.MouseDown
  260.  
  261.        If Me.Enabled Then
  262.  
  263.            Me.DragInfo = New ControlDragger(Control.MousePosition, Me._ctrl.Location)
  264.  
  265.        End If
  266.  
  267.    End Sub
  268.  
  269.    ''' <summary>
  270.    ''' Handles the MouseMove event of the control.
  271.    ''' </summary>
  272.    ''' <param name="sender">The source of the event.</param>
  273.    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
  274.    Private Sub ctrl_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) _
  275.    Handles _ctrl.MouseMove
  276.  
  277.        If Me.Enabled AndAlso (Me.DragInfo IsNot ControlDragger.Empty) Then
  278.  
  279.            Me._ctrl.Location = New Point(Me.DragInfo.GetNewLocation(Control.MousePosition))
  280.  
  281.        End If
  282.  
  283.    End Sub
  284.  
  285.    ''' <summary>
  286.    ''' Handles the MouseUp event of the control.
  287.    ''' </summary>
  288.    ''' <param name="sender">The source of the event.</param>
  289.    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
  290.    Private Sub ctrl_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs) _
  291.    Handles _ctrl.MouseUp
  292.  
  293.        Me.DragInfo = ControlDragger.Empty
  294.  
  295.    End Sub
  296.  
  297. #End Region
  298.  
  299. #Region " IDisposable "
  300.  
  301.    ''' <summary>
  302.    ''' To detect redundant calls when disposing.
  303.    ''' </summary>
  304.    Private IsDisposed As Boolean = False
  305.  
  306.    ''' <summary>
  307.    ''' Prevent calls to methods after disposing.
  308.    ''' </summary>
  309.    ''' <exception cref="System.ObjectDisposedException"></exception>
  310.    Private Sub DisposedCheck()
  311.  
  312.        If Me.IsDisposed Then
  313.            Throw New ObjectDisposedException(Me.GetType().FullName)
  314.        End If
  315.  
  316.    End Sub
  317.  
  318.    ''' <summary>
  319.    ''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.
  320.    ''' </summary>
  321.    Public Sub Dispose() Implements IDisposable.Dispose
  322.        Dispose(True)
  323.        GC.SuppressFinalize(Me)
  324.    End Sub
  325.  
  326.    ''' <summary>
  327.    ''' Releases unmanaged and - optionally - managed resources.
  328.    ''' </summary>
  329.    ''' <param name="IsDisposing">
  330.    ''' <c>true</c> to release both managed and unmanaged resources;
  331.    ''' <c>false</c> to release only unmanaged resources.
  332.    ''' </param>
  333.    Protected Sub Dispose(ByVal IsDisposing As Boolean)
  334.  
  335.        If Not Me.IsDisposed Then
  336.  
  337.            If IsDisposing Then
  338.  
  339.                With Me._ctrl
  340.  
  341.                    If Not .IsDisposed AndAlso Not .Disposing Then
  342.  
  343.                        RemoveHandler .MouseEnter, AddressOf ctrl_MouseEnter
  344.                        RemoveHandler .MouseLeave, AddressOf ctrl_MouseLeave
  345.                        RemoveHandler .MouseDown, AddressOf ctrl_MouseDown
  346.                        RemoveHandler .MouseMove, AddressOf ctrl_MouseMove
  347.                        RemoveHandler .MouseUp, AddressOf ctrl_MouseUp
  348.  
  349.                    End If
  350.  
  351.                End With ' Me._ctrl
  352.  
  353.                With Me
  354.  
  355.                    .Enabled = False
  356.                    .DragInfo = ControlDragger.Empty
  357.                    .InitialMouseCoords = Point.Empty
  358.                    .InitialLocation = Point.Empty
  359.                    .oldCursor = Nothing
  360.                    ._ctrl = Nothing
  361.  
  362.                End With ' Me
  363.  
  364.            End If ' IsDisposing
  365.  
  366.        End If ' Not Me.IsDisposed
  367.  
  368.        Me.IsDisposed = True
  369.  
  370.    End Sub
  371.  
  372. #End Region
  373.  
  374. End Class
  375.  
  376. #End Region



Ejemplo de cómo añadir en tiempo de ejecución la característica Resize (redimensionar) en un control, para redimensionarlo por la UI.

Código
  1. ' ***********************************************************************
  2. ' Author           : Elektro
  3. ' Last Modified On : 11-10-2014
  4. ' ***********************************************************************
  5. ' <copyright file="ControlResizer.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. 'Public Class Form1
  13. '
  14. '    Private Resizer As ControlResizer = ControlResizer.Empty
  15. '
  16. '    Private Sub InitializeResizer()
  17. '        Me.Resizer = New ControlResizer(Button1)
  18. '        Me.Resizer.Enabled = True
  19. '        Me.Resizer.PixelMargin = 4
  20. '    End Sub
  21. '
  22. '    Private Sub AlternateResizer()
  23. '        Me.Resizer.Enabled = Not Resizer.Enabled
  24. '    End Sub
  25. '
  26. '    Private Sub FinishResizer()
  27. '        Me.Resizer.Dispose()
  28. '    End Sub
  29. '
  30. '    Private Sub Test() Handles MyBase.Shown
  31. '        Me.InitializeResizer()
  32. '    End Sub
  33. '
  34. 'End Class
  35.  
  36. #End Region
  37.  
  38. #Region " Imports "
  39.  
  40. Imports System.ComponentModel
  41.  
  42. #End Region
  43.  
  44. #Region " Control Resizer "
  45.  
  46. ''' <summary>
  47. ''' Enable or disable resize at runtime on a <see cref="Control"/>.
  48. ''' </summary>
  49. Public Class ControlResizer : Implements IDisposable
  50.  
  51. #Region " Properties "
  52.  
  53. #Region " Visible "
  54.  
  55.    ''' <summary>
  56.    ''' Gets the associated <see cref="Control"/> used to perform resizable operations.
  57.    ''' </summary>
  58.    ''' <value>The control.</value>
  59.    <EditorBrowsable(EditorBrowsableState.Always)>
  60.    <Description("The associated Control used to perform resizable operations.")>
  61.    Friend ReadOnly Property Control As Control
  62.        Get
  63.            Return Me._ctrl
  64.        End Get
  65.    End Property
  66.    ''' <summary>
  67.    ''' The associated <see cref="Control"/> used to perform draggable operations.
  68.    ''' </summary>
  69.    Private WithEvents _ctrl As Control = Nothing
  70.  
  71.    ''' <summary>
  72.    ''' Gets or sets the pixel margin required to activate resize indicators.
  73.    ''' </summary>
  74.    ''' <value>The pixel margin required activate resize indicators.</value>
  75.    <EditorBrowsable(EditorBrowsableState.Always)>
  76.    <Description("The associated Control used to perform resizable operations.")>
  77.    Friend Property PixelMargin As Integer = 4I
  78.  
  79.    ''' <summary>
  80.    ''' Gets or sets a value indicating whether resize is enabled on the associated <see cref="Control"/>.
  81.    ''' </summary>
  82.    ''' <value><c>true</c> if resize is enabled; otherwise, <c>false</c>.</value>
  83.    <EditorBrowsable(EditorBrowsableState.Always)>
  84.    <Description("A value indicating whether resize is enabled on the associated control.")>
  85.    Friend Property Enabled As Boolean = True
  86.  
  87.    ''' <summary>
  88.    ''' Represents a <see cref="T:ControlResizer"/> instance that is <c>Nothing</c>.
  89.    ''' </summary>
  90.    ''' <value><c>Nothing</c></value>
  91.    <EditorBrowsable(EditorBrowsableState.Always)>
  92.    <Description("Represents a ControlResizer instance that is Nothing.")>
  93.    Public Shared ReadOnly Property Empty As ControlResizer
  94.        Get
  95.            Return Nothing
  96.        End Get
  97.    End Property
  98.  
  99. #End Region
  100.  
  101. #Region " Hidden "
  102.  
  103.    ''' <summary>
  104.    ''' Gets or sets a value indicating whether the left mouse button is down.
  105.    ''' </summary>
  106.    ''' <value><c>true</c> if left mouse button is down; otherwise, <c>false</c>.</value>
  107.    Private Property IsLeftMouseButtonDown As Boolean = False
  108.  
  109.    ''' <summary>
  110.    ''' Gets or sets the current active edge.
  111.    ''' </summary>
  112.    ''' <value>The current active edge.</value>
  113.    Private Property ActiveEdge As Edges = Edges.None
  114.  
  115.    ''' <summary>
  116.    ''' Gets or sets the old control's cursor to restore it after resizing.
  117.    ''' </summary>
  118.    ''' <value>The old control's cursor.</value>
  119.    Private Property oldCursor As Cursor = Nothing
  120.  
  121. #End Region
  122.  
  123. #End Region
  124.  
  125. #Region " Enumerations "
  126.  
  127.    ''' <summary>
  128.    ''' Contains the Edges.
  129.    ''' </summary>
  130.    Private Enum Edges As Integer
  131.  
  132.        ''' <summary>
  133.        ''' Any edge.
  134.        ''' </summary>
  135.        None = 0I
  136.  
  137.        ''' <summary>
  138.        ''' Left edge.
  139.        ''' </summary>
  140.        Left = 1I
  141.  
  142.        ''' <summary>
  143.        ''' Right edge.
  144.        ''' </summary>
  145.        Right = 2I
  146.  
  147.        ''' <summary>
  148.        ''' Top edge.
  149.        ''' </summary>
  150.        Top = 3I
  151.  
  152.        ''' <summary>
  153.        ''' Bottom edge.
  154.        ''' </summary>
  155.        Bottom = 4I
  156.  
  157.        ''' <summary>
  158.        ''' Top-Left edge.
  159.        ''' </summary>
  160.        TopLeft = 5I
  161.  
  162.        ''' <summary>
  163.        ''' Top-Right edge.
  164.        ''' </summary>
  165.        TopRight = 6I
  166.  
  167.        ''' <summary>
  168.        ''' Bottom-Left edge.
  169.        ''' </summary>
  170.        BottomLeft = 7I
  171.  
  172.        ''' <summary>
  173.        ''' Bottom-Right edge.
  174.        ''' </summary>
  175.        BottomRight = 8I
  176.  
  177.    End Enum
  178.  
  179. #End Region
  180.  
  181. #Region " Constructors "
  182.  
  183.    ''' <summary>
  184.    ''' Prevents a default instance of the <see cref="ControlResizer"/> class from being created.
  185.    ''' </summary>
  186.    Private Sub New()
  187.    End Sub
  188.  
  189.    ''' <summary>
  190.    ''' Initializes a new instance of the <see cref="ControlResizer"/> class.
  191.    ''' </summary>
  192.    ''' <param name="ctrl">The control.</param>
  193.    Public Sub New(ByVal ctrl As Control)
  194.  
  195.        Me._ctrl = ctrl
  196.  
  197.    End Sub
  198.  
  199. #End Region
  200.  
  201. #Region " Event Handlers "
  202.  
  203.    ''' <summary>
  204.    ''' Handles the MouseEnter event of the control.
  205.    ''' </summary>
  206.    ''' <param name="sender">The source of the event.</param>
  207.    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  208.    Private Sub ctrl_MouseEnter(ByVal sender As Object, ByVal e As EventArgs) _
  209.    Handles _ctrl.MouseEnter
  210.  
  211.        Me.oldCursor = Me._ctrl.Cursor
  212.  
  213.    End Sub
  214.  
  215.    ''' <summary>
  216.    ''' Handles the MouseLeave event of the control.
  217.    ''' </summary>
  218.    ''' <param name="sender">The source of the event.</param>
  219.    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  220.    Private Sub ctrl_MouseLeave(ByVal sender As Object, ByVal e As EventArgs) _
  221.    Handles _ctrl.MouseLeave
  222.  
  223.        Me.ActiveEdge = Edges.None
  224.        Me._ctrl.Cursor = Me.oldCursor
  225.  
  226.    End Sub
  227.  
  228.    ''' <summary>
  229.    ''' Handles the MouseDown event of the control.
  230.    ''' </summary>
  231.    ''' <param name="sender">The source of the event.</param>
  232.    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
  233.    Private Sub ctrl_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) _
  234.    Handles _ctrl.MouseDown
  235.  
  236.        Me.IsLeftMouseButtonDown = (e.Button = MouseButtons.Left)
  237.  
  238.    End Sub
  239.  
  240.    ''' <summary>
  241.    ''' Handles the MouseUp event of the control.
  242.    ''' </summary>
  243.    ''' <param name="sender">The source of the event.</param>
  244.    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
  245.    Private Sub ctrl_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs) _
  246.    Handles _ctrl.MouseUp
  247.  
  248.        Me.IsLeftMouseButtonDown = False
  249.  
  250.    End Sub
  251.  
  252.    ''' <summary>
  253.    ''' Handles the MouseMove event of the control.
  254.    ''' </summary>
  255.    ''' <param name="sender">The source of the event.</param>
  256.    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
  257.    Private Sub ctrl_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) _
  258.    Handles _ctrl.MouseMove
  259.  
  260.        If Not Me.Enabled Then
  261.            Exit Sub
  262.  
  263.        ElseIf (Me.IsLeftMouseButtonDown) AndAlso Not (Me.ActiveEdge = Edges.None) Then
  264.            Me.SetControlBounds(e)
  265.  
  266.        Else
  267.            Me.SetActiveEdge(e)
  268.            Me.SetSizeCursor()
  269.  
  270.        End If
  271.  
  272.    End Sub
  273.  
  274. #End Region
  275.  
  276. #Region " Private Methods "
  277.  
  278.    ''' <summary>
  279.    ''' Sets the active edge.
  280.    ''' </summary>
  281.    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
  282.    Private Sub SetActiveEdge(ByVal e As MouseEventArgs)
  283.  
  284.        Select Case True
  285.  
  286.            ' Top-Left Corner
  287.            Case e.X <= (Me.PixelMargin * 2) AndAlso
  288.                 e.Y <= (Me.PixelMargin * 2)
  289.  
  290.                Me.ActiveEdge = Edges.TopLeft
  291.  
  292.                ' TopRight Corner
  293.            Case e.X > Me._ctrl.Width - (Me.PixelMargin * 2) AndAlso
  294.                 e.Y <= (Me.PixelMargin * 2)
  295.  
  296.                Me.ActiveEdge = Edges.TopRight
  297.  
  298.                ' Bottom-Left Corner
  299.            Case (e.X <= Me.PixelMargin * 2) AndAlso
  300.                 (e.Y > Me._ctrl.Height - (Me.PixelMargin * 2))
  301.  
  302.                Me.ActiveEdge = Edges.BottomLeft
  303.  
  304.                ' Bottom-Right Corner
  305.            Case (e.X > Me._ctrl.Width - (Me.PixelMargin * 2) - 1) AndAlso
  306.                 (e.Y > Me._ctrl.Height - (Me.PixelMargin * 2))
  307.  
  308.                Me.ActiveEdge = Edges.BottomRight
  309.  
  310.  
  311.                ' Left Edge
  312.            Case e.X <= Me.PixelMargin
  313.                Me.ActiveEdge = Edges.Left
  314.  
  315.                ' Right Edge
  316.            Case e.X > Me._ctrl.Width - (Me.PixelMargin + 1)
  317.                Me.ActiveEdge = Edges.Right
  318.  
  319.                ' Top Edge
  320.            Case e.Y <= Me.PixelMargin
  321.                Me.ActiveEdge = Edges.Top
  322.  
  323.                ' Bottom Edge
  324.            Case e.Y > Me._ctrl.Height - (Me.PixelMargin + 1)
  325.                Me.ActiveEdge = Edges.Bottom
  326.  
  327.            Case Else ' Any Edge
  328.                Me.ActiveEdge = Edges.None
  329.  
  330.        End Select
  331.  
  332.    End Sub
  333.  
  334.    ''' <summary>
  335.    ''' Sets the size cursor.
  336.    ''' </summary>
  337.    Private Sub SetSizeCursor()
  338.  
  339.        Select Case Me.ActiveEdge
  340.  
  341.            Case Edges.Left
  342.                Me._ctrl.Cursor = Cursors.SizeWE
  343.  
  344.            Case Edges.Right
  345.                Me._ctrl.Cursor = Cursors.SizeWE
  346.  
  347.            Case Edges.Top
  348.                Me._ctrl.Cursor = Cursors.SizeNS
  349.  
  350.            Case Edges.Bottom
  351.                Me._ctrl.Cursor = Cursors.SizeNS
  352.  
  353.            Case Edges.TopLeft
  354.                Me._ctrl.Cursor = Cursors.SizeNWSE
  355.  
  356.            Case Edges.TopRight
  357.                Me._ctrl.Cursor = Cursors.SizeNESW
  358.  
  359.            Case Edges.BottomLeft
  360.                Me._ctrl.Cursor = Cursors.SizeNESW
  361.  
  362.            Case Edges.BottomRight
  363.                Me._ctrl.Cursor = Cursors.SizeNWSE
  364.  
  365.            Case Edges.None
  366.                If Me.oldCursor IsNot Nothing Then
  367.                    Me._ctrl.Cursor = Me.oldCursor
  368.                End If
  369.  
  370.        End Select
  371.  
  372.    End Sub
  373.  
  374.    ''' <summary>
  375.    ''' Sets the control bounds.
  376.    ''' </summary>
  377.    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
  378.    Private Sub SetControlBounds(ByVal e As MouseEventArgs)
  379.  
  380.        If Me._ctrl.Size.Width = Me._ctrl.MinimumSize.Width Then
  381.            ' Exit Sub
  382.        Else
  383.            Debug.WriteLine(Me._ctrl.Size.ToString)
  384.        End If
  385.  
  386.        Me._ctrl.SuspendLayout()
  387.  
  388.        Select Case Me.ActiveEdge
  389.  
  390.            Case Edges.Left
  391.                If Not Me._ctrl.Width - e.X < (Me._ctrl.MinimumSize.Width) Then
  392.                    Me._ctrl.SetBounds(x:=Me._ctrl.Left + e.X,
  393.                                       y:=Me._ctrl.Top,
  394.                                       width:=Me._ctrl.Width - e.X,
  395.                                       height:=Me._ctrl.Height)
  396.                End If
  397.  
  398.            Case Edges.Right
  399.                Me._ctrl.SetBounds(x:=Me._ctrl.Left,
  400.                                   y:=Me._ctrl.Top,
  401.                                   width:=Me._ctrl.Width - (Me._ctrl.Width - e.X),
  402.                                   height:=Me._ctrl.Height)
  403.  
  404.            Case Edges.Top
  405.                If Not Me._ctrl.Height - e.Y < (Me._ctrl.MinimumSize.Height) Then
  406.                    Me._ctrl.SetBounds(x:=Me._ctrl.Left,
  407.                                       y:=Me._ctrl.Top + e.Y,
  408.                                       width:=Me._ctrl.Width,
  409.                                       height:=Me._ctrl.Height - e.Y)
  410.                End If
  411.  
  412.            Case Edges.Bottom
  413.                Me._ctrl.SetBounds(x:=Me._ctrl.Left,
  414.                                   y:=Me._ctrl.Top,
  415.                                   width:=Me._ctrl.Width,
  416.                                   height:=Me._ctrl.Height - (Me._ctrl.Height - e.Y))
  417.  
  418.            Case Edges.TopLeft
  419.                Me._ctrl.SetBounds(x:=If(Not Me._ctrl.Width - e.X < (Me._ctrl.MinimumSize.Width),
  420.                                         Me._ctrl.Left + e.X,
  421.                                         Me._ctrl.Left),
  422.                                   y:=If(Not Me._ctrl.Height - e.Y < (Me._ctrl.MinimumSize.Height),
  423.                                         Me._ctrl.Top + e.Y,
  424.                                         Me._ctrl.Top),
  425.                                   width:=If(Not Me._ctrl.Width - e.X < (Me._ctrl.MinimumSize.Width),
  426.                                             Me._ctrl.Width - e.X,
  427.                                             Me._ctrl.Width),
  428.                                   height:=If(Not Me._ctrl.Height - e.Y < (Me._ctrl.MinimumSize.Height),
  429.                                              Me._ctrl.Height - e.Y,
  430.                                              Me._ctrl.Height))
  431.  
  432.            Case Edges.TopRight
  433.                Me._ctrl.SetBounds(x:=Me._ctrl.Left,
  434.                                   y:=If(Not Me._ctrl.Height - e.Y < (Me._ctrl.MinimumSize.Height),
  435.                                         Me._ctrl.Top + e.Y,
  436.                                         Me._ctrl.Top),
  437.                                   width:=Me._ctrl.Width - (Me._ctrl.Width - e.X),
  438.                                   height:=If(Not Me._ctrl.Height - e.Y < (Me._ctrl.MinimumSize.Height),
  439.                                              Me._ctrl.Height - e.Y,
  440.                                              Me._ctrl.Height))
  441.  
  442.            Case Edges.BottomLeft
  443.                Me._ctrl.SetBounds(x:=If(Not Me._ctrl.Width - e.X < (Me._ctrl.MinimumSize.Width),
  444.                                         Me._ctrl.Left + e.X,
  445.                                         Me._ctrl.Left),
  446.                                   y:=Me._ctrl.Top,
  447.                                   width:=If(Not Me._ctrl.Width - e.X < (Me._ctrl.MinimumSize.Width),
  448.                                             Me._ctrl.Width - e.X,
  449.                                             Me._ctrl.Width),
  450.                                   height:=Me._ctrl.Height - (Me._ctrl.Height - e.Y))
  451.  
  452.            Case Edges.BottomRight
  453.                Me._ctrl.SetBounds(x:=Me._ctrl.Left,
  454.                                   y:=Me._ctrl.Top,
  455.                                   width:=Me._ctrl.Width - (Me._ctrl.Width - e.X),
  456.                                   height:=Me._ctrl.Height - (Me._ctrl.Height - e.Y))
  457.  
  458.        End Select
  459.  
  460.        Me._ctrl.ResumeLayout()
  461.  
  462.    End Sub
  463.  
  464. #End Region
  465.  
  466. #Region " Hidden Methods "
  467.  
  468.    ''' <summary>
  469.    ''' Serves as a hash function for a particular type.
  470.    ''' </summary>
  471.    <EditorBrowsable(EditorBrowsableState.Never)>
  472.    Public Shadows Sub GetHashCode()
  473.    End Sub
  474.  
  475.    ''' <summary>
  476.    ''' Gets the System.Type of the current instance.
  477.    ''' </summary>
  478.    ''' <returns>The exact runtime type of the current instance.</returns>
  479.    <EditorBrowsable(EditorBrowsableState.Never)>
  480.    Public Shadows Function [GetType]()
  481.        Return Me.GetType
  482.    End Function
  483.  
  484.    ''' <summary>
  485.    ''' Determines whether the specified System.Object instances are considered equal.
  486.    ''' </summary>
  487.    <EditorBrowsable(EditorBrowsableState.Never)>
  488.    Public Shadows Sub Equals()
  489.    End Sub
  490.  
  491.    ''' <summary>
  492.    ''' Determines whether the specified System.Object instances are the same instance.
  493.    ''' </summary>
  494.    <EditorBrowsable(EditorBrowsableState.Never)>
  495.    Private Shadows Sub ReferenceEquals()
  496.    End Sub
  497.  
  498.    ''' <summary>
  499.    ''' Returns a String that represents the current object.
  500.    ''' </summary>
  501.    <EditorBrowsable(EditorBrowsableState.Never)>
  502.    Public Shadows Sub ToString()
  503.    End Sub
  504.  
  505. #End Region
  506.  
  507. #Region " IDisposable "
  508.  
  509.    ''' <summary>
  510.    ''' To detect redundant calls when disposing.
  511.    ''' </summary>
  512.    Private IsDisposed As Boolean = False
  513.  
  514.    ''' <summary>
  515.    ''' Prevent calls to methods after disposing.
  516.    ''' </summary>
  517.    ''' <exception cref="System.ObjectDisposedException"></exception>
  518.    Private Sub DisposedCheck()
  519.  
  520.        If Me.IsDisposed Then
  521.            Throw New ObjectDisposedException(Me.GetType().FullName)
  522.        End If
  523.  
  524.    End Sub
  525.  
  526.    ''' <summary>
  527.    ''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.
  528.    ''' </summary>
  529.    Public Sub Dispose() Implements IDisposable.Dispose
  530.        Dispose(True)
  531.        GC.SuppressFinalize(Me)
  532.    End Sub
  533.  
  534.    ''' <summary>
  535.    ''' Releases unmanaged and - optionally - managed resources.
  536.    ''' </summary>
  537.    ''' <param name="IsDisposing">
  538.    ''' <c>true</c> to release both managed and unmanaged resources;
  539.    ''' <c>false</c> to release only unmanaged resources.
  540.    ''' </param>
  541.    Protected Sub Dispose(ByVal IsDisposing As Boolean)
  542.  
  543.        If Not Me.IsDisposed Then
  544.  
  545.            If IsDisposing Then
  546.  
  547.                With Me._ctrl
  548.  
  549.                    If Not .IsDisposed AndAlso Not .Disposing Then
  550.  
  551.                        RemoveHandler .MouseEnter, AddressOf ctrl_MouseEnter
  552.                        RemoveHandler .MouseLeave, AddressOf ctrl_MouseLeave
  553.                        RemoveHandler .MouseDown, AddressOf ctrl_MouseDown
  554.                        RemoveHandler .MouseMove, AddressOf ctrl_MouseMove
  555.                        RemoveHandler .MouseUp, AddressOf ctrl_MouseUp
  556.  
  557.                    End If
  558.  
  559.                End With ' Me._ctrl
  560.  
  561.                With Me
  562.  
  563.                    .Enabled = False
  564.                    .oldCursor = Nothing
  565.                    ._ctrl = Nothing
  566.  
  567.                End With ' Me
  568.  
  569.            End If ' IsDisposing
  570.  
  571.        End If ' Not Me.IsDisposed
  572.  
  573.        Me.IsDisposed = True
  574.  
  575.    End Sub
  576.  
  577. #End Region
  578.  
  579. End Class
  580.  
  581. #End Region
En línea



Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.874



Ver Perfil
Re: Librería de Snippets !! (Compartan aquí sus snippets)
« Respuesta #446 en: 30 Noviembre 2014, 01:58 am »

Una actualización de este snippet para añadir el efecto de parpadeo a un control, o al texto de un control, es muy sencillo de usar.

Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 16-November-2014
  4. ' ***********************************************************************
  5. ' <copyright file="Blinker.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Option Restrictions "
  11.  
  12. Option Strict On
  13. Option Explicit On
  14. Option Infer Off
  15.  
  16. #End Region
  17.  
  18. #Region " Usage Examples "
  19.  
  20. 'Public Class Form1
  21. '
  22. '    Private labelBlinker As Blinker
  23. '
  24. '    Private Shadows Sub Shown() Handles MyBase.Shown
  25. '
  26. '        Me.labelBlinker = New Blinker(ctrl:=Label1)
  27. '
  28. '        ' Blink
  29. '        With Me.labelBlinker
  30. '            .Blink(interval:=500)
  31. '            .BlinkText(interval:=500, customText:="Custom Text!")
  32. '        End With
  33. '
  34. '        ' Unblink
  35. '        With Me.labelBlinker
  36. '            .Unblink(visible:=True)
  37. '            .UnblinkText(restoreText:=True)
  38. '        End With
  39. '
  40. '    End Sub
  41. '
  42. 'End Class
  43.  
  44. #End Region
  45.  
  46. ''' <summary>
  47. ''' Blinks a Control.
  48. ''' </summary>
  49. Friend NotInheritable Class Blinker
  50.  
  51. #Region " Properties "
  52.  
  53.    ''' <summary>
  54.    ''' Gets or sets the control to blink.
  55.    ''' </summary>
  56.    ''' <value>The control to blink.</value>
  57.    Friend Property Ctrl As Control
  58.  
  59. #End Region
  60.  
  61. #Region " Objects "
  62.  
  63.    ''' <summary>
  64.    ''' A custom text to restore it after blinking the control.
  65.    ''' </summary>
  66.    Private textToRestore As String
  67.  
  68.    ''' <summary>
  69.    ''' A Timer to blink a control.
  70.    ''' </summary>
  71.    Private WithEvents blinkTimer As Timer
  72.  
  73.    ''' <summary>
  74.    ''' A Timer to blink the text of a control.
  75.    ''' </summary>
  76.    Private WithEvents blinkTextTimer As Timer
  77.  
  78.    ''' <summary>
  79.    ''' Determines whether the control is blinking.
  80.    ''' </summary>
  81.    Private isBlinking As Boolean = False
  82.  
  83.    ''' <summary>
  84.    ''' Determines whether the text of the control is blinking.
  85.    ''' </summary>
  86.    Private isBlinkingText As Boolean = False
  87.  
  88. #End Region
  89.  
  90. #Region " Constructors "
  91.  
  92.    ''' <summary>
  93.    ''' Initializes a new instance of the <see cref="Blinker" /> class.
  94.    ''' </summary>
  95.    ''' <param name="ctrl">Indicates the control to blink.</param>
  96.    Public Sub New(ByVal ctrl As Control)
  97.  
  98.        ' Assign the control to blink.
  99.        Me.Ctrl = ctrl
  100.  
  101.    End Sub
  102.  
  103.    ''' <summary>
  104.    ''' Prevents a default instance of the <see cref="Blinker"/> class from being created.
  105.    ''' </summary>
  106.    Private Sub New()
  107.    End Sub
  108.  
  109. #End Region
  110.  
  111. #Region " Public Methods "
  112.  
  113.    ''' <summary>
  114.    ''' Blinks the Control.
  115.    ''' </summary>
  116.    ''' <param name="Interval">Indicates the blink interval, in ms.</param>
  117.    Public Sub Blink(Optional ByVal interval As Integer = 500I)
  118.  
  119.        If blinkTimer Is Nothing Then
  120.            blinkTimer = New Timer
  121.        End If
  122.  
  123.        With blinkTimer
  124.            .Interval = interval
  125.            .Enabled = True
  126.        End With
  127.  
  128.        Me.isBlinking = True
  129.  
  130.    End Sub
  131.  
  132.    ''' <summary>
  133.    ''' Stop blinking the Control.
  134.    ''' </summary>
  135.    ''' <param name="Visible">Indicates the visibility of the control.</param>
  136.    Public Sub Unblink(Optional ByVal visible As Boolean = True)
  137.  
  138.        If Not isBlinking Then
  139.            Exit Sub
  140.        End If
  141.  
  142.        With blinkTimer
  143.            .Enabled = False
  144.        End With
  145.  
  146.        Me.Ctrl.Visible = visible
  147.        Me.isBlinking = False
  148.  
  149.    End Sub
  150.  
  151.    ''' <summary>
  152.    ''' Blinks the text content of the Control.
  153.    ''' </summary>
  154.    ''' <param name="Interval">Indicates the blink interval.</param>
  155.    ''' <param name="CustomText">Indicates a custom text to blink.</param>
  156.    Public Sub BlinkText(Optional ByVal interval As Integer = 500I,
  157.                         Optional ByVal customText As String = Nothing)
  158.  
  159.        If blinkTextTimer Is Nothing Then
  160.            blinkTextTimer = New Timer
  161.        End If
  162.  
  163.        With blinkTextTimer
  164.            .Tag = If(String.IsNullOrEmpty(customText), Me.Ctrl.Text, customText)
  165.            .Interval = interval
  166.            .Enabled = True
  167.        End With
  168.  
  169.        Me.textToRestore = Me.Ctrl.Text
  170.        Me.isBlinkingText = True
  171.  
  172.    End Sub
  173.  
  174.    ''' <summary>
  175.    ''' Stop blinking the text content of the Control.
  176.    ''' </summary>
  177.    ''' <param name="RestoreText">If set to <c>true</c>, the control text is resetted to the initial state before started blinking.</param>
  178.    Public Sub UnblinkText(Optional ByVal restoreText As Boolean = False)
  179.  
  180.        If Not isBlinkingText Then
  181.            Exit Sub
  182.        End If
  183.  
  184.        With blinkTextTimer
  185.            .Enabled = False
  186.        End With
  187.  
  188.        If restoreText Then
  189.            Me.Ctrl.Text = Me.textToRestore
  190.        End If
  191.  
  192.        Me.isBlinkingText = False
  193.  
  194.    End Sub
  195.  
  196. #End Region
  197.  
  198. #Region " Event Handlers"
  199.  
  200.    ''' <summary>
  201.    ''' Handles the Tick event of the BlinkTimer control.
  202.    ''' </summary>
  203.    ''' <param name="sender">The source of the event.</param>
  204.    ''' <param name="e">The <see cref="EventArgs" /> instance containing the event data.</param>
  205.    Private Sub BlinkTimer_Tick(ByVal sender As Object, ByVal e As EventArgs) _
  206.    Handles blinkTimer.Tick
  207.  
  208.        Me.Ctrl.Visible = Not Me.Ctrl.Visible
  209.  
  210.    End Sub
  211.  
  212.    ''' <summary>
  213.    ''' Handles the Tick event of the BlinkTextTimer control.
  214.    ''' </summary>
  215.    ''' <param name="sender">The source of the event.</param>
  216.    ''' <param name="e">The <see cref="EventArgs" /> instance containing the event data.</param>
  217.    Private Sub BlinkTextTimer_Tick(ByVal sender As Object, ByVal e As EventArgs) _
  218.    Handles blinkTextTimer.Tick
  219.  
  220.        If String.IsNullOrEmpty(Me.Ctrl.Text) Then
  221.            Me.Ctrl.Text = DirectCast(DirectCast(sender, Timer).Tag, String)
  222.  
  223.        Else
  224.            Me.Ctrl.Text = String.Empty
  225.  
  226.        End If
  227.  
  228.    End Sub
  229.  
  230. #End Region
  231.  
  232. End Class
En línea



TrashAmbishion


Desconectado Desconectado

Mensajes: 756


Ver Perfil
Re: Librería de Snippets !! (Compartan aquí sus snippets)
« Respuesta #447 en: 27 Diciembre 2014, 19:38 pm »

Chevere los snippets estan actualizados con los ultimos ejemplos que estas publicando, salu2 y gracias por los aportes, son muy utiles
En línea

Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.874



Ver Perfil
Re: Librería de Snippets !! (Compartan aquí sus snippets)
« Respuesta #448 en: 28 Diciembre 2014, 11:51 am »

Chevere los snippets estan actualizados con los ultimos ejemplos que estas publicando, salu2 y gracias por los aportes, son muy utiles

Gracias por comentar :)



He ideado este código para ordenar una base de datos de firmas de la aplicación PeId, y eliminar firmas duplicadas:

http://www.aldeid.com/wiki/PEiD#PEiD

Código
  1.        Dim commentPattern As New Regex(";.+", RegexOptions.Multiline)
  2.        Dim blockPattern As New Regex("\n\s+?$", RegexOptions.Multiline)
  3.        Dim namePattern As New Regex("\[(.+)\]", RegexOptions.Singleline)
  4.        Dim sigPattern As New Regex("signature\s=\s(.+)", RegexOptions.Singleline)
  5.  
  6.        Dim userDB As String = File.ReadAllText(".\UserDB.txt", Encoding.UTF8)
  7.  
  8.        Dim orderedBlocks As IEnumerable(Of String) =
  9.            From match As String In blockPattern.Split(userDB)
  10.            Order By namePattern.Match(match).Value
  11.            Select commentPattern.Replace(match, "").
  12.                   Trim(Environment.NewLine.ToCharArray)
  13.  
  14.        Dim distinctedBlocks As IEnumerable(Of String) =
  15.            From match As String In orderedBlocks
  16.            Group By sigPattern.Match(match).Value
  17.            Into Group
  18.            Select Group.First
  19.  
  20.        File.WriteAllText(".\New_UserDB.txt", String.Join(New String(ControlChars.Lf, 2), distinctedBlocks), Encoding.UTF8)
  21.  
En línea



Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.874



Ver Perfil
Re: Librería de Snippets !! (Compartan aquí sus snippets)
« Respuesta #449 en: 19 Enero 2015, 16:03 pm »

Compriimir una imagen mediante pérdida de calidad, hasta el tamaño objetivo:

Código
  1.        ''' <summary>
  2.        ''' Compress an image to the specified target filesize.
  3.        ''' </summary>
  4.        ''' <param name="inputFile">The input image file.</param>
  5.        ''' <param name="targettFile">The target image file.</param>
  6.        ''' <param name="targetImageFormat">The target image format.</param>
  7.        ''' <param name="targetFileSize">The target filesize, in bytes.</param>
  8.        ''' <exception cref="System.NotImplementedException">Resize Image to -1% and reset quality compression...</exception>
  9.        Private Sub CompressImage(ByVal inputFile As String,
  10.                                  ByVal targettFile As String,
  11.                                  ByVal targetImageFormat As ImageFormat,
  12.                                  ByVal targetFileSize As Long)
  13.  
  14.            Dim qualityPercent As Integer = 100
  15.            Dim bmp As New Bitmap(inputFile)
  16.            Dim codecInfo As ImageCodecInfo = (From codec As ImageCodecInfo In ImageCodecInfo.GetImageDecoders
  17.                                               Where codec.FormatID = targetImageFormat.Guid).First
  18.            Dim encoder As Imaging.Encoder = Imaging.Encoder.Quality
  19.            Dim encoderParameters As New EncoderParameters(1)
  20.  
  21.            Using encoderParameter As New EncoderParameter(encoder, qualityPercent)
  22.                encoderParameters.Param(0) = encoderParameter
  23.                bmp.Save(targettFile, codecInfo, encoderParameters)
  24.            End Using
  25.  
  26.            Dim fInfo As New FileInfo(targettFile)
  27.  
  28.            Do Until fInfo.Length <= targetFileSize
  29.  
  30.                qualityPercent -= 1
  31.  
  32.                If qualityPercent = 50 Then ' Esto lo pongo de manera opcional.
  33.                    Throw New NotImplementedException("Resize Image to -1% and reset quality compression...")
  34.                End If
  35.  
  36.               ' If qualityPercent = 60 Then
  37.               '     resizePercent -= 1
  38.               '     bmp = ImageTools.ResizeImage(bmp, resizePercent)
  39.               '     qualityPercent = 99
  40.               ' End If
  41.  
  42.                Using encoderParameter As New EncoderParameter(encoder, qualityPercent)
  43.                    encoderParameters.Param(0) = encoderParameter
  44.                    bmp.Save(targettFile, codecInfo, encoderParameters)
  45.                End Using
  46.                fInfo = New FileInfo(targettFile)
  47.  
  48.            Loop
  49.  
  50.            encoderParameters.Dispose()
  51.            bmp.Dispose()
  52.  
  53.        End Sub

Plus esta funcion para redimensionar una imagen mediante porcentaje, para utilizarla en conjunto con el método de arriba:

Código
  1.        ''' <summary>
  2.        ''' Resizes an image by a percentage.
  3.        ''' </summary>
  4.        ''' <param name="Bitmap">Indicates the image to resize.</param>
  5.        ''' <param name="Percent">Indicates the percent size.</param>
  6.        ''' <returns>Bitmap.</returns>
  7.        Public Function ResizeImage(ByVal bitmap As Drawing.Bitmap,
  8.                                    ByVal percent As Double,
  9.                                    Optional ByVal quality As Drawing2D.InterpolationMode =
  10.                                                              Drawing2D.InterpolationMode.HighQualityBicubic,
  11.                                    Optional ByVal pixelFormat As Imaging.PixelFormat =
  12.                                                                  Imaging.PixelFormat.Format24bppRgb) As Drawing.Bitmap
  13.  
  14.            Dim width As Integer = (bitmap.Width \ (100I / percent))
  15.            Dim height As Integer = (bitmap.Height \ (100I / percent))
  16.  
  17.            Dim newBitmap As New Bitmap(width, height, pixelFormat)
  18.  
  19.            Using g As Graphics = Graphics.FromImage(newBitmap)
  20.                g.InterpolationMode = quality
  21.                g.DrawImage(bitmap, 0, 0, width, height)
  22.            End Using
  23.  
  24.            Return newBitmap
  25.  
  26.        End Function
« Última modificación: 19 Enero 2015, 16:11 pm por Eleкtro » En línea



Páginas: 1 ... 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 [45] 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 Ir Arriba Respuesta Imprimir 

Ir a:  

WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines