Autor
|
Tema: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets) (Leído 529,049 veces)
|
Eleкtro
Ex-Staff
Desconectado
Mensajes: 9.874
|
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. ' 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.874
|
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 RegionEDITO: Ya lo he documentado yo así rapidamente: #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: 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.874
|
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. 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.874
|
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: ' 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: ' 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.874
|
Una class para ordenar los items de un listview según la columna: ' *********************************************************************** ' Author : Elektro ' Last Modified On : 08-20-2014 ' *********************************************************************** ' <copyright file="ListView Column-Sorter.vb" company="Elektro Studios"> ' Copyright (c) Elektro Studios. All rights reserved. ' </copyright> ' *********************************************************************** #Region " Usage Examples " 'Public Class ListViewColumnSorter_TestForm : Inherits form ' ' ''' <summary> ' ''' The listview to sort. ' ''' </summary> ' Private WithEvents LV As New ListView ' ' ''' <summary> ' ''' The 'ListViewColumnSorter' instance. ' ''' </summary> ' Private Sorter As New ListViewColumnSorter ' ' ''' <summary> ' ''' Initializes a new instance of the <see cref="ListViewColumnSorter_TestForm"/> class. ' ''' </summary> ' Public Sub New() ' ' ' This call is required by the designer. ' InitializeComponent() ' ' With LV ' Set the Listview properties. ' ' ' Set the sorter, our 'ListViewColumnSorter'. ' .ListViewItemSorter = Sorter ' ' ' The sorting default direction. ' .Sorting = SortOrder.Ascending ' ' ' Set the default sort-modifier. ' Sorter.SortModifier = ListViewColumnSorter.SortModifiers.SortByText ' ' ' Add some columns. ' .Columns.Add("Text").Tag = ListViewColumnSorter.SortModifiers.SortByText ' .Columns.Add("Numbers").Tag = ListViewColumnSorter.SortModifiers.SortByNumber ' .Columns.Add("Dates").Tag = ListViewColumnSorter.SortModifiers.SortByDate ' ' ' Adjust the column sizes. ' For Each col As ColumnHeader In LV.Columns ' col.Width = 100I ' Next ' ' ' Add some items. ' .Items.Add("hello").SubItems.AddRange({"1", "11/11/2000"}) ' .Items.Add("yeehaa!").SubItems.AddRange({"2", "11-11-2000"}) ' .Items.Add("El3ktr0").SubItems.AddRange({"10", "9/9/1999"}) ' .Items.Add("wow").SubItems.AddRange({"100", "21/08/2014"}) ' ' ' Visual-Style things. ' .Dock = DockStyle.Fill ' .View = View.Details ' .FullRowSelect = True ' ' End With ' ' With Me ' Set the Form properties. ' ' .Size = New Size(400, 200) ' .FormBorderStyle = Windows.Forms.FormBorderStyle.FixedSingle ' .MaximizeBox = False ' .StartPosition = FormStartPosition.CenterScreen ' .Text = "ListViewColumnSorter TestForm" ' ' End With ' ' ' Add the Listview to UI. ' Me.Controls.Add(LV) ' ' End Sub ' ' ''' <summary> ' ''' Handles the 'ColumnClick' event of the 'ListView1' control. ' ''' </summary> ' Private Sub ListView1_ColumnClick(ByVal sender As Object, ByVal e As ColumnClickEventArgs) _ ' Handles LV.ColumnClick ' ' ' Dinamycaly sets the sort-modifier to sort the column by text, number, or date. ' Sorter.SortModifier = sender.columns(e.Column).tag ' ' ' Determine whether clicked column is already the column that is being sorted. ' If e.Column = Sorter.Column Then ' ' ' Reverse the current sort direction for this column. ' If Sorter.Order = SortOrder.Ascending Then ' Sorter.Order = SortOrder.Descending ' ' Else ' Sorter.Order = SortOrder.Ascending ' ' End If ' Sorter.Order ' ' Else ' ' ' Set the column number that is to be sorted, default to ascending. ' Sorter.Column = e.Column ' Sorter.Order = SortOrder.Ascending ' ' End If ' e.Column ' ' ' Perform the sort with these new sort options. ' sender.Sort() ' ' End Sub ' 'End Class #End Region #Region " Imports " Imports System.Text.RegularExpressions Imports System.ComponentModel #End Region #Region " ListView Column-Sorter " ''' <summary> ''' Performs a sorting comparison. ''' </summary> Public Class ListViewColumnSorter : Implements IComparer #Region " Objects " '''' <summary> '''' Indicates the comparer instance. '''' </summary> Private Comparer As Object = New TextComparer #End Region #Region " Properties " ''' <summary> ''' Gets or sets the number of the column to which to apply the sorting operation (Defaults to '0'). ''' </summary> Public Property Column As Integer Get Return Me._Column End Get Set(ByVal value As Integer) Me._Column = value End Set End Property Private _Column As Integer = 0I ''' <summary> ''' Gets or sets the order of sorting to apply. ''' </summary> Public Property Order As SortOrder Get Return Me._Order End Get Set(ByVal value As SortOrder) Me._Order = value End Set End Property Private _Order As SortOrder = SortOrder.None ''' <summary> ''' Gets or sets the sort modifier. ''' </summary> ''' <value>The sort modifier.</value> Public Property SortModifier As SortModifiers Get Return Me._SortModifier End Get Set(ByVal value As SortModifiers) Me._SortModifier = value End Set End Property Private _SortModifier As SortModifiers = SortModifiers.SortByText #End Region #Region " Enumerations " ''' <summary> ''' Specifies a comparison result. ''' </summary> Public Enum ComparerResult As Integer ''' <summary> ''' 'X' is equals to 'Y'. ''' </summary> Equals = 0I ''' <summary> ''' 'X' is less than 'Y'. ''' </summary> Less = -1I ''' <summary> ''' 'X' is greater than 'Y'. ''' </summary> Greater = 1I End Enum ''' <summary> ''' Indicates a Sorting Modifier. ''' </summary> Public Enum SortModifiers As Integer ''' <summary> ''' Treats the values ​​as text. ''' </summary> SortByText = 0I ''' <summary> ''' Treats the values ​​as numbers. ''' </summary> SortByNumber = 1I ''' <summary> ''' Treats valuesthe values ​​as dates. ''' </summary> SortByDate = 2I End Enum #End Region #Region " Private Methods " ''' <summary> ''' Compares two objects and returns a value indicating whether one is less than, equal to, or greater than the other. ''' </summary> ''' <param name="x">The first object to compare.</param> ''' <param name="y">The second object to compare.</param> ''' <returns> ''' A signed integer that indicates the relative values of <paramref name="x"/> and <paramref name="y"/>, ''' 0: <paramref name="x"/> equals <paramref name="y"/>. ''' Less than 0: <paramref name="x"/> is less than <paramref name="y"/>. ''' Greater than 0: <paramref name="x"/> is greater than <paramref name="y"/>. ''' </returns> Private Function Compare(ByVal x As Object, ByVal y As Object) As Integer Implements IComparer.Compare Dim CompareResult As ComparerResult = ComparerResult.Equals Dim LVItemX, LVItemY As ListViewItem ' Cast the objects to be compared LVItemX = DirectCast(x, ListViewItem) LVItemY = DirectCast(y, ListViewItem) Dim strX As String = If(Not LVItemX.SubItems.Count <= Me._Column, LVItemX.SubItems(Me._Column).Text, Nothing) Dim strY As String = If(Not LVItemY.SubItems.Count <= Me._Column, LVItemY.SubItems(Me._Column).Text, Nothing) Dim listViewMain As ListView = LVItemX.ListView ' Calculate correct return value based on object comparison If listViewMain.Sorting <> SortOrder.Ascending AndAlso listViewMain.Sorting <> SortOrder.Descending Then ' Return '0' to indicate they are equal Return ComparerResult.Equals End If If Me._SortModifier.Equals(SortModifiers.SortByText) Then ' Compare the two items If LVItemX.SubItems.Count <= Me._Column AndAlso LVItemY.SubItems.Count <= Me._Column Then CompareResult = Me.Comparer.Compare(Nothing, Nothing) ElseIf LVItemX.SubItems.Count <= Me._Column AndAlso LVItemY.SubItems.Count > Me._Column Then CompareResult = Me.Comparer.Compare(Nothing, strY) ElseIf LVItemX.SubItems.Count > Me._Column AndAlso LVItemY.SubItems.Count <= Me._Column Then CompareResult = Me.Comparer.Compare(strX, Nothing) Else CompareResult = Me.Comparer.Compare(strX, strY) End If Else ' Me._SortModifier IsNot 'SortByText' Select Case Me._SortModifier Case SortModifiers.SortByNumber If Me.Comparer.GetType <> GetType(NumericComparer) Then Me.Comparer = New NumericComparer End If Case SortModifiers.SortByDate If Me.Comparer.GetType <> GetType(DateComparer) Then Me.Comparer = New DateComparer End If Case Else If Me.Comparer.GetType <> GetType(TextComparer) Then Me.Comparer = New TextComparer End If End Select CompareResult = Comparer.Compare(strX, strY) End If ' Me._SortModifier.Equals(...) ' Calculate correct return value based on object comparison If Me._Order = SortOrder.Ascending Then ' Ascending sort is selected, return normal result of compare operation Return CompareResult ElseIf Me._Order = SortOrder.Descending Then ' Descending sort is selected, return negative result of compare operation Return (-CompareResult) Else ' Return '0' to indicate they are equal Return 0I End If ' Me._Order = ... End Function #End Region #Region " Hidden Methods " ''' <summary> ''' Serves as a hash function for a particular type. ''' </summary> <EditorBrowsable(EditorBrowsableState.Never)> Public Shadows Sub GetHashCode() End Sub ''' <summary> ''' Determines whether the specified System.Object instances are considered equal. ''' </summary> <EditorBrowsable(EditorBrowsableState.Never)> Public Shadows Sub Equals() End Sub ''' <summary> ''' Gets the System.Type of the current instance. ''' </summary> ''' <returns>The exact runtime type of the current instance.</returns> <EditorBrowsable(EditorBrowsableState.Never)> Public Shadows Function [GetType]() Return Me.GetType End Function ''' <summary> ''' Returns a String that represents the current object. ''' </summary> <EditorBrowsable(EditorBrowsableState.Never)> Public Shadows Sub ToString() End Sub #End Region End Class #End Region #Region " Comparers " #Region " Text " ''' <summary> ''' Performs a text comparison. ''' </summary> Public Class TextComparer : Inherits CaseInsensitiveComparer #Region " Enumerations " ''' <summary> ''' Specifies a comparison result. ''' </summary> Public Enum ComparerResult As Integer ''' <summary> ''' 'X' is equals to 'Y'. ''' </summary> Equals = 0I ''' <summary> ''' 'X' is less than 'Y'. ''' </summary> Less = -1I ''' <summary> ''' 'X' is greater than 'Y'. ''' </summary> Greater = 1I End Enum #End Region #Region " Methods " ''' <summary> ''' Compares two objects and returns a value indicating whether one is less than, equal to, or greater than the other. ''' </summary> ''' <param name="x">The first object to compare.</param> ''' <param name="y">The second object to compare.</param> ''' <returns> ''' A signed integer that indicates the relative values of <paramref name="x"/> and <paramref name="y"/>, ''' 0: <paramref name="x"/> equals <paramref name="y"/>. ''' Less than 0: <paramref name="x"/> is less than <paramref name="y"/>. ''' Greater than 0: <paramref name="x"/> is greater than <paramref name="y"/>. ''' </returns> Friend Shadows Function Compare(ByVal x As Object, ByVal y As Object) As Integer ' Null parsing. If x Is Nothing AndAlso y Is Nothing Then Return ComparerResult.Equals ' X is equals to Y. ElseIf x Is Nothing AndAlso y IsNot Nothing Then Return ComparerResult.Less ' X is less than Y. ElseIf x IsNot Nothing AndAlso y Is Nothing Then Return ComparerResult.Greater ' X is greater than Y. End If ' String parsing: If (TypeOf x Is String) AndAlso (TypeOf y Is String) Then ' True and True Return [Enum].Parse(GetType(ComparerResult), MyBase.Compare(x, y)) ElseIf (TypeOf x Is String) AndAlso Not (TypeOf y Is String) Then ' True and False Return ComparerResult.Greater ' X is greater than Y. ElseIf Not (TypeOf x Is String) AndAlso (TypeOf y Is String) Then ' False and True Return ComparerResult.Less ' X is less than Y. Else ' False and False Return ComparerResult.Equals End If End Function #End Region End Class #End Region #Region " Numeric " ''' <summary> ''' Performs a numeric comparison. ''' </summary> Public Class NumericComparer : Implements IComparer #Region " Enumerations " ''' <summary> ''' Specifies a comparison result. ''' </summary> Public Enum ComparerResult As Integer ''' <summary> ''' 'X' is equals to 'Y'. ''' </summary> Equals = 0I ''' <summary> ''' 'X' is less than 'Y'. ''' </summary> Less = -1I ''' <summary> ''' 'X' is greater than 'Y'. ''' </summary> Greater = 1I End Enum #End Region #Region " Methods " ''' <summary> ''' Compares two objects and returns a value indicating whether one is less than, equal to, or greater than the other. ''' </summary> ''' <param name="x">The first object to compare.</param> ''' <param name="y">The second object to compare.</param> ''' <returns> ''' A signed integer that indicates the relative values of <paramref name="x"/> and <paramref name="y"/>, ''' 0: <paramref name="x"/> equals <paramref name="y"/>. ''' Less than 0: <paramref name="x" /> is less than <paramref name="y"/>. ''' Greater than 0: <paramref name="x"/> is greater than <paramref name="y"/>. ''' </returns> Public Function Compare(ByVal x As Object, ByVal y As Object) As Integer _ Implements IComparer.Compare ' Null parsing. If x Is Nothing AndAlso y Is Nothing Then Return ComparerResult.Equals ' X is equals to Y. ElseIf x Is Nothing AndAlso y IsNot Nothing Then Return ComparerResult.Less ' X is less than Y. ElseIf x IsNot Nothing AndAlso y Is Nothing Then Return ComparerResult.Greater ' X is greater than Y. End If ' The single variables to parse the text. Dim SingleX, SingleY As Single ' Single parsing: If Single.TryParse(x, SingleX) AndAlso Single.TryParse(y, SingleY) Then ' True and True Return [Enum].Parse(GetType(ComparerResult), SingleX.CompareTo(SingleY)) ElseIf Single.TryParse(x, SingleX) AndAlso Not Single.TryParse(y, SingleY) Then ' True and False Return ComparerResult.Greater ' X is greater than Y. ElseIf Not Single.TryParse(x, SingleX) AndAlso Single.TryParse(y, SingleY) Then ' False and True Return ComparerResult.Less ' X is less than Y. Else ' False and False Return [Enum].Parse(GetType(ComparerResult), x.ToString.CompareTo(y.ToString)) End If End Function #End Region End Class #End Region #Region " Date " ''' <summary> ''' Performs a date comparison. ''' </summary> Public Class DateComparer : Implements IComparer #Region " Enumerations " ''' <summary> ''' Specifies a comparison result. ''' </summary> Public Enum ComparerResult As Integer ''' <summary> ''' 'X' is equals to 'Y'. ''' </summary> Equals = 0I ''' <summary> ''' 'X' is less than 'Y'. ''' </summary> Less = -1I ''' <summary> ''' 'X' is greater than 'Y'. ''' </summary> Greater = 1I End Enum #End Region #Region " Methods " ''' <summary> ''' Compares two objects and returns a value indicating whether one is less than, equal to, or greater than the other. ''' </summary> ''' <param name="x">The first object to compare.</param> ''' <param name="y">The second object to compare.</param> ''' <returns> ''' A signed integer that indicates the relative values of <paramref name="x"/> and <paramref name="y"/>, ''' 0: <paramref name="x"/> equals <paramref name="y"/>. ''' Less than 0: <paramref name="x"/> is less than <paramref name="y"/>. ''' Greater than 0: <paramref name="x"/> is greater than <paramref name="y"/>. ''' </returns> Public Function Compare(ByVal x As Object, ByVal y As Object) As Integer Implements IComparer.Compare ' Null parsing. If x Is Nothing AndAlso y Is Nothing Then Return ComparerResult.Equals ' X is equals to Y. ElseIf x Is Nothing AndAlso y IsNot Nothing Then Return ComparerResult.Less ' X is less than Y. ElseIf x IsNot Nothing AndAlso y Is Nothing Then Return ComparerResult.Greater ' X is greater than Y. End If ' The Date variables to parse the text. Dim DateX, DateY As Date ' Date parsing: If Date.TryParse(x, DateX) AndAlso Date.TryParse(y, DateY) Then ' True and True Return [Enum].Parse(GetType(ComparerResult), DateX.CompareTo(DateY)) ElseIf Date.TryParse(x, DateX) AndAlso Not Date.TryParse(y, DateY) Then ' True and False Return ComparerResult.Greater ' X is greater than Y. ElseIf Not Date.TryParse(x, DateX) AndAlso Date.TryParse(y, DateY) Then ' False and True Return ComparerResult.Less ' X is less than Y. Else ' False and False Return [Enum].Parse(GetType(ComparerResult), x.ToString.CompareTo(y.ToString)) End If End Function #End Region End Class #End Region #End Region
|
|
|
En línea
|
|
|
|
Eleкtro
Ex-Staff
Desconectado
Mensajes: 9.874
|
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. ' 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.874
|
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: #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: #Region " Set Header and Footer " ' Create the excel workbook. Dim workbook As IWorkbook = New XSSFWorkbook() Dim sheet As ISheet = workbook.CreateSheet("Sheet1") ' Create a sheet. With sheet ' Create a cell and add a value. .CreateRow(0).CreateCell(1).SetCellValue("test") ' Set header text. .Header.Left = HSSFHeader.Page ' Page is a static property of HSSFHeader and HSSFFooter. .Header.Center = "This is a test sheet" ' Set footer text. .Footer.Left = "Copyright NPOI Team" .Footer.Right = "created by Tony Qu(瞿杰)" End With Save changes. Using sw As IO. FileStream = IO. File. Create(".\Header-Footer Example.xlsx") workbook.Write(sw) End Using #End Region
Añadir comentarios a una celda: #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: #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: #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: #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: #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): #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: #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: #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: #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: ' 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) {} Return wb.AddPicture(buffer, PictureType.JPEG) End Function
Unir celdas: ' 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: ' 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: ' 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.874
|
Una versión actualizada de mi Reg-EditorContiene todo tipo de métodos para el manejo del registro de Windows. ' *********************************************************************** ' 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.874
|
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. ' *********************************************************************** ' 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: ''' <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.874
|
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. 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. ''' <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 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. 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. 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. ' 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). 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. 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. 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. 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
|
|
|
|
|
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
|
25,871
|
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,080
|
3 Febrero 2014, 20:19 pm
por Eleкtro
|
|
|
Librería de Snippets para Delphi
« 1 2 »
Programación General
|
crack81
|
15
|
21,150
|
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,071
|
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,540
|
4 Julio 2018, 21:35 pm
por Eleкtro
|
|