Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)

[Eleкtro]

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

Código (vbnet) [Seleccionar] Expandir

    ' Refresh Windows Explorer
    ' ( by Elektro )
    '
    ' Instructions:
    ' 1. Add a reference to "Microsoft Shell And Controls Automation"
    '
    ' Usage Examples:
    ' RefreshWindowsExplorer()

    ''' <summary>
    ''' Refreshes all the Windows Explorer instances.
    ''' </summary>
    Private Sub RefreshWindowsExplorer()

        ' Indicates the Windows Explorer localized names.
        Dim allowedWindowNames As String() =
            {
                "Windows Explorer",
                "Explorador de archivos"
            }

        ' Shell interface instance.
        Dim shell As New Shell32.Shell

        ' Refresh the Windows Explorer instances asynchronouslly.
        Threading.Tasks.Task.Factory.StartNew(Sub()

                                                  For i As Integer = 0I To (shell.Windows.Count() - 1I)

                                                      Dim window As Object = shell.Windows(i)

                                                      If allowedWindowNames.Contains(window.Name()) Then
                                                          window.Refresh()
                                                      End If

                                                  Next i

                                              End Sub)
    End Sub


Ejemplo de uso:

Código (vbnet) [Seleccionar] Expandir

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

        ' Show checkboxes
        My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced",
                                      "AutoCheckSelect", 1, Microsoft.Win32.RegistryValueKind.DWord)

        RefreshWindowsExplorer()

    End Sub

[Eleкtro]

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 (vbnet) [Seleccionar] Expandir

#Region " Usage Examples "

' Usage Examples:
' MsgBox(Crc32.Calculate("C:\File"))
' MsgBox(Convert.ToString(Crc32.Calculate("C:\File"), 16).ToUpper)

#End Region

#Region " Imports "

Imports System.IO

#End Region

#Region "CRC-32"

''' <summary>
''' ISO 3309 CRC-32 Calculator.
''' </summary>
Public NotInheritable Class Crc32

#Region " Variables "

    ''' <summary>
    ''' The CRC-32 polynomial.
    ''' </summary>
    Private Shared ReadOnly CRC32Poly As UInteger = &HEDB88320UI

    ''' <summary>
    ''' The CRC32 table.
    ''' </summary>
    Private Shared Crc32Table(0UI To 255UI) As UInteger

#End Region

#Region " Constructors "

    ''' <summary>
    ''' Prevents a default instance of the <see cref="Crc32"/> class from being created.
    ''' </summary>
    Private Sub New()
    End Sub

    ''' <summary>
    ''' Initialize the CRC table from the polynomial.
    ''' </summary>
    Shared Sub New()

        Dim i As UInteger
        Dim j As UInteger
        Dim l As UInteger

        For i = 0 To 255

            j = i

            For l = 0 To 7

                If (j And 1) Then
                    j = ((j >> 1) Xor CRC32Poly)
                Else
                    j >>= 1
                End If

            Next l

            Crc32Table(i) = j

        Next i

    End Sub

#End Region

#Region " Public Methods "

    ''' <summary>
    ''' Validates a file against an input CRC.
    ''' </summary>
    ''' <param name="fileName">Filename of the file to validate.</param>
    ''' <param name="inputCrc">The CRC value against which the validation should occur.</param>
    ''' <returns>True if the input CRC matches the calculated CRC of the data.</returns>
    Public Shared Function Validate(ByVal fileName As String,
                                    ByVal inputCrc As UInteger) As Boolean

        Return Calculate(fileName) = inputCrc

    End Function

    ''' <summary>
    ''' Validates a byte array against an input CRC.
    ''' </summary>
    ''' <param name="data">The byte array to validate.</param>
    ''' <param name="inputCrc">The CRC value against which the validation should occur.</param>
    ''' <returns>True if the input CRC matches the calculated CRC of the data.</returns>
    Public Shared Function Validate(ByVal data() As Byte,
                                    ByVal inputCrc As UInteger) As Boolean

        Return Calculate(data) = inputCrc

    End Function

    ''' <summary>
    ''' Calculate the CRC-32 of a file.
    ''' </summary>
    ''' <param name="fileName">Filename of the file to calculate.</param>
    ''' <param name="bufflen">Specify the size, in bytes, of the read buffer to be used (default is 1k).</param>
    ''' <returns>A 32-bit unsigned integer representing the calculated CRC.</returns>
    ''' <exception cref="System.IO.FileNotFoundException">fileName could not be found.</exception>
    Public Shared Function Calculate(ByVal fileName As String,
                                     Optional ByVal bufflen As Integer = 1024) As UInteger

        If (Not File.Exists(fileName)) Then
            Throw New FileNotFoundException(fileName & " could not be found.")
            Return 0
        End If

        Return Calculate(New FileStream(fileName, FileMode.Open, FileAccess.Read, FileShare.Read), bufflen)

    End Function

    ''' <summary>
    ''' Calculate the CRC-32 of an array of bytes.
    ''' </summary>
    ''' <param name="data">Byte array containing the bytes to calculate.</param>
    ''' <param name="startIndex">Specifies the starting index to begin the calculation (default is 0).</param>
    ''' <param name="length">Specify the length of the byte array to check (default is -1, or all bytes).</param>
    ''' <param name="crc">Input CRC value for ongoing calculations (default is FFFFFFFFh).</param>
    ''' <returns>A 32-bit unsigned integer representing the calculated CRC.</returns>
    ''' <exception cref="System.ArgumentNullException">data;data cannot be equal to null.</exception>
    ''' <exception cref="System.ArgumentOutOfRangeException">length;length must be -1 or a positive number.</exception>
    Public Shared Function Calculate(ByVal data() As Byte,
                                     Optional ByVal startIndex As Integer = 0I,
                                     Optional ByVal length As Integer = -1I,
                                     Optional ByVal crc As UInteger = &HFFFFFFFFUI) As UInteger

        If data Is Nothing Then
            Throw New ArgumentNullException("data", "data cannot be equal to null.")
        End If

        If length = -1 Then
            length = data.Length - startIndex
        End If

        If length <= 0 Then
            Throw New ArgumentOutOfRangeException("length", "length must be -1 or a positive number.")
        End If

        Dim j As Integer
        Dim c As Integer = length - 1

        For j = startIndex To c
            crc = Crc32Table((crc Xor data(j)) And &HFF) Xor (crc >> 8)
        Next j

        Calculate = crc Xor &HFFFFFFFFUI

    End Function

    ''' <summary>
    ''' Calculate the CRC-32 of a Stream.
    ''' </summary>
    ''' <param name="stream">The Stream to calculate.</param>
    ''' <param name="bufflen">Specify the size, in bytes, of the read buffer to be used (default is 1k).</param>
    ''' <param name="closeStream">if set to <c>true</c> the stream gets closed after CRC-32 is calculated.</param>
    ''' <returns>A 32-bit unsigned integer representing the calculated CRC.</returns>
    Public Shared Function Calculate(ByVal stream As Stream,
                                     Optional ByVal bufflen As Integer = 1024I,
                                     Optional ByVal closeStream As Boolean = True) As UInteger

        '' our working marshal buffer will be 1k, this is a good compromise between eating up memory and efficiency.
        Dim blen As Integer = bufflen
        Dim crc As UInteger = &HFFFFFFFFUI

        Dim b() As Byte

        Dim i As Long
        Dim l As Long = stream.Length
        Dim c As Long = l - 1

        Dim e As Integer
        Dim j As Integer

        ReDim b(blen - 1)

        For i = 0 To c Step blen

            e = CInt(l - i)

            If e > blen Then
                e = blen
            End If

            If (stream.Position <> i) Then
                stream.Seek(i, SeekOrigin.Begin)
            End If

            stream.Read(b, 0, e)

            e -= 1

            For j = 0 To e
                crc = Crc32Table((crc Xor b(j)) And &HFF) Xor (crc >> 8)
            Next j

        Next i

        If (closeStream) Then
            stream.Close()
        End If

        Calculate = crc Xor &HFFFFFFFFUI

    End Function

#End Region

End Class

#End Region

[Eleкtro]

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

Código (vbnet) [Seleccionar] Expandir

' ***********************************************************************
' Author   : Elektro
' Modified : 29-November-2014
' ***********************************************************************
' <copyright file="StringRenamer.vb" company="Elektro Studios">
'     Copyright (c) Elektro Studios. All rights reserved.
' </copyright>
' ***********************************************************************

#Region " Option Statements "

Option Explicit On
Option Strict On
Option Infer Off

#End Region

#Region " Usage Examples "

' MsgBox(StringRenamer.Rename("Hello World!", StringRenamer.FormatCase.Upper))
' MsgBox(StringRenamer.Rename("Hello World!", StringRenamer.FormatCase.Upper, "\s+", "-", System.Text.RegularExpressions.RegexOptions.None))

#End Region

#Region " Imports "

Imports System.Text
Imports System.Text.RegularExpressions
Imports System.Globalization

#End Region

#Region " String Renamer "

