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

[Eleкtro]

Obtiene las expresiones XPath de un documento Html, usando la librería HtmlAgilityPack.

PD: Si encuentran algún fallo porfavor reportármelo, no conozco mucho el tema de los XPath.

Código (vbnet) [Seleccionar] Expandir

   ' Get Html XPaths
   ' By Elektro
   '
   ' Example Usage:
   '
   ' Dim Document As New HtmlAgilityPack.HtmlDocument
   ' Document.LoadHtml(IO.File.ReadAllText("C:\File.html"))
   ' Dim XpathList As List(Of String) = GetHtmlXPaths(Document)
   ' ListBox1.Items.AddRange((From XPath As String In XpathList Select XPath).ToArray)

   ''' <summary>
   ''' Gets all the XPath expressions of an <see cref="HtmlAgilityPack.HtmlDocument"/> document.
   ''' </summary>
   ''' <param name="Document">Indicates the <see cref="HtmlAgilityPack.HtmlDocument"/> document.</param>
   ''' <returns>List(Of System.String).</returns>
   Public Function GetHtmlXPaths(ByVal Document As HtmlAgilityPack.HtmlDocument) As List(Of String)

       Dim XPathList As New List(Of String)
       Dim XPath As String = String.Empty

       For Each Child As HtmlAgilityPack.HtmlNode In Document.DocumentNode.ChildNodes

           If Child.NodeType = HtmlAgilityPack.HtmlNodeType.Element Then
               GetHtmlXPaths(Child, XPathList, XPath)
           End If

       Next Child

       Return XPathList

   End Function

   ''' <summary>
   ''' Gets all the XPath expressions of an <see cref="HtmlAgilityPack.HtmlNode"/>.
   ''' </summary>
   ''' <param name="Node">Indicates the <see cref="HtmlAgilityPack.HtmlNode"/>.</param>
   ''' <param name="XPathList">Indicates a ByReffered XPath list as a <see cref="List(Of String)"/>.</param>
   ''' <param name="XPath">Indicates the current XPath.</param>
   Private Sub GetHtmlXPaths(ByVal Node As HtmlAgilityPack.HtmlNode,
                             ByRef XPathList As List(Of String),
                             Optional ByVal XPath As String = Nothing)

       XPath &= Node.XPath.Substring(Node.XPath.LastIndexOf("/"c))

       Const ClassNameFilter As String = "[@class='{0}']"
       Dim ClassName As String = Node.GetAttributeValue("class", String.Empty)

       If Not String.IsNullOrEmpty(ClassName) Then
           XPath &= String.Format(ClassNameFilter, ClassName)
       End If

       If Not XPathList.Contains(XPath) Then
           XPathList.Add(XPath)
       End If

       For Each Child As HtmlAgilityPack.HtmlNode In Node.ChildNodes

           If Child.NodeType = HtmlAgilityPack.HtmlNodeType.Element Then
               GetHtmlXPaths(Child, XPathList, XPath)
           End If

       Next Child

   End Sub


[Eleкtro]

Me encontré por ahí un ErrorProvider extendido, ya no recuerdo donde lo encontré, y la documentación es... bueno, muy pobre, pero es facil de usar y sencillo de entender a pesar de ello:

'Following class is inherited from basic ErrorProvider class
#Region "Error Provider Extended"
Public Class ErrorProviderExtended
   Inherits System.Windows.Forms.ErrorProvider
   Private _validationcontrols As New ValidationControlCollection
   Private _summarymessage As String = "Please enter following mandatory fields,"

   'This property will be used for displaying a summary message about all empty fields
   'Default value is "Please enter following mandatory fields,". You can set any other
   'message using this property.
   Public Property SummaryMessage() As String
       Get
           Return _summarymessage
       End Get
       Set(ByVal Value As String)
           _summarymessage = Value
       End Set
   End Property

   'Controls property is of type ValidationControlCollection which is inherited from CollectionBase
   'Controls holds all those objects which should be validated.
   Public Property Controls() As ValidationControlCollection
       Get
           Return _validationcontrols
       End Get
       Set(ByVal Value As ValidationControlCollection)
           _validationcontrols = Value
       End Set
   End Property

   'Following function returns true if all fields on form are entered.
   'If not all fields are entered, this function displays a message box which contains all those field names
   'which are empty and returns FALSE.
   Public Function CheckAndShowSummaryErrorMessage() As Boolean
       If Controls.Count <= 0 Then
           Return True
       End If
       Dim i As Integer
       Dim msg As String = SummaryMessage + vbNewLine + vbNewLine
       Dim berrors As Boolean = False
       For i = 0 To Controls.Count - 1
           If Controls(i).Validate Then
               If Trim(Controls(i).ControlObj.text) = "" Then
                   msg &= "> " & Controls(i).DisplayName & vbNewLine
                   SetError(Controls(i).ControlObj, Controls(i).ErrorMessage)
                   berrors = True
               Else
                   SetError(Controls(i).ControlObj, "")
               End If
           Else
               SetError(Controls(i).ControlObj, "")
           End If
       Next
       If berrors Then
           System.Windows.Forms.MessageBox.Show(msg, "Missing Information", Windows.Forms.MessageBoxButtons.OK, Windows.Forms.MessageBoxIcon.Stop)
           Return False
       Else
           Return True
       End If
   End Function

   'Following function clears error messages from all controls.
   Public Sub ClearAllErrorMessages()
       Dim i As Integer
       For i = 0 To Controls.Count - 1
           SetError(Controls(i).ControlObj, "")
       Next
   End Sub

   'This function hooks validation event with all controls.
   Public Sub SetErrorEvents()
       Dim i As Integer
       For i = 0 To Controls.Count - 1
           AddHandler CType(Controls(i).ControlObj, System.Windows.Forms.Control).Validating, AddressOf Validation_Event
       Next
   End Sub

   'Following event is hooked for all controls, it sets an error message with the use of ErrorProvider.
   Private Sub Validation_Event(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) 'Handles txtCompanyName.Validating
       If Controls(sender).Validate Then
           If Trim(sender.Text) = "" Then
               MyBase.SetError(sender, Controls(sender).ErrorMessage)
           Else
               MyBase.SetError(sender, "")
           End If
       End If
   End Sub
End Class
#End Region

'Following class is inherited from CollectionBase class. It is used for holding all Validation Controls.
'This class is collection of ValidationControl class objects.
'This class is used by ErrorProviderExtended class.
#Region "ValidationControlCollection"
Public Class ValidationControlCollection
   Inherits CollectionBase
   Default Public Property Item(ByVal ListIndex As Integer) As ValidationControl
       Get
           Return Me.List(ListIndex)
       End Get
       Set(ByVal Value As ValidationControl)
           Me.List(ListIndex) = Value
       End Set
   End Property


   Default Public Property Item(ByVal pControl As Object) As ValidationControl
       Get
           If IsNothing(pControl) Then
               Return Nothing
           End If

           If GetIndex(pControl.Name) < 0 Then
               Return New ValidationControl
           End If
           Return Me.List(GetIndex(pControl.Name))
       End Get
       Set(ByVal Value As ValidationControl)
           If IsNothing(pControl) Then Exit Property
           If GetIndex(pControl.Name) < 0 Then
               Exit Property
           End If
           Me.List(GetIndex(pControl.Name)) = Value
       End Set
   End Property
   Function GetIndex(ByVal ControlName As String) As Integer
       Dim i As Integer
       For i = 0 To Count - 1
           If Item(i).ControlObj.name.toupper = ControlName.ToUpper Then
               Return i
           End If
       Next
       Return -1
   End Function
   Public Sub Add(ByRef pControl As Object, ByVal pDisplayName As String)
       If IsNothing(pControl) Then Exit Sub
       Dim obj As New ValidationControl
       obj.ControlObj = pControl
       obj.DisplayName = pDisplayName
       obj.ErrorMessage = "Please enter " + pDisplayName
       Me.List.Add(obj)
   End Sub

   Public Sub Add(ByRef pControl As Object, ByVal pDisplayName As String, ByVal pErrorMessage As String)
       If IsNothing(pControl) Then Exit Sub
       Dim obj As New ValidationControl
       obj.ControlObj = pControl
       obj.DisplayName = pDisplayName
       obj.ErrorMessage = pErrorMessage
       Me.List.Add(obj)
   End Sub
   Public Sub Add(ByRef pControl As Object)
       If IsNothing(pControl) Then Exit Sub
       Dim obj As New ValidationControl
       obj.ControlObj = pControl
       obj.DisplayName = pControl.Name
       obj.ErrorMessage = "Please enter " + pControl.Name
       Me.List.Add(obj)
   End Sub
   Public Sub Add(ByVal pControl As ValidationControl)
       If IsNothing(pControl) Then Exit Sub
       Me.List.Add(pControl)
   End Sub
   Public Sub Remove(ByVal pControl As Object)
       If IsNothing(pControl) Then Exit Sub
       Dim i As Integer = Me.GetIndex(pControl.Name)
       If i >= 0 Then
           Me.List.RemoveAt(i)
       End If
   End Sub
End Class
#End Region

'ValidationControl class is used to hold any control from windows form.
'It holds any control in ControlObj property.
#Region "ValidationControl"
Public Class ValidationControl
   Private _control As Object
   Private _displayname As String
   Private _errormessage As String
   Private _validate As Boolean = True

   'Validate property decides weather control is to be validated. Default value is TRUE.
   Public Property Validate() As Boolean
       Get
           Return _validate
       End Get
       Set(ByVal Value As Boolean)
           _validate = Value
       End Set
   End Property

   'ControlObj is a control from windows form which is to be validated.
   'For example txtStudentName
   Public Property ControlObj() As Object
       Get
           Return _control
       End Get
       Set(ByVal Value As Object)
           _control = Value
       End Set
   End Property

   'DisplayName property is used for displaying summary message to user.
   'For example, for txtStudentName you can set 'Student Full Name' as field name.
   'This field name will be displayed in summary message.
   Public Property DisplayName() As String
       Get
           Return _displayname
       End Get
       Set(ByVal Value As String)
           _displayname = Value
       End Set
   End Property

   'ErrorMessage is also used for displaying summary message.
   'For example, you can enter 'Student Name is mandatory' as an error message.
   Public Property ErrorMessage() As String
       Get
           Return _errormessage
       End Get
       Set(ByVal Value As String)
           _errormessage = Value
       End Set
   End Property
End Class
#End Region


EDITO: Ya lo he documentado yo así rapidamente:

Código (vbnet) [Seleccionar] Expandir

#Region "Error Provider Extended"

''' <summary>
''' Provides a user interface for indicating that a control on a form has an error associated with it.
''' </summary>
Public Class ErrorProviderExtended

   Inherits System.Windows.Forms.ErrorProvider
   Private _validationcontrols As New ValidationControlCollection
   Private _summarymessage As String = "Please enter following mandatory fields,"

   ''' <summary>
   ''' Gets or sets the summary message.
   ''' This property will be used for displaying a summary message about all empty fields.
   ''' Default value is "Please enter following mandatory fields,".
   ''' You can set any other message using this property.
   ''' </summary>
   ''' <value>The summary message.</value>
   Public Property SummaryMessage() As String
       Get
           Return _summarymessage
       End Get
       Set(ByVal Value As String)
           _summarymessage = Value
       End Set
   End Property

   ''' <summary>
   ''' Gets or sets the controls which should be validated.
   ''' </summary>
   ''' <value>The controls.</value>
   Public Property Controls() As ValidationControlCollection
       Get
           Return _validationcontrols
       End Get
       Set(ByVal Value As ValidationControlCollection)
           _validationcontrols = Value
       End Set
   End Property

   ''' <summary>
   ''' Checks the and show summary error message.
   ''' </summary>
   ''' <param name="ShowMessage">
   ''' If set to <c>true</c>, This function displays a message box which contains all the field names which are empty.
   ''' </param>
   ''' <returns><c>true</c> if all fields on form are entered, <c>false</c> otherwise.</returns>
   Public Function CheckAndShowSummaryErrorMessage(Optional ByVal ShowMessage As Boolean = False) As Boolean

       If Controls.Count <= 0 Then
           Return True
       End If

       Dim i As Integer
       Dim msg As String = SummaryMessage + vbNewLine + vbNewLine
       Dim berrors As Boolean = False

       For i = 0 To Controls.Count - 1

           If Controls(i).Validate Then
               If Trim(Controls(i).ControlObj.text) = "" Then
                   If ShowMessage Then
                       msg &= "> " & Controls(i).DisplayName & vbNewLine
                   End If
                   SetError(Controls(i).ControlObj, Controls(i).ErrorMessage)
                   berrors = True
               Else
                   SetError(Controls(i).ControlObj, "")
               End If
           Else
               SetError(Controls(i).ControlObj, "")
           End If

       Next i

       If berrors Then
           If ShowMessage Then
               MessageBox.Show(msg, "Missing Information", MessageBoxButtons.OK, MessageBoxIcon.Stop)
           End If
           Return False
       Else
           Return True
       End If

   End Function

   ''' <summary>
   ''' Clears error messages from all controls.
   ''' </summary>
   Public Sub ClearAllErrorMessages()

       Dim i As Integer
       For i = 0 To Controls.Count - 1
           SetError(Controls(i).ControlObj, "")
       Next

   End Sub

   ''' <summary>
   ''' Hooks validation event with all controls.
   ''' </summary>
   Public Sub SetErrorEvents()

       Dim i As Integer
       For i = 0 To Controls.Count - 1
           AddHandler CType(Controls(i).ControlObj, System.Windows.Forms.Control).Validating, AddressOf Validation_Event
       Next

   End Sub

   ''' <summary>
   ''' Handles the Event event of the Validation control.
   ''' This event is hooked for all controls,
   ''' it sets an error message with the use of ErrorProvider
   ''' </summary>
   ''' <param name="sender">The source of the event.</param>
   ''' <param name="e">The <see cref="System.ComponentModel.CancelEventArgs"/> instance containing the event data.</param>
   Private Sub Validation_Event(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs)

       If Controls(sender).Validate Then
           If Trim(sender.Text) = "" Then
               MyBase.SetError(sender, Controls(sender).ErrorMessage)
           Else
               MyBase.SetError(sender, "")
           End If
       End If

   End Sub

End Class

#End Region

#Region "ValidationControlCollection"

''' <summary>
''' This class is used for holding all Validation Controls.
''' This class is collection of 'ValidationControl' class objects.
''' This class is used by 'ErrorProviderExtended' class.
''' </summary>
Public Class ValidationControlCollection : Inherits CollectionBase

   Default Public Property Item(ByVal ListIndex As Integer) As ValidationControl
       Get
           Return Me.List(ListIndex)
       End Get
       Set(ByVal Value As ValidationControl)
           Me.List(ListIndex) = Value
       End Set
   End Property

   Default Public Property Item(ByVal pControl As Object) As ValidationControl
       Get
           If IsNothing(pControl) Then
               Return Nothing
           End If

           If GetIndex(pControl.Name) < 0 Then
               Return New ValidationControl
           End If
           Return Me.List(GetIndex(pControl.Name))
       End Get
       Set(ByVal Value As ValidationControl)
           If IsNothing(pControl) Then Exit Property
           If GetIndex(pControl.Name) < 0 Then
               Exit Property
           End If
           Me.List(GetIndex(pControl.Name)) = Value
       End Set
   End Property

   Function GetIndex(ByVal ControlName As String) As Integer
       Dim i As Integer
       For i = 0 To Count - 1
           If Item(i).ControlObj.name.toupper = ControlName.ToUpper Then
               Return i
           End If
       Next
       Return -1
   End Function

   Public Sub Add(ByRef pControl As Object, ByVal pDisplayName As String)
       If IsNothing(pControl) Then Exit Sub
       Dim obj As New ValidationControl
       obj.ControlObj = pControl
       obj.DisplayName = pDisplayName
       obj.ErrorMessage = "Please enter " + pDisplayName
       Me.List.Add(obj)
   End Sub

   Public Sub Add(ByRef pControl As Object, ByVal pDisplayName As String, ByVal pErrorMessage As String)
       If IsNothing(pControl) Then Exit Sub
       Dim obj As New ValidationControl
       obj.ControlObj = pControl
       obj.DisplayName = pDisplayName
       obj.ErrorMessage = pErrorMessage
       Me.List.Add(obj)
   End Sub

   Public Sub Add(ByRef pControl As Object)
       If IsNothing(pControl) Then Exit Sub
       Dim obj As New ValidationControl
       obj.ControlObj = pControl
       obj.DisplayName = pControl.Name
       obj.ErrorMessage = "Please enter " + pControl.Name
       Me.List.Add(obj)
   End Sub

   Public Sub Add(ByVal pControl As ValidationControl)
       If IsNothing(pControl) Then Exit Sub
       Me.List.Add(pControl)
   End Sub

   Public Sub Remove(ByVal pControl As Object)
       If IsNothing(pControl) Then Exit Sub
       Dim i As Integer = Me.GetIndex(pControl.Name)
       If i >= 0 Then
           Me.List.RemoveAt(i)
       End If
   End Sub
