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

Foro de elhacker.net

Programación

Programación General

.NET (C#, VB.NET, ASP) (Moderador: kub0x)

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

0 Usuarios y 1 Visitante están viendo este tema.

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

Autor

Tema: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets) (Leído 533,677 veces)

Eleкtro

Ex-Staff

Desconectado

Mensajes: 9.885

Re: Librería de Snippets !! (Compartan aquí sus snippets)

« Respuesta #420 en: 19 Agosto 2014, 10:37 am »

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

    ' 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


« Última modificación: 19 Agosto 2014, 10:42 am por Eleкtro »	En línea

Eleкtro

Ex-Staff

Desconectado

Mensajes: 9.885

Re: Librería de Snippets !! (Compartan aquí sus snippets)

« Respuesta #421 en: 19 Agosto 2014, 12:02 pm »

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

#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

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


« Última modificación: 19 Agosto 2014, 12:30 pm por Eleкtro »	En línea

Eleкtro

Ex-Staff

Desconectado

Mensajes: 9.885

Re: Librería de Snippets !! (Compartan aquí sus snippets)

« Respuesta #422 en: 19 Agosto 2014, 22:06 pm »

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

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


	En línea

Eleкtro

Ex-Staff

Desconectado

Mensajes: 9.885

Re: Librería de Snippets !! (Compartan aquí sus snippets)

« Respuesta #423 en: 20 Agosto 2014, 02:06 am »

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

' 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

' 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!


	En línea

Eleкtro

Ex-Staff

Desconectado

Mensajes: 9.885

Re: Librería de Snippets !! (Compartan aquí sus snippets)

« Respuesta #424 en: 21 Agosto 2014, 13:03 pm »

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

Código

' ***********************************************************************
' 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 &#8203;&#8203;as text.
        ''' </summary>
        SortByText = 0I
 
        ''' <summary>
        ''' Treats the values &#8203;&#8203;as numbers.
        ''' </summary>
        SortByNumber = 1I
 
        ''' <summary>
        ''' Treats valuesthe values &#8203;&#8203;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


	En línea

Eleкtro

Ex-Staff

Desconectado

Mensajes: 9.885

Re: Librería de Snippets !! (Compartan aquí sus snippets)

« Respuesta #425 en: 21 Agosto 2014, 13:58 pm »

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

    ' 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


« Última modificación: 21 Agosto 2014, 14:03 pm por Eleкtro »	En línea

Eleкtro

Ex-Staff

Desconectado

Mensajes: 9.885

Re: Librería de Snippets !! (Compartan aquí sus snippets)

« Respuesta #426 en: 22 Agosto 2014, 20:08 pm »

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

#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

#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&#65288;&#30655;&#26480;&#65289;"
 
    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

#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

#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

#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

#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

#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

#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

#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

#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

#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

        ' 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

        ' 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

        ' 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

        ' 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


« Última modificación: 23 Agosto 2014, 12:50 pm por Eleкtro »	En línea

Eleкtro

Ex-Staff

Desconectado

Mensajes: 9.885

Re: Librería de Snippets !! (Compartan aquí sus snippets)

« Respuesta #427 en: 30 Agosto 2014, 19:45 pm »

Una versión actualizada de mi Reg-Editor

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

Código

' ***********************************************************************
' 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


	En línea

Eleкtro

Ex-Staff

Desconectado

Mensajes: 9.885

Re: Librería de Snippets !! (Compartan aquí sus snippets)

« Respuesta #428 en: 4 Septiembre 2014, 18:31 pm »

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

' ***********************************************************************
' 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

    ''' <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)


	En línea

Eleкtro

Ex-Staff

Desconectado

Mensajes: 9.885

Re: Librería de Snippets !! (Compartan aquí sus snippets)

« Respuesta #429 en: 5 Septiembre 2014, 18:29 pm »

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

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

    ''' <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

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

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

        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

        ' 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

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

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

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

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


« Última modificación: 5 Septiembre 2014, 18:34 pm por Eleкtro »	En línea

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

Ir a:

Mensajes similares
	Asunto	Iniciado por	Respuestas	Vistas	Último mensaje
	Librería de Snippets en C/C++ « 1 2 3 4 » Programación C/C++	z3nth10n	31	26,090	2 Agosto 2013, 17:13 pm por 0xDani
	[APORTE] [VBS] Snippets para manipular reglas de bloqueo del firewall de Windows Scripting	Eleкtro	1	4,116	3 Febrero 2014, 20:19 pm por Eleкtro
	Librería de Snippets para Delphi « 1 2 » Programación General	crack81	15	21,355	25 Marzo 2016, 18:39 pm por crack81
	Una organización en Github para subir, proyectos, snippets y otros? Sugerencias y dudas sobre el Foro	z3nth10n	0	3,106	21 Febrero 2017, 10:47 am por z3nth10n
	índice de la Librería de Snippets para VB.NET !! .NET (C#, VB.NET, ASP)	Eleкtro	7	6,593	4 Julio 2018, 21:35 pm por Eleкtro