''' <summary>
''' Renames a string.
''' </summary>
Public NotInheritable Class StringRenamer

#Region " Enumerations "

    ''' <summary>
    ''' Specifies a string format case.
    ''' </summary>
    Public Enum FormatCase As Integer

        ''' <summary>
        ''' LowerCase
        '''
        ''' [Example]
        ''' Input : ABCDEF
        ''' Output: abcdef
        ''' </summary>
        Lower = &H0

        ''' <summary>
        ''' UpperCase.
        '''
        ''' [Example]
        ''' Input : abcdef
        ''' Output: ABCDEF
        ''' </summary>
        Upper = &H1

        ''' <summary>
        ''' TitleCase.
        '''
        ''' [Example]
        ''' Input : abcdef
        ''' Output: Abcdef
        ''' </summary>
        Title = &H2

        ''' <summary>
        ''' WordCase.
        '''
        ''' [Example]
        ''' Input : abc def
        ''' Output: Abc Def
        ''' </summary>
        Word = &H3

        ''' <summary>
        ''' CamelCase (With first letter to LowerCase).
        '''
        ''' [Example]
        ''' Input : ABC DEF
        ''' Output: abcDef
        ''' </summary>
        CamelLower = &H4

        ''' <summary>
        ''' CamelCase (With first letter to UpperCase).
        '''
        ''' [Example]
        ''' Input : ABC DEF
        ''' Output: AbcDef
        ''' </summary>
        CamelUpper = &H5

        ''' <summary>
        ''' MixedCase (With first letter to LowerCase).
        '''
        ''' [Example]
        ''' Input : ab cd ef
        ''' Output: aB Cd eF
        ''' </summary>
        MixedTitleLower = &H6

        ''' <summary>
        ''' MixedCase (With first letter to UpperCase).
        '''
        ''' [Example]
        ''' Input : ab cd ef
        ''' Output: Ab cD Ef
        ''' </summary>
        MixedTitleUpper = &H7

        ''' <summary>
        ''' MixedCase (With first letter of each word to LowerCase).
        '''
        ''' [Example]
        ''' Input : ab cd ef
        ''' Output: aB cD eF
        ''' </summary>
        MixedWordLower = &H8

        ''' <summary>
        ''' MixedCase (With first letter of each word to UpperCase).
        '''
        ''' [Example]
        ''' Input : ab cd ef
        ''' Output: Ab Cd Ef
        ''' </summary>
        MixedWordUpper = &H9

        ''' <summary>
        ''' ToggleCase.
        '''
        ''' [Example]
        ''' Input : abc def ghi
        ''' Output: aBC dEF gHI
        ''' </summary>
        Toggle = &H10

        ''' <summary>
        ''' Duplicates the characters.
        '''
        ''' [Example]
        ''' Input : Hello World!
        ''' Output: HHeelllloo  WWoorrlldd!!
        ''' </summary>
        Duplicated = &H11

        ''' <summary>
        ''' Inverts the characters.
        '''
        ''' [Example]
        ''' Input : Hello World!
        ''' Output: hELLO wORLD!
        ''' </summary>
        Inverted = &H12

    End Enum

#End Region

#Region " Publix Methods "

#End Region

    ''' <summary>
    ''' Renames a string to the specified StringCase.
    ''' </summary>
    ''' <param name="str">The string to rename.</param>
    ''' <param name="fCase">The format case.</param>
    ''' <returns>The renamed string.</returns>
    Public Shared Function Rename(ByVal str As String,
                                  ByVal fCase As FormatCase) As String

        Select Case fCase

            Case FormatCase.Lower
                Return str.ToLower

            Case FormatCase.Upper
                Return str.ToUpper

            Case FormatCase.Title
                Return Char.ToUpper(str.First) & str.Substring(1).ToLower

            Case FormatCase.Word
                Return CultureInfo.InvariantCulture.TextInfo.ToTitleCase(str.ToLower)

            Case FormatCase.CamelLower
                Return Char.ToLower(str.First) &
                       CultureInfo.InvariantCulture.TextInfo.ToTitleCase(str.ToLower).
                       Replace(" "c, String.Empty).
                       Substring(1)

            Case FormatCase.CamelUpper
                Return Char.ToUpper(str.First) &
                       CultureInfo.InvariantCulture.TextInfo.ToTitleCase(str.ToLower).
                       Replace(" "c, String.Empty).
                       Substring(1)

            Case FormatCase.MixedTitleLower
                Dim sb As New StringBuilder
                For i As Integer = 0 To (str.Length - 1) Step 2
                    If Not (i + 1) >= str.Length Then
                        sb.Append(Char.ToLower(str(i)) & Char.ToUpper(str(i + 1)))
                    Else
                        sb.Append(Char.ToLower(str(i)))
                    End If
                Next i
                Return sb.ToString

            Case FormatCase.MixedTitleUpper
                Dim sb As New StringBuilder
                For i As Integer = 0 To (str.Length - 1) Step 2
                    If Not (i + 1) >= str.Length Then
                        sb.Append(Char.ToUpper(str(i)) & Char.ToLower(str(i + 1)))
                    Else
                        sb.Append(Char.ToUpper(str(i)))
                    End If
                Next i
                Return sb.ToString

            Case FormatCase.MixedWordLower
                Dim sb As New StringBuilder
                For Each token As String In str.Split
                    sb.Append(StringRenamer.Rename(token, FormatCase.MixedTitleLower) & " ")
                Next token
                Return sb.ToString

            Case FormatCase.MixedWordUpper
                Dim sb As New StringBuilder
                For Each token As String In str.Split
                    sb.Append(StringRenamer.Rename(token, FormatCase.MixedTitleUpper) & " ")
                Next token
                Return sb.ToString

            Case FormatCase.Toggle
                Dim sb As New StringBuilder
                For Each token As String In str.Split
                    sb.Append(Char.ToLower(token.First) & token.Substring(1).ToUpper & " ")
                Next token
                Return sb.ToString

            Case FormatCase.Duplicated
                Dim sb As New StringBuilder
                For Each c As Char In str
                    sb.Append(New String(c, 2))
                Next c
                Return sb.ToString

            Case FormatCase.Inverted
                Dim sb As New StringBuilder
                For Each c As Char In str
                    sb.Append(If(Char.IsLower(c),
                                 Char.ToUpper(c),
                                 Char.ToLower(c)))
                Next c
                Return sb.ToString

            Case Else
                Return str

        End Select

    End Function

    ''' <summary>
    ''' Rename a string to the specified StringCase,
    ''' Also finds and replaces text after the string is renamed.
    ''' </summary>
    ''' <param name="str">The string to rename.</param>
    ''' <param name="fCase">The format case.</param>
    ''' <param name="FindWhat">The RegEx pattern to match.</param>
    ''' <param name="ReplaceWith">The replacement string.</param>
    ''' <param name="regexOptions">The RegEx options.</param>
    ''' <returns>The renamed string.</returns>
    Public Shared Function Rename(ByVal str As String,
                                  ByVal fCase As FormatCase,
                                  ByVal findWhat As String,
                                  ByVal replaceWith As String,
                                  ByVal regexOptions As RegexOptions) As String

        Return Regex.Replace(StringRenamer.Rename(str, fCase),
                             findWhat,
                             replaceWith,
                             regexOptions)

    End Function

End Class

#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 (vbnet) [Seleccionar] Expandir


        ''' <summary>
        ''' Handles the AfterExpand event of the FolderView1 control.
        ''' </summary>
        ''' <param name="sender">The source of the event.</param>
        ''' <param name="e">The <see cref="FolderViewEventArgs"/> instance containing the event data.</param>
        Private Sub FolderView1_AfterExpand(ByVal sender As Object, ByVal e As FolderViewEventArgs) _
        Handles FolderView1.AfterExpand

            ' This event occurs when node is expanded.

            If e.Node.HasExpandedOnce Then
                Exit Sub
            End If

            Me.FilterNodeFiles(folderView:=DirectCast(sender, FolderView),
                               allowedExtensions:=".mp3".ToLower.Split)

        End Sub

        ''' <summary>
        ''' Handles the BeforeNodeSort event of the FolderView1 control.
        ''' </summary>
        ''' <param name="sender">The source of the event.</param>
        ''' <param name="e">The <see cref="BeforeNodeSortEventArgs"/> instance containing the event data.</param>
        Private Sub FolderView1_BeforeNodeSort(sender As Object, e As BeforeNodeSortEventArgs) _
        Handles FolderView1.BeforeNodeSort

            ' This event occurs when a file is created/moved/pasted inside a node.

            Me.FilterNodeFiles(folderView:=DirectCast(sender, FolderView),
                               allowedExtensions:=".mp3".ToLower.Split)

        End Sub

        ''' <summary>
        ''' Filters the files that can be shown in the TreeNodes of a <see cref="FolderView"/>.
        ''' </summary>
        ''' <param name="folderView">The <see cref="FolderView"/>.</param>
        ''' <param name="allowedExtensions">The allowed file extensions.</param>
        Private Sub FilterNodeFiles(ByVal folderView As FolderView, ByVal allowedExtensions() As String)

            For Each node As FOVTreeNode In folderView.Nodes.Cast(Of FOVTreeNode).Reverse

                If Not (node.IsFolder) _
                AndAlso Not (allowedExtensions.Contains(IO.Path.GetExtension(node.Text).ToLower)) Then

                    node.Delete()

                End If

            Next node

        End Sub




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 (vbnet) [Seleccionar] Expandir


' ***********************************************************************
' Author   : Elektro
' Modified : 29-Novembder-2014
' ***********************************************************************
' <copyright file="TagLibSharp Helper.vb" company="Elektro Studios">
'     Copyright (c) Elektro Studios. All rights reserved.
' </copyright>
' ***********************************************************************

#Region " Usage Examples "

'Dim tagger As New TagLibSharpHelper
'tagger.LoadFile("C:\Users\Administrador\Desktop\1.mp3")

'Dim sb As New System.Text.StringBuilder
'With sb
'    .AppendLine(String.Format("Is Corrupt?: {0}", tagger.IsCorrupt))
'    .AppendLine(String.Format("Is Writeable?: {0}", tagger.IsWriteable))
'    .AppendLine()
'    .AppendLine(String.Format("Tags: {0}", tagger.GetTags))
'    .AppendLine()
'    .AppendLine(String.Format("Title: {0}", tagger.GetTitle))
'    .AppendLine(String.Format("Artist: {0}", tagger.GetArtist))
'    .AppendLine(String.Format("Album: {0}", tagger.GetAlbum))
'    .AppendLine(String.Format("Genre: {0}", tagger.GetGenre))
'    .AppendLine(String.Format("Year: {0}", tagger.GetYear))
'End With
'MessageBox.Show(sb.ToString)

'tagger.RemoveTag(TagLib.TagTypes.Id3v1 Or TagLib.TagTypes.Id3v2) ' Removes ID3v1 + ID3v2 Tags

'tagger.SetTag(Sub(x As TagLib.File) x.Tag.Title = "Title Test")

'tagger.SetTags({Sub(x As TagLib.File) x.Tag.Title = "Title Test",
'                Sub(x As TagLib.File) x.Tag.Performers = {"My Artist"}})

#End Region

#Region " Option Statements "

Option Strict On
Option Explicit On
Option Infer Off

#End Region

#Region " Imports "

Imports TagLib

#End Region

#Region " TagLibSharp Helper "

Public NotInheritable Class TagLibSharpHelper

#Region " Properties "

    ''' <summary>
    ''' Gets or sets the <see cref="TagLib.File"/> object.
    ''' </summary>
    ''' <value>The <see cref="TagLib.File"/> object.</value>
    Private Property TagFile As TagLib.File

    Public ReadOnly Property CurrentFile As String
        Get
            Return Me.TagFile.Name
        End Get
    End Property

#End Region

#Region " Constructors "

    ''' <summary>
    ''' Initializes a new instance of the <see cref="TagLibSharpHelper"/> class.
    ''' </summary>
    Public Sub New()
    End Sub

    ''' <summary>
    ''' Initializes a new instance of the <see cref="TagLibSharpHelper" /> class.
    ''' </summary>
    ''' <param name="file">The file to load.</param>
    Public Sub New(ByVal file As String)
        Me.LoadFile(file)
    End Sub

#End Region

#Region " Public Methods "

    ''' <summary>
    ''' Instances a file.
    ''' </summary>
    ''' <param name="file">The file to load.</param>
    Public Sub LoadFile(ByVal file As String)

        Try
            Me.TagFile = TagLib.File.Create(file)

        Catch ex As CorruptFileException
            Throw

        Catch ex As UnsupportedFormatException
            Throw

        Catch ex As Exception
            Throw

        End Try

    End Sub

    ''' <summary>
    ''' Determines whether the current file is possibly corrupted.
    ''' </summary>
    Public Function IsCorrupt() As Boolean

        Me.CheckTagFile()
        Return Me.TagFile.PossiblyCorrupt

    End Function

    ''' <summary>
    ''' Determines whether the current file can be written.
    ''' </summary>
    Public Function IsWriteable() As Boolean

        Me.CheckTagFile()
        Return Me.TagFile.Writeable

    End Function

    ''' <summary>
    ''' Get TagTypes of file.
    ''' </summary>
    Public Function GetTags() As String

        Me.CheckTagFile()
        Return Me.TagFile.TagTypesOnDisk.ToString

    End Function

    ''' <summary>
    ''' Gets the Title tag of the current file.
    ''' </summary>
    Public Function GetTitle() As String

        Me.CheckTagFile()
        Return Me.TagFile.Tag.Title

    End Function

    ''' <summary>
    ''' Gets the Artist tag of the current file.
    ''' </summary>
    Public Function GetArtist() As String

        Me.CheckTagFile()

        If Me.TagFile.Tag.Performers.Count <> 0 Then
            Return Me.TagFile.Tag.Performers(0)

        Else
            Return String.Empty

        End If

    End Function

    ''' <summary>
    ''' Gets the Album tag of the current file.
    ''' </summary>
    Public Function GetAlbum() As String

        Me.CheckTagFile()
        Return Me.TagFile.Tag.Album

    End Function

    ''' <summary>
    ''' Gets the Genre tag of the current file.
    ''' </summary>
    Public Function GetGenre() As String

        Me.CheckTagFile()
        If Me.TagFile.Tag.Genres.Count <> 0 Then
            Return Me.TagFile.Tag.Genres(0)

        Else
            Return String.Empty

        End If

    End Function

    ''' <summary>
    ''' Gets the Year tag of the current file.
    ''' </summary>
    Public Function GetYear() As String

        Me.CheckTagFile()
        Return Me.TagFile.Tag.Year.ToString

    End Function

    ''' <summary>
    ''' Sets a Tag field.
    ''' </summary>
    Public Sub SetTag(ByVal fieldSetter As Action(Of TagLib.File))

        Me.CheckTagFile()
        If Not Me.IsCorrupt AndAlso Me.IsWriteable Then

            Try
                fieldSetter(TagFile)

            Catch ex As Exception
                Throw

            End Try

            Me.SaveFile()

        End If

    End Sub

    ''' <summary>
    ''' Sets multiple Tag fields.
    ''' </summary>
    Public Sub SetTags(ByVal fieldSetter() As Action(Of TagLib.File))

        Me.CheckTagFile()
        If Not Me.IsCorrupt AndAlso Me.IsWriteable Then

            For Each field As Action(Of TagLib.File) In fieldSetter

                Try
                    field(TagFile)

                Catch ex As Exception
                    Throw

                End Try

            Next field

            Me.SaveFile()

        End If

    End Sub

    ''' <summary>
    ''' Remove a Tag from the current file.
    ''' </summary>
    ''' <param name="tagTypes">The tag types to remove from file.</param>
    Public Sub RemoveTag(ByVal tagTypes As TagTypes)

        Me.CheckTagFile()
        If Not Me.IsCorrupt AndAlso Me.IsWriteable Then

            Try
                Me.TagFile.RemoveTags(tagTypes)

            Catch ex As Exception
                Throw

            End Try

            Me.SaveFile()

        End If

    End Sub

#End Region

#Region " Private Methods "

    ''' <summary>
    ''' Saves the current file.
    ''' </summary>
    Private Sub SaveFile()

        Me.CheckTagFile()

        Try
            Me.TagFile.Save()

        Catch ex As Exception
            Throw

        End Try

    End Sub

    ''' <summary>
    ''' Checks whether a <see cref="TagLib.File"/> object is loaded.
    ''' </summary>
    Private Sub CheckTagFile()

        If Me.TagFile Is Nothing Then

            Throw New Exception("Any file is loaded.")

        End If

    End Sub

#End Region

End Class

#End Region




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 (vbnet) [Seleccionar] Expandir


        ''' <summary>
        ''' Handles the SplitterMoving event of the KryptonSeparator1 control.
        ''' </summary>
        ''' <param name="sender">The source of the event.</param>
        ''' <param name="e">The <see cref="SplitterCancelEventArgs"/> instance containing the event data.</param>
        Private Sub KryptonSeparator1_SplitterMoving(ByVal sender As Object, ByVal e As SplitterCancelEventArgs) _
        Handles KryptonSeparator1.SplitterMoving

            Dim separator As KryptonSeparator = DirectCast(sender, KryptonSeparator)
            Dim leftCtrl As Control = Me.ListBox1
            Dim rightCtrl As Control = Me.ListBox2

            If (e.MouseCursorX > 0) _
            AndAlso Not ((rightCtrl.Size.Width - e.MouseCursorX) < rightCtrl.MinimumSize.Width) Then

                separator.Location = New Point(separator.Location.X + e.MouseCursorX, separator.Location.Y)
                leftCtrl.Width += e.MouseCursorX
                rightCtrl.Width -= e.MouseCursorX
                rightCtrl.Left = separator.Right

            ElseIf (e.MouseCursorX < 0) _
            AndAlso Not ((leftCtrl.Size.Width + e.MouseCursorX - separator.Width) < leftCtrl.MinimumSize.Width) Then

                separator.Location = New Point(separator.Location.X - separator.Width, separator.Location.Y)
                leftCtrl.Width -= separator.Width
                rightCtrl.Width += separator.Width
                rightCtrl.Left = separator.Right

            End If

        End Sub