End Class

#End Region

#Region "ValidationControl"

''' <summary>
''' ValidationControl class is used to hold any control from windows form.
''' 'It holds any control in 'ControlObj' property.
''' </summary>
Public Class ValidationControl

   Private _control As Object
   Private _displayname As String
   Private _errormessage As String
   Private _validate As Boolean = True

   ''' <summary>
   ''' Decides weather control is to be validated. Default value is TRUE.
   ''' </summary>
   ''' <value><c>true</c> if validate; otherwise, <c>false</c>.</value>
   Public Property Validate() As Boolean
       Get
           Return _validate
       End Get
       Set(ByVal Value As Boolean)
           _validate = Value
       End Set
   End Property

   ''' <summary>
   ''' ControlObj is a Control from windows form which is to be validated.
   ''' </summary>
   ''' <value>The control object.</value>
   Public Property ControlObj() As Object
       Get
           Return _control
       End Get
       Set(ByVal Value As Object)
           _control = Value
       End Set
   End Property

   ''' <summary>
   ''' DisplayName property is used for displaying summary message to user.
   ''' This field name will be displayed in summary message.
   ''' </summary>
   ''' <value>The display name.</value>
   Public Property DisplayName() As String
       Get
           Return _displayname
       End Get
       Set(ByVal Value As String)
           _displayname = Value
       End Set
   End Property

   ''' <summary>
   ''' ErrorMessage is also used for displaying summary message.
   ''' </summary>
   ''' <value>The error message.</value>
   Public Property ErrorMessage() As String
       Get
           Return _errormessage
       End Get
       Set(ByVal Value As String)
           _errormessage = Value
       End Set
   End Property

End Class

#End Region

Escribí este Form para probar su utilidad:

Código (vbnet) [Seleccionar] Expandir

Public Class ErrorProviderExtended_TestForm

    ''' <summary>
    ''' The ErrorProviderExtended instance.
    ''' </summary>
    Private WithEvents MyErrorProvider As New ErrorProviderExtended

    ''' <summary>
    ''' Control to validate its content.
    ''' </summary>
    Private WithEvents tbValue As New TextBox

    ''' <summary>
    ''' Control that validates general errors.
    ''' </summary>
    Private WithEvents btValidator As New Button

    ''' <summary>
    ''' Control that reports the current error message.
    ''' </summary>
    Private lblError As New Label

    ''' <summary>
    ''' Control used to indicate a textbox hint.
    ''' </summary>
    Private lblHint As New Label

    ''' <summary>
    ''' This value determines whether exists errors that need to be fixed.
    ''' </summary>
    Dim ErrorExists As Boolean = False

    Public Sub New()

        ' This call is required by the designer.
        InitializeComponent()

        With Me.lblHint
            .Location = New Point(10, 10)
            .Text = "Type an 'Int32' value:"
            .ForeColor = Color.WhiteSmoke
            .AutoSize = True
        End With

        With Me.tbValue
            .Location = New Point(15, 25)
            .Size = New Size(100, Me.tbValue.Height)
        End With

        With Me.lblError
            .Location = New Point(10, 50)
            .Text = ""
            .ForeColor = Color.WhiteSmoke
            .AutoSize = True
        End With

        With Me.btValidator
            .Location = New Point(Me.lblError.Location.X, Me.lblError.Location.Y + 20)
            .Text = "Validate"
            .FlatStyle = FlatStyle.System
        End With

        With Me
            .MaximizeBox = False
            .StartPosition = FormStartPosition.CenterScreen
            .FormBorderStyle = Windows.Forms.FormBorderStyle.FixedSingle
            .Size = New Point(220, 150)
            .BackColor = Color.FromArgb(34, 34, 36)
            .Controls.AddRange({Me.lblHint, Me.lblError, Me.tbValue, Me.btValidator})
        End With

    End Sub

    Private Sub Test_Load() Handles Me.Load

        With MyErrorProvider
            .Controls.Add(Me.tbValue, "Int32")
            .Controls(Me.tbValue).Validate = True
            .SummaryMessage = "Following fields are mandatory."
        End With

        ' Change the textbox text to produce an intentional error.
        tbValue.AppendText(" ")
        tbValue.Clear()

    End Sub

    Private Sub Button1_Click() _
    Handles btValidator.Click

        ' The following function checks all empty fields and returns TRUE if all fields are entered.
        ' If any mandotary field is empty this function displays a message and returns FALSE.
        If MyErrorProvider.CheckAndShowSummaryErrorMessage(ShowMessage:=True) Then

            If Not Me.ErrorExists Then
                MessageBox.Show("Data submited successfully.", "", MessageBoxButtons.OK, MessageBoxIcon.Information)
            Else
                MessageBox.Show("Data cannot be submited, fix the error(s).", "", MessageBoxButtons.OK, MessageBoxIcon.Error)
            End If

        End If

    End Sub

    ''' <summary>
    ''' Handles the TextChanged event of the tbValue control.
    ''' </summary>
    Private Sub tbValue_TextChanged(sender As Object, e As EventArgs) _
    Handles tbValue.TextChanged

        Dim Value As String = sender.text

        If String.IsNullOrEmpty(Value) Then
            MyErrorProvider.SetError(sender, "TextBox is empty.")

        ElseIf Not Single.TryParse(Value, New Single) Then
            MyErrorProvider.SetError(sender, "The value cannot contain letters.")

        ElseIf Single.TryParse(Value, New Single) Then

            If Value > Integer.MaxValue Then
                MyErrorProvider.SetError(sender, "Value is greater than " & CStr(Integer.MaxValue))
            Else ' Remove the error.
                MyErrorProvider.SetError(sender, String.Empty)
            End If

        Else ' Remove the error.
            MyErrorProvider.SetError(sender, String.Empty)

        End If

        Me.lblError.Text = MyErrorProvider.GetError(sender)

        If String.IsNullOrEmpty(Me.lblError.Text) Then
            Me.lblError.Text = "No errors :)"
            Me.ErrorExists = False
        Else
            Me.ErrorExists = True
        End If

    End Sub

End Class




[Eleкtro]

Un ejemplo de uso de la librería MagicGraphics: http://www.codeproject.com/Articles/19188/Magic-Graphics







Escribí este Form para jugar un poco con la funcionalidad de esta librería, la verdad es que es muy sencillo.

Código (vbnet) [Seleccionar] Expandir

Public Class MagicGraphics_Test

    Private WithEvents RotationTimer As New Timer With {.Enabled = True, .Interval = 25}

    Dim SC As MagicGraphics.ShapeContainer

    Private Sub Tst_Shown() Handles MyBase.Shown

        SC = New MagicGraphics.ShapeContainer(PictureBox1.CreateGraphics, PictureBox1.Width, PictureBox1.Height, Color.Black, PictureBox1.Image)
        PictureBox1.Image = SC.BMP
        SC.AutoFlush = False

        Dim Sq As New MagicGraphics.Rectangle(New Pen(Color.Black, 3), Brushes.Aqua, 60, 20, 50, 50)
        Sq.FillingBrush = New Drawing2D.LinearGradientBrush(New Point(0, 0), New Point(60, 0), Color.Yellow, Color.Red)
        SC.AddShape(Sq)
        Dim El As New MagicGraphics.Ellipse(New Pen(Color.Black, 3), Brushes.Olive, 60, 88, 50, 71)
        El.FillingBrush = New Drawing2D.LinearGradientBrush(New Point(0, 0), New Point(30, 0), Color.Red, Color.SteelBlue)
        SC.AddShape(El)

        RotationTimer.Start()

    End Sub


    Private Sub RotationTimer_Tick() Handles RotationTimer.Tick

        Static Direction As Integer = 1I ' 0 = Left, 1 = Right

        For X As Integer = 0I To (SC.ShapesL.Count - 1)

            Dim shp As MagicGraphics.Shape = SC.ShapesL(X)

            shp.Rotate(-8)

            If shp.Location.X > (PictureBox1.Width - shp.Width) Then
                Direction = 1I ' Right

            ElseIf shp.Location.X < PictureBox1.Location.X Then
                Direction = 0I ' Left

            End If

            If Direction = 0 Then
                shp.Move(shp.Location.X + 2, shp.Location.Y)

            Else
                shp.Move(shp.Location.X - 2, shp.Location.Y)

            End If

            ' Debug.WriteLine(String.Format("Shape {0} Rotation: {1}", CStr(X), shp.Rotation))

        Next X

        SC.Flush()

    End Sub

End Class


[Eleкtro]

He escrito este ejemplo para mostrar como se puede compartir un espacio de memoria que puede ser leido por diferentes aplicaciones:



Esta sería la aplicación número 1, creen un nuevo proyecto, copien y compilen este Form:

Código (vbnet) [Seleccionar] Expandir

' Example of sharing memory across different running applications.
' By Elektro
'
' *************************
' This is the Application 1
' *************************

#Region " Imports "

Imports System.IO.MemoryMappedFiles

#End Region

#Region " Application 2 "