[Eleкtro]

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 [Seleccionar] Expandir

· Título
        (Sub-menu)
        · Run
        · Open Files...

Código (vbnet) [Seleccionar] Expandir


#Region " Option Statements "

Option Strict On
Option Explicit On
Option Infer Off

#End Region

#Region " Imports "

Imports SharpShell.Attributes
Imports SharpShell.SharpContextMenu
Imports System.IO
Imports System.Runtime.InteropServices
Imports System.Text
Imports System.Windows.Forms
Imports System.ComponentModel

#End Region

#Region " MyAppContextMenu "

''' <summary>
''' The Application Context Menu Extension.
''' </summary>
<ComVisible(True)>
<COMServerAssociation(AssociationType.ClassOfExtension, ".ext")>
Public Class MyAppContextMenu : Inherits SharpContextMenu

#Region " Objects "

   ''' <summary>
   ''' Contains the application information.
   ''' </summary>
   Private ReadOnly application As New AppInfo With
           {
               .Title = "Menu Title",
               .Filename = "Application Filename",
               .Directory = My.Application.Info.DirectoryPath
           }

#End Region

#Region " Types "

   ''' <summary>
   ''' Contains information about an application.
   ''' This class cannot be inherited.
   ''' </summary>
   Protected NotInheritable Class AppInfo

       ''' <summary>
       ''' Gets or sets the application title.
       ''' </summary>
       ''' <value>The application title.</value>
       Protected Friend Property Title As String

       ''' <summary>
       ''' Gets or sets the application filename.
       ''' </summary>
       ''' <value>The application filename.</value>
       Protected Friend Property Filename As String

       ''' <summary>
       ''' Gets or sets the application working directory.
       ''' </summary>
       ''' <value>The application working directory.</value>
       Protected Friend Property Directory As String

       ''' <summary>
       ''' Gets the full qualified application path.
       ''' </summary>
       ''' <value>The full qualified application path.</value>
       Protected Friend ReadOnly Property FullPath As String
           Get
               Return Path.Combine(Me.Directory, Me.Filename, ".exe")
           End Get
       End Property

   End Class

#End Region

#Region " SharpShell Methods "

   ''' <summary>
   ''' Determines whether this instance can a shell context show menu, given the specified selected file list.
   ''' </summary>
   ''' <returns>
   ''' <c>true</c> if this instance should show a shell context menu for the specified file list; otherwise, <c>false</c>.
   ''' </returns>
   Protected Overrides Function CanShowMenu() As Boolean

       Return True

   End Function

   ''' <summary>
   ''' Creates the context menu.
   ''' </summary>
   ''' <returns>The context menu for the shell context menu.</returns>
   Protected Overrides Function CreateMenu() As ContextMenuStrip

       ' Create the menu strip.
       Dim menu As New ContextMenuStrip()

       ' Create the main item, this is used to show our application title.
       Dim itemTitle As New ToolStripMenuItem() With
           {
               .Text = Me.application.Title,
               .Image = My.Resources.TitleIcon
           }

       ' Create a 'Run' item.
       Dim itemRun As New ToolStripMenuItem() With
           {
               .Text = "Run",
               .Image = My.Resources.RunIcon
           }

       ' Create a 'Open file' item.
       Dim itemOpenFile As New ToolStripMenuItem() With
           {
               .Text = "Open file...",
               .Image = My.Resources.OpenFileIcon
           }

       ' Create a 'Open files' item.
       Dim itemOpenFiles As New ToolStripMenuItem() With
           {
               .Text = "Open files...",
               .Image = My.Resources.OpenFileIcon
           }

       ' Add the main item into the context menu.
       menu.Items.Add(itemTitle)

       ' Add the 'Run' sub-item into the 'itemTitle' item.
       itemTitle.DropDownItems.Add(itemRun)

       ' Add the 'Open file' or 'Open files' sub-item into the 'itemTitle' item.
       ' Depending on the amount of selected files.
       itemTitle.DropDownItems.Add(If(Me.SelectedItemPaths.Count = 1, itemOpenFile, itemOpenFiles))

       ' Suscribe to events.
       AddHandler itemRun.Click, AddressOf ItemRun_Click
       AddHandler itemOpenFile.Click, AddressOf ItemOpenFile_Click
       AddHandler itemOpenFiles.Click, AddressOf ItemOpenFiles_Click

       ' Return the menu.
       Return menu

   End Function

#End Region

#Region " Application Methods "

   ''' <summary>
   ''' Runs the specified application.
   ''' </summary>
   ''' <param name="fileName">The name of an application file to run in the process.</param>
   ''' <param name="arguments">Command-line arguments to pass when starting the process.</param>
   Private Sub RunApp(ByVal fileName As String,
                      Optional ByVal arguments As String = "")

       Try
           Process.Start(fileName, arguments)

       Catch ex As FileNotFoundException
           ' Do something.

       Catch ex As InvalidOperationException
           ' Do something.

       Catch ex As Win32Exception
           ' Dim errorCode As Integer = Marshal.GetLastWin32Error()
           ' Do something.

       Catch ex As Exception
           ' Do something.

       End Try

   End Sub

   ''' <summary>
   ''' Opens the given file in the specified application.
   ''' </summary>
   ''' <param name="appPath">The application filepath to run.</param>
   ''' <param name="filepath">The filepath to send to the application arguments.</param>
   ''' <param name="stringFormat">The string format used to format the filepath.</param>
   Private Sub OpenFile(ByVal appPath As String,
                        ByVal filepath As String,
                        Optional ByVal stringFormat As String = """{0}""")

       Me.RunApp(appPath, String.Format(stringFormat, filepath))

   End Sub

   ''' <summary>
   ''' Opens the given files in the specified application.
   ''' </summary>
   ''' <param name="appPath">The application filepath to run.</param>
   ''' <param name="filepaths">The filepaths to send to the application arguments.</param>
   ''' <param name="stringFormat">The string format used to join the filepaths.</param>
   Private Sub OpenFiles(ByVal appPath As String,
                         ByVal filepaths As IEnumerable(Of String),
                         Optional ByVal stringFormat As String = """{0}"" ")

       Me.RunApp(fileName:=appPath,
                 arguments:=Me.JoinFilePaths(filepaths, stringFormat))

   End Sub

   ''' <summary>
   ''' Joins the selected filepaths in a single line, filepaths are closed with double-quotes and separated by a space.
   ''' eg: "File1" "File2" "File3"
   ''' </summary>
   ''' <param name="filepaths">The filepaths to join.</param>
   ''' <param name="joinFormat">The string format used to join the filepaths.</param>
   ''' <returns>The joined and formatted filepaths.</returns>
   Private Function JoinFilePaths(ByVal filepaths As IEnumerable(Of String),
                                  ByVal joinFormat As String) As String

       Dim sb As New StringBuilder()

       For Each filePath As String In filepaths
           sb.Append(String.Format(joinFormat, filePath))
       Next filePath

       Return sb.ToString

   End Function

#End Region

#Region " Event Handlers "

   ''' <summary>
   ''' Handles the Click event of the ItemRun menu item.
   ''' </summary>
   ''' <param name="sender">The source of the event.</param>
   ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
   Private Sub ItemRun_Click(ByVal sender As Object, ByVal e As EventArgs)

       Me.RunApp(fileName:=Me.application.FullPath)

   End Sub

   ''' <summary>
   ''' Handles the Click event of the ItemOpenFile menu item.
   ''' </summary>
   ''' <param name="sender">The source of the event.</param>
   ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
   Private Sub ItemOpenFile_Click(ByVal sender As Object, ByVal e As EventArgs)

       Me.OpenFile(appPath:=Me.application.FullPath,
                   filepath:=Me.SelectedItemPaths.First)

   End Sub

   ''' <summary>
   ''' Handles the Click event of the ItemOpenFiles menu item.
   ''' </summary>
   ''' <param name="sender">The source of the event.</param>
   ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
   Private Sub ItemOpenFiles_Click(ByVal sender As Object, ByVal e As EventArgs)

       Me.OpenFiles(appPath:=Me.application.FullPath,
                    filepaths:=Me.SelectedItemPaths)

   End Sub

#End Region

End Class

#End Region


[Eleкtro]

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 (vbnet) [Seleccionar] Expandir

' ***********************************************************************
' Author   : Elektro
' Modified : 27-November-2014
' ***********************************************************************
' <copyright file="CenteredMessageBox.vb" company="Elektro Studios">
'     Copyright (c) Elektro Studios. All rights reserved.
' </copyright>
' ***********************************************************************

#Region " Usage Examples "

'Using New CenteredMessageBox(ownerForm:=Me,
'                             textFont:=New Font("Lucida Console", Font.SizeInPoints, FontStyle.Italic),
'                             timeOut:=2500)
'
'    MessageBox.Show("Text", "Title", MessageBoxButtons.OK, MessageBoxIcon.Information)
'
'End Using

#End Region

#Region " Option Statements "

Option Explicit On
Option Strict On
Option Infer Off

#End Region

#Region " Imports "

Imports System.Drawing
Imports System.Runtime.InteropServices
Imports System.Text
Imports System.Windows.Forms
Imports System.ComponentModel

#End Region

#Region " Centered MessageBox "

''' <summary>
''' A customized <see cref="MessageBox"/>.
''' This class cannot be inherited.
''' </summary>
Friend NotInheritable Class CenteredMessageBox : Implements IDisposable