''' <summary>
''' Class MemoryMappedFile_Form1.
''' This should be the Class used to compile our first application.
''' </summary>
Public Class MemoryMappedFile_Form1

    ' The controls to create on execution-time.
    Dim WithEvents btMakeFile As New Button ' Writes the memory.
    Dim WithEvents btReadFile As New Button ' Reads the memory.
    Dim tbMessage As New TextBox ' Determines the string to map into memory.
    Dim tbReceptor As New TextBox ' Print the memory read's result.
    Dim lbInfoButtons As New Label ' Informs the user with a usage hint for the buttons.
    Dim lbInfotbMessage As New Label ' Informs the user with a usage hint for 'tbMessage'.

    ''' <summary>
    ''' Indicates the name of our memory-file.
    ''' </summary>
    Private ReadOnly MemoryName As String = "My Memory-File Name"

    ''' <summary>
    ''' Indicates the memory buffersize to store the <see cref="MemoryName"/>, in bytes.
    ''' </summary>
    Private ReadOnly MemoryBufferSize As Integer = 1024I

    ''' <summary>
    ''' Indicates the string to map in memory.
    ''' </summary>
    Private ReadOnly Property strMessage As String
        Get
            Return tbMessage.Text
        End Get
    End Property

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

        ' This call is required by the designer.
        InitializeComponent()

        ' Set the properties of the controls.
        With lbInfotbMessage
            .Location = New Point(20, 10)
            .Text = "Type in this TextBox the message to write in memory:"
            .AutoSize = True
            ' .Size = tbReceptor.Size
        End With
        With tbMessage
            .Text = "Hello world from application one!"
            .Location = New Point(20, 30)
            .Size = New Size(310, Me.tbMessage.Height)
        End With
        With btMakeFile
            .Text = "Write Memory"
            .Size = New Size(130, 45)
            .Location = New Point(20, 50)
        End With
        With btReadFile
            .Text = "Read Memory"
            .Size = New Size(130, 45)
            .Location = New Point(200, 50)
        End With
        With tbReceptor
            .Location = New Point(20, 130)
            .Size = New Size(310, 100)
            .Multiline = True
        End With
        With lbInfoButtons
            .Location = New Point(tbReceptor.Location.X, tbReceptor.Location.Y - 30)
            .Text = "Press '" & btMakeFile.Text & "' button to create the memory file, that memory can be read from both applications."
            .AutoSize = False
            .Size = tbReceptor.Size
        End With

        ' Set the Form properties.
        With Me
            .Text = "Application 1"
            .Size = New Size(365, 300)
            .FormBorderStyle = Windows.Forms.FormBorderStyle.FixedSingle
            .MaximizeBox = False
            .StartPosition = FormStartPosition.CenterScreen
        End With

        ' Add the controls on the UI.
        Me.Controls.AddRange({lbInfotbMessage, tbMessage, btMakeFile, btReadFile, tbReceptor, lbInfoButtons})

    End Sub

    ''' <summary>
    ''' Writes a byte sequence into a <see cref="MemoryMappedFile"/>.
    ''' </summary>
    ''' <param name="Name">Indicates the name to assign the <see cref="MemoryMappedFile"/>.</param>
    ''' <param name="BufferLength">Indicates the <see cref="MemoryMappedFile"/> buffer-length to write in.</param>
    ''' <param name="Data">Indicates the byte-data to write inside the <see cref="MemoryMappedFile"/>.</param>
    Private Sub MakeMemoryMappedFile(ByVal Name As String, ByVal BufferLength As Integer, ByVal Data As Byte())

        ' Create or open the memory-mapped file.
        Dim MessageFile As MemoryMappedFile =
            MemoryMappedFile.CreateOrOpen(Name, Me.MemoryBufferSize, MemoryMappedFileAccess.ReadWrite)

        ' Write the byte-sequence into memory.
        Using Writer As MemoryMappedViewAccessor =
            MessageFile.CreateViewAccessor(0L, Me.MemoryBufferSize, MemoryMappedFileAccess.ReadWrite)

            ' Firstly fill with null all the buffer.
            Writer.WriteArray(Of Byte)(0L, System.Text.Encoding.ASCII.GetBytes(New String(Nothing, Me.MemoryBufferSize)), 0I, Me.MemoryBufferSize)

            ' Secondly write the byte-data.
            Writer.WriteArray(Of Byte)(0L, Data, 0I, Data.Length)

        End Using ' Writer

    End Sub

    ''' <summary>
    ''' Reads a byte-sequence from a <see cref="MemoryMappedFile"/>.
    ''' </summary>
    ''' <param name="Name">Indicates an existing <see cref="MemoryMappedFile"/> assigned name.</param>
    ''' <param name="BufferLength">The buffer-length to read in.</param>
    ''' <returns>System.Byte().</returns>
    Private Function ReadMemoryMappedFile(ByVal Name As String, ByVal BufferLength As Integer) As Byte()

        Try
            Using MemoryFile As MemoryMappedFile =
                MemoryMappedFile.OpenExisting(Name, MemoryMappedFileRights.Read)

                Using Reader As MemoryMappedViewAccessor =
                    MemoryFile.CreateViewAccessor(0L, BufferLength, MemoryMappedFileAccess.Read)

                    Dim ReadBytes As Byte() = New Byte(BufferLength - 1I) {}
                    Reader.ReadArray(Of Byte)(0L, ReadBytes, 0I, ReadBytes.Length)
                    Return ReadBytes

                End Using ' Reader

            End Using ' MemoryFile

        Catch ex As IO.FileNotFoundException
            Throw
            Return Nothing

        End Try

    End Function

    ''' <summary>
    ''' Handles the 'Click' event of the 'btMakeFile' control.
    ''' </summary>
    Private Sub btMakeFile_Click() Handles btMakeFile.Click

        ' Get the byte-data to create the memory-mapped file.
        Dim WriteData As Byte() = System.Text.Encoding.ASCII.GetBytes(Me.strMessage)

        ' Create the memory-mapped file.
        Me.MakeMemoryMappedFile(Name:=Me.MemoryName, BufferLength:=Me.MemoryBufferSize, Data:=WriteData)

    End Sub

    ''' <summary>
    ''' Handles the 'Click' event of the 'btReadFile' control.
    ''' </summary>
    Private Sub btReadFile_Click() Handles btReadFile.Click


        Dim ReadBytes As Byte()

        Try ' Read the byte-sequence from memory.
            ReadBytes = ReadMemoryMappedFile(Name:=Me.MemoryName, BufferLength:=Me.MemoryBufferSize)

        Catch ex As IO.FileNotFoundException
            Me.tbReceptor.Text = "Memory-mapped file does not exist."
            Exit Sub

        End Try

        ' Convert the bytes to String.
        Dim Message As String = System.Text.Encoding.ASCII.GetString(ReadBytes.ToArray)

        ' Remove null chars (leading zero-bytes)
        Message = Message.Trim({ControlChars.NullChar})

        ' Print the message.
        tbReceptor.Text = Message

    End Sub

End Class

#End Region

Esta sería la aplicación número 2, creen un nuevo proyecto, copien y compilen este Form:

Código (vbnet) [Seleccionar] Expandir

' Example of sharing memory across different running applications.
' By Elektro
'
' *************************
' This is the Application 2
' *************************

#Region " Imports "

Imports System.IO.MemoryMappedFiles

#End Region

#Region " Application 2 "

''' <summary>
''' Class MemoryMappedFile_Form2.
''' This should be the Class used to compile our first application.
''' </summary>
Public Class MemoryMappedFile_Form2

    ' The controls to create on execution-time.
    Dim WithEvents btMakeFile As New Button ' Writes the memory.
    Dim WithEvents btReadFile As New Button ' Reads the memory.
    Dim tbMessage As New TextBox ' Determines the string to map into memory.
    Dim tbReceptor As New TextBox ' Print the memory read's result.
    Dim lbInfoButtons As New Label ' Informs the user with a usage hint for the buttons.
    Dim lbInfotbMessage As New Label ' Informs the user with a usage hint for 'tbMessage'.

    ''' <summary>
    ''' Indicates the name of our memory-file.
    ''' </summary>
    Private ReadOnly MemoryName As String = "My Memory-File Name"

    ''' <summary>
    ''' Indicates the memory buffersize to store the <see cref="MemoryName"/>, in bytes.
    ''' </summary>
    Private ReadOnly MemoryBufferSize As Integer = 1024I

    ''' <summary>
    ''' Indicates the string to map in memory.
    ''' </summary>
    Private ReadOnly Property strMessage As String
        Get
            Return tbMessage.Text
        End Get
    End Property

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

        ' This call is required by the designer.
        InitializeComponent()

        ' Set the properties of the controls.
        With lbInfotbMessage
            .Location = New Point(20, 10)
            .Text = "Type in this TextBox the message to write in memory:"
            .AutoSize = True
            ' .Size = tbReceptor.Size
        End With
        With tbMessage
            .Text = "Hello world from application two!"
            .Location = New Point(20, 30)
            .Size = New Size(310, Me.tbMessage.Height)
        End With
        With btMakeFile
            .Text = "Write Memory"
            .Size = New Size(130, 45)
            .Location = New Point(20, 50)
        End With
        With btReadFile
            .Text = "Read Memory"
            .Size = New Size(130, 45)
            .Location = New Point(200, 50)
        End With
        With tbReceptor
            .Location = New Point(20, 130)
            .Size = New Size(310, 100)
            .Multiline = True
        End With
        With lbInfoButtons
            .Location = New Point(tbReceptor.Location.X, tbReceptor.Location.Y - 30)
            .Text = "Press '" & btMakeFile.Text & "' button to create the memory file, that memory can be read from both applications."
            .AutoSize = False
            .Size = tbReceptor.Size
        End With

        ' Set the Form properties.
        With Me
            .Text = "Application 2"
            .Size = New Size(365, 300)
            .FormBorderStyle = Windows.Forms.FormBorderStyle.FixedSingle
            .MaximizeBox = False
            .StartPosition = FormStartPosition.CenterScreen
        End With

        ' Add the controls on the UI.
        Me.Controls.AddRange({lbInfotbMessage, tbMessage, btMakeFile, btReadFile, tbReceptor, lbInfoButtons})

    End Sub

    ''' <summary>
    ''' Writes a byte sequence into a <see cref="MemoryMappedFile"/>.
    ''' </summary>
    ''' <param name="Name">Indicates the name to assign the <see cref="MemoryMappedFile"/>.</param>
    ''' <param name="BufferLength">Indicates the <see cref="MemoryMappedFile"/> buffer-length to write in.</param>
    ''' <param name="Data">Indicates the byte-data to write inside the <see cref="MemoryMappedFile"/>.</param>
    Private Sub MakeMemoryMappedFile(ByVal Name As String, ByVal BufferLength As Integer, ByVal Data As Byte())

        ' Create or open the memory-mapped file.
        Dim MessageFile As MemoryMappedFile =
            MemoryMappedFile.CreateOrOpen(Name, Me.MemoryBufferSize, MemoryMappedFileAccess.ReadWrite)

        ' Write the byte-sequence into memory.
        Using Writer As MemoryMappedViewAccessor =
            MessageFile.CreateViewAccessor(0L, Me.MemoryBufferSize, MemoryMappedFileAccess.ReadWrite)

            ' Firstly fill with null all the buffer.
            Writer.WriteArray(Of Byte)(0L, System.Text.Encoding.ASCII.GetBytes(New String(Nothing, Me.MemoryBufferSize)), 0I, Me.MemoryBufferSize)

            ' Secondly write the byte-data.
            Writer.WriteArray(Of Byte)(0L, Data, 0I, Data.Length)

        End Using ' Writer

    End Sub

    ''' <summary>
    ''' Reads a byte-sequence from a <see cref="MemoryMappedFile"/>.
    ''' </summary>
    ''' <param name="Name">Indicates an existing <see cref="MemoryMappedFile"/> assigned name.</param>
    ''' <param name="BufferLength">The buffer-length to read in.</param>
    ''' <returns>System.Byte().</returns>
    Private Function ReadMemoryMappedFile(ByVal Name As String, ByVal BufferLength As Integer) As Byte()

        Try
            Using MemoryFile As MemoryMappedFile =
                MemoryMappedFile.OpenExisting(Name, MemoryMappedFileRights.Read)

                Using Reader As MemoryMappedViewAccessor =
                    MemoryFile.CreateViewAccessor(0L, BufferLength, MemoryMappedFileAccess.Read)

                    Dim ReadBytes As Byte() = New Byte(BufferLength - 1I) {}
                    Reader.ReadArray(Of Byte)(0L, ReadBytes, 0I, ReadBytes.Length)
                    Return ReadBytes

                End Using ' Reader

            End Using ' MemoryFile

        Catch ex As IO.FileNotFoundException
            Throw
            Return Nothing

        End Try

    End Function

    ''' <summary>
    ''' Handles the 'Click' event of the 'btMakeFile' control.
    ''' </summary>
    Private Sub btMakeFile_Click() Handles btMakeFile.Click

        ' Get the byte-data to create the memory-mapped file.
        Dim WriteData As Byte() = System.Text.Encoding.ASCII.GetBytes(Me.strMessage)

        ' Create the memory-mapped file.
        Me.MakeMemoryMappedFile(Name:=Me.MemoryName, BufferLength:=Me.MemoryBufferSize, Data:=WriteData)

    End Sub

    ''' <summary>
    ''' Handles the 'Click' event of the 'btReadFile' control.
    ''' </summary>
    Private Sub btReadFile_Click() Handles btReadFile.Click


        Dim ReadBytes As Byte()

        Try ' Read the byte-sequence from memory.
            ReadBytes = ReadMemoryMappedFile(Name:=Me.MemoryName, BufferLength:=Me.MemoryBufferSize)

        Catch ex As IO.FileNotFoundException
            Me.tbReceptor.Text = "Memory-mapped file does not exist."
            Exit Sub

        End Try

        ' Convert the bytes to String.
        Dim Message As String = System.Text.Encoding.ASCII.GetString(ReadBytes.ToArray)

        ' Remove null chars (leading zero-bytes)
        Message = Message.Trim({ControlChars.NullChar})

        ' Print the message.
        tbReceptor.Text = Message

    End Sub

End Class

#End Region

Ahora ya solo tienen que ejecutar ambas aplicaciones para testear.

Saludos!

[Eleкtro]

Una class para ordenar los items de un listview según la columna:

Código (vbnet) [Seleccionar] Expandir

' ***********************************************************************
' Author           : Elektro
' Last Modified On : 08-20-2014
' ***********************************************************************
' <copyright file="ListView Column-Sorter.vb" company="Elektro Studios">
'     Copyright (c) Elektro Studios. All rights reserved.
' </copyright>
' ***********************************************************************

#Region " Usage Examples "

'Public Class ListViewColumnSorter_TestForm : Inherits form
'
'    ''' <summary>
'    ''' The listview to sort.
'    ''' </summary>
'    Private WithEvents LV As New ListView
'
'    ''' <summary>
'    ''' The 'ListViewColumnSorter' instance.
'    ''' </summary>
'    Private Sorter As New ListViewColumnSorter
'
'    ''' <summary>
'    ''' Initializes a new instance of the <see cref="ListViewColumnSorter_TestForm"/> class.
'    ''' </summary>
'    Public Sub New()
'
'        ' This call is required by the designer.
'        InitializeComponent()
'
'        With LV ' Set the Listview properties.
'
'            ' Set the sorter, our 'ListViewColumnSorter'.
'            .ListViewItemSorter = Sorter
'
'            ' The sorting default direction.
'            .Sorting = SortOrder.Ascending
'
'            ' Set the default sort-modifier.
'            Sorter.SortModifier = ListViewColumnSorter.SortModifiers.SortByText
'
'            ' Add some columns.
'            .Columns.Add("Text").Tag = ListViewColumnSorter.SortModifiers.SortByText
'            .Columns.Add("Numbers").Tag = ListViewColumnSorter.SortModifiers.SortByNumber
'            .Columns.Add("Dates").Tag = ListViewColumnSorter.SortModifiers.SortByDate
'
'            ' Adjust the column sizes.
'            For Each col As ColumnHeader In LV.Columns
'                col.Width = 100I
'            Next
'
'            ' Add some items.
'            .Items.Add("hello").SubItems.AddRange({"1", "11/11/2000"})
'            .Items.Add("yeehaa!").SubItems.AddRange({"2", "11-11-2000"})
'            .Items.Add("El3ktr0").SubItems.AddRange({"10", "9/9/1999"})
'            .Items.Add("wow").SubItems.AddRange({"100", "21/08/2014"})
'
'            ' Visual-Style things.
'            .Dock = DockStyle.Fill
'            .View = View.Details
'            .FullRowSelect = True
'
'        End With
'
'        With Me ' Set the Form properties.
'
'            .Size = New Size(400, 200)
'            .FormBorderStyle = Windows.Forms.FormBorderStyle.FixedSingle
'            .MaximizeBox = False
'            .StartPosition = FormStartPosition.CenterScreen
'            .Text = "ListViewColumnSorter TestForm"
'
'        End With
'
'        ' Add the Listview to UI.
'        Me.Controls.Add(LV)
'
'    End Sub
'
'    ''' <summary>
'    ''' Handles the 'ColumnClick' event of the 'ListView1' control.
'    ''' </summary>
'    Private Sub ListView1_ColumnClick(ByVal sender As Object, ByVal e As ColumnClickEventArgs) _
'    Handles LV.ColumnClick
'
'        ' Dinamycaly sets the sort-modifier to sort the column by text, number, or date.
'        Sorter.SortModifier = sender.columns(e.Column).tag
'
'        ' Determine whether clicked column is already the column that is being sorted.
'        If e.Column = Sorter.Column Then
'
'            ' Reverse the current sort direction for this column.
'            If Sorter.Order = SortOrder.Ascending Then
'                Sorter.Order = SortOrder.Descending
'
'            Else
'                Sorter.Order = SortOrder.Ascending
'
'            End If ' Sorter.Order
'
'        Else
'
'            ' Set the column number that is to be sorted, default to ascending.
'            Sorter.Column = e.Column
'            Sorter.Order = SortOrder.Ascending
'
'        End If ' e.Column
'
'        ' Perform the sort with these new sort options.
'        sender.Sort()
'
'    End Sub
'
'End Class

#End Region

#Region " Imports "

Imports System.Text.RegularExpressions
Imports System.ComponentModel

#End Region

#Region " ListView Column-Sorter "

''' <summary>
''' Performs a sorting comparison.
''' </summary>
Public Class ListViewColumnSorter : Implements IComparer

#Region " Objects "

    '''' <summary>
    '''' Indicates the comparer instance.
    '''' </summary>
    Private Comparer As Object = New TextComparer

#End Region

#Region " Properties "

    ''' <summary>
    ''' Gets or sets the number of the column to which to apply the sorting operation (Defaults to '0').
    ''' </summary>
    Public Property Column As Integer
        Get
            Return Me._Column
        End Get
        Set(ByVal value As Integer)
            Me._Column = value
        End Set
    End Property
    Private _Column As Integer = 0I

    ''' <summary>
    ''' Gets or sets the order of sorting to apply.
    ''' </summary>
    Public Property Order As SortOrder
        Get
            Return Me._Order
        End Get
        Set(ByVal value As SortOrder)
            Me._Order = value
        End Set
    End Property
    Private _Order As SortOrder = SortOrder.None

    ''' <summary>
    ''' Gets or sets the sort modifier.
    ''' </summary>
    ''' <value>The sort modifier.</value>
    Public Property SortModifier As SortModifiers
        Get
            Return Me._SortModifier
        End Get
        Set(ByVal value As SortModifiers)
            Me._SortModifier = value
        End Set
    End Property
    Private _SortModifier As SortModifiers = SortModifiers.SortByText

#End Region

#Region " Enumerations "

    ''' <summary>
    ''' Specifies a comparison result.
    ''' </summary>
    Public Enum ComparerResult As Integer

        ''' <summary>
        ''' 'X' is equals to 'Y'.
        ''' </summary>
        Equals = 0I

        ''' <summary>
        ''' 'X' is less than 'Y'.
        ''' </summary>
        Less = -1I

        ''' <summary>
        ''' 'X' is greater than 'Y'.
        ''' </summary>
        Greater = 1I

    End Enum

    ''' <summary>
    ''' Indicates a Sorting Modifier.
    ''' </summary>
    Public Enum SortModifiers As Integer

        ''' <summary>
        ''' Treats the values ​​as text.
        ''' </summary>
        SortByText = 0I

        ''' <summary>
        ''' Treats the values ​​as numbers.
        ''' </summary>
        SortByNumber = 1I

        ''' <summary>
        ''' Treats valuesthe values ​​as dates.
        ''' </summary>
        SortByDate = 2I

    End Enum

#End Region

#Region " Private Methods "

    ''' <summary>
    ''' Compares two objects and returns a value indicating whether one is less than, equal to, or greater than the other.
    ''' </summary>
    ''' <param name="x">The first object to compare.</param>
    ''' <param name="y">The second object to compare.</param>
    ''' <returns>
    ''' A signed integer that indicates the relative values of <paramref name="x"/> and <paramref name="y"/>,
    ''' 0: <paramref name="x"/> equals <paramref name="y"/>.
    ''' Less than 0: <paramref name="x"/> is less than <paramref name="y"/>.
    ''' Greater than 0: <paramref name="x"/> is greater than <paramref name="y"/>.
    ''' </returns>
    Private Function Compare(ByVal x As Object, ByVal y As Object) As Integer Implements IComparer.Compare

        Dim CompareResult As ComparerResult = ComparerResult.Equals
        Dim LVItemX, LVItemY As ListViewItem

        ' Cast the objects to be compared
        LVItemX = DirectCast(x, ListViewItem)
        LVItemY = DirectCast(y, ListViewItem)

        Dim strX As String = If(Not LVItemX.SubItems.Count <= Me._Column,
                               LVItemX.SubItems(Me._Column).Text,
                               Nothing)

        Dim strY As String = If(Not LVItemY.SubItems.Count <= Me._Column,
                                LVItemY.SubItems(Me._Column).Text,
                                Nothing)

        Dim listViewMain As ListView = LVItemX.ListView

        ' Calculate correct return value based on object comparison
        If listViewMain.Sorting <> SortOrder.Ascending AndAlso listViewMain.Sorting <> SortOrder.Descending Then

            ' Return '0' to indicate they are equal
            Return ComparerResult.Equals

        End If

        If Me._SortModifier.Equals(SortModifiers.SortByText) Then

            ' Compare the two items
            If LVItemX.SubItems.Count <= Me._Column AndAlso LVItemY.SubItems.Count <= Me._Column Then
                CompareResult = Me.Comparer.Compare(Nothing, Nothing)

            ElseIf LVItemX.SubItems.Count <= Me._Column AndAlso LVItemY.SubItems.Count > Me._Column Then
                CompareResult = Me.Comparer.Compare(Nothing, strY)

            ElseIf LVItemX.SubItems.Count > Me._Column AndAlso LVItemY.SubItems.Count <= Me._Column Then
                CompareResult = Me.Comparer.Compare(strX, Nothing)

            Else
                CompareResult = Me.Comparer.Compare(strX, strY)

            End If

        Else ' Me._SortModifier IsNot 'SortByText'

            Select Case Me._SortModifier

                Case SortModifiers.SortByNumber
                    If Me.Comparer.GetType <> GetType(NumericComparer) Then
                        Me.Comparer = New NumericComparer
                    End If

                Case SortModifiers.SortByDate
                    If Me.Comparer.GetType <> GetType(DateComparer) Then
                        Me.Comparer = New DateComparer
                    End If

                Case Else
                    If Me.Comparer.GetType <> GetType(TextComparer) Then
                        Me.Comparer = New TextComparer
                    End If

            End Select

            CompareResult = Comparer.Compare(strX, strY)

        End If ' Me._SortModifier.Equals(...)

        ' Calculate correct return value based on object comparison
        If Me._Order = SortOrder.Ascending Then
            ' Ascending sort is selected, return normal result of compare operation
            Return CompareResult

        ElseIf Me._Order = SortOrder.Descending Then
            ' Descending sort is selected, return negative result of compare operation
            Return (-CompareResult)

        Else
            ' Return '0' to indicate they are equal
            Return 0I

        End If ' Me._Order = ...

    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>
    ''' Determines whether the specified System.Object instances are considered equal.
    ''' </summary>
    <EditorBrowsable(EditorBrowsableState.Never)>
    Public Shadows Sub Equals()
    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>
    ''' Returns a String that represents the current object.
    ''' </summary>
    <EditorBrowsable(EditorBrowsableState.Never)>
    Public Shadows Sub ToString()
    End Sub

#End Region

End Class

#End Region

#Region " Comparers "

#Region " Text "

''' <summary>
''' Performs a text comparison.
''' </summary>
Public Class TextComparer : Inherits CaseInsensitiveComparer

#Region " Enumerations "

    ''' <summary>
    ''' Specifies a comparison result.
    ''' </summary>
    Public Enum ComparerResult As Integer

        ''' <summary>
        ''' 'X' is equals to 'Y'.
        ''' </summary>
        Equals = 0I

        ''' <summary>
        ''' 'X' is less than 'Y'.
        ''' </summary>
        Less = -1I

        ''' <summary>
        ''' 'X' is greater than 'Y'.
        ''' </summary>
        Greater = 1I

    End Enum

#End Region

#Region " Methods "

    ''' <summary>
    ''' Compares two objects and returns a value indicating whether one is less than, equal to, or greater than the other.
    ''' </summary>
    ''' <param name="x">The first object to compare.</param>
    ''' <param name="y">The second object to compare.</param>
    ''' <returns>
    ''' A signed integer that indicates the relative values of <paramref name="x"/> and <paramref name="y"/>,
    ''' 0: <paramref name="x"/> equals <paramref name="y"/>.
    ''' Less than 0: <paramref name="x"/> is less than <paramref name="y"/>.
    ''' Greater than 0: <paramref name="x"/> is greater than <paramref name="y"/>.
    ''' </returns>
    Friend Shadows Function Compare(ByVal x As Object, ByVal y As Object) As Integer

        ' Null parsing.
        If x Is Nothing AndAlso y Is Nothing Then
            Return ComparerResult.Equals ' X is equals to Y.

        ElseIf x Is Nothing AndAlso y IsNot Nothing Then
            Return ComparerResult.Less ' X is less than Y.

        ElseIf x IsNot Nothing AndAlso y Is Nothing Then
            Return ComparerResult.Greater ' X is greater than Y.

        End If

        ' String parsing:
        If (TypeOf x Is String) AndAlso (TypeOf y Is String) Then ' True and True
            Return [Enum].Parse(GetType(ComparerResult),
                                MyBase.Compare(x, y))

        ElseIf (TypeOf x Is String) AndAlso Not (TypeOf y Is String) Then ' True and False
            Return ComparerResult.Greater ' X is greater than Y.

        ElseIf Not (TypeOf x Is String) AndAlso (TypeOf y Is String) Then ' False and True
            Return ComparerResult.Less ' X is less than Y.

        Else ' False and False
            Return ComparerResult.Equals

        End If

    End Function

#End Region

End Class

#End Region

#Region " Numeric "

''' <summary>
''' Performs a numeric comparison.
''' </summary>
Public Class NumericComparer : Implements IComparer

#Region " Enumerations "

    ''' <summary>
    ''' Specifies a comparison result.
    ''' </summary>
    Public Enum ComparerResult As Integer

        ''' <summary>
        ''' 'X' is equals to 'Y'.
        ''' </summary>
        Equals = 0I

        ''' <summary>
        ''' 'X' is less than 'Y'.
        ''' </summary>
        Less = -1I

        ''' <summary>
        ''' 'X' is greater than 'Y'.
        ''' </summary>
        Greater = 1I

    End Enum

#End Region

#Region " Methods "

    ''' <summary>
    ''' Compares two objects and returns a value indicating whether one is less than, equal to, or greater than the other.
    ''' </summary>
    ''' <param name="x">The first object to compare.</param>
    ''' <param name="y">The second object to compare.</param>
    ''' <returns>
    ''' A signed integer that indicates the relative values of <paramref name="x"/> and <paramref name="y"/>,
    ''' 0: <paramref name="x"/> equals <paramref name="y"/>.
    ''' Less than 0: <paramref name="x" /> is less than <paramref name="y"/>.
    ''' Greater than 0: <paramref name="x"/> is greater than <paramref name="y"/>.
    ''' </returns>
    Public Function Compare(ByVal x As Object, ByVal y As Object) As Integer _
    Implements IComparer.Compare

        ' Null parsing.
        If x Is Nothing AndAlso y Is Nothing Then
            Return ComparerResult.Equals ' X is equals to Y.

        ElseIf x Is Nothing AndAlso y IsNot Nothing Then
            Return ComparerResult.Less ' X is less than Y.

        ElseIf x IsNot Nothing AndAlso y Is Nothing Then
            Return ComparerResult.Greater ' X is greater than Y.

        End If

        ' The single variables to parse the text.
        Dim SingleX, SingleY As Single

        ' Single parsing:
        If Single.TryParse(x, SingleX) AndAlso Single.TryParse(y, SingleY) Then ' True and True
            Return [Enum].Parse(GetType(ComparerResult),
                                SingleX.CompareTo(SingleY))

        ElseIf Single.TryParse(x, SingleX) AndAlso Not Single.TryParse(y, SingleY) Then ' True and False
            Return ComparerResult.Greater ' X is greater than Y.

        ElseIf Not Single.TryParse(x, SingleX) AndAlso Single.TryParse(y, SingleY) Then ' False and True
            Return ComparerResult.Less ' X is less than Y.

        Else ' False and False
            Return [Enum].Parse(GetType(ComparerResult),
                                x.ToString.CompareTo(y.ToString))

        End If

    End Function

#End Region

End Class

#End Region

#Region " Date "

''' <summary>
''' Performs a date comparison.
''' </summary>
Public Class DateComparer : Implements IComparer

#Region " Enumerations "

    ''' <summary>
    ''' Specifies a comparison result.
    ''' </summary>
    Public Enum ComparerResult As Integer

        ''' <summary>
        ''' 'X' is equals to 'Y'.
        ''' </summary>
        Equals = 0I

        ''' <summary>
        ''' 'X' is less than 'Y'.
        ''' </summary>
        Less = -1I

        ''' <summary>
        ''' 'X' is greater than 'Y'.
        ''' </summary>
        Greater = 1I

    End Enum

#End Region

#Region " Methods "

    ''' <summary>
    ''' Compares two objects and returns a value indicating whether one is less than, equal to, or greater than the other.
    ''' </summary>
    ''' <param name="x">The first object to compare.</param>
    ''' <param name="y">The second object to compare.</param>
    ''' <returns>
    ''' A signed integer that indicates the relative values of <paramref name="x"/> and <paramref name="y"/>,
    ''' 0: <paramref name="x"/> equals <paramref name="y"/>.
    ''' Less than 0: <paramref name="x"/> is less than <paramref name="y"/>.
    ''' Greater than 0: <paramref name="x"/> is greater than <paramref name="y"/>.
    ''' </returns>
    Public Function Compare(ByVal x As Object, ByVal y As Object) As Integer Implements IComparer.Compare

        ' Null parsing.
        If x Is Nothing AndAlso y Is Nothing Then
            Return ComparerResult.Equals ' X is equals to Y.

        ElseIf x Is Nothing AndAlso y IsNot Nothing Then
            Return ComparerResult.Less ' X is less than Y.

        ElseIf x IsNot Nothing AndAlso y Is Nothing Then
            Return ComparerResult.Greater ' X is greater than Y.

        End If

        ' The Date variables to parse the text.
        Dim DateX, DateY As Date

        ' Date parsing:
        If Date.TryParse(x, DateX) AndAlso Date.TryParse(y, DateY) Then ' True and True
            Return [Enum].Parse(GetType(ComparerResult),
                                DateX.CompareTo(DateY))

        ElseIf Date.TryParse(x, DateX) AndAlso Not Date.TryParse(y, DateY) Then ' True and False
            Return ComparerResult.Greater ' X is greater than Y.

        ElseIf Not Date.TryParse(x, DateX) AndAlso Date.TryParse(y, DateY) Then ' False and True
            Return ComparerResult.Less ' X is less than Y.

        Else ' False and False
            Return [Enum].Parse(GetType(ComparerResult),
                                x.ToString.CompareTo(y.ToString))

        End If

    End Function

#End Region

End Class

#End Region

#End Region

[Eleкtro]

Unos métodos de uso genérico para utilizar la librería IconLib ( http://www.codeproject.com/Articles/16178/IconLib-Icons-Unfolded-MultiIcon-and-Windows-Vista ) para crear iconos o leer las capas de un icono.

PD: Hay que modificar un poco el source (escrito en C#) para permitir la creación de iconos de 512 x 512 (es facil, busquen un if con "256" y añadan el valor "512" a la enumeración de formatos de iconos), pero por otro lado no hay ningún problema para leer este tamaño de icono sin realizar modificaciones.

Código (vbnet) [Seleccionar] Expandir

   ' Create Icon
   ' By Elektro
   '
   ' Usage Examples:
   '
   ' Dim IconFile As IconLib.SingleIcon = CreateIcon("C:\Image.ico", IconLib.IconOutputFormat.All)
   ' For Each IconLayer As IconLib.IconImage In IconFile
   '     PictureBox1.BackgroundImage = IconLayer.Icon.ToBitmap
   '     Debug.WriteLine(IconLayer.Icon.Size.ToString)
   '     Application.DoEvents()
   '     Threading.Thread.Sleep(750)
   ' Next IconLayer
   '
   ''' <summary>
   ''' Creates an icon with the specified image.
   ''' </summary>
   ''' <param name="imagefile">Indicates the image.</param>
   ''' <param name="format">Indicates the icon format.</param>
   ''' <returns>IconLib.SingleIcon.</returns>
   Public Function CreateIcon(ByVal imagefile As String,
                              Optional ByVal format As IconLib.IconOutputFormat =
                                                       IconLib.IconOutputFormat.All) As IconLib.SingleIcon

       Dim sIcon As IconLib.SingleIcon = New IconLib.MultiIcon().Add("Icon1")
       sIcon.CreateFrom(imagefile, format)

       Return sIcon

   End Function

   ' Get Icon-Layers
   ' By Elektro
   '
   ' Usage Examples:
   '
   ' For Each IconLayer As IconLib.IconImage In GetIconLayers("C:\Image.ico")
   '     PictureBox1.BackgroundImage = IconLayer.Icon.ToBitmap
   '     Debug.WriteLine(IconLayer.Icon.Size.ToString)
   '     Application.DoEvents()
   '     Threading.Thread.Sleep(750)
   ' Next IconLayer
   '
   ''' <summary>
   ''' Gets all the icon layers inside an icon file.
   ''' </summary>
   ''' <param name="iconfile">Indicates the icon file.</param>
   ''' <returns>IconLib.SingleIcon.</returns>
   Public Function GetIconLayers(ByVal iconfile As String) As IconLib.SingleIcon

       Dim mIcon As IconLib.MultiIcon = New IconLib.MultiIcon()
       mIcon.Load(iconfile)

       Return mIcon.First

   End Function


[Eleкtro]

Por algún motivo no me puedo instalar el MS Office así que tuve que buscar alguna alternativa para poder seguir desarrollando con manejo de Excel sin interop, y di con esta magnifica librería, NPOI:



http://npoi.codeplex.com/

Tomé los ejemplos oficiales en C# y escribí los siguientes ejemplos en VB.NET



Crear un workbook:

Código (vbnet) [Seleccionar] Expandir

#Region " Create a WorkBook "

       ' Create the excel workbook.
       Dim workbook As IWorkbook = New XSSFWorkbook()

       ' Create a sheet.
       Dim sheet As ISheet = workbook.CreateSheet("Sheet A1")

       ' Create a cell.
       Dim cell As ICell = sheet.CreateRow(0).CreateCell(0)

       ' Set cell value.
       cell.SetCellValue("This is a test")

       ' Set the width of column A1.
       sheet.SetColumnWidth(0, 50 * 256)

       ' Set the height of row A1.
       sheet.CreateRow(0).Height = 200

       ' Save changes.
       Using sw As IO.FileStream = IO.File.Create(".\Create a Workbook Example.xlsx")
           workbook.Write(sw)
       End Using