#Region " Properties "

   ''' <summary>
   ''' Gets the messagebox main window handle (hwnd).
   ''' </summary>
   ''' <value>The messagebox main window handle (hwnd).</value>
   Friend ReadOnly Property MessageBoxWindowHandle As IntPtr
       Get
           Return Me.messageBoxWindowHandle1
       End Get
   End Property
   ''' <summary>
   ''' The messagebox main window handle (hwnd).
   ''' </summary>
   Private messageBoxWindowHandle1 As IntPtr

   ''' <summary>
   ''' Gets the owner <see cref="Form"/> to center the <see cref="CenteredMessageBox"/>.
   ''' </summary>
   ''' <value>The owner <see cref="Form"/> to center the <see cref="CenteredMessageBox"/>.</value>
   Friend ReadOnly Property OwnerForm As Form
       Get
           Return Me.ownerForm1
       End Get
   End Property
   ''' <summary>
   ''' The owner <see cref="Form"/> to center the <see cref="CenteredMessageBox"/>
   ''' </summary>
   Private ownerForm1 As Form

   ''' <summary>
   ''' Gets the <see cref="Font"/> used to display the <see cref="CenteredMessageBox"/> text.
   ''' </summary>
   ''' <value>The <see cref="Font"/> used to display the <see cref="CenteredMessageBox"/> text.</value>
   Friend ReadOnly Property Font As Font
       Get
           Return Me.font1
       End Get
   End Property
   ''' <summary>
   ''' The <see cref="Font"/> used to display the <see cref="CenteredMessageBox"/> text.
   ''' </summary>
   Private ReadOnly font1 As Font

   ''' <summary>
   ''' Gets the time interval to auto-close this <see cref="CenteredMessageBox"/>, in milliseconds.
   ''' Default value is '0', which means Infinite.
   ''' </summary>
   Friend ReadOnly Property TimeOut As Integer
       Get
           Return Me.timeOut1
       End Get
   End Property
   ''' <summary>
   ''' The time interval to auto-close this <see cref="CenteredMessageBox"/>, in milliseconds.
   ''' Default value is '0', which means Infinite.
   ''' </summary>
   Private ReadOnly timeOut1 As Integer = 0

#End Region

#Region " Objects "

   ''' <summary>
   ''' A <see cref="Windows.Forms.Timer"/> that keeps track of <see cref="TimeOut"/> value to close this <see cref="CenteredMessageBox"/>.
   ''' </summary>
   Private WithEvents timeoutTimer As Timer

   ''' <summary>
   ''' Keeps track of the current amount of tries to find this <see cref="CenteredMessageBox"/> dialog.
   ''' </summary>
   Private tries As Integer

#End Region

#Region " P/Invoke "

   ''' <summary>
   ''' Platform Invocation methods (P/Invoke), access unmanaged code.
   ''' This class does not suppress stack walks for unmanaged code permission.
   ''' <see cref="System.Security.SuppressUnmanagedCodeSecurityAttribute"/>  must not be applied to this class.
   ''' This class is for methods that can be used anywhere because a stack walk will be performed.
   ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/ms182161.aspx
   ''' </summary>
   Protected NotInheritable Class NativeMethods

#Region " Functions "

       ''' <summary>
       ''' Retrieves the thread identifier of the calling thread.
       ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms683183%28v=vs.85%29.aspx
       ''' </summary>
       ''' <returns>The thread identifier of the calling thread.</returns>
       <DllImport("kernel32.dll", SetLastError:=False)>
       Protected Friend Shared Function GetCurrentThreadId() As Integer
       End Function

       ''' <summary>
       ''' Enumerates all nonchild windows associated with a thread by passing the handle to each window,
       ''' in turn, to an application-defined callback function.
       ''' <see cref="EnumThreadWindows"/> continues until the last window is enumerated or the callback function returns <c>false</c>.
       ''' To enumerate child windows of a particular window, use the EnumChildWindows function.
       ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633495%28v=vs.85%29.aspx
       ''' </summary>
       ''' <param name="dwThreadId">The identifier of the thread whose windows are to be enumerated.</param>
       ''' <param name="lpfn">A pointer to an application-defined callback function.</param>
       ''' <param name="lParam">An application-defined value to be passed to the callback function.</param>
       ''' <returns>
       ''' <c>true</c> if the callback function returns <c>true</c> for all windows in the thread specified by dwThreadId parameter.
       ''' <c>false</c> if the callback function returns <c>false</c> on any enumerated window,
       ''' or if there are no windows found in the thread specified by dwThreadId parameter.</returns>
       <DllImport("user32.dll", SetLastError:=False)>
       Protected Friend Shared Function EnumThreadWindows(
                     ByVal dwThreadId As Integer,
                     ByVal lpfn As NativeMethods.EnumThreadWndProc,
                     ByVal lParam As IntPtr
           ) As <MarshalAs(UnmanagedType.Bool)> Boolean
       End Function

       ''' <summary>
       ''' Retrieves the name of the class to which the specified window belongs.
       ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633582%28v=vs.85%29.aspx
       ''' </summary>
       ''' <param name="hWnd">A handle to the window and, indirectly, the class to which the window belongs.</param>
       ''' <param name="buffer">The class name string.</param>
       ''' <param name="buflen">
       ''' The length of the lpClassName buffer, in characters.
       ''' The buffer must be large enough to include the terminating null character;
       ''' otherwise, the class name string is truncated to nMaxCount-1 characters.
       ''' </param>
       ''' <returns>
       ''' If the function succeeds, the return value is the number of characters copied to the buffer,
       ''' not including the terminating null character.
       ''' If the function fails, the return value is 0.
       ''' </returns>
       <DllImport("user32.dll", SetLastError:=False, CharSet:=CharSet.Auto)>
       Protected Friend Shared Function GetClassName(
                     ByVal hWnd As IntPtr,
                     ByVal buffer As StringBuilder,
                     ByVal buflen As Integer
           ) As Integer
       End Function

       ''' <summary>
       ''' Retrieves a handle to a control in the specified dialog box.
       ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms645481%28v=vs.85%29.aspx
       ''' </summary>
       ''' <param name="hWnd">A handle to the dialog box that contains the control.</param>
       ''' <param name="item">The identifier of the control to be retrieved.</param>
       ''' <returns>
       ''' If the function succeeds, the return value is the window handle of the specified control.
       ''' If the function fails, the return value is <see cref="IntPtr.Zero"/>,
       ''' indicating an invalid dialog box handle or a nonexistent control
       ''' </returns>
       <DllImport("user32.dll", SetLastError:=False)>
       Protected Friend Shared Function GetDlgItem(
                     ByVal hWnd As IntPtr,
                     ByVal item As Integer
           ) As IntPtr
       End Function

       ''' <summary>
       ''' Retrieves the dimensions of the bounding rectangle of the specified window.
       ''' The dimensions are given in screen coordinates that are relative to the upper-left corner of the screen.
       ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633519%28v=vs.85%29.aspx
       ''' </summary>
       ''' <param name="hWnd">A handle to the window.</param>
       ''' <param name="rc">
       ''' A pointer to a <see cref="RECT"/> structure that receives the screen coordinates of
       ''' the upper-left and lower-right corners of the window.
       ''' </param>
       ''' <returns><c>true</c> if the function succeeds, <c>false</c> otherwise.</returns>
       <DllImport("user32.dll", SetLastError:=False)>
       Protected Friend Shared Function GetWindowRect(
                     ByVal hWnd As IntPtr,
                     ByRef rc As Rect
           ) As <MarshalAs(UnmanagedType.Bool)> Boolean
       End Function

       ''' <summary>
       ''' Destroys the specified window.
       ''' The function sends WM_DESTROY and WM_NCDESTROY messages to the window to deactivate it and remove the keyboard focus from it.
       ''' The function also destroys the window's menu, flushes the thread message queue, destroys timers, removes clipboard ownership,
       ''' and breaks the clipboard viewer chain (if the window is at the top of the viewer chain).
       ''' If the specified window is a parent or owner window,
       ''' DestroyWindow automatically destroys the associated child or owned windows when it destroys the parent or owner window.
       ''' The function first destroys child or owned windows, and then it destroys the parent or owner window.
       ''' DestroyWindow also destroys modeless dialog boxes created by the CreateDialog function.
       ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms632682%28v=vs.85%29.aspx
       ''' </summary>
       ''' <param name="hwnd">Handle to the window to be destroyed.</param>
       ''' <returns><c>true</c> if the function succeeds, <c>false</c> otherwise.</returns>
       <DllImport("user32.dll", SetLastError:=False)>
       Protected Friend Shared Function DestroyWindow(
                     ByVal hwnd As IntPtr
           ) As <MarshalAs(UnmanagedType.Bool)> Boolean
       End Function

       ''' <summary>
       ''' Changes the position and dimensions of the specified window.
       ''' For a top-level window, the position and dimensions are relative to the upper-left corner of the screen.
       ''' For a child window, they are relative to the upper-left corner of the parent window's client area.
       ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633534%28v=vs.85%29.aspx
       ''' </summary>
       ''' <param name="hWnd">A handle to the window.</param>
       ''' <param name="x">The new position of the left side of the window.</param>
       ''' <param name="y">The new position of the top of the window.</param>
       ''' <param name="width">The new width of the window.</param>
       ''' <param name="height">The new height of the window.</param>
       ''' <param name="repaint">
       ''' Indicates whether the window is to be repainted.
       ''' If this parameter is TRUE, the window receives a message.
       ''' If the parameter is FALSE, no repainting of any kind occurs.
       ''' This applies to the client area, the nonclient area (including the title bar and scroll bars),
       ''' and any part of the parent window uncovered as a result of moving a child window.
       ''' </param>
       ''' <returns><c>true</c> if the function succeeds, <c>false</c> otherwise.</returns>
       <DllImport("user32.dll", SetLastError:=False)>
       Protected Friend Shared Function MoveWindow(
                     ByVal hWnd As IntPtr,
                     ByVal x As Integer,
                     ByVal y As Integer,
                     ByVal width As Integer,
                     ByVal height As Integer,
                     ByVal repaint As Boolean
           ) As <MarshalAs(UnmanagedType.Bool)> Boolean
       End Function

       ''' <summary>
       ''' Changes the size, position, and Z order of a child, pop-up, or top-level window.
       ''' These windows are ordered according to their appearance on the screen.
       ''' The topmost window receives the highest rank and is the first window in the Z order.
       ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633545%28v=vs.85%29.aspx
       ''' </summary>
       ''' <param name="hWnd">A handle to the window.</param>
       ''' <param name="hWndInsertAfter">A handle to the window to precede the positioned window in the Z order.</param>
       ''' <param name="x">The new position of the left side of the window, in client coordinates.</param>
       ''' <param name="y">The new position of the top of the window, in client coordinates.</param>
       ''' <param name="cx">The new width of the window, in pixels.</param>
       ''' <param name="cy">The new height of the window, in pixels.</param>
       ''' <param name="uFlags">The window sizing and positioning flags.</param>
       ''' <returns><c>true</c> if the function succeeds, <c>false</c> otherwise.</returns>
       <DllImport("user32.dll", SetLastError:=True)> _
       Protected Friend Shared Function SetWindowPos(
                     ByVal hWnd As IntPtr,
                     ByVal hWndInsertAfter As IntPtr,
                     ByVal x As Integer,
                     ByVal y As Integer,
                     ByVal cx As Integer,
                     ByVal cy As Integer,
                     ByVal uFlags As SetWindowPosFlags
           ) As <MarshalAs(UnmanagedType.Bool)> Boolean
       End Function

       ''' <summary>
       ''' Sends the specified message to a window or windows.
       ''' The <see cref="SendMessage"/> function calls the window procedure for the specified window and
       ''' does not return until the window procedure has processed the message.
       ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms644950%28v=vs.85%29.aspx
       ''' </summary>
       ''' <param name="hWnd">A handle to the window whose window procedure will receive the message.</param>
       ''' <param name="msg">The windows message to be sent.</param>
       ''' <param name="wParam">Additional message-specific information.</param>
       ''' <param name="lParam">Additional message-specific information.</param>
       ''' <returns>The result of the message processing; it depends on the message sent.</returns>
       <DllImport("user32.dll", SetLastError:=False)>
       Protected Friend Shared Function SendMessage(
                     ByVal hWnd As IntPtr,
                     ByVal msg As WindowsMessages,
                     ByVal wParam As IntPtr,
                     ByVal lParam As IntPtr
           ) As IntPtr
       End Function

#End Region

#Region " Callbacks "

       ''' <summary>
       ''' An application-defined callback function used with the <see cref="EnumThreadWindows"/> function.
       ''' It receives the window handles associated with a thread.
       ''' The WNDENUMPROC type defines a pointer to this callback function.
       ''' <see cref="EnumThreadWndProc"/> is a placeholder for the application-defined function name
       ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633496%28v=vs.85%29.aspx
       ''' </summary>
       ''' <param name="hWnd">A handle to a window associated with the thread specified in the <see cref="EnumThreadWindows"/> function.</param>
       ''' <param name="lParam">The application-defined value given in the <see cref="EnumThreadWindows"/> function.</param>
       ''' <returns>
       ''' To continue enumeration, the callback function must return <c>true</c>;
       ''' To stop enumeration, it must return <c>false</c>.
       ''' </returns>
       Protected Friend Delegate Function EnumThreadWndProc(
                 ByVal hWnd As IntPtr,
                 ByVal lParam As IntPtr
       ) As Boolean