#End Region



Deinifir la cabecera y el pie de página:

Código (vbnet) [Seleccionar] Expandir

#Region " Set Header and Footer "

   ' Create the excel workbook.
   Dim workbook As IWorkbook = New XSSFWorkbook()
   Dim sheet As ISheet = workbook.CreateSheet("Sheet1") ' Create a sheet.

   With sheet

   ' Create a cell and add a value.
       .CreateRow(0).CreateCell(1).SetCellValue("test")

   ' Set header text.
       .Header.Left = HSSFHeader.Page

   ' Page is a static property of HSSFHeader and HSSFFooter.
       .Header.Center = "This is a test sheet"

   ' Set footer text.
       .Footer.Left = "Copyright NPOI Team"
       .Footer.Right = "created by Tony Qu（瞿杰）"

   End With

    Save changes.
   Using sw As IO.FileStream = IO.File.Create(".\Header-Footer Example.xlsx")
       workbook.Write(sw)
   End Using

#End Region



Añadir comentarios a una celda:

Código (vbnet) [Seleccionar] Expandir

#Region " Add Comments "

   ' Create the excel workbook.
   Dim workbook As IWorkbook = New XSSFWorkbook()
   Dim sheet As ISheet = workbook.CreateSheet("some comments") ' Create the first sheet.

   ' Create the drawing patriarch. This is the top level container for all shapes including cell comments.
   Dim patr As IDrawing = sheet.CreateDrawingPatriarch()

   ' Create a cell in row 3.
   Dim cell1 As ICell = sheet.CreateRow(3).CreateCell(1)
   cell1.SetCellValue(New XSSFRichTextString("Hello, World"))

   ' Create a richtext to use it in the comment.
   Dim strComment As New XSSFRichTextString("This is saying you hello")

   ' Create the richtext font style.
   Dim font As IFont = workbook.CreateFont()
   With font
       .FontName = "Arial"
       .FontHeightInPoints = 10
       .Boldweight = CShort(FontBoldWeight.Bold)
       .Color = HSSFColor.Red.Index
   End With

   ' Apply font style to the text in the comment.
   strComment.ApplyFont(font)

   ' Create a comment, Anchor defines size and position of the comment in worksheet.
   Dim comment1 As IComment = patr.CreateCellComment(New XSSFClientAnchor(0, 0, 0, 0, 4, 2, 6, 5))
   With comment1

   ' Set comment text.
       .[String] = strComment

   ' Set comment author.
       .Author = "Elektro"

   ' By default comments are hidden. This one is always visible.
       .Visible = True

   End With

   '* The first way to assign comment to a cell is via CellComment method:
   cell1.CellComment = comment1
   '* The second way to assign comment to a cell is to implicitly specify its row and column.
   '* Note: It is possible to set row and column of a non-existing cell.
   comment1.Row = 3
   comment1.Column = 1

   ' Save changes.
   Using sw As IO.FileStream = IO.File.Create(".\Comment Example.xlsx")
       workbook.Write(sw)
   End Using

#End Region



Definir propiedades personalizadas:

Código (vbnet) [Seleccionar] Expandir

#Region " Set Custom Properties "

   ' Create the excel workbook.
   Dim workbook As XSSFWorkbook = New XSSFWorkbook()
   Dim sheet As ISheet = workbook.CreateSheet("Sheet1") ' Create the first sheet.

   ' Get the properties.
   Dim props As POIXMLProperties = workbook.GetProperties()

   With props ' Set some default properties.
       .CoreProperties.Title = "Properties Example"
       .CoreProperties.Creator = "Elektro"
       .CoreProperties.Created = DateTime.Now
   End With

   ' Set a custom property.
   If Not props.CustomProperties.Contains("My Property Name") Then
       props.CustomProperties.AddProperty("My Property Name", "Hello World!")
   End If

   ' Save changes.
   Using sw As IO.FileStream = IO.File.Create(".\Properties Example.xlsx")
       workbook.Write(sw)
   End Using

#End Region



Rellenar el color de fondo de una celda:

Código (vbnet) [Seleccionar] Expandir

#Region " Fill Cell Background "

   ' Create the excel workbook.
   Dim workbook As IWorkbook = New XSSFWorkbook()

   ' Create a sheet.
   Dim sheet As ISheet = workbook.CreateSheet("Sheet1")

   ' Create a cell.
   Dim cell1 As ICell = sheet.CreateRow(0).CreateCell(0)

   ' Set the cell text.
   cell1.SetCellValue("Hello")

   ' Set the Background Style.
   Dim style As ICellStyle = workbook.CreateCellStyle()
   With style
       .FillForegroundColor = IndexedColors.Blue.Index
       .FillPattern = FillPattern.BigSpots
       .FillBackgroundColor = IndexedColors.Pink.Index
   End With

   ' Fill the cell background.
   cell1.CellStyle = style

   ' Save changes.
   Using sw As IO.FileStream = IO.File.Create(".\Fill background Example.xlsx")
       workbook.Write(sw)
   End Using

#End Region



Añadir un hyperlink:

Código (vbnet) [Seleccionar] Expandir

#Region " Add HyperLinks "

   ' Create the excel workbook.
   Dim workbook As IWorkbook = New XSSFWorkbook()
   Dim cell As ICell = Nothing
   Dim sheet As ISheet = workbook.CreateSheet("Hyperlinks") ' Create the first sheet.

   ' Set the Hyperlink style.
   Dim HyperLinkStyle As ICellStyle = workbook.CreateCellStyle()
   Dim HyperLinkFont As IFont = workbook.CreateFont()
   HyperLinkFont.Underline = FontUnderlineType.[Single]
   HyperLinkFont.Color = HSSFColor.Blue.Index
   HyperLinkStyle.SetFont(HyperLinkFont)

   ' Link to an URL.
   Dim LinkURL As New XSSFHyperlink(HyperlinkType.Url) With {.Address = "http://poi.apache.org/"}
   cell = sheet.CreateRow(0).CreateCell(0)
   With cell
       .SetCellValue("URL Link")
       .Hyperlink = LinkURL
       .CellStyle = HyperLinkStyle
   End With

   ' Link to a file.
   Dim LinkFile As New XSSFHyperlink(HyperlinkType.File) With {.Address = "link1.xls"}
   cell = sheet.CreateRow(1).CreateCell(0)
   With cell
       .SetCellValue("File Link")
       .Hyperlink = LinkFile
       .CellStyle = HyperLinkStyle
   End With

   ' Link to an e-amil.
   Dim LinkMail As New XSSFHyperlink(HyperlinkType.Email) With {.Address = "mailto:poi@apache.org?subject=Hyperlinks"}
   With cell
       cell = sheet.CreateRow(2).CreateCell(0)
       .SetCellValue("Email Link")
       .Hyperlink = LinkMail
       .CellStyle = HyperLinkStyle
   End With

   ' Link to a place in the workbook.
   Dim LinkSheet As New XSSFHyperlink(HyperlinkType.Document) With {.Address = "'Target ISheet'!A1"}
   Dim sheet2 As ISheet = workbook.CreateSheet("Target ISheet") ' Create a target sheet.
   sheet2.CreateRow(0).CreateCell(0).SetCellValue("Target ICell") ' Create a target cell.
   With cell
       cell = sheet.CreateRow(3).CreateCell(0)
       .SetCellValue("Worksheet Link")
       .Hyperlink = LinkSheet
       .CellStyle = HyperLinkStyle
   End With

   ' Save changes.
   Using sw As IO.FileStream = IO.File.Create(".\HyperLink Example.xlsx")
       workbook.Write(sw)
   End Using

#End Region



Establecer el estilo de fuente:

Código (vbnet) [Seleccionar] Expandir

#Region " Set Font style "

   ' Create the excel workbook.
   Dim workbook As IWorkbook = New XSSFWorkbook()
   Dim sheet1 As ISheet = workbook.CreateSheet("Sheet1") ' Create the first sheet.

   ' Create a cell style.
   Dim style1 As ICellStyle = workbook.CreateCellStyle()

   ' Create a font style.
   Dim font1 As IFont = workbook.CreateFont()
   With font1 ' underlined, italic, red color, fontsize=20
       .Color = IndexedColors.Red.Index
       .IsItalic = True
       .Underline = FontUnderlineType.[Double]
       .FontHeightInPoints = 20
   End With

   ' bind font1 with style1
   style1.SetFont(font1)

   ' Create a cell, add text, and apply the font.
   Dim cell1 As ICell = sheet1.CreateRow(1).CreateCell(1)
   With cell1
       .SetCellValue("Hello World!")
       .CellStyle = style1
   End With

   ' Save changes.
   Using sw As IO.FileStream = IO.File.Create(".\Font-Style Example.xlsx")
       workbook.Write(sw)
   End Using

#End Region



Establecer el tipo de fuente para texto con formato (rich text):

Código (vbnet) [Seleccionar] Expandir

#Region " Set Font style RichText "

   ' Create the excel workbook.
   Dim workbook As IWorkbook = New XSSFWorkbook()
   Dim sheet1 As ISheet = workbook.CreateSheet("Sheet1") ' Create the first sheet.

   ' Create a cell with rich text.
   Dim cell1 As ICell = sheet1.CreateRow(0).CreateCell(0)

   ' Create a richtext.
   Dim richtext As New XSSFRichTextString("Microsoft OfficeTM")

   ' Create a font style.
   Dim font1 As IFont = workbook.CreateFont()
   With font1
       .FontHeightInPoints = 12
   End With
   richtext.ApplyFont(0, 16, font1) ' apply font to "Microsoft Office".

   ' Create a font style.
   Dim font2 As IFont = workbook.CreateFont()
   With font2
       .TypeOffset = FontSuperScript.Super
       .IsItalic = True
       .Color = IndexedColors.Blue.Index
       .FontHeightInPoints = 8
   End With
   richtext.ApplyFont(16, 18, font2) ' apply font to "TM"

   ' Add the richtext into the cell.
   cell1.SetCellValue(richtext)

   ' Save changes.
   Using sw As IO.FileStream = IO.File.Create(".\Font-Style RichText Example.xlsx")
       workbook.Write(sw)
   End Using

#End Region



Añadir una tabla:

Código (vbnet) [Seleccionar] Expandir

#Region " Add a Table "

   ' Create the excel workbook.
   Dim workbook As IWorkbook = New XSSFWorkbook()
   Dim sheet1 As XSSFSheet = DirectCast(workbook.CreateSheet("Sheet1"), XSSFSheet) ' Create the first sheet.

   ' Create a cell with text.
   sheet1.CreateRow(0).CreateCell(0).SetCellValue("This is a Sample")

   ' Create a table.
   Dim x As Integer = 1
   For i As Integer = 1 To 15
   Dim row As IRow = sheet1.CreateRow(i)
       For j As Integer = 0 To 14
           row.CreateCell(j).SetCellValue(System.Math.Max(System.Threading.Interlocked.Increment(x), x - 1))
       Next j
   Next i
   Dim table As XSSFTable = sheet1.CreateTable()
   table.Name = "Tabella1"
   table.DisplayName = "Tabella1"

   ' Save changes.
   Using sw As IO.FileStream = IO.File.Create(".\Table Example.xlsx")
       workbook.Write(sw)
   End Using

#End Region



Formatear el valor de una celda:

Código (vbnet) [Seleccionar] Expandir

#Region " Format Cell Data "

   Private Sub Test() Handles MyBase.Shown

       ' Create the excel workbook.
       Dim workbook As IWorkbook = New XSSFWorkbook()

       ' Create a sheet.
       Dim sheet As ISheet = workbook.CreateSheet("Sheet1")

       ' Create the format instance.
       Dim format As IDataFormat = workbook.CreateDataFormat()

       ' Increase the width of Column A.
       sheet.SetColumnWidth(0, 5000)

       ' Create a row and put some cells in it. Rows are 0 based.
       Dim cell1 As ICell = sheet.CreateRow(0).CreateCell(0)
       Dim cell2 As ICell = sheet.CreateRow(1).CreateCell(0)
       Dim cell3 As ICell = sheet.CreateRow(2).CreateCell(0)
       Dim cell4 As ICell = sheet.CreateRow(3).CreateCell(0)
       Dim cell5 As ICell = sheet.CreateRow(4).CreateCell(0)
       Dim cell6 As ICell = sheet.CreateRow(5).CreateCell(0)
       Dim cell7 As ICell = sheet.CreateRow(6).CreateCell(0)

       ' Format the cell values.

       ' [Cell1]
       ' Number format with 2 digits after the decimal point. eg: "1.20"
       SetValueAndFormat(workbook, cell1, 1.2, HSSFDataFormat.GetBuiltinFormat("0.00"))

       ' [Cell2]
       ' RMB currency format with comma. eg: "¥20,000"
       SetValueAndFormat(workbook, cell2, 20000, format.GetFormat("¥#,##0"))

       ' [Cell3]
       ' Scentific number format. eg: "3.15E+00"
       SetValueAndFormat(workbook, cell3, 3.151234, format.GetFormat("0.00E+00"))

       ' [Cell4]
       ' Percent format, 2 digits after the decimal point. eg: "99.33%"
       SetValueAndFormat(workbook, cell4, 0.99333, format.GetFormat("0.00%"))

       ' [Cell5]
       ' Phone number format. eg: "021-65881234"
       SetValueAndFormat(workbook, cell5, 2165881234UI, format.GetFormat("000-00000000"))

       ' [Cell6]:
       ' Formula value with datetime style.
       cell6.CellFormula = "DateValue(""2005-11-11"")+TIMEVALUE(""11:11:11"")"
       Dim cellStyle6 As ICellStyle = workbook.CreateCellStyle()
       cellStyle6.DataFormat = HSSFDataFormat.GetBuiltinFormat("m/d/yy h:mm")
       cell6.CellStyle = cellStyle6

       ' [Cell7]:
       ' Display current time in AM/PM format.
       SetDate(workbook, cell7, DateTime.Now, format.GetFormat("[$-409]h:mm:ss AM/PM;@"))

       ' Save changes.
       Using sw As IO.FileStream = IO.File.Create(".\Formula Example.xlsx")
           workbook.Write(sw)
       End Using

   End Sub

   Private Shared Sub SetValueAndFormat(ByVal workbook As IWorkbook,
                                        ByVal cell As ICell,
                                        ByVal value As Double,
                                        ByVal formatId As Short)

       cell.SetCellValue(value)
       Dim cellStyle As ICellStyle = workbook.CreateCellStyle()
       cellStyle.DataFormat = formatId
       cell.CellStyle = cellStyle

   End Sub

   Private Shared Sub SetDate(ByVal workbook As IWorkbook,
                              ByVal cell As ICell,
                              ByVal value As DateTime,
                              ByVal formatId As Short)

       'set value for the cell
       If Not value = Nothing Then
           cell.SetCellValue(value)
       End If

       Dim cellStyle As ICellStyle = workbook.CreateCellStyle()
       cellStyle.DataFormat = formatId
       cell.CellStyle = cellStyle

   End Sub

#End Region



Ocultar una fila o una columna:

Código (vbnet) [Seleccionar] Expandir