#End Region

#Region " Enumerations "

       ''' <summary>
       ''' Specifies a System-Defined Message.
       ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms644927%28v=vs.85%29.aspx#system_defined
       ''' </summary>
       <Description("Enum used for 'SendMessage' function.")>
       Protected Friend Enum WindowsMessages As Integer

           ' **************************************
           ' NOTE:
           ' This enumeration is partially defined.
           ' **************************************

           ''' <summary>
           ''' Sets the font that a control is to use when drawing text.
           ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms632642%28v=vs.85%29.aspx
           ''' </summary>
           WM_SETFONT = &H30

           ''' <summary>
           ''' Retrieves the font with which the control is currently drawing its text.
           ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms632624%28v=vs.85%29.aspx
           ''' </summary>
           WM_GETFONT = &H31

       End Enum

       ''' <summary>
       ''' Specifies the window sizing and positioning flags.
       ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633545%28v=vs.85%29.aspx
       ''' </summary>
       <FlagsAttribute>
       <Description("Enum used for 'SetWindowPos' function.")>
       Protected Friend Enum SetWindowPosFlags As UInteger

           ' **************************************
           ' NOTE:
           ' This enumeration is partially defined.
           ' **************************************

           ''' <summary>
           ''' Indicates any flag.
           ''' </summary>
           None = &H0UI

       End Enum

#End Region

#Region " Structures "

       ''' <summary>
       ''' Defines the coordinates of the upper-left and lower-right corners of a rectangle.
       ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/dd162897%28v=vs.85%29.aspx
       ''' </summary>
       <Description("Structure used for 'GetWindowRect' function.")>
       Protected Friend Structure Rect

           ''' <summary>
           ''' The x-coordinate of the upper-left corner of the rectangle.
           ''' </summary>
           Friend Left As Integer

           ''' <summary>
           ''' The y-coordinate of the upper-left corner of the rectangle.
           ''' </summary>
           Friend Top As Integer

           ''' <summary>
           ''' The x-coordinate of the lower-right corner of the rectangle.
           ''' </summary>
           Friend Right As Integer

           ''' <summary>
           ''' The y-coordinate of the lower-right corner of the rectangle.
           ''' </summary>
           Friend Bottom As Integer

       End Structure

#End Region

   End Class

#End Region

#Region " Constructors "

   ''' <summary>
   ''' Initializes a new instance of the <see cref="CenteredMessageBox"/> class.
   ''' </summary>
   ''' <param name="ownerForm">The form that owns this <see cref="CenteredMessageBox"/>.</param>
   ''' <param name="TextFont">The <see cref="Font"/> used to display the text of this <see cref="CenteredMessageBox"/>.</param>
   ''' <param name="TimeOut">
   ''' The time interval to auto-close this <see cref="CenteredMessageBox"/>, in milliseconds;
   ''' Default value is '0', which means Infinite.
   ''' </param>
   Public Sub New(ByVal ownerForm As Form,
                  Optional textFont As Font = Nothing,
                  Optional timeOut As Integer = 0I)

       Me.ownerForm1 = ownerForm
       Me.font1 = textFont
       Me.timeOut1 = timeOut
       Me.ownerForm1.BeginInvoke(New MethodInvoker(AddressOf Me.FindDialog))

   End Sub

   ''' <summary>
   ''' Prevents a default instance of the <see cref="CenteredMessageBox"/> class from being created.
   ''' </summary>
   Private Sub New()
   End Sub

#End Region

#Region " Private Methods "

   ''' <summary>
   ''' Finds the <see cref="CenteredMessageBox"/> dialog window.
   ''' </summary>
   Private Sub FindDialog()

       ' Enumerate windows to find the message box
       If Me.tries < 0 Then
           Return
       End If

       Dim callback As New NativeMethods.EnumThreadWndProc(AddressOf Me.CheckWindow)

       If NativeMethods.EnumThreadWindows(NativeMethods.GetCurrentThreadId(), callback, IntPtr.Zero) Then

           If Threading.Interlocked.Increment(Me.tries) < 10 Then
               Me.ownerForm1.BeginInvoke(New MethodInvoker(AddressOf Me.FindDialog))
           End If

       End If

       If Me.timeOut1 > 0 Then

           Me.timeoutTimer = New Timer With
                             {
                                 .Interval = Me.timeOut1,
                                 .Enabled = True
                             }

           Me.timeoutTimer.Start()

       End If

   End Sub

   ''' <summary>
   ''' Checks whether the specified window is our <see cref="CenteredMessageBox"/> dialog.
   ''' </summary>
   ''' <param name="hWnd">A handle to the window to check.</param>
   ''' <param name="lParam">The application-defined value given in the <see cref="NativeMethods.EnumThreadWindows"/> function.</param>
   ''' <returns>
   ''' <c>true</c> the specified window is our <see cref="CenteredMessageBox"/> dialog, <c>false</c> otherwise.
   ''' </returns>
   Private Function CheckWindow(ByVal hWnd As IntPtr,
                                ByVal lParam As IntPtr) As Boolean

       ' Checks if <hWnd> is a dialog
       Dim sb As New StringBuilder(260)
       NativeMethods.GetClassName(hWnd, sb, sb.Capacity)
       If sb.ToString() <> "#32770" Then
           Return True
       End If

       ' Get the control that displays the text.
       Dim hText As IntPtr = NativeMethods.GetDlgItem(hWnd, &HFFFFI)
       Me.messageBoxWindowHandle1 = hWnd

       ' Get the dialog Rect.
       Dim frmRect As New Rectangle(Me.ownerForm1.Location, Me.ownerForm1.Size)
       Dim dlgRect As NativeMethods.Rect
       NativeMethods.GetWindowRect(hWnd, dlgRect)

       ' Set the custom Font (if any).
       If hText <> IntPtr.Zero Then

           Me.SetFont(font:=Me.font1,
                      hwnd:=hText,
                      rect:=frmRect)

       End If

       ' Center the dialog window in the specified Form.
       Me.CenterDialog(hwnd:=hWnd,
                       dialogRect:=dlgRect,
                       formRect:=frmRect)

       ' Stop the EnumThreadWndProc callback by sending False.
       Return False

   End Function

   ''' <summary>
   ''' Sets the font of this <see cref="CenteredMessageBox"/> window.
   ''' </summary>
   ''' <param name="font">The <see cref="Font"/> used to display the <see cref="CenteredMessageBox"/> text.</param>
   ''' <param name="hwnd">A handle to the <see cref="CenteredMessageBox"/> window.</param>
   ''' <param name="rect">A <see cref="Rectangle"/> to positionate the text.</param>
   Private Sub SetFont(ByVal font As Font,
                       ByVal hwnd As IntPtr,
                       ByVal rect As Rectangle)

       Select Case font IsNot Nothing

           Case True
               ' Set the text position.
               NativeMethods.SetWindowPos(hWnd:=hwnd,
                                          hWndInsertAfter:=IntPtr.Zero,
                                          x:=65,
                                          y:=35,
                                          cx:=rect.Width,
                                          cy:=font.Height,
                                          uFlags:=NativeMethods.SetWindowPosFlags.None)

               ' Set the new font.
               NativeMethods.SendMessage(hWnd:=hwnd,
                                         msg:=NativeMethods.WindowsMessages.WM_SETFONT,
                                         wParam:=font.ToHfont,
                                         lParam:=New IntPtr(1))

           Case Else
               ' Do Nothing.

               ' Get the dialog font.
               ' dim fnt as Font = Font.FromHfont(NativeMethods.SendMessage(hWnd:=hwnd,
               '                                                            msg:=NativeMethods.WindowsMessages.WM_GETFONT,
               '                                                            wParam:=IntPtr.Zero,
               '                                                            lParam:=IntPtr.Zero))

       End Select

   End Sub

   ''' <summary>
   ''' Centers the <see cref="CenteredMessageBox"/> dialog in the specified <see cref="Form"/>.
   ''' </summary>
   ''' <param name="hwnd">A handle to the <see cref="CenteredMessageBox"/> window.</param>
   ''' <param name="dialogRect">The dialog <see cref="NativeMethods.Rect"/> structure.</param>
   ''' <param name="formRect">The form <see cref="Rectangle"/> structure.</param>
   Private Sub CenterDialog(ByVal hwnd As IntPtr,
                            ByVal dialogRect As NativeMethods.Rect,
                            ByVal formRect As Rectangle)

       ' Resize and positionate the messagebox window.
       NativeMethods.MoveWindow(hwnd,
                                x:=formRect.Left + (formRect.Width - dialogRect.Right + dialogRect.Left) \ 2I,
                                y:=formRect.Top + (formRect.Height - dialogRect.Bottom + dialogRect.Top) \ 2I,
                                width:=(dialogRect.Right - dialogRect.Left),
                                height:=(dialogRect.Bottom - dialogRect.Top),
                                repaint:=True)

   End Sub

#End Region

#Region " Event Handlers "

   ''' <summary>
   ''' Handles the Tick event of the TimeoutTimer control.
   ''' </summary>
   ''' <param name="sender">The source of the event.</param>
   ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
   Private Sub TimeoutTimer_Tick(ByVal sender As Object, ByVal e As EventArgs) _
   Handles timeoutTimer.Tick

       NativeMethods.DestroyWindow(Me.messageBoxWindowHandle1)
       Me.Dispose()

   End Sub

#End Region

#Region " IDisposable "

   ''' <summary>
   ''' To detect redundant calls when disposing.
   ''' </summary>
   Private isDisposed As Boolean = False

   ''' <summary>
   ''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.
   ''' </summary>
   Public Sub Dispose() Implements IDisposable.Dispose

       Me.Dispose(isDisposing:=True)
       GC.SuppressFinalize(obj:=Me)

   End Sub

   ''' <summary>
   ''' Releases unmanaged and - optionally - managed resources.
   ''' </summary>
   ''' <param name="IsDisposing">
   ''' <c>true</c> to release both managed and unmanaged resources;
   ''' <c>false</c> to release only unmanaged resources.
   ''' </param>
   Protected Sub Dispose(ByVal isDisposing As Boolean)

       If Not Me.isDisposed Then

           If isDisposing Then

               Me.tries = -1
               Me.ownerForm1 = Nothing

               If Me.font1 IsNot Nothing Then
                   Me.font1.Dispose()
               End If

           End If

       End If

       Me.isDisposed = True

   End Sub

#End Region

End Class

#End Region

[Eleкtro]

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 (vbnet) [Seleccionar] Expandir

' ***********************************************************************
' Author           : Elektro
' Last Modified On : 11-10-2014
' ***********************************************************************
' <copyright file="ControlDragger.vb" company="Elektro Studios">
'     Copyright (c) Elektro Studios. All rights reserved.
' </copyright>
' ***********************************************************************

#Region " Usage Examples "

'Public Class Form1
'
'    Private Dragger As ControlDragger = ControlDragger.Empty
'
'    Private Sub InitializeDrag()
'        Me.Dragger = New ControlDragger(Button1)
'        Me.Dragger.Cursor = Cursors.SizeAll
'        Me.Dragger.Enabled = True
'    End Sub
'
'    Private Sub AlternateDrag()
'        Dragger.Enabled = Not Dragger.Enabled
'    End Sub
'
'    Private Sub FinishDrag()
'        Dragger.Dispose()
'    End Sub
'
'    Private Sub Test() Handles MyBase.Shown
'        Me.InitializeDrag()
'    End Sub
'
'End Class

#End Region

#Region " Imports "

Imports System.ComponentModel

#End Region

#Region " Control Dragger "

''' <summary>
''' Enable or disable drag at runtime on a <see cref="Control"/>.
''' </summary>
Friend NotInheritable Class ControlDragger : Implements IDisposable