#Region " Hide row or column "

   ' Create the excel workbook.
   Dim workbook As IWorkbook = New XSSFWorkbook()

   ' Create a sheet.
   Dim sheet As ISheet = workbook.CreateSheet("Sheet1")

   ' Create some rows.
   Dim r1 As IRow = sheet.CreateRow(0)
   Dim r2 As IRow = sheet.CreateRow(1)
   Dim r3 As IRow = sheet.CreateRow(2)
   Dim r4 As IRow = sheet.CreateRow(3)
   Dim r5 As IRow = sheet.CreateRow(4)

   ' Hide IRow 2.
   r2.ZeroHeight = True

   ' Hide column C.
   sheet.SetColumnHidden(2, True)

   ' Save changes.
   Using sw As IO.FileStream = IO.File.Create(".\Hide Row or Column Example.xlsx")
       workbook.Write(sw)
   End Using

#End Region



Añadir una imagen:

Código (vbnet) [Seleccionar] Expandir

       ' Create the excel workbook.
       Dim workbook As IWorkbook = New XSSFWorkbook()

       ' Create a sheet.
       Dim sheet As ISheet = workbook.CreateSheet("PictureSheet")

       ' Create the drawing patriarch. This is the top level container for all shapes including cell comments.
       Dim patriarch As IDrawing = sheet.CreateDrawingPatriarch()

       ' Create the anchor.
       Dim anchor As New XSSFClientAnchor(500, 200, 0, 0, 2, 2, 4, 7)
       anchor.AnchorType = 2

       ' Load the picture and get the picture index in the workbook.
       Dim imageId As Integer = LoadImage("C:\Users\Administrador\Desktop\4t0n.png", workbook)
       Dim picture As XSSFPicture = DirectCast(patriarch.CreatePicture(anchor, imageId), XSSFPicture)

       ' Reset the image to the original size.
       ' Note: Resize will reset client anchor you set.
       'picture.Resize();  

       ' Save changes.
       Using sw As IO.FileStream = IO.File.Create(".\Add Picture Example.xlsx")
           workbook.Write(sw)
       End Using


   Public Shared Function LoadImage(path As String, wb As IWorkbook) As Integer
       Dim file As New FileStream(path, FileMode.Open, FileAccess.Read)
       Dim buffer As Byte() = New Byte(file.Length - 1) {}
       file.Read(buffer, 0, CInt(file.Length))
       Return wb.AddPicture(buffer, PictureType.JPEG)
   End Function



Unir celdas:

Código (vbnet) [Seleccionar] Expandir

       ' Create the excel workbook.
       Dim workbook As IWorkbook = New XSSFWorkbook()

       ' Create a sheet.
       Dim sheet As ISheet = workbook.CreateSheet("Sheet1")

       ' Create a cell.
       Dim cell As ICell = sheet.CreateRow(1).CreateCell(1)
       cell.SetCellValue(New XSSFRichTextString("This is a test of merging"))

       ' Merge B2 cell with C2 cell.
       sheet.AddMergedRegion(New CellRangeAddress(1, 1, 1, 2))

       ' Save changes.
       Using sw As IO.FileStream = IO.File.Create(".\Merge Cells Example.xlsx")
           workbook.Write(sw)
       End Using



Proteger con contraseña:

Código (vbnet) [Seleccionar] Expandir

       ' Create the excel workbook.
       Dim workbook As IWorkbook = New XSSFWorkbook()

       ' Create a sheet.
       Dim sheet As XSSFSheet = DirectCast(workbook.CreateSheet("Sheet A1"), XSSFSheet)

       With sheet ' Lock accessing excel operations.
           .LockFormatRows()
           .LockFormatCells()
           .LockFormatColumns()
           .LockDeleteColumns()
           .LockDeleteRows()
           .LockInsertHyperlinks()
           .LockInsertColumns()
           .LockInsertRows()
       End With

       ' Set the password to unprotect:
       Dim password As String = "Your Password"
       sheet.ProtectSheet(password)

       ' Save changes.
       Using sw As IO.FileStream = IO.File.Create(".\Protect Cells Example.xlsx")
           workbook.Write(sw)
       End Using


EDITO:

Como leer un workbook:

Código (vbnet) [Seleccionar] Expandir

       ' The existing workbook filepath.
       Dim WorkBookFile As String = "C:\MyWorkBook.xlsx"

       ' Create the excel workbook instance.
       Dim workbook As IWorkbook = Nothing

       ' Load the workbook.
       Using file As New IO.FileStream(WorkBookFile, IO.FileMode.Open, IO.FileAccess.Read)
           workbook = New XSSFWorkbook(file)
       End Using

       ' Get the first sheet.
       Dim sheet As ISheet = workbook.GetSheetAt(0)

       ' Get the first row.
       Dim row As IRow = sheet.GetRow(0)

       ' Create a cell.
       Dim cell As ICell = row.CreateCell(1)

       ' Get the cell value.
       If String.IsNullOrEmpty(cell.StringCellValue) Then ' If value is emty then...

           ' Set cell value.
           cell.SetCellValue("This is a test")

       End If

       ' Save changes.
       Using sw As IO.FileStream = IO.File.Create(WorkBookFile)
           workbook.Write(sw)
       End Using

[Eleкtro]

Una versión actualizada de mi Reg-Editor

Contiene todo tipo de métodos para el manejo del registro de Windows.

Código (vbnet) [Seleccionar] Expandir

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

#Region " Usage Examples "

' -----------
' Create Key:
' -----------
' RegEdit.CreateKey("HKCU\Software\MyProgram")                        ' Creates "HKCU\Software\MyProgram"
' RegEdit.CreateKey("HKEY_CURRENT_USER\Software\MyProgram\Settings\") ' Creates "HKCU\Software\MyProgram\Settings"
'
' -----------
' Delete Key:
' -----------
' RegEdit.DeleteKey("HKLM\Software\7-zip")                ' Deletes the "7-zip" tree including subkeys
' RegEdit.DeleteKey("HKEY_LOCAL_MACHINE\Software\7-zip\") ' Deletes the "7-zip" tree including subkeys
'
' -------------
' Delete Value:
' -------------
' RegEdit.DeleteValue("HKCU\Software\7-Zip", "Lang")               ' Deletes "Lang" Value
' RegEdit.DeleteValue("HKEY_CURRENT_USER\Software\7-Zip\", "Lang") ' Deletes "Lang" Value
'
' ----------
' Get Value:
' ----------
' Dim Data As String = RegEdit.GetValue("HKCU\Software\MyProgram", "Value name"))
' Dim Data As String = RegEdit.GetValue("HKEY_CURRENT_USER\Software\MyProgram", "Value name"))
'
' ----------
' Set Value:
' ----------
' RegEdit.SetValue("HKCU\Software\MyProgram", "Value name", "Data", Microsoft.Win32.RegistryValueKind.String)               ' Create/Replace "Value Name" with "Data" as string data
' RegEdit.SetValue("HKEY_CURRENT_USER\Software\MyProgram\", "Value name", "Data", Microsoft.Win32.RegistryValueKind.String) ' Create/Replace "Value Name" with "Data" as string data
'
' -----------
' Export Key:
' -----------
' RegEdit.ExportKey("HKLM", "C:\HKLM.reg")                  ' Export entire "HKEY_LOCAL_MACHINE" Tree to "C:\HKLM.reg" file.
' RegEdit.ExportKey("HKLM\Software\7-zip\", "C:\7-zip.reg") ' Export entire "7-zip" Tree to "C:\7-zip.reg" file.
'
' ------------
' Import File:
' ------------
' RegEdit.ImportRegFile("C:\Registry_File.reg") ' Install a registry file.
'
' ------------
' Jump To Key:
' ------------
' RegEdit.JumpToKey("HKLM")                               ' Opens Regedit at "HKEY_LOCAL_MACHINE" Root.
' RegEdit.JumpToKey("HKEY_LOCAL_MACHINE\Software\7-zip\") ' Opens Regedit at "HKEY_LOCAL_MACHINE\Software\7-zip" tree.
'
' -----------
' Exist Key?:
' -----------
' MsgBox(RegEdit.ExistKey("HKCU\software") ' Checks if "Software" Key exist.

' -------------
' Exist Value?:
' -------------
' MsgBox(RegEdit.ExistValue("HKLM\software\7-zip", "Path") ' Checks if "Path" value exist.
'
' ------------
' Exist Data?:
' ------------
' MsgBox(RegEdit.ExistData("HKLM\software\7-zip", "Path") ' Checks if "Path" value have empty data.
'
' ---------
' Copy Key:
' ---------
' RegEdit.CopyKey("HKCU\Software\7-Zip", "HKCU\Software\7-zip Backup") ' Copies "HKCU\Software\7-Zip" to "HKCU\Software\7-zip Backup"
'
' -----------
' Copy Value:
' -----------
' RegEdit.CopyValue("HKLM\software\7-zip", "path", "HKLM\software\7-zip", "path_backup") ' Copies "Path" value with their data to "HKLM\software\7-zip" "path_backup".
'
' -------------------
' SetUserAccessKey:
' -------------------
' RegEdit.SetUserAccessKey("HKCU\Software\7-Zip", {RegEdit.ReginiUserAccess.Administrators_Full_Access})
' RegEdit.SetUserAccessKey("HKEY_CURRENT_USER\Software\7-Zip", {RegEdit.ReginiUserAccess.Administrators_Full_Access, RegEdit.ReginiUserAccess.Creator_Full_Access, RegEdit.ReginiUserAccess.System_Full_Access})

#End Region

#Region " Imports "

Imports Microsoft.Win32
Imports System.IO
Imports System.Text

#End Region

#Region " RegEdit "

''' <summary>
''' Contains registry related methods.
''' </summary>
Public Class RegEdit

#Region " Enumerations "

    ''' <summary>
    ''' Specifies an User identifier for Regini.exe command.
    ''' </summary>
    Public Enum ReginiUserAccess As Integer

        Administrators_Full_Access = 1I

        Administrators_Read_Access = 2I

        Administrators_Read_and_Write_Access = 3I

        Administrators_Read_Write_and_Delete_Access = 4I

        Administrators_Read_Write_and_Execute_Access = 20I

        Creator_Full_Access = 5I

        Creator_Read_and_Write_Access = 6I

        Interactive_User_Full_Access = 21I

        Interactive_User_Read_and_Write_Access = 22I

        Interactive_User_Read_Write_and_Delete_Access = 23I

        Power_Users_Full_Access = 11I

        Power_Users_Read_and_Write_Access = 12I

        Power_Users_Read_Write_and_Delete_Access = 13I

        System_Full_Access = 17I

        System_Operators_Full_Access = 14I

        System_Operators_Read_and_Write_Access = 15I

        System_Operators_Read_Write_and_Delete_Access = 16I

        System_Read_Access = 19I

        System_Read_and_Write_Access = 18I

        World_Full_Access = 7I

        World_Read_Access = 8I

        World_Read_and_Write_Access = 9I

        World_Read_Write_and_Delete_Access = 10I

    End Enum

#End Region

#Region " Public Methods "

#Region " Create "

    ''' <summary>
    ''' Creates a new registry key.
    ''' </summary>
    ''' <param name="Key">Indicates the registry key.</param>
    Public Shared Sub CreateKey(ByVal Key As String)

        Using Reg As RegistryKey = GetRoot(Key)

            Reg.CreateSubKey(GetPath(Key), RegistryKeyPermissionCheck.Default, RegistryOptions.None)

        End Using

    End Sub

#End Region

#Region " Delete "

    ''' <summary>
    ''' Deletes a registry key.
    ''' </summary>
    ''' <param name="Key">Indicates the registry key.</param>
    Public Shared Sub DeleteKey(ByVal Key As String)

        Using Reg As RegistryKey = GetRoot(Key)

            Reg.DeleteSubKeyTree(GetPath(Key), throwOnMissingSubKey:=False)

        End Using

    End Sub

    ''' <summary>
    ''' Delete a registry value.
    ''' </summary>
    ''' <param name="Key">Indicates the registry key.</param>
    ''' <param name="Value">Indicates the registry value.</param>
    Public Shared Sub DeleteValue(ByVal Key As String,
                                  ByVal Value As String)

        Using Reg As RegistryKey = GetRoot(Key)

            Reg.OpenSubKey(GetPath(Key), writable:=False).
                DeleteValue(Value, throwOnMissingValue:=False)

        End Using

    End Sub

#End Region

#Region " Get "

    ''' <summary>
    ''' Gets the data of a registry value.
    ''' </summary>
    ''' <param name="Key">Indicates the registry key.</param>
    ''' <param name="Value">Indicates the registry value.</param>
    ''' <returns>The registry data.</returns>
    Public Shared Function GetValue(ByVal Key As String,
                                    ByVal Value As String) As Object

        Using Reg As RegistryKey = GetRoot(Key)

            Return Reg.OpenSubKey(GetPath(Key), writable:=False).
                       GetValue(Value, defaultValue:=Nothing)

        End Using

    End Function

#End Region

#Region " Set "

    ''' <summary>
    ''' Set the data of a registry value.
    ''' If the Key or value doesn't exist it will be created.
    ''' </summary>
    ''' <param name="Key">Indicates the registry key.</param>
    ''' <param name="Value">Indicates the registry value.</param>
    ''' <param name="Data">Indicates the registry data.</param>
    ''' <param name="DataType">Indicates the type of data.</param>
    Public Shared Sub SetValue(ByVal Key As String,
                               ByVal Value As String,
                               ByVal Data As Object,
                               Optional ByVal DataType As RegistryValueKind = RegistryValueKind.Unknown)

        Using Reg As RegistryKey = GetRoot(Key)

            Select Case DataType

                Case RegistryValueKind.Unknown
                    Reg.OpenSubKey(GetPath(Key), writable:=True).
                        SetValue(Value, Data)

                Case RegistryValueKind.Binary
                    Reg.OpenSubKey(GetPath(Key), writable:=True).
                        SetValue(Value, Encoding.ASCII.GetBytes(Data), RegistryValueKind.Binary)

                Case Else
                    Reg.OpenSubKey(GetPath(Key), writable:=True).
                        SetValue(Value, Data, DataType)

            End Select

        End Using

    End Sub

#End Region

#Region " Exist "

    ''' <summary>
    ''' Determines whether a Key exists.
    ''' </summary>
    ''' <param name="Key">Indicates the registry key.</param>
    ''' <returns><c>true</c> if key exist, <c>false</c> otherwise.</returns>
    Public Shared Function ExistKey(ByVal Key As String) As Boolean

        Dim RootKey As RegistryKey = GetRoot(Key)
        Dim KeyPath As String = GetPath(Key)

        If (RootKey Is Nothing) OrElse (String.IsNullOrEmpty(KeyPath)) Then
            Return False
        End If

        Using Reg As RegistryKey = RootKey

            Return RootKey.OpenSubKey(KeyPath, writable:=False) IsNot Nothing

        End Using

    End Function

    ''' <summary>
    ''' Determines whether a value exists.
    ''' </summary>
    ''' <param name="Key">Indicates the registry key.</param>
    ''' <param name="Value">Indicates the registry value.</param>
    ''' <returns><c>true</c> if value exist, <c>false</c> otherwise.</returns>
    Public Shared Function ExistValue(ByVal Key As String, ByVal Value As String) As Boolean

        Dim RootKey As RegistryKey = GetRoot(Key)
        Dim KeyPath As String = GetPath(Key)

        If (RootKey Is Nothing) OrElse (String.IsNullOrEmpty(KeyPath)) Then
            Return False
        End If

        Using Reg As RegistryKey = RootKey

            Return RootKey.OpenSubKey(KeyPath, writable:=False).
                           GetValue(Value, defaultValue:=Nothing) IsNot Nothing

        End Using

    End Function

    ''' <summary>
    ''' Determines whether data exists in a registry value.
    ''' </summary>
    ''' <param name="Key">Indicates the registry key.</param>
    ''' <param name="Value">Indicates the registry value.</param>
    ''' <returns><c>true</c> if data exist, <c>false</c> otherwise.</returns>
    Public Shared Function ExistData(ByVal Key As String, ByVal Value As String) As Boolean

        Dim RootKey As RegistryKey = GetRoot(Key)
        Dim KeyPath As String = GetPath(Key)

        If (RootKey Is Nothing) OrElse (String.IsNullOrEmpty(KeyPath)) Then
            Return False
        End If

        Using Reg As RegistryKey = RootKey

            Return Not String.IsNullOrEmpty(RootKey.OpenSubKey(KeyPath, writable:=False).
                                                    GetValue(Value, defaultValue:=Nothing))

        End Using

    End Function

#End Region

#Region " Copy "

    ''' <summary>
    ''' Copy a key tree to another location on the registry.
    ''' </summary>
    ''' <param name="OldKey">Indicates the registry key to be copied from.</param>
    ''' <param name="NewKey">Indicates the registry key to be pasted from.</param>
    Public Shared Sub CopyKey(ByVal OldKey As String,
                              ByVal NewKey As String)

        Using OldReg As RegistryKey = GetRoot(OldKey).OpenSubKey(GetPath(OldKey), writable:=False)

            CreateKey(NewKey)

            Using NewReg As RegistryKey = GetRoot(NewKey).OpenSubKey(GetPath(NewKey), writable:=True)

                CopySubKeys(OldReg, NewReg)

            End Using ' NewReg

        End Using ' OldReg

    End Sub

    ''' <summary>
    ''' Copies a value with their data to another location on the registry.
    ''' If the Key don't exist it will be created automatically.
    ''' </summary>
    ''' <param name="OldKey">Indicates the registry key to be copied from.</param>
    ''' <param name="OldValue">Indicates the registry value to be copied from.</param>
    ''' <param name="NewKey">Indicates the registry key to be pasted from.</param>
    ''' <param name="NewValue">Indicates the registry value to be pasted from.</param>
    Public Shared Sub CopyValue(ByVal OldKey As String,
                                ByVal OldValue As String,
                                ByVal NewKey As String,
                                ByVal NewValue As String)

        CreateKey(Key:=NewKey)
        SetValue(Key:=NewKey, Value:=NewValue, Data:=GetValue(OldKey, OldValue), DataType:=RegistryValueKind.Unknown)

    End Sub

#End Region

#Region " Process dependant methods "

    ''' <summary>
    ''' Opens Regedit process and jumps at the specified key.
    ''' </summary>
    ''' <param name="Key">Indicates the registry key.</param>
    Public Shared Sub JumpToKey(ByVal Key As String)

        Using Reg As RegistryKey = GetRoot(Key)

            SetValue(Key:="HKCU\Software\Microsoft\Windows\CurrentVersion\Applets\Regedit",
                     Value:="LastKey",
                     Data:=String.Format("{0}\{1}", Reg.Name, GetPath(Key)),
                     DataType:=RegistryValueKind.String)

        End Using

        Process.Start(Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Regedit.exe"))

    End Sub

    ''' <summary>
    ''' Imports a registry file.
    ''' </summary>
    ''' <param name="RegFile">The registry file to import.</param>
    ''' <returns><c>true</c> if operation succeeds, <c>false</c> otherwise.</returns>
    Public Shared Function ImportRegFile(ByVal RegFile As String) As Boolean

        Using proc As New Process With {
            .StartInfo = New ProcessStartInfo() With {
                  .FileName = Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.System), "Reg.exe"),
                  .Arguments = String.Format("Import ""{0}""", RegFile),
                  .CreateNoWindow = True,
                  .WindowStyle = ProcessWindowStyle.Hidden,
                  .UseShellExecute = False
                }
            }

            proc.Start()
            proc.WaitForExit()

            Return Not CBool(proc.ExitCode)

        End Using

    End Function

    ''' <summary>
    ''' Exports a key to a registry file.
    ''' </summary>
    ''' <param name="Key">Indicates the registry key.</param>
    ''' <param name="OutputFile">Indicates the output file.</param>
    ''' <returns><c>true</c> if operation succeeds, <c>false</c> otherwise.</returns>
    Public Shared Function ExportKey(ByVal Key As String, ByVal OutputFile As String) As Boolean

        Using Reg As RegistryKey = GetRoot(Key)

            Using proc As New Process With {
                    .StartInfo = New ProcessStartInfo() With {
                          .FileName = Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.System), "Reg.exe"),
                          .Arguments = String.Format("Export ""{0}\{1}"" ""{2}"" /y", Reg.Name, GetPath(Key), OutputFile),
                          .CreateNoWindow = True,
                          .WindowStyle = ProcessWindowStyle.Hidden,
                          .UseShellExecute = False
                        }
                    }

                proc.Start()
                proc.WaitForExit()

                Return Not CBool(proc.ExitCode)

            End Using

        End Using

    End Function

    ''' <summary>
    ''' Modifies the user permissions of a registry key.
    ''' </summary>
    ''' <param name="Key">Indicates the registry key.</param>
    ''' <param name="UserAccess">Indicates the user-access.</param>
    ''' <returns><c>true</c> if operation succeeds, <c>false</c> otherwise.</returns>
    Public Shared Function SetUserAccessKey(ByVal Key As String, ByVal UserAccess() As ReginiUserAccess) As Boolean

        Dim tmpFile As String = Path.Combine(Path.GetTempPath(), "Regini.ini")

        Dim PermissionString As String =
            String.Format("[{0}]",
                          String.Join(" "c, UserAccess.Cast(Of Integer)))

        Using TextFile As New StreamWriter(path:=tmpFile, append:=False, encoding:=Encoding.Default)

            Using Reg As RegistryKey = GetRoot(Key)

                TextFile.WriteLine(String.Format("""{0}\{1}"" {2}", Reg.Name, GetPath(Key), PermissionString))

            End Using ' Reg

        End Using ' TextFile

        Using proc As New Process With {
            .StartInfo = New ProcessStartInfo() With {
                   .FileName = Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.System), "Regini.exe"),
                   .Arguments = ControlChars.Quote & tmpFile & ControlChars.Quote,
                   .CreateNoWindow = True,
                   .WindowStyle = ProcessWindowStyle.Hidden,
                   .UseShellExecute = False
                }
            }

            proc.Start()
            proc.WaitForExit()

            Return Not CBool(proc.ExitCode)

        End Using

    End Function

#End Region

#End Region

#Region " Private Methods "

#Region " Get "

    ''' <summary>
    ''' Gets the registry root of a key.
    ''' </summary>
    ''' <param name="Key">Indicates the registry key.</param>
    ''' <returns>The registry root.</returns>
    Private Shared Function GetRoot(ByVal Key As String) As RegistryKey

        Select Case Key.ToUpper.Split("\").First

            Case "HKCR", "HKEY_CLASSES_ROOT"
                Return Registry.ClassesRoot

            Case "HKCC", "HKEY_CURRENT_CONFIG"
                Return Registry.CurrentConfig

            Case "HKCU", "HKEY_CURRENT_USER"
                Return Registry.CurrentUser

            Case "HKLM", "HKEY_LOCAL_MACHINE"
                Return Registry.LocalMachine

            Case "HKEY_PERFORMANCE_DATA"
                Return Registry.PerformanceData

            Case Else
                Return Nothing

        End Select

    End Function

    ''' <summary>
    ''' Returns the registry path of a key.
    ''' </summary>
    ''' <param name="Key">Indicates the registry key.</param>
    ''' <returns>The registry path.</returns>
    Private Shared Function GetPath(ByVal Key As String) As String

        If String.IsNullOrEmpty(Key) Then
            Return String.Empty
        End If

        Dim KeyPath As String = Key.Substring(Key.IndexOf("\"c) + 1I)

        If KeyPath.EndsWith("\"c) Then
            KeyPath = KeyPath.Substring(0I, KeyPath.LastIndexOf("\"c))
        End If

        Return KeyPath

    End Function

#End Region

#Region " Copy "

    ''' <summary>
    ''' Copies the sub-keys of the specified registry key.
    ''' </summary>
    ''' <param name="OldKey">Indicates the old key.</param>
    ''' <param name="NewKey">Indicates the new key.</param>
    Private Shared Sub CopySubKeys(ByVal OldKey As RegistryKey, ByVal NewKey As RegistryKey)

        ' Copy Values
        For Each Value As String In OldKey.GetValueNames()

            NewKey.SetValue(Value, OldKey.GetValue(Value))

        Next Value

        ' Copy Subkeys
        For Each SubKey As String In OldKey.GetSubKeyNames()

            CreateKey(String.Format("{0}\{1}", NewKey.Name, SubKey))
            CopySubKeys(OldKey.OpenSubKey(SubKey, writable:=False), NewKey.OpenSubKey(SubKey, writable:=True))

        Next SubKey

    End Sub

#End Region

#End Region

End Class

#End Region

[Eleкtro]

BetfairUtil

Con esta class pueden analizar los próximos eventos de un mercado de futbol de la página Betfair, para meterlos por ejemplo como DataSource de un GridView:



Nota: es necesaria la librería HtmlAgilityPack.

Código (vbnet) [Seleccionar] Expandir

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

#Region " Imports "

Imports HtmlAgilityPack
Imports System.Web

#End Region

''' <summary>
''' Contains web related methods for Betfair.
''' </summary>
Public Class BetfairUtil

#Region " XPath Expressions "

   ''' <summary>
   ''' XPath to locate the coming-up events grid.
   ''' </summary>
   Private Shared ReadOnly XPathComingUpGrid As String = "//*/ul[1][@class='event-list']/li[@class='avb-row COMING_UP']/*"

   ''' <summary>
   ''' XPath to locate the home team name.
   ''' </summary>
   Private Shared ReadOnly XPathHomeTeam As String = ".//span[@class='home-team-name']"

   ''' <summary>
   ''' XPath to locate the away team name.
   ''' </summary>
   Private Shared ReadOnly XPathAwayTeam As String = ".//span[@class='away-team-name']"

   ''' <summary>
   ''' XPath to locate the day which the teams will play.
   ''' </summary>
   Private Shared ReadOnly XPathPlayDay As String = ".//span[@class='date']"

   ''' <summary>
   ''' XPath to locate the hour at which the teams will play.
   ''' </summary>
   Private Shared ReadOnly XPathPlayHour As String = XPathPlayDay

   ''' <summary>
   ''' XPath to locate the odds value 1.
   ''' </summary>
   Private Shared ReadOnly XPathOddResult1 As String = ".//*/li[@class='selection sel-0']/*/span['ui-runner-price*']"

   ''' <summary>
   ''' XPath to locate the odds value 2.
   ''' </summary>
   Private Shared ReadOnly XPathOddResult2 As String = ".//*/li[@class='selection sel-1']/*/span['ui-runner-price*']"

   ''' <summary>
   ''' XPath to locate the odds value 3.
   ''' </summary>
   Private Shared ReadOnly XPathOddResult3 As String = ".//*/li[@class='selection sel-2']/*/span['ui-runner-price*']"

#End Region

#Region " Types "

   ''' <summary>
   ''' Specifies an event info.
   ''' </summary>
   Public Class BetfairEventInfo

       ''' <summary>
       ''' Gets or sets the home team name.
       ''' </summary>
       ''' <value>The home team name.</value>
       Public Property HomeTeam As String

       ''' <summary>
       ''' Gets or sets the away team name.
       ''' </summary>
       ''' <value>The away team name.</value>
       Public Property AwayTeam As String

       ''' <summary>
       ''' Gets or sets the day which the teams will play.
       ''' </summary>
       ''' <value>The day which the teams will play.</value>
       Public Property PlayDay As String

       ''' <summary>
       ''' Gets or sets the hour at which the teams will play.
       ''' </summary>
       ''' <value>The hour at which the teams will play.</value>
       Public Property PlayHour As String

       ''' <summary>
       ''' Gets or sets the odds value for result '1'.
       ''' (which depending on the Betfair section could be the value for column-names: "1", "Yes" or "More than...")
       ''' </summary>
       ''' <value>The odds value for result '1'.</value>
       Public Property Result1 As Double

       ''' <summary>
       ''' Gets or sets the odds value for result '2'.
       ''' (which depending on the Betfair section could be the value for column-names: "X", "No" or "Less than...")
       ''' </summary>
       ''' <value>The odds value for result '2'.</value>
       Public Property Result2 As Double

       ''' <summary>
       ''' (which depending on the Betfair section could be the value for column-names: "2")
       ''' </summary>
       ''' <value>The odds value for result 'X'.</value>
       Public Property ResultX As Double

   End Class

#End Region

#Region " Public Methods "

   ''' <summary>
   ''' Gets the coming-up events from a Betfair page.
   ''' </summary>
   ''' <param name="HtmlSource">The Betfair webpage raw Html source-code to parse the events.</param>
   ''' <returns>List(Of EventInfo).</returns>
   ''' <exception cref="System.Exception">Node not found in the html source-code, maybe there is any coming-up event?</exception>
   Public Shared Function GetComingUpEvents(ByVal HtmlSource As String) As List(Of BetfairEventInfo)

       ' The event collection to add events.
       Dim EventInfoList As New List(Of BetfairEventInfo)

       ' The current event info.
       Dim EventInfo As BetfairEventInfo

       ' Initialize the HtmlDoc object.
       Dim Doc As New HtmlDocument

       ' Load the Html document.
       Doc.LoadHtml(HtmlSource)

       ' A temporal node to determine whether the node exist.
       Dim tempNode As HtmlNode

       ' The HtmlDocument nodes to analyze.
       Dim Nodes As HtmlNodeCollection

       ' Select the Teams nodes.
       Nodes = Doc.DocumentNode.SelectNodes(XPathComingUpGrid)

       If Nodes Is Nothing Then ' Node not found in the html source-code.
           Throw New Exception("Node not found in the html source-code, maybe there is any coming-up event?")
           Return Nothing
       End If

       ' Loop trough the nodes.
       For Each Node As HtmlNode In Nodes

           EventInfo = New BetfairEventInfo

           ' Retrieve and set the home team name.
           EventInfo.HomeTeam = HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathHomeTeam).InnerText.
                                                       Replace("(W)", String.Empty).
                                                       Replace("(HT)", String.Empty).
                                                       Replace("(QAT)", String.Empty).
                                                       Replace("(Uru)", String.Empty).
                                                       Replace("(Ecu)", String.Empty).
                                                       Replace("(Bol)", String.Empty).
                                                       Trim)

           ' Retrieve and set the away team name.
           EventInfo.AwayTeam = HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathAwayTeam).InnerText.
                                                       Replace("(W)", String.Empty).
                                                       Replace("(HT)", String.Empty).
                                                       Replace("(QAT)", String.Empty).
                                                       Replace("(Uru)", String.Empty).
                                                       Replace("(Ecu)", String.Empty).
                                                       Replace("(Bol)", String.Empty).
                                                       Trim)

           ' Retrieve and set the day which the teams will play.
           tempNode = Node.SelectSingleNode(XPathPlayDay)
           If tempNode IsNot Nothing Then

               EventInfo.PlayDay = HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathPlayDay).
                                                          InnerText.
                                                          Trim)

               ' This value can contains different words or one word;
               ' Such as: "Mañana 14:00" or "14:00" or "03 Sep 14".
               ' If the value is only the hour, the day is today.
               If EventInfo.PlayDay Like "##:##" Then
                   EventInfo.PlayDay = "Hoy"

               ElseIf EventInfo.PlayDay Like "Mañana*" Then
                   EventInfo.PlayDay = EventInfo.PlayDay.Split(" "c).First

               End If

               If Not EventInfo.PlayDay Like "## *" Then

                   ' Retrieve and set the hour at which the teams will play.
                   EventInfo.PlayHour = HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathPlayHour).
                                                               InnerText.
                                                               Trim.
                                                               Split(" "c).Last)
               Else
                   EventInfo.PlayHour = "N/A" ' Unknown, the hour is not displayed.
               End If

           Else
               EventInfo.PlayDay = "Error"
               EventInfo.PlayHour = "Error"

           End If

           ' Retrieve and set the odds for result '1'.
           tempNode = Node.SelectSingleNode(XPathOddResult1) ' Test whether the node exists.
           If tempNode IsNot Nothing Then
               If String.IsNullOrEmpty(HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathOddResult1).InnerText).Trim) _
               OrElse String.IsNullOrWhiteSpace(HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathOddResult1).InnerText).Trim) _
               OrElse HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathOddResult1).InnerText).Trim.Equals("NC", StringComparison.OrdinalIgnoreCase) Then
                   EventInfo.Result1 = 0

               Else
                   EventInfo.Result1 = Node.SelectSingleNode(XPathOddResult1).InnerText.Trim().Replace(".", ",")
               End If

           Else
               EventInfo.Result1 = 0
           End If

           ' Retrieve and set the odds for result '2'.
           tempNode = Node.SelectSingleNode(XPathOddResult2) ' Test whether the node exists.
           If tempNode IsNot Nothing Then
               If String.IsNullOrEmpty(HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathOddResult2).InnerText).Trim) _
               OrElse String.IsNullOrWhiteSpace(HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathOddResult2).InnerText).Trim) _
               OrElse HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathOddResult2).InnerText).Trim.Equals("NC", StringComparison.OrdinalIgnoreCase) Then
                   EventInfo.Result2 = 0

               Else
                   EventInfo.Result2 = Node.SelectSingleNode(XPathOddResult2).InnerText.Trim().Replace(".", ",")

               End If

           Else
               EventInfo.Result2 = 0
           End If

           ' Retrieve and set the odds for result 'X'.
           tempNode = Node.SelectSingleNode(XPathOddResult3) ' Test whether the node exists.
           If tempNode IsNot Nothing Then
               If String.IsNullOrEmpty(HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathOddResult3).InnerText).Trim) _
               OrElse String.IsNullOrWhiteSpace(HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathOddResult3).InnerText).Trim) _
               OrElse HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathOddResult3).InnerText).Trim.Equals("NC", StringComparison.OrdinalIgnoreCase) Then
                   EventInfo.ResultX = 0

               Else
                   EventInfo.ResultX = Node.SelectSingleNode(XPathOddResult3).InnerText.Trim().Replace(".", ",")

               End If
           Else
               EventInfo.ResultX = 0
           End If

           ' Add the event-into into the event collection.
           EventInfoList.Add(EventInfo)

       Next Node

       Return EventInfoList

   End Function

#End Region

End Class


Ejemplo de uso:

Código (vbnet) [Seleccionar] Expandir

   ''' <summary>
   ''' Contains the Betfair coming-up events-info.
   ''' </summary>
   Private ComingUpEvents As List(Of BetfairEventInfo)

   ' Parse the Betfair page source-code to get the events.
   Me.ComingUpEvents = BetfairUtil.GetComingUpEvents(Me.HtmlSource)

[Eleкtro]

Comparto algunos Snippets relacionados con los controles de Telerik: http://www.telerik.com/products/winforms.aspx

[Telerik] [RadDropDownList] Select next item on MouseWheel.

Ejemplo de como seleccionar el item anterior o siguiente usando la rueda del mouse.

Código (vbnet) [Seleccionar] Expandir

Public Class RadDropDownList_TestForm

    ''' <summary>
    ''' Handles the MouseDown event of the RadDropDownList1 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 RadDropDownList1_MouseWheel(Byval sender As Object, Byval e As MouseEventArgs) _
    Handles RadDropDownList1.MouseWheel

        Select Case e.Delta

            Case Is > 0 ' MouseWhell scroll up.
                If sender.SelectedIndex > 0I Then
                    sender.SelectedIndex -= 1I
                End If

            Case Else ' MouseWhell scroll down.
                If sender.SelectedIndex < sender.Items.Count Then
                    sender.SelectedIndex += 1I
                End If

        End Select

    End Sub

End Class




[Telerik] [RadDropDownList] Align text after selecting an item.

Ejemplo de como alinear el texto después de seleccionar un item.

Código (vbnet) [Seleccionar] Expandir

    ''' <summary>
    ''' Handles the SelectedIndexChanged event of the RadDropDownList1 control.
    ''' </summary>
    ''' <param name="sender">The source of the event.</param>
    ''' <param name="e">The <see cref="Data.PositionChangedEventArgs"/> instance containing the event data.</param>
    Private Sub RadDropDownList1_SelectedIndexChanged(ByVal sender As Object, ByVal e As Data.PositionChangedEventArgs) _
    Handles RadDropDownList1.SelectedIndexChanged

        ' Center the selected item text.
        sender.DropDownListElement.EditableElement.TextAlignment = ContentAlignment.MiddleCenter

    End Sub




[Telerik] [RadMessageBox] Example.

Ejemplo de como usar un RadMessageBox

Código (vbnet) [Seleccionar] Expandir

Imports Telerik.WinControls

Public Class RadMessageBox_TestForm

    Private Sub RadMessageBox_TestForm_Load() Handles MyBase.Load

        RadMessageBox.SetThemeName("VisualStudio2012Dark")
        ' RadMessageBox.SetThemeName(Me.ThemeName) ' Use this for RadForm or other Rad control.

        RadMessageBox.Instance.Cursor = Cursors.Arrow
        RadMessageBox.Instance.EnableBeep = True
        RadMessageBox.Instance.ShowInTaskbar = False
        RadMessageBox.Instance.ShowIcon = True
        RadMessageBox.Instance.Icon = SystemIcons.Application
        RadMessageBox.Instance.FormBorderStyle = Windows.Forms.FormBorderStyle.FixedDialog

        RadMessageBox.Show("Hello World !", Me.Name, MessageBoxButtons.OK, RadMessageIcon.Info)

    End Sub

End Class




[Telerik] [RadGridView] Example.

Ejemplo de como usar un RadGridView.

Código (vbnet) [Seleccionar] Expandir

Imports Telerik.WinControls.UI

Public Class RadGridView_TestForm

    ''' <summary>
    ''' The row collection of the RadGridView.
    ''' </summary>
    Private Rows As New List(Of GridViewDataRowInfo)

    Private Sub RadGridView_TestForm_Load() Handles MyBase.Load

        ' Set the RadGridView language localization.
        ' RadGridLocalizationProvider.CurrentProvider = New MyRadGridViewLocalizationProvider_Spanish

        ' Create some columns.
        With RadGridView1
            .Columns.Add("MyColumnString", "Strings")
            .Columns.Add("MyColumnHour", "Hours")
            .Columns.Add("MyColumnInteger", "Integers")
            .Columns.Add("MyColumnDouble", "Doubles")
        End With

        ' Set the RadGridView properties.
        With RadGridView1

            .ThemeName = "VisualStudio2012Dark" ' The visual theme.
            .EnableAlternatingRowColor = True ' Enable color alternating between rows.
            .TableElement.AlternatingRowColor = Color.FromArgb(52, 52, 56) ' The alternate color, a dark-gray.
            .AutoGenerateColumns = False ' Deny the control to auto-generate columns when setting a DataSource.
            .ReadOnly = True ' Disable Adding, Removing, and Editing on the control.

            ' Set the column datatypes.
            .Columns("MyColumnString").DataType = GetType(String)
            .Columns("MyColumnHour").DataType = GetType(String)
            .Columns("MyColumnInteger").DataType = GetType(Integer)
            .Columns("MyColumnDouble").DataType = GetType(Double)

        End With

        ' Create a row.
        Dim Row As New GridViewDataRowInfo(Me.RadGridView1.MasterView)
        With Row
            .Cells(0).Value = "Hello!"
            .Cells(1).Value = "22:00"
            .Cells(2).Value = 10
            .Cells(3).Value = 5.5
        End With
        Me.Rows.Add(Row)

        ' add the row in the grid.
        Me.RadGridView1.Rows.AddRange(Rows.ToArray)

    End Sub

End Class




[Telerik] [RadGridView] Export as CSV.

Ejemplo de como exportar un RadGridView a CSV.

Código (vbnet) [Seleccionar] Expandir

        Dim Exporter As New ExportToCSV(Me.RadGridView1)
        With Exporter
            .HiddenColumnOption = HiddenOption.DoNotExport ' Don't export hidden columns.
            .HiddenRowOption = HiddenOption.DoNotExport ' Don't export hidden rows.
            .SummariesExportOption = SummariesOption.DoNotExport
            .ColumnDelimiter = " | "
            .RowDelimiter = "; "
            .
        End With

        Exporter.RunExport("C:\Exported Data.xls")



[Telerik] [RadGridView] Export as HTML.

Ejemplo de como exportar un RadGridView a HTML.

Código (vbnet) [Seleccionar] Expandir

        ' Export the data contained in the RadGridView DataSource.
        Dim Exporter As New ExportToHTML(Me.RadGridView1)
        With Exporter
            .HiddenColumnOption = HiddenOption.DoNotExport ' Don't export hidden columns.
            .HiddenRowOption = HiddenOption.DoNotExport ' Don't export hidden rows.
            .SummariesExportOption = SummariesOption.DoNotExport
            .AutoSizeColumns = False
            .ExportVisualSettings = True
            .FileExtension = "htm"
            .TableBorderThickness = 2
            .TableCaption = "My Exported Table"
        End With

        Exporter.RunExport("C:\Exported Data.htm")



[Telerik] [RadGridView] Export as XLS.

Ejemplo de como exportar el DataSource de un RadGridView a Excel (xls).

Código (vbnet) [Seleccionar] Expandir

Imports Telerik.WinControls.UI
Imports Telerik.WinControls.UI.Export
Imports Telerik.WinControls.UI.Localization

Public Class RadGridView_TestForm

    Private Sub RadGridView_TestForm_Load() Handles MyBase.Load

        ' Set the RadGridView language localization.
        ' RadGridLocalizationProvider.CurrentProvider = New MyRadGridViewLocalizationProvider_Spanish

        ' Set the RadGridView properties.
        With RadGridView1

            .ThemeName = "VisualStudio2012Dark" ' The visual theme.
            .EnableAlternatingRowColor = True ' Enable color alternating between rows.
            .TableElement.AlternatingRowColor = Color.FromArgb(52, 52, 56) ' The alternate color, a dark-gray.
            .AutoGenerateColumns = False ' Deny the control to auto-generate columns when setting a DataSource.
            .ReadOnly = True ' Disable Adding, Removing, and Editing on the control.

            ' Set the column datatypes.
            .Columns("MyColumnString").DataType = GetType(String)
            .Columns("MyColumnHour").DataType = GetType(String)
            .Columns("MyColumnInteger").DataType = GetType(Integer)
            .Columns("MyColumnDouble").DataType = GetType(Double)

            ' Set the excel export datatypes.
            .Columns("MyColumnString").ExcelExportType = DisplayFormatType.Text
            .Columns("MyColumnHour").ExcelExportType = DisplayFormatType.Custom
            .Columns("MyColumnHour").ExcelExportFormatString = "h:mm"
            .Columns("MyColumnInteger").ExcelExportType = DisplayFormatType.Custom
            .Columns("MyColumnInteger").ExcelExportFormatString = "0"
            .Columns("MyColumnDouble").ExcelExportType = DisplayFormatType.Custom
            .Columns("MyColumnDouble").ExcelExportFormatString = "0.00"

        End With

        ' Export the data contained in the RadGridView DataSource.
        Dim Exporter As New ExportToExcelML(Me.RadGridView1)
        With Exporter
            .HiddenColumnOption = HiddenOption.DoNotExport ' Don't export hidden columns.
            .HiddenRowOption = HiddenOption.DoNotExport ' Don't export hidden rows.
            .ExportVisualSettings = True ' Export the RadGridView current theme.
            .SheetMaxRows = ExcelMaxRows._65536
            .SheetName = "Betfair Market Analyzer"
            .SummariesExportOption = SummariesOption.DoNotExport
        End With

        Exporter.RunExport("C:\Exported Data.xls")

    End Sub

End Class



[Telerik] [RadSplitButton] Set a Default Item.

Ejemplo de como asignar un item por defecto.

Código (vbnet) [Seleccionar] Expandir

Imports Telerik.WinControls.UI

Public Class RadSplitButton_TestForm

    Dim WithEvents MenuItem1 As New RadMenuItem With {.Text = "Item 1"}
    Dim WithEvents MenuItem2 As New RadMenuItem With {.Text = "Item 2"}
    Dim WithEvents MenuItem3 As New RadMenuItem With {.Text = "Item 3"}

    Private Sub RadSplitButton_TestForm_Load() Handles MyBase.Load

        RadSplitButton1.Items.AddRange({MenuItem1, MenuItem2, MenuItem3})
        RadSplitButton1.DefaultItem = MenuItem2

    End Sub

    Private Sub MenuItem2_Click() Handles MenuItem2.Click

        MsgBox("I'm the default item!")

    End Sub

End Class



[Telerik] [RadSplitButton] Distinguish an Arrow click without a Default Item set.

Ejemplo de como distinguir cuando se hace un click sobre el control o sobre la flecha del control.

Código (vbnet) [Seleccionar] Expandir

Public Class RadSplitButton_TestForm

    ''' <summary>
    ''' Flag that determines whether the RadSplitButton menu-opening should be canceled.
    ''' </summary>
    Private CancelOpening As Boolean = False

    Private Sub RadSplitButton1_DropDownOpening(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) _
    Handles RadSplitButton1.DropDownOpening

        e.Cancel = Me.CancelOpening

    End Sub

    Private Sub RadSplitButton1_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) _
    Handles RadSplitButton1.MouseMove

        Me.CancelOpening = Not sender.DropDownButtonElement.ArrowButton.IsMouseOverElement

    End Sub

    Private Sub RadSplitButton1_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) _
    Handles RadSplitButton1.Click

        If e.Button = Windows.Forms.MouseButtons.Left AndAlso Me.CancelOpening Then
            MsgBox("clicked out the arrow!")

        ElseIf Not Me.CancelOpening Then
            MsgBox("clicked over the arrow!")

        End If

    End Sub

End Class




[Telerik] [RadDropDownButton] Distinguish an Arrow click without a Default Item set.

Ejemplo de como distinguir cuando se hace un click sobre el control o sobre la flecha del control.

Código (vbnet) [Seleccionar] Expandir

Public Class RadDropDownButton_TestForm

    ''' <summary>
    ''' Flag that determines whether the RadSplitButton menu-opening should be canceled.
    ''' </summary>
    Private CancelOpening As Boolean = False

    Private Sub RadDropDownButton1_DropDownOpening(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) _
    Handles RadDropDownButton1.DropDownOpening

        e.Cancel = Me.CancelOpening

    End Sub

    Private Sub RadDropDownButton1_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) _
    Handles RadDropDownButton1.MouseMove

        Me.CancelOpening = Not sender.DropDownButtonElement.ArrowButton.IsMouseOverElement

    End Sub

    Private Sub RadDropDownButton1_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) _
    Handles RadDropDownButton1.Click

        If e.Button = Windows.Forms.MouseButtons.Left AndAlso Me.CancelOpening Then
            MsgBox("clicked out the arrow!")

        ElseIf Not Me.CancelOpening Then
            MsgBox("clicked over the arrow!")

        End If

    End Sub

End Class