#Region " Properties "

    ''' <summary>
    ''' Gets the associated <see cref="Control"/> used to perform draggable operations.
    ''' </summary>
    ''' <value>The control.</value>
    <EditorBrowsable(EditorBrowsableState.Always)>
    <Description("The associated Control used to perform draggable operations.")>
    Friend ReadOnly Property Control As Control
        Get
            Return Me._ctrl
        End Get
    End Property
    ''' <summary>
    ''' The associated <see cref="Control"/> used to perform draggable operations.
    ''' </summary>
    Private WithEvents _ctrl As Control = Nothing

    ''' <summary>
    ''' Represents a <see cref="T:ControlDragger"/> instance that is <c>Nothing</c>.
    ''' </summary>
    ''' <value><c>Nothing</c></value>
    <EditorBrowsable(EditorBrowsableState.Always)>
    <Description("Represents a ControlDragger instance that is Nothing.")>
    Public Shared ReadOnly Property Empty As ControlDragger
        Get
            Return Nothing
        End Get
    End Property

    ''' <summary>
    ''' Gets or sets a value indicating whether drag is enabled on the associated <see cref="Control"/>.
    ''' </summary>
    ''' <value><c>true</c> if drag is enabled; otherwise, <c>false</c>.</value>
    <EditorBrowsable(EditorBrowsableState.Always)>
    <Description("A value indicating whether drag is enabled on the associated control.")>
    Friend Property Enabled As Boolean = True

    ''' <summary>
    ''' Gets or sets the <see cref="Cursor"/> used to drag the associated <see cref="Control"/>.
    ''' </summary>
    ''' <value>The <see cref="Cursor"/>.</value>
    <EditorBrowsable(EditorBrowsableState.Always)>
    <Description("The Cursor used to drag the associated Control")>
    Friend Property Cursor As Cursor = Cursors.SizeAll

    ''' <summary>
    ''' A <see cref="T:ControlDragger"/> instance instance containing the draggable information of the associated <see cref="Control"/>.
    ''' </summary>
    ''' <value>The draggable information.</value>
    <EditorBrowsable(EditorBrowsableState.Never)>
    <Description("A ControlDragger instance instance containing the draggable information of the associated Control.")>
    Private Property DragInfo As ControlDragger = ControlDragger.Empty

    ''' <summary>
    ''' Gets or sets the initial mouse coordinates, normally <see cref="Control.MousePosition"/>.
    ''' </summary>
    ''' <value>The initial mouse coordinates.</value>
    <EditorBrowsable(EditorBrowsableState.Never)>
    <Description("The initial mouse coordinates, normally 'Control.MousePosition'")>
    Private Property InitialMouseCoords As Point = Point.Empty

    ''' <summary>
    ''' Gets or sets the initial <see cref="Control"/> location, normally <see cref="Control.Location"/>.
    ''' </summary>
    ''' <value>The initial location.</value>
    <EditorBrowsable(EditorBrowsableState.Never)>
    <Description("The initial Control location, normally 'Control.Location'")>
    Private Property InitialLocation As Point = Point.Empty

    ''' <summary>
    ''' Gets or sets the old control's cursor to restore it after dragging.
    ''' </summary>
    ''' <value>The old control's cursor.</value>
    <EditorBrowsable(EditorBrowsableState.Never)>
    <Description("The old control's cursor to restore it after dragging.")>
    Private Property oldCursor As Cursor = Nothing

#End Region

#Region " Constructors "

    ''' <summary>
    ''' Prevents a default instance of the <see cref="ControlDragger"/> class from being created.
    ''' </summary>
    Private Sub New()
    End Sub

    ''' <summary>
    ''' Initializes a new instance of the <see cref="ControlDragger"/> class.
    ''' </summary>
    ''' <param name="ctrl">The <see cref="Control"/> used to perform draggable operations.</param>
    Public Sub New(ByVal ctrl As Control)

        Me._ctrl = ctrl

    End Sub

    ''' <summary>
    ''' Initializes a new instance of the <see cref="ControlDragger"/> class.
    ''' </summary>
    ''' <param name="mouseCoordinates">The current mouse coordinates.</param>
    ''' <param name="location">The current location.</param>
    Private Sub New(ByVal mouseCoordinates As Point, ByVal location As Point)

        Me.InitialMouseCoords = mouseCoordinates
        Me.InitialLocation = location

    End Sub

#End Region

#Region " Private Methods "

    ''' <summary>
    ''' Return the new location.
    ''' </summary>
    ''' <param name="mouseCoordinates">The current mouse coordinates.</param>
    ''' <returns>The new location.</returns>
    Private Function GetNewLocation(ByVal mouseCoordinates As Point) As Point

        Return New Point(InitialLocation.X + (mouseCoordinates.X - InitialMouseCoords.X),
                         InitialLocation.Y + (mouseCoordinates.Y - InitialMouseCoords.Y))

    End Function

#End Region

#Region " Hidden Methods "

    ''' <summary>
    ''' Serves as a hash function for a particular type.
    ''' </summary>
    <EditorBrowsable(EditorBrowsableState.Never)>
    Public Shadows Sub GetHashCode()
    End Sub

    ''' <summary>
    ''' Gets the System.Type of the current instance.
    ''' </summary>
    ''' <returns>The exact runtime type of the current instance.</returns>
    <EditorBrowsable(EditorBrowsableState.Never)>
    Public Shadows Function [GetType]()
        Return Me.GetType
    End Function

    ''' <summary>
    ''' Determines whether the specified System.Object instances are considered equal.
    ''' </summary>
    <EditorBrowsable(EditorBrowsableState.Never)>
    Public Shadows Sub Equals()
    End Sub

    ''' <summary>
    ''' Determines whether the specified System.Object instances are the same instance.
    ''' </summary>
    <EditorBrowsable(EditorBrowsableState.Never)>
    Private Shadows Sub ReferenceEquals()
    End Sub

    ''' <summary>
    ''' Returns a String that represents the current object.
    ''' </summary>
    <EditorBrowsable(EditorBrowsableState.Never)>
    Public Shadows Sub ToString()
    End Sub

#End Region

#Region " Event Handlers "

    ''' <summary>
    ''' Handles the MouseEnter event of the control.
    ''' </summary>
    ''' <param name="sender">The source of the event.</param>
    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
    Private Sub ctrl_MouseEnter(ByVal sender As Object, ByVal e As EventArgs) _
    Handles _ctrl.MouseEnter

        Me.oldCursor = Me._ctrl.Cursor

        If Me.Enabled Then

            Me._ctrl.Cursor = Me.Cursor
            Me._ctrl.BringToFront()

        End If

    End Sub

    ''' <summary>
    ''' Handles the MouseLeave event of the control.
    ''' </summary>
    ''' <param name="sender">The source of the event.</param>
    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
    Private Sub ctrl_MouseLeave(ByVal sender As Object, ByVal e As EventArgs) _
    Handles _ctrl.MouseLeave

        Me._ctrl.Cursor = Me.oldCursor

    End Sub

    ''' <summary>
    ''' Handles the MouseDown event of the control.
    ''' </summary>
    ''' <param name="sender">The source of the event.</param>
    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
    Private Sub ctrl_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) _
    Handles _ctrl.MouseDown

        If Me.Enabled Then

            Me.DragInfo = New ControlDragger(Control.MousePosition, Me._ctrl.Location)

        End If

    End Sub

    ''' <summary>
    ''' Handles the MouseMove event of the control.
    ''' </summary>
    ''' <param name="sender">The source of the event.</param>
    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
    Private Sub ctrl_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) _
    Handles _ctrl.MouseMove

        If Me.Enabled AndAlso (Me.DragInfo IsNot ControlDragger.Empty) Then

            Me._ctrl.Location = New Point(Me.DragInfo.GetNewLocation(Control.MousePosition))

        End If

    End Sub

    ''' <summary>
    ''' Handles the MouseUp event of the control.
    ''' </summary>
    ''' <param name="sender">The source of the event.</param>
    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
    Private Sub ctrl_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs) _
    Handles _ctrl.MouseUp

        Me.DragInfo = ControlDragger.Empty

    End Sub

#End Region

#Region " IDisposable "

    ''' <summary>
    ''' To detect redundant calls when disposing.
    ''' </summary>
    Private IsDisposed As Boolean = False

    ''' <summary>
    ''' Prevent calls to methods after disposing.
    ''' </summary>
    ''' <exception cref="System.ObjectDisposedException"></exception>
    Private Sub DisposedCheck()

        If Me.IsDisposed Then
            Throw New ObjectDisposedException(Me.GetType().FullName)
        End If

    End Sub

    ''' <summary>
    ''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.
    ''' </summary>
    Public Sub Dispose() Implements IDisposable.Dispose
        Dispose(True)
        GC.SuppressFinalize(Me)
    End Sub

    ''' <summary>
    ''' Releases unmanaged and - optionally - managed resources.
    ''' </summary>
    ''' <param name="IsDisposing">
    ''' <c>true</c> to release both managed and unmanaged resources;
    ''' <c>false</c> to release only unmanaged resources.
    ''' </param>
    Protected Sub Dispose(ByVal IsDisposing As Boolean)

        If Not Me.IsDisposed Then

            If IsDisposing Then

                With Me._ctrl

                    If Not .IsDisposed AndAlso Not .Disposing Then

                        RemoveHandler .MouseEnter, AddressOf ctrl_MouseEnter
                        RemoveHandler .MouseLeave, AddressOf ctrl_MouseLeave
                        RemoveHandler .MouseDown, AddressOf ctrl_MouseDown
                        RemoveHandler .MouseMove, AddressOf ctrl_MouseMove
                        RemoveHandler .MouseUp, AddressOf ctrl_MouseUp

                    End If

                End With ' Me._ctrl

                With Me

                    .Enabled = False
                    .DragInfo = ControlDragger.Empty
                    .InitialMouseCoords = Point.Empty
                    .InitialLocation = Point.Empty
                    .oldCursor = Nothing
                    ._ctrl = Nothing

                End With ' Me

            End If ' IsDisposing

        End If ' Not Me.IsDisposed

        Me.IsDisposed = True

    End Sub

#End Region

End Class

#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 (vbnet) [Seleccionar] Expandir

' ***********************************************************************
' Author           : Elektro
' Last Modified On : 11-10-2014
' ***********************************************************************
' <copyright file="ControlResizer.vb" company="Elektro Studios">
'     Copyright (c) Elektro Studios. All rights reserved.
' </copyright>
' ***********************************************************************

#Region " Usage Examples "

'Public Class Form1
'
'    Private Resizer As ControlResizer = ControlResizer.Empty
'
'    Private Sub InitializeResizer()
'        Me.Resizer = New ControlResizer(Button1)
'        Me.Resizer.Enabled = True
'        Me.Resizer.PixelMargin = 4
'    End Sub
'
'    Private Sub AlternateResizer()
'        Me.Resizer.Enabled = Not Resizer.Enabled
'    End Sub
'
'    Private Sub FinishResizer()
'        Me.Resizer.Dispose()
'    End Sub
'
'    Private Sub Test() Handles MyBase.Shown
'        Me.InitializeResizer()
'    End Sub
'
'End Class

#End Region

#Region " Imports "

Imports System.ComponentModel

#End Region

#Region " Control Resizer "

''' <summary>
''' Enable or disable resize at runtime on a <see cref="Control"/>.
''' </summary>
Public Class ControlResizer : Implements IDisposable

#Region " Properties "

#Region " Visible "

    ''' <summary>
    ''' Gets the associated <see cref="Control"/> used to perform resizable operations.
    ''' </summary>
    ''' <value>The control.</value>
    <EditorBrowsable(EditorBrowsableState.Always)>
    <Description("The associated Control used to perform resizable operations.")>
    Friend ReadOnly Property Control As Control
        Get
            Return Me._ctrl
        End Get
    End Property
    ''' <summary>
    ''' The associated <see cref="Control"/> used to perform draggable operations.
    ''' </summary>
    Private WithEvents _ctrl As Control = Nothing

    ''' <summary>
    ''' Gets or sets the pixel margin required to activate resize indicators.
    ''' </summary>
    ''' <value>The pixel margin required activate resize indicators.</value>
    <EditorBrowsable(EditorBrowsableState.Always)>
    <Description("The associated Control used to perform resizable operations.")>
    Friend Property PixelMargin As Integer = 4I

    ''' <summary>
    ''' Gets or sets a value indicating whether resize is enabled on the associated <see cref="Control"/>.
    ''' </summary>
    ''' <value><c>true</c> if resize is enabled; otherwise, <c>false</c>.</value>
    <EditorBrowsable(EditorBrowsableState.Always)>
    <Description("A value indicating whether resize is enabled on the associated control.")>
    Friend Property Enabled As Boolean = True

    ''' <summary>
    ''' Represents a <see cref="T:ControlResizer"/> instance that is <c>Nothing</c>.
    ''' </summary>
    ''' <value><c>Nothing</c></value>
    <EditorBrowsable(EditorBrowsableState.Always)>
    <Description("Represents a ControlResizer instance that is Nothing.")>
    Public Shared ReadOnly Property Empty As ControlResizer
        Get
            Return Nothing
        End Get
    End Property

#End Region

#Region " Hidden "

    ''' <summary>
    ''' Gets or sets a value indicating whether the left mouse button is down.
    ''' </summary>
    ''' <value><c>true</c> if left mouse button is down; otherwise, <c>false</c>.</value>
    Private Property IsLeftMouseButtonDown As Boolean = False

    ''' <summary>
    ''' Gets or sets the current active edge.
    ''' </summary>
    ''' <value>The current active edge.</value>
    Private Property ActiveEdge As Edges = Edges.None

    ''' <summary>
    ''' Gets or sets the old control's cursor to restore it after resizing.
    ''' </summary>
    ''' <value>The old control's cursor.</value>
    Private Property oldCursor As Cursor = Nothing

#End Region

#End Region

#Region " Enumerations "

    ''' <summary>
    ''' Contains the Edges.
    ''' </summary>
    Private Enum Edges As Integer

        ''' <summary>
        ''' Any edge.
        ''' </summary>
        None = 0I

        ''' <summary>
        ''' Left edge.
        ''' </summary>
        Left = 1I

        ''' <summary>
        ''' Right edge.
        ''' </summary>
        Right = 2I

        ''' <summary>
        ''' Top edge.
        ''' </summary>
        Top = 3I

        ''' <summary>
        ''' Bottom edge.
        ''' </summary>
        Bottom = 4I

        ''' <summary>
        ''' Top-Left edge.
        ''' </summary>
        TopLeft = 5I

        ''' <summary>
        ''' Top-Right edge.
        ''' </summary>
        TopRight = 6I

        ''' <summary>
        ''' Bottom-Left edge.
        ''' </summary>
        BottomLeft = 7I

        ''' <summary>
        ''' Bottom-Right edge.
        ''' </summary>
        BottomRight = 8I

    End Enum

#End Region

#Region " Constructors "

    ''' <summary>
    ''' Prevents a default instance of the <see cref="ControlResizer"/> class from being created.
    ''' </summary>
    Private Sub New()
    End Sub

    ''' <summary>
    ''' Initializes a new instance of the <see cref="ControlResizer"/> class.
    ''' </summary>
    ''' <param name="ctrl">The control.</param>
    Public Sub New(ByVal ctrl As Control)

        Me._ctrl = ctrl

    End Sub

#End Region

#Region " Event Handlers "

    ''' <summary>
    ''' Handles the MouseEnter event of the control.
    ''' </summary>
    ''' <param name="sender">The source of the event.</param>
    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
    Private Sub ctrl_MouseEnter(ByVal sender As Object, ByVal e As EventArgs) _
    Handles _ctrl.MouseEnter

        Me.oldCursor = Me._ctrl.Cursor

    End Sub

    ''' <summary>
    ''' Handles the MouseLeave event of the control.
    ''' </summary>
    ''' <param name="sender">The source of the event.</param>
    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
    Private Sub ctrl_MouseLeave(ByVal sender As Object, ByVal e As EventArgs) _
    Handles _ctrl.MouseLeave

        Me.ActiveEdge = Edges.None
        Me._ctrl.Cursor = Me.oldCursor

    End Sub

    ''' <summary>
    ''' Handles the MouseDown event of the control.
    ''' </summary>
    ''' <param name="sender">The source of the event.</param>
    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
    Private Sub ctrl_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) _
    Handles _ctrl.MouseDown

        Me.IsLeftMouseButtonDown = (e.Button = MouseButtons.Left)

    End Sub

    ''' <summary>
    ''' Handles the MouseUp event of the control.
    ''' </summary>
    ''' <param name="sender">The source of the event.</param>
    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
    Private Sub ctrl_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs) _
    Handles _ctrl.MouseUp

        Me.IsLeftMouseButtonDown = False

    End Sub

    ''' <summary>
    ''' Handles the MouseMove event of the control.
    ''' </summary>
    ''' <param name="sender">The source of the event.</param>
    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
    Private Sub ctrl_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) _
    Handles _ctrl.MouseMove

        If Not Me.Enabled Then
            Exit Sub

        ElseIf (Me.IsLeftMouseButtonDown) AndAlso Not (Me.ActiveEdge = Edges.None) Then
            Me.SetControlBounds(e)

        Else
            Me.SetActiveEdge(e)
            Me.SetSizeCursor()

        End If

    End Sub

#End Region

#Region " Private Methods "

    ''' <summary>
    ''' Sets the active edge.
    ''' </summary>
    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
    Private Sub SetActiveEdge(ByVal e As MouseEventArgs)

        Select Case True

            ' Top-Left Corner
            Case e.X <= (Me.PixelMargin * 2) AndAlso
                 e.Y <= (Me.PixelMargin * 2)

                Me.ActiveEdge = Edges.TopLeft

                ' TopRight Corner
            Case e.X > Me._ctrl.Width - (Me.PixelMargin * 2) AndAlso
                 e.Y <= (Me.PixelMargin * 2)

                Me.ActiveEdge = Edges.TopRight

                ' Bottom-Left Corner
            Case (e.X <= Me.PixelMargin * 2) AndAlso
                 (e.Y > Me._ctrl.Height - (Me.PixelMargin * 2))

                Me.ActiveEdge = Edges.BottomLeft

                ' Bottom-Right Corner
            Case (e.X > Me._ctrl.Width - (Me.PixelMargin * 2) - 1) AndAlso
                 (e.Y > Me._ctrl.Height - (Me.PixelMargin * 2))

                Me.ActiveEdge = Edges.BottomRight


                ' Left Edge
            Case e.X <= Me.PixelMargin
                Me.ActiveEdge = Edges.Left

                ' Right Edge
            Case e.X > Me._ctrl.Width - (Me.PixelMargin + 1)
                Me.ActiveEdge = Edges.Right

                ' Top Edge
            Case e.Y <= Me.PixelMargin
                Me.ActiveEdge = Edges.Top

                ' Bottom Edge
            Case e.Y > Me._ctrl.Height - (Me.PixelMargin + 1)
                Me.ActiveEdge = Edges.Bottom

            Case Else ' Any Edge
                Me.ActiveEdge = Edges.None

        End Select

    End Sub

    ''' <summary>
    ''' Sets the size cursor.
    ''' </summary>
    Private Sub SetSizeCursor()

        Select Case Me.ActiveEdge

            Case Edges.Left
                Me._ctrl.Cursor = Cursors.SizeWE

            Case Edges.Right
                Me._ctrl.Cursor = Cursors.SizeWE

            Case Edges.Top
                Me._ctrl.Cursor = Cursors.SizeNS

            Case Edges.Bottom
                Me._ctrl.Cursor = Cursors.SizeNS

            Case Edges.TopLeft
                Me._ctrl.Cursor = Cursors.SizeNWSE

            Case Edges.TopRight
                Me._ctrl.Cursor = Cursors.SizeNESW

            Case Edges.BottomLeft
                Me._ctrl.Cursor = Cursors.SizeNESW

            Case Edges.BottomRight
                Me._ctrl.Cursor = Cursors.SizeNWSE

            Case Edges.None
                If Me.oldCursor IsNot Nothing Then
                    Me._ctrl.Cursor = Me.oldCursor
                End If

        End Select

    End Sub

    ''' <summary>
    ''' Sets the control bounds.
    ''' </summary>
    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
    Private Sub SetControlBounds(ByVal e As MouseEventArgs)

        If Me._ctrl.Size.Width = Me._ctrl.MinimumSize.Width Then
            ' Exit Sub
        Else
            Debug.WriteLine(Me._ctrl.Size.ToString)
        End If

        Me._ctrl.SuspendLayout()

        Select Case Me.ActiveEdge

            Case Edges.Left
                If Not Me._ctrl.Width - e.X < (Me._ctrl.MinimumSize.Width) Then
                    Me._ctrl.SetBounds(x:=Me._ctrl.Left + e.X,
                                       y:=Me._ctrl.Top,
                                       width:=Me._ctrl.Width - e.X,
                                       height:=Me._ctrl.Height)
                End If

            Case Edges.Right
                Me._ctrl.SetBounds(x:=Me._ctrl.Left,
                                   y:=Me._ctrl.Top,
                                   width:=Me._ctrl.Width - (Me._ctrl.Width - e.X),
                                   height:=Me._ctrl.Height)

            Case Edges.Top
                If Not Me._ctrl.Height - e.Y < (Me._ctrl.MinimumSize.Height) Then
                    Me._ctrl.SetBounds(x:=Me._ctrl.Left,
                                       y:=Me._ctrl.Top + e.Y,
                                       width:=Me._ctrl.Width,
                                       height:=Me._ctrl.Height - e.Y)
                End If

            Case Edges.Bottom
                Me._ctrl.SetBounds(x:=Me._ctrl.Left,
                                   y:=Me._ctrl.Top,
                                   width:=Me._ctrl.Width,
                                   height:=Me._ctrl.Height - (Me._ctrl.Height - e.Y))

            Case Edges.TopLeft
                Me._ctrl.SetBounds(x:=If(Not Me._ctrl.Width - e.X < (Me._ctrl.MinimumSize.Width),
                                         Me._ctrl.Left + e.X,
                                         Me._ctrl.Left),
                                   y:=If(Not Me._ctrl.Height - e.Y < (Me._ctrl.MinimumSize.Height),
                                         Me._ctrl.Top + e.Y,
                                         Me._ctrl.Top),
                                   width:=If(Not Me._ctrl.Width - e.X < (Me._ctrl.MinimumSize.Width),
                                             Me._ctrl.Width - e.X,
                                             Me._ctrl.Width),
                                   height:=If(Not Me._ctrl.Height - e.Y < (Me._ctrl.MinimumSize.Height),
                                              Me._ctrl.Height - e.Y,
                                              Me._ctrl.Height))

            Case Edges.TopRight
                Me._ctrl.SetBounds(x:=Me._ctrl.Left,
                                   y:=If(Not Me._ctrl.Height - e.Y < (Me._ctrl.MinimumSize.Height),
                                         Me._ctrl.Top + e.Y,
                                         Me._ctrl.Top),
                                   width:=Me._ctrl.Width - (Me._ctrl.Width - e.X),
                                   height:=If(Not Me._ctrl.Height - e.Y < (Me._ctrl.MinimumSize.Height),
                                              Me._ctrl.Height - e.Y,
                                              Me._ctrl.Height))

            Case Edges.BottomLeft
                Me._ctrl.SetBounds(x:=If(Not Me._ctrl.Width - e.X < (Me._ctrl.MinimumSize.Width),
                                         Me._ctrl.Left + e.X,
                                         Me._ctrl.Left),
                                   y:=Me._ctrl.Top,
                                   width:=If(Not Me._ctrl.Width - e.X < (Me._ctrl.MinimumSize.Width),
                                             Me._ctrl.Width - e.X,
                                             Me._ctrl.Width),
                                   height:=Me._ctrl.Height - (Me._ctrl.Height - e.Y))

            Case Edges.BottomRight
                Me._ctrl.SetBounds(x:=Me._ctrl.Left,
                                   y:=Me._ctrl.Top,
                                   width:=Me._ctrl.Width - (Me._ctrl.Width - e.X),
                                   height:=Me._ctrl.Height - (Me._ctrl.Height - e.Y))

        End Select

        Me._ctrl.ResumeLayout()

    End Sub

#End Region

#Region " Hidden Methods "

    ''' <summary>
    ''' Serves as a hash function for a particular type.
    ''' </summary>
    <EditorBrowsable(EditorBrowsableState.Never)>
    Public Shadows Sub GetHashCode()
    End Sub

    ''' <summary>
    ''' Gets the System.Type of the current instance.
    ''' </summary>
    ''' <returns>The exact runtime type of the current instance.</returns>
    <EditorBrowsable(EditorBrowsableState.Never)>
    Public Shadows Function [GetType]()
        Return Me.GetType
    End Function

    ''' <summary>
    ''' Determines whether the specified System.Object instances are considered equal.
    ''' </summary>
    <EditorBrowsable(EditorBrowsableState.Never)>
    Public Shadows Sub Equals()
    End Sub

    ''' <summary>
    ''' Determines whether the specified System.Object instances are the same instance.
    ''' </summary>
    <EditorBrowsable(EditorBrowsableState.Never)>
    Private Shadows Sub ReferenceEquals()
    End Sub

    ''' <summary>
    ''' Returns a String that represents the current object.
    ''' </summary>
    <EditorBrowsable(EditorBrowsableState.Never)>
    Public Shadows Sub ToString()
    End Sub

#End Region

#Region " IDisposable "

    ''' <summary>
    ''' To detect redundant calls when disposing.
    ''' </summary>
    Private IsDisposed As Boolean = False

    ''' <summary>
    ''' Prevent calls to methods after disposing.
    ''' </summary>
    ''' <exception cref="System.ObjectDisposedException"></exception>
    Private Sub DisposedCheck()

        If Me.IsDisposed Then
            Throw New ObjectDisposedException(Me.GetType().FullName)
        End If

    End Sub

    ''' <summary>
    ''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.
    ''' </summary>
    Public Sub Dispose() Implements IDisposable.Dispose
        Dispose(True)
        GC.SuppressFinalize(Me)
    End Sub

    ''' <summary>
    ''' Releases unmanaged and - optionally - managed resources.
    ''' </summary>
    ''' <param name="IsDisposing">
    ''' <c>true</c> to release both managed and unmanaged resources;
    ''' <c>false</c> to release only unmanaged resources.
    ''' </param>
    Protected Sub Dispose(ByVal IsDisposing As Boolean)

        If Not Me.IsDisposed Then

            If IsDisposing Then

                With Me._ctrl

                    If Not .IsDisposed AndAlso Not .Disposing Then

                        RemoveHandler .MouseEnter, AddressOf ctrl_MouseEnter
                        RemoveHandler .MouseLeave, AddressOf ctrl_MouseLeave
                        RemoveHandler .MouseDown, AddressOf ctrl_MouseDown
                        RemoveHandler .MouseMove, AddressOf ctrl_MouseMove
                        RemoveHandler .MouseUp, AddressOf ctrl_MouseUp

                    End If

                End With ' Me._ctrl

                With Me

                    .Enabled = False
                    .oldCursor = Nothing
                    ._ctrl = Nothing

                End With ' Me

            End If ' IsDisposing

        End If ' Not Me.IsDisposed

        Me.IsDisposed = True

    End Sub

#End Region

End Class

#End Region

[Eleкtro]

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 (vbnet) [Seleccionar] Expandir

' ***********************************************************************
' Author   : Elektro
' Modified : 16-November-2014
' ***********************************************************************
' <copyright file="Blinker.vb" company="Elektro Studios">
'     Copyright (c) Elektro Studios. All rights reserved.
' </copyright>
' ***********************************************************************

#Region " Option Restrictions "

Option Strict On
Option Explicit On
Option Infer Off

#End Region

#Region " Usage Examples "

'Public Class Form1
'
'    Private labelBlinker As Blinker
'
'    Private Shadows Sub Shown() Handles MyBase.Shown
'
'        Me.labelBlinker = New Blinker(ctrl:=Label1)
'
'        ' Blink
'        With Me.labelBlinker
'            .Blink(interval:=500)
'            .BlinkText(interval:=500, customText:="Custom Text!")
'        End With
'
'        ' Unblink
'        With Me.labelBlinker
'            .Unblink(visible:=True)
'            .UnblinkText(restoreText:=True)
'        End With
'
'    End Sub
'
'End Class

#End Region

''' <summary>
''' Blinks a Control.
''' </summary>
Friend NotInheritable Class Blinker

#Region " Properties "

    ''' <summary>
    ''' Gets or sets the control to blink.
    ''' </summary>
    ''' <value>The control to blink.</value>
    Friend Property Ctrl As Control

#End Region

#Region " Objects "

    ''' <summary>
    ''' A custom text to restore it after blinking the control.
    ''' </summary>
    Private textToRestore As String

    ''' <summary>
    ''' A Timer to blink a control.
    ''' </summary>
    Private WithEvents blinkTimer As Timer

    ''' <summary>
    ''' A Timer to blink the text of a control.
    ''' </summary>
    Private WithEvents blinkTextTimer As Timer

    ''' <summary>
    ''' Determines whether the control is blinking.
    ''' </summary>
    Private isBlinking As Boolean = False

    ''' <summary>
    ''' Determines whether the text of the control is blinking.
    ''' </summary>
    Private isBlinkingText As Boolean = False

#End Region

#Region " Constructors "

    ''' <summary>
    ''' Initializes a new instance of the <see cref="Blinker" /> class.
    ''' </summary>
    ''' <param name="ctrl">Indicates the control to blink.</param>
    Public Sub New(ByVal ctrl As Control)

        ' Assign the control to blink.
        Me.Ctrl = ctrl

    End Sub

    ''' <summary>
    ''' Prevents a default instance of the <see cref="Blinker"/> class from being created.
    ''' </summary>
    Private Sub New()
    End Sub

#End Region

#Region " Public Methods "

    ''' <summary>
    ''' Blinks the Control.
    ''' </summary>
    ''' <param name="Interval">Indicates the blink interval, in ms.</param>
    Public Sub Blink(Optional ByVal interval As Integer = 500I)

        If blinkTimer Is Nothing Then
            blinkTimer = New Timer
        End If

        With blinkTimer
            .Interval = interval
            .Enabled = True
        End With

        Me.isBlinking = True

    End Sub

    ''' <summary>
    ''' Stop blinking the Control.
    ''' </summary>
    ''' <param name="Visible">Indicates the visibility of the control.</param>
    Public Sub Unblink(Optional ByVal visible As Boolean = True)

        If Not isBlinking Then
            Exit Sub
        End If

        With blinkTimer
            .Enabled = False
        End With

        Me.Ctrl.Visible = visible
        Me.isBlinking = False

    End Sub

    ''' <summary>
    ''' Blinks the text content of the Control.
    ''' </summary>
    ''' <param name="Interval">Indicates the blink interval.</param>
    ''' <param name="CustomText">Indicates a custom text to blink.</param>
    Public Sub BlinkText(Optional ByVal interval As Integer = 500I,
                         Optional ByVal customText As String = Nothing)

        If blinkTextTimer Is Nothing Then
            blinkTextTimer = New Timer
        End If

        With blinkTextTimer
            .Tag = If(String.IsNullOrEmpty(customText), Me.Ctrl.Text, customText)
            .Interval = interval
            .Enabled = True
        End With

        Me.textToRestore = Me.Ctrl.Text
        Me.isBlinkingText = True

    End Sub

    ''' <summary>
    ''' Stop blinking the text content of the Control.
    ''' </summary>
    ''' <param name="RestoreText">If set to <c>true</c>, the control text is resetted to the initial state before started blinking.</param>
    Public Sub UnblinkText(Optional ByVal restoreText As Boolean = False)

        If Not isBlinkingText Then
            Exit Sub
        End If

        With blinkTextTimer
            .Enabled = False
        End With

        If restoreText Then
            Me.Ctrl.Text = Me.textToRestore
        End If

        Me.isBlinkingText = False

    End Sub

#End Region

#Region " Event Handlers"

    ''' <summary>
    ''' Handles the Tick event of the BlinkTimer control.
    ''' </summary>
    ''' <param name="sender">The source of the event.</param>
    ''' <param name="e">The <see cref="EventArgs" /> instance containing the event data.</param>
    Private Sub BlinkTimer_Tick(ByVal sender As Object, ByVal e As EventArgs) _
    Handles blinkTimer.Tick

        Me.Ctrl.Visible = Not Me.Ctrl.Visible

    End Sub

    ''' <summary>
    ''' Handles the Tick event of the BlinkTextTimer control.
    ''' </summary>
    ''' <param name="sender">The source of the event.</param>
    ''' <param name="e">The <see cref="EventArgs" /> instance containing the event data.</param>
    Private Sub BlinkTextTimer_Tick(ByVal sender As Object, ByVal e As EventArgs) _
    Handles blinkTextTimer.Tick

        If String.IsNullOrEmpty(Me.Ctrl.Text) Then
            Me.Ctrl.Text = DirectCast(DirectCast(sender, Timer).Tag, String)

        Else
            Me.Ctrl.Text = String.Empty

        End If

    End Sub

#End Region

End Class

[TrashAmbishion]

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

[Eleкtro]

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 (vbnet) [Seleccionar] Expandir


        Dim commentPattern As New Regex(";.+", RegexOptions.Multiline)
        Dim blockPattern As New Regex("\n\s+?$", RegexOptions.Multiline)
        Dim namePattern As New Regex("\[(.+)\]", RegexOptions.Singleline)
        Dim sigPattern As New Regex("signature\s=\s(.+)", RegexOptions.Singleline)

        Dim userDB As String = File.ReadAllText(".\UserDB.txt", Encoding.UTF8)

        Dim orderedBlocks As IEnumerable(Of String) =
            From match As String In blockPattern.Split(userDB)
            Order By namePattern.Match(match).Value
            Select commentPattern.Replace(match, "").
                   Trim(Environment.NewLine.ToCharArray)

        Dim distinctedBlocks As IEnumerable(Of String) =
            From match As String In orderedBlocks
            Group By sigPattern.Match(match).Value
            Into Group
            Select Group.First

        File.WriteAllText(".\New_UserDB.txt", String.Join(New String(ControlChars.Lf, 2), distinctedBlocks), Encoding.UTF8)


[Eleкtro]

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

Código (vbnet) [Seleccionar] Expandir

       ''' <summary>
       ''' Compress an image to the specified target filesize.
       ''' </summary>
       ''' <param name="inputFile">The input image file.</param>
       ''' <param name="targettFile">The target image file.</param>
       ''' <param name="targetImageFormat">The target image format.</param>
       ''' <param name="targetFileSize">The target filesize, in bytes.</param>
       ''' <exception cref="System.NotImplementedException">Resize Image to -1% and reset quality compression...</exception>
       Private Sub CompressImage(ByVal inputFile As String,
                                 ByVal targettFile As String,
                                 ByVal targetImageFormat As ImageFormat,
                                 ByVal targetFileSize As Long)

           Dim qualityPercent As Integer = 100
           Dim bmp As New Bitmap(inputFile)
           Dim codecInfo As ImageCodecInfo = (From codec As ImageCodecInfo In ImageCodecInfo.GetImageDecoders
                                              Where codec.FormatID = targetImageFormat.Guid).First
           Dim encoder As Imaging.Encoder = Imaging.Encoder.Quality
           Dim encoderParameters As New EncoderParameters(1)

           Using encoderParameter As New EncoderParameter(encoder, qualityPercent)
               encoderParameters.Param(0) = encoderParameter
               bmp.Save(targettFile, codecInfo, encoderParameters)
           End Using

           Dim fInfo As New FileInfo(targettFile)

           Do Until fInfo.Length <= targetFileSize

               qualityPercent -= 1

               If qualityPercent = 50 Then ' Esto lo pongo de manera opcional.
                   Throw New NotImplementedException("Resize Image to -1% and reset quality compression...")
               End If

               ' If qualityPercent = 60 Then
               '     resizePercent -= 1
               '     bmp = ImageTools.ResizeImage(bmp, resizePercent)
               '     qualityPercent = 99
               ' End If

               Using encoderParameter As New EncoderParameter(encoder, qualityPercent)
                   encoderParameters.Param(0) = encoderParameter
                   bmp.Save(targettFile, codecInfo, encoderParameters)
               End Using
               fInfo = New FileInfo(targettFile)

           Loop

           encoderParameters.Dispose()
           bmp.Dispose()

       End Sub

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

Código (vbnet) [Seleccionar] Expandir

       ''' <summary>
       ''' Resizes an image by a percentage.
       ''' </summary>
       ''' <param name="Bitmap">Indicates the image to resize.</param>
       ''' <param name="Percent">Indicates the percent size.</param>
       ''' <returns>Bitmap.</returns>
       Public Function ResizeImage(ByVal bitmap As Drawing.Bitmap,
                                   ByVal percent As Double,
                                   Optional ByVal quality As Drawing2D.InterpolationMode =
                                                             Drawing2D.InterpolationMode.HighQualityBicubic,
                                   Optional ByVal pixelFormat As Imaging.PixelFormat =
                                                                 Imaging.PixelFormat.Format24bppRgb) As Drawing.Bitmap

           Dim width As Integer = (bitmap.Width \ (100I / percent))
           Dim height As Integer = (bitmap.Height \ (100I / percent))

           Dim newBitmap As New Bitmap(width, height, pixelFormat)

           Using g As Graphics = Graphics.FromImage(newBitmap)
               g.InterpolationMode = quality
               g.DrawImage(bitmap, 0, 0, width, height)
           End Using

           Return newBitmap

       End Function