Autor
|
Tema: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets) (Leído 529,083 veces)
|
Eleкtro
Ex-Staff
Desconectado
Mensajes: 9.874
|
Actualizada la colección de snippets con un total de 544 Snippets......Casi nada!!http://elektrostudios.tk/Snippets.zipEn la primera página de este hilo tienen un índice de todos los snippets que contiene el pack. PD: Algunos de los antiguos snippets (no todos) han sido mejorados y/o simplificados. Saludos!
|
|
« Última modificación: 5 Diciembre 2013, 19:49 pm por EleKtro H@cker »
|
En línea
|
|
|
|
Eleкtro
Ex-Staff
Desconectado
Mensajes: 9.874
|
Un ayudante para la interface MCI, reproduce archivos wav,mp3,midi y obtiene información esencial del archivo. La class es algo básica, solo le añadí lo esencial porque me dió bastantes problemas la verdad. ' [ MCI Player ] ' ' // By Elektro H@cker #Region " Usage Examples " ' Dim AudioFile As New MCIPlayer("C:\Audio.wav") ' AudioFile.Play(AudioPlayMode.BackgroundLoop) ' Dim sb As New System.Text.StringBuilder ' sb.AppendLine("Filename: " & AudioFile.Filename) ' sb.AppendLine("State...: " & AudioFile.State.ToString) ' sb.AppendLine("Mode....: " & AudioFile.PlaybackMode.ToString) ' sb.AppendLine("Channels: " & CStr(AudioFile.Channels)) ' sb.AppendLine("Duration: " & TimeSpan.FromMilliseconds(AudioFile.Duration).ToString("hh\:mm\:ss")) ' MessageBox.Show(sb.ToString, "MCI Player", MessageBoxButtons.OK, MessageBoxIcon.Information) ' AudioFile.Stop() #End Region #Region " MCI Player " ''' <summary> ''' Play Wave, MP3 or MIDI files ''' </summary> Public Class MCIPlayer Inherits NativeWindow Implements IDisposable #Region " API " ''' <summary> ''' Sends a command string to an MCI device. ''' The device that the command is sent to is specified in the command string. ''' </summary> ''' <param name="command"> ''' Pointer to a null-terminated string that specifies an MCI command string. ''' For a list, see Multimedia Command Strings. ''' </param> ''' <param name="buffer"> ''' Buffer that receives return information. ''' If no return information is needed, this parameter can be NULL. ''' </param> ''' <param name="bufferSize"> ''' Size, in characters, of the return buffer specified. ''' </param> ''' <param name="hwndCallback"> ''' Handle to a callback window if the "notify" flag was specified in the command string. ''' </param> <System.Runtime.InteropServices. DllImport("winmm.dll", SetLastError:=True)> Private Shared Function mciSendString( ByVal command As String, ByVal buffer As System.Text.StringBuilder, ByVal bufferSize As Integer, ByVal hwndCallback As IntPtr ) As Integer End Function #End Region #Region " Variables " ''' <summary> ''' The form to manage Windows Messages. ''' </summary> Private WithEvents formulary As Form = Nothing ''' <summary> ''' Indicates the audio play command of mciSendString. ''' </summary> Private PlayCommand As String = String.Empty ''' <summary> ''' Buffer that receives return information. ''' </summary> Private ReturnInfo As New System.Text.StringBuilder() With {.Capacity = 255} ''' <summary> ''' The current filename of the file that is to be played. ''' </summary> Private _filename As String = String.Empty ''' <summary> ''' Indicates the current playback mode. ''' </summary> Private _PlaybackMode As AudioPlayMode ''' <summary> ''' Flag to cancel the BackgroundLoop PlaybackMode. ''' </summary> Private CancelLoop As Boolean = False #End Region #Region " Properties " ''' <summary> ''' The current filename of the file that is to be played. ''' </summary> Public Property Filename() As String Get Return _filename End Get Set(ByVal value As String) If Not IO. File. Exists(value ) Then Throw New IO.FileNotFoundException Exit Property End If _filename = value End Set End Property ''' <summary> ''' Gets che current Playback State. ''' </summary> Public ReadOnly Property State As PlaybackState Get mciSendString("status file mode", ReturnInfo, ReturnInfo.Capacity, IntPtr.Zero) Return [Enum].Parse(GetType(PlaybackState), ReturnInfo.ToString, True) End Get End Property ''' <summary> ''' Gets or sets the playback mode of the current file. ''' </summary> Public Property PlaybackMode As AudioPlayMode Get Return _PlaybackMode End Get Set(value As AudioPlayMode) _PlaybackMode = value End Set End Property ''' <summary> ''' Gets the channels of the file. ''' </summary> ReadOnly Property Channels() As Integer Get mciSendString("status file channels", ReturnInfo, ReturnInfo.Capacity, IntPtr.Zero) Return If(IsNumeric(ReturnInfo.ToString), CInt(ReturnInfo.ToString), -1) End Get End Property ''' <summary> ''' Gets the file duration in Milleseconds. ''' </summary> ReadOnly Property Duration() As Integer Get mciSendString("set file time format milliseconds", Nothing, 0, IntPtr.Zero) mciSendString("status file length", ReturnInfo, ReturnInfo.Capacity, IntPtr.Zero) Return If(String.IsNullOrEmpty(ReturnInfo.ToString), 0, CInt(ReturnInfo.ToString)) End Get End Property #End Region #Region " Enumerations " ''' <summary> ''' Audio File playback state. ''' </summary> Public Enum PlaybackState As Short ''' <summary> ''' File is playing. ''' </summary> Playing = 0 ''' <summary> ''' File is paused. ''' </summary> Paused = 1 ''' <summary> ''' File is stopped. ''' </summary> Stopped = 2 End Enum ''' <summary> ''' Windows Message Identifiers. ''' </summary> Public Enum KnownMessages As Integer ''' <summary> ''' Notifies an application that an MCI device has completed an operation. ''' MCI devices send this message only when the MCI_NOTIFY flag is used. ''' </summary> MM_MCINOTIFY = 953 End Enum #End Region #Region " Constructor " ''' <summary> ''' Play Wave, MP3 or MIDI files. ''' </summary> ''' <param name="AudioFile">Indicates the filename of the media to play.</param> Public Sub New(ByVal AudioFile As String) ' Set the Audio file. Me.Filename = AudioFile ' Set the Formulary. Me.formulary = Form.ActiveForm ' Assign the form handle. SetFormHandle() End Sub ''' <summary> ''' Play Wave, MP3 or MIDI files. ''' </summary> ''' <param name="Formulary">Indicates the Form to assign the Handle.</param> ''' <param name="AudioFile">Indicates the filename of the media to play.</param> ''' <remarks></remarks> Public Sub New(ByVal Formulary As Form, ByVal AudioFile As String) ' Set the Audio file. Me.Filename = AudioFile ' Set the Formulary. Me.formulary = Formulary ' Assign the form handle. SetFormHandle() End Sub #End Region #Region " Public Methods " ''' <summary> ''' Plays the file that is specified as the filename. ''' </summary> ''' <remarks></remarks> Public Sub Play(ByVal PlayMode As AudioPlayMode) DisposedCheck() Select Case PlayMode Case AudioPlayMode.Background PlayCommand = "play file from 0" Me.PlaybackMode = AudioPlayMode.Background Case AudioPlayMode.BackgroundLoop PlayCommand = "play file from 0 notify" Me.PlaybackMode = AudioPlayMode.BackgroundLoop Case AudioPlayMode.WaitToComplete PlayCommand = "play file from 0 wait" Me.PlaybackMode = AudioPlayMode.WaitToComplete End Select ' Open command Select Case Me.Filename.Split(".").LastOrDefault Case "mp3" mciSendString(String.Format("open ""{0}"" type mpegvideo alias file", Me.Filename), Nothing, 0, IntPtr.Zero) Case "wav" mciSendString(String.Format("open ""{0}"" type waveaudio alias file", Me.Filename), Nothing, 0, IntPtr.Zero) Case "mid", "midi" mciSendString("stop midi", Nothing, 0, 0) mciSendString("close midi", Nothing, 0, 0) mciSendString(String.Format("open sequencer! ""{0}"" alias file", Me.Filename), Nothing, 0, IntPtr.Zero) Case Else Throw New Exception("File type not supported.") [Close]() End Select ' Play command mciSendString(PlayCommand, Nothing, 0, If(PlaybackMode = AudioPlayMode.BackgroundLoop, Me.Handle, IntPtr.Zero)) End Sub ''' <summary> ''' Pause the current playback. ''' </summary> ''' <remarks></remarks> Public Sub Pause() DisposedCheck() CancelLoop = True mciSendString("pause file", Nothing, 0, IntPtr.Zero) End Sub ''' <summary> ''' Resume the current playback if it is currently paused. ''' </summary> Public Sub [Resume]() DisposedCheck() If Me.State = PlaybackState.Paused Then CancelLoop = False mciSendString("resume file", Nothing, 0, IntPtr.Zero) End If End Sub ''' <summary> ''' Stop the current playback. ''' </summary> Public Sub [Stop]() DisposedCheck() CancelLoop = True mciSendString("stop file", Nothing, 0, IntPtr.Zero) End Sub ''' <summary> ''' Close the current file. ''' </summary> Public Overloads Sub [Close]() DisposedCheck() CancelLoop = True mciSendString("close file", Nothing, 0, IntPtr.Zero) End Sub #End Region #Region " Event Handlers " ''' <summary> ''' Assign the handle of the target form to this NativeWindow, ''' necessary to override WndProc. ''' </summary> Private Sub SetFormHandle() _ Handles formulary.HandleCreated, formulary.Load, formulary.Shown Try If Not Me.Handle.Equals(Me.formulary.Handle) Then Me.AssignHandle(Me.formulary.Handle) End If Catch ' ex As InvalidOperationException End Try End Sub ''' <summary> ''' Releases the Handle. ''' </summary> Private Sub OnHandleDestroyed() _ Handles formulary.HandleDestroyed Me.ReleaseHandle() End Sub #End Region #Region " Windows Messages " ''' <summary> ''' Processes Windows messages for this Window. ''' </summary> ''' <param name="m"> ''' Contains the Windows Message parameters. ''' </param> Protected Overrides Sub WndProc(ByRef m As Message) MyBase.WndProc(m) If m.Msg = KnownMessages.MM_MCINOTIFY Then If Not CancelLoop Then Play(AudioPlayMode.BackgroundLoop) Else CancelLoop = False End If End If End Sub #End Region #Region " IDisposable " ''' <summary> ''' To detect redundant calls when disposing. ''' </summary> Private IsDisposed As Boolean = False ''' <summary> ''' Prevents calls to methods after disposing. ''' </summary> Private Sub DisposedCheck() If Me.IsDisposed Then Throw New ObjectDisposedException(Me.GetType().FullName) End If End Sub ''' <summary> ''' Disposes the objects generated by this instance. ''' </summary> Public Sub Dispose() Implements IDisposable.Dispose Dispose(True) GC.SuppressFinalize(Me) End Sub ' IDisposable Protected Overridable Sub Dispose(IsDisposing As Boolean) If Not Me.IsDisposed Then If IsDisposing Then [Close]() Me.formulary = Nothing Me.ReleaseHandle() Me.DestroyHandle() End If End If Me.IsDisposed = True End Sub #End Region End Class #End Region
Un pequeño ejemplo que hice para recordar el uso de una Task: #Region " TASK Example " Public Class Form1 ' NORMAL TASK USAGE: ' ------------------ Private Task1 As Threading.Tasks.Task Private Task1CTS As New Threading.CancellationTokenSource Private Task1CT As Threading.CancellationToken = Task1CTS.Token Private Sub MyTask1(ByVal CancellationToken As Threading.CancellationToken) For x As Integer = 0 To 9999 If Not CancellationToken.IsCancellationRequested Then Debug. Print("Task1: " & x ) Else MsgBox(String.Format("Task1 Canceled at ""{0}""", x)) Exit Sub End If Next x End Sub ' ANONYMOUS TASK METHOD: ' --------------------- Private Task2 As Threading.Tasks.Task Private Task2CTS As New Threading.CancellationTokenSource Private Task2CT As Threading.CancellationToken = Task2CTS.Token Private Delegate Function Task2Delegate(ByVal CancellationToken As Threading.CancellationToken) Private MyTask2 As Task2Delegate = Function(CancellationToken As Threading.CancellationToken) As Boolean For x As Integer = 0 To 9999 If Not CancellationToken.IsCancellationRequested Then Debug. Print("Task2: " & x ) Else MsgBox(String.Format("Task2 Canceled at ""{0}""", x)) Return False End If Next x Return True End Function Private Sub TaskTest() Handles MyBase.Shown ' Run an asynchronous Task. Task1 = Threading.Tasks.Task.Factory.StartNew(Sub() MyTask1(Task1CT), Task1CT) ' Wait 2 seconds (Just to demonstrate this example) Threading.Thread.Sleep(2 * 1000) ' Cancel the Task. Task1CTS.Cancel() ' Wait for the Task to finish the being cancelled. Task1.Wait() ' Show the task status MsgBox(Task1.Status.ToString) ' Result: RanToCompletion ' ReStart the Task1. Task1 = Threading.Tasks.Task.Factory.StartNew(Sub() MyTask1(Task1CT), Task1CT) ' Start the Task2 Task2 = Threading.Tasks.Task.Factory.StartNew(Of Boolean)(Function() MyTask2(Task2CT), Task2CT) ' Wait for both Taks to finish their execution. Threading.Tasks.Task.WaitAll() End Sub End Class #End Region
|
|
|
En línea
|
|
|
|
Eleкtro
Ex-Staff
Desconectado
Mensajes: 9.874
|
Un buen ejemplo de como parsear un documento HTML utilizando la librería HTMLAgilityPack. Public Class Form1 Private ReadOnly html As String = <a><![CDATA[ <!DOCTYPE html> <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> <body> <div class="infolinks"><input type="hidden" name="IL_IN_TAG" value="1"/></div><div id="main"> <div class="music"> <h2 class="boxtitle">New releases \ <small> <a href="/newalbums" title="New releases mp3 downloads" rel="bookmark">see all</a></small> </h2> <div class="item"> <div class="thumb"> <a href="http://www.mp3crank.com/curt-smith/deceptively-heavy-121861" rel="bookmark" lang="en" title="Curt Smith - Deceptively Heavy album downloads"><img width="100" height="100" alt="Mp3 downloads Curt Smith - Deceptively Heavy" title="Free mp3 downloads Curt Smith - Deceptively Heavy" src="http://www.mp3crank.com/cover-album/Curt-Smith-Deceptively-Heavy-400x400.jpg"/></a> </div> <div class="release"> <h3>Curt Smith</h3> <h4> <a href="http://www.mp3crank.com/curt-smith/deceptively-heavy-121861" title="Mp3 downloads Curt Smith - Deceptively Heavy">Deceptively Heavy</a> </h4> <script src="/ads/button.js"></script> </div> <div class="release-year"> <p>Year</p> <span>2013</span> </div> <div class="genre"> <p>Genre</p> <a href="http://www.mp3crank.com/genre/indie" rel="tag">Indie</a><a href="http://www.mp3crank.com/genre/pop" rel="tag">Pop</a> </div> </div> <div class="item"> <div class="thumb"> <a href="http://www.mp3crank.com/wolf-eyes/lower-demos-121866" rel="bookmark" lang="en" title="Wolf Eyes - Lower Demos album downloads"><img width="100" height="100" alt="Mp3 downloads Wolf Eyes - Lower Demos" title="Free mp3 downloads Wolf Eyes - Lower Demos" src="http://www.mp3crank.com/cover-album/Wolf-Eyes-–-Lower-Demos.jpg" /></a> </div> <div class="release"> <h3>Wolf Eyes</h3> <h4> <a href="http://www.mp3crank.com/wolf-eyes/lower-demos-121866" title="Mp3 downloads Wolf Eyes - Lower Demos">Lower Demos</a> </h4> <script src="/ads/button.js"></script> </div> <div class="release-year"> <p>Year</p> <span>2013</span> </div> <div class="genre"> <p>Genre</p> <a href="http://www.mp3crank.com/genre/rock" rel="tag">Rock</a> </div> </div> </div> </div> </body> </html> ]]></a>.Value Private sb As New System.Text.StringBuilder Private htmldoc As HtmlAgilityPack.HtmlDocument = New HtmlAgilityPack.HtmlDocument Private htmlnodes As HtmlAgilityPack.HtmlNodeCollection = Nothing Private Title As String = String.Empty Private Cover As String = String.Empty Private Year As String = String.Empty Private Genres As String() = {String.Empty} Private URL As String = String.Empty Private Sub Test() Handles MyBase.Shown ' Load the html document. htmldoc.LoadHtml(html) ' Select the (10 items) nodes. ' All "SelectSingleNode" below will use this DIV element as a starting point. htmlnodes = htmldoc.DocumentNode.SelectNodes("//div[@class='item']") ' Loop trough the nodes. For Each node As HtmlAgilityPack.HtmlNode In htmlnodes Title = node.SelectSingleNode(".//div[@class='release']/h4/a[@title]").GetAttributeValue("title", "Unknown Title") Cover = node.SelectSingleNode(".//div[@class='thumb']/a/img[@src]").GetAttributeValue("src", String.Empty) Year = node.SelectSingleNode(".//div[@class='release-year']/span").InnerText Genres = (From n In node.SelectNodes(".//div[@class='genre']/a") Select n.InnerText).ToArray() URL = node.SelectSingleNode(".//div[@class='release']/h4/a[@href]").GetAttributeValue("href", "Unknown URL") ' Display the information: sb.Clear() sb.AppendLine(String.Format("Title : {0}", Title)) sb.AppendLine(String.Format("Cover : {0}", Cover)) sb.AppendLine(String.Format("Year : {0}", Year)) sb.AppendLine(String.Format("Genres: {0}", String.Join(", ", Genres))) sb.AppendLine(String.Format("URL : {0}", URL)) MsgBox(sb.ToString) Next node End Sub End Class
|
|
|
En línea
|
|
|
|
Eleкtro
Ex-Staff
Desconectado
Mensajes: 9.874
|
Una nueva versión de mi INI manager, empecé desde cero para simplificar todo el código y le añadí un parámetro al método "Get_Value" para devolver un valor por defecto (se debe especificar) si el valor no se encuentra. ' [ INI File Manager ] ' ' // By Elektro H@cker #Region " Usage Examples " '' Set the initialization file path. 'INIFileManager.FilePath = IO.Path.Combine(Application.StartupPath, "Config.ini") '' Create the initialization file. 'INIFileManager.File.Create() '' Check that the initialization file exist. 'MsgBox(INIFileManager.File.Exist) '' Writes a new entire initialization file with the specified text content. 'INIFileManager.File.Write(New List(Of String) From {"[Section Name 1]"}) '' Set an existing value or append it at the enf of the initialization file. 'INIFileManager.Key.Set("KeyName1", "Value1") '' Set an existing value on a specific section or append them at the enf of the initialization file. 'INIFileManager.Key.Set("KeyName2", "Value2", "[Section Name 2]") '' Gets the value of the specified Key name, 'MsgBox(INIFileManager.Key.Get("KeyName1")) '' Gets the value of the specified Key name on the specified Section. 'MsgBox(INIFileManager.Key.Get("KeyName2", , "[Section Name 2]")) '' Gets the value of the specified Key name and returns a default value if the key name is not found. 'MsgBox(INIFileManager.Key.Get("KeyName0", "I'm a default value")) '' Gets the value of the specified Key name, and assign it to a control property. 'CheckBox1.Checked = CType(INIFileManager.Key.Get("KeyName1"), Boolean) '' Checks whether a Key exists. 'MsgBox(INIFileManager.Key.Exist("KeyName1")) '' Checks whether a Key exists on a specific section. 'MsgBox(INIFileManager.Key.Exist("KeyName2", "[First Section]")) '' Remove a key name. 'INIFileManager.Key.Remove("KeyName1") '' Remove a key name on the specified Section. 'INIFileManager.Key.Remove("KeyName2", "[Section Name 2]") '' Add a new section. 'INIFileManager.Section.Add("[Section Name 3]") '' Get the contents of a specific section. 'MsgBox(String.Join(Environment.NewLine, INIFileManager.Section.Get("[Section Name 1]"))) '' Remove an existing section. 'INIFileManager.Section.Remove("[Section Name 2]") '' Checks that the initialization file contains at least one section. 'MsgBox(INIFileManager.Section.Has()) '' Sort the initialization file (And remove empty lines). 'INIFileManager.File.Sort(True) '' Gets the initialization file section names. 'MsgBox(String.Join(", ", INIFileManager.Section.GetNames())) '' Gets the initialization file content. 'MsgBox(String.Join(Environment.NewLine, INIFileManager.File.Get())) '' Delete the initialization file from disk. 'INIFileManager.File.Delete() #End Region #Region " INI File Manager " Public Class INIFileManager #Region " Members " #Region " Properties " ''' <summary> ''' Indicates the initialization file path. ''' </summary> Public Shared Property FilePath As String = IO.Path.Combine(Application.StartupPath, Process.GetCurrentProcess().ProcessName & ".ini") #End Region #Region " Variables " ''' <summary> ''' Stores the initialization file content. ''' </summary> Private Shared Content As New List(Of String) ''' <summary> ''' Stores the INI section names. ''' </summary> Private Shared SectionNames As String() = {String.Empty} ''' <summary> ''' Indicates the start element index of a section name. ''' </summary> Private Shared SectionStartIndex As Integer = -1 ''' <summary> ''' Indicates the end element index of a section name. ''' </summary> Private Shared SectionEndIndex As Integer = -1 ''' <summary> ''' Stores a single sorted section block with their keys and values. ''' </summary> Private Shared SortedSection As New List(Of String) ''' <summary> ''' Stores all the sorted section blocks with their keys and values. ''' </summary> Private Shared SortedSections As New List(Of String) ''' <summary> ''' Indicates the INI element index that contains the Key and value. ''' </summary> Private Shared KeyIndex As Integer = -1 ''' <summary> ''' Indicates the culture to compare the strings. ''' </summary> Private Shared ReadOnly CompareMode As StringComparison = StringComparison.InvariantCultureIgnoreCase #End Region #Region " Exceptions " ''' <summary> ''' Exception is thrown when a section name parameter has invalid format. ''' </summary> Private Class SectionNameInvalidFormatException Inherits Exception Public Sub New() MyBase.New("Section name parameter has invalid format." & Environment.NewLine & "The rigth syntax is: [SectionName]") End Sub Public Sub New(message As String) MyBase.New(message) End Sub Public Sub New(message As String, inner As Exception) MyBase.New(message, inner) End Sub End Class #End Region #End Region #Region " Methods " <System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)> Private Shadows Sub ReferenceEquals() End Sub <System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)> Private Shadows Sub Equals() End Sub <System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)> Private Shadows Sub ReferenceEquals() End Sub <System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)> Private Shadows Sub Equals() End Sub ''' <summary> ''' Checks whether the initialization file exist. ''' </summary> ''' <returns>True if initialization file exist, otherwise False.</returns> Public Shared Function Exist() As Boolean Return IO. File. Exists(FilePath ) End Function ''' <summary> ''' Creates the initialization file. ''' If the file already exist it would be replaced. ''' </summary> ''' <param name="Encoding">The Text encoding to write the initialization file.</param> ''' <returns>True if the operation success, otherwise False.</returns> Public Shared Function Create(Optional ByVal Encoding As System.Text.Encoding = Nothing) As Boolean Try IO. File. WriteAllText(FilePath, String.Empty, If(Encoding Is Nothing, System.Text.Encoding.Default, Encoding)) Catch ex As Exception Throw Return False End Try Return True End Function ''' <summary> ''' Deletes the initialization file. ''' </summary> ''' <returns>True if the operation success, otherwise False.</returns> Public Shared Function Delete() As Boolean If Not [File]. Exist Then Return False Try Catch ex As Exception Throw Return False End Try Content = Nothing Return True End Function ''' <summary> ''' Returns the initialization file content. ''' </summary> ''' <param name="Encoding">The Text encoding to read the initialization file.</param> Public Shared Function [Get](Optional ByVal Encoding As System.Text.Encoding = Nothing) As List(Of String) Content = IO. File. ReadAllLines(FilePath, If(Encoding Is Nothing, System.Text.Encoding.Default, Encoding)).ToList() Return Content End Function ''' <summary> ''' Sort the initialization file content by the Key names. ''' If the initialization file contains sections then the sections are sorted by their names also. ''' </summary> ''' <param name="RemoveEmptyLines">Remove empty lines.</param> ''' <param name="Encoding">The Text encoding to read the initialization file.</param> ''' <returns>True if the operation success, otherwise False.</returns> Public Shared Function Sort(Optional ByVal RemoveEmptyLines As Boolean = False, Optional ByVal Encoding As System.Text.Encoding = Nothing) As Boolean If Not [File]. Exist() Then Return False Select Case Section.Has(Encoding) Case True ' initialization file contains at least one Section. SortedSection.Clear() SortedSections.Clear() Section.GetNames(Encoding) ' Get the (sorted) section names For Each name As String In SectionNames SortedSection = Section.[Get](name, Encoding) ' Get the single section lines. If RemoveEmptyLines Then ' Remove empty lines. SortedSection = SortedSection.Where(Function(line) _ Not String.IsNullOrEmpty(line) AndAlso Not String.IsNullOrWhiteSpace(line)).ToList End If SortedSection.Sort() ' Sort the single section keys. SortedSections.Add(name) ' Add the section name to the sorted sections list. SortedSections.AddRange(SortedSection) ' Add the single section to the sorted sections list. Next name Content = SortedSections Case False ' initialization file doesn't contains any Section. Content.Sort() If RemoveEmptyLines Then Content = Content.Where(Function(line) _ Not String.IsNullOrEmpty(line) AndAlso Not String.IsNullOrWhiteSpace(line)).ToList End If End Select ' Section.Has() ' Save changes. Return [File]. Write(Content, Encoding ) End Function ''' <summary> ''' Writes a new initialization file with the specified text content.. ''' </summary> ''' <param name="Content">Indicates the text content to write in the initialization file.</param> ''' <param name="Encoding">The Text encoding to read the initialization file.</param> ''' <returns>True if the operation success, otherwise False.</returns> Public Shared Function Write(ByVal Content As List(Of String), Optional ByVal Encoding As System.Text.Encoding = Nothing) As Boolean Try IO. File. WriteAllLines(FilePath, Content, If(Encoding Is Nothing, System.Text.Encoding.Default, Encoding)) Catch ex As Exception Throw Return False End Try Return True End Function End Class Public Class [Key] <System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)> Private Shadows Sub ReferenceEquals() End Sub <System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)> Private Shadows Sub Equals() End Sub ''' <summary> ''' Return a value indicating whether a key name exist or not. ''' </summary> ''' <param name="KeyName">Indicates the key name that contains the value to modify.</param> ''' <param name="SectionName">Indicates the Section name where to find the key name.</param> ''' <param name="Encoding">The Text encoding to write the initialization file.</param> ''' <returns>True if the key name exist, otherwise False.</returns> Public Shared Function Exist(ByVal KeyName As String, Optional ByVal SectionName As String = Nothing, Optional ByVal Encoding As System.Text.Encoding = Nothing) As Boolean If Not [File]. Exist() Then Return False [Key].GetIndex(KeyName, SectionName) Select Case SectionName Is Nothing Case True Return Convert.ToBoolean(Not KeyIndex) Case Else Return Convert.ToBoolean(Not (KeyIndex + SectionStartIndex)) End Select End Function ''' <summary> ''' Set the value of an existing key name. ''' ''' If the initialization file doesn't exists, or else the Key doesn't exist, ''' or else the Section parameter is not specified and the key name doesn't exist; ''' then the 'key=value' is appended to the end of the initialization file. ''' ''' if the specified Section name exist but the Key name doesn't exist, ''' then the 'key=value' is appended to the end of the Section. ''' ''' </summary> ''' <param name="KeyName">Indicates the key name that contains the value to modify.</param> ''' <param name="Value">Indicates the new value.</param> ''' <param name="SectionName">Indicates the Section name where to find the key name.</param> ''' <param name="Encoding">The Text encoding to write the initialization file.</param> ''' <returns>True if the operation success, otherwise False.</returns> Public Shared Function [Set](ByVal KeyName As String, ByVal Value As String, Optional ByVal SectionName As String = Nothing, Optional ByVal Encoding As System.Text.Encoding = Nothing) As Boolean If Not [File]. Exist() Then [File]. Create() [Key].GetIndex(KeyName, SectionName) ' If KeyName is not found and indicated Section is found, then... If KeyIndex = -1 AndAlso SectionEndIndex <> -1 Then ' If section EndIndex is the last line of file, then... If SectionEndIndex = Content.Count Then Content(Content.Count - 1) = Content(Content.Count - 1) & Environment.NewLine & String.Format("{0}={1}", KeyName, Value) Else ' If not section EndIndex is the last line of file, then... Content(SectionEndIndex) = String.Format("{0}={1}", KeyName, Value) & Environment.NewLine & Content(SectionEndIndex) End If ' If KeyName is found then... ElseIf KeyIndex <> -1 Then Content(KeyIndex) = String.Format("{0}={1}", KeyName, Value) ' If KeyName is not found and Section parameter is passed. then... ElseIf KeyIndex = -1 AndAlso SectionName IsNot Nothing Then Content.Add(SectionName) Content.Add(String.Format("{0}={1}", KeyName, Value)) ' If KeyName is not found, then... ElseIf KeyIndex = -1 Then Content.Add(String.Format("{0}={1}", KeyName, Value)) End If ' Save changes. Return [File]. Write(Content, Encoding ) End Function ''' <summary> ''' Get the value of an existing key name. ''' If the initialization file or else the Key doesn't exist then a 'Nothing' object is returned. ''' </summary> ''' <param name="KeyName">Indicates the key name to retrieve their value.</param> ''' <param name="DefaultValue">Indicates a default value to return if the key name is not found.</param> ''' <param name="SectionName">Indicates the Section name where to find the key name.</param> ''' <param name="Encoding">The Text encoding to read the initialization file.</param> Public Shared Function [Get](ByVal KeyName As String, Optional ByVal DefaultValue As Object = Nothing, Optional ByVal SectionName As String = Nothing, Optional ByVal Encoding As System.Text.Encoding = Nothing) As Object If Not [File]. Exist() Then Return DefaultValue [Key].GetIndex(KeyName, SectionName) Select Case KeyIndex Case Is <> -1 ' KeyName found. Return Content(KeyIndex).Substring(Content(KeyIndex).IndexOf("=") + 1) Case Else ' KeyName not found. Return DefaultValue End Select End Function ''' <summary> ''' Returns the initialization file line index of the key name. ''' </summary> ''' <param name="KeyName">Indicates the Key name to retrieve their value.</param> ''' <param name="SectionName">Indicates the Section name where to find the key name.</param> ''' <param name="Encoding">The Text encoding to read the initialization file.</param> Private Shared Sub GetIndex(ByVal KeyName As String, Optional ByVal SectionName As String = Nothing, Optional ByVal Encoding As System.Text.Encoding = Nothing) If Content Is Nothing Then [File]. Get(Encoding ) ' Reset the INI index elements to negative values. KeyIndex = -1 SectionStartIndex = -1 SectionEndIndex = -1 If SectionName IsNot Nothing AndAlso Not SectionName Like "[[]?*[]]" Then Throw New SectionNameInvalidFormatException Exit Sub End If ' Locate the KeyName and set their element index. ' If the KeyName is not found then the value is set to "-1" to return an specified default value. Select Case String.IsNullOrEmpty(SectionName) Case True ' Any SectionName parameter is specified. KeyIndex = Content.FindIndex(Function(line) line.StartsWith(String.Format("{0}=", KeyName), StringComparison.InvariantCultureIgnoreCase)) Case False ' SectionName parameter is specified. Select Case Section.Has(Encoding) Case True ' INI contains at least one Section. SectionStartIndex = Content.FindIndex(Function(line) line.Trim.Equals(SectionName.Trim, CompareMode)) If SectionStartIndex = -1 Then ' Section doesn't exist. Exit Sub End If SectionEndIndex = Content.FindIndex(SectionStartIndex + 1, Function(line) line.Trim Like "[[]?*[]]") If SectionEndIndex = -1 Then ' This fixes the value if the section is at the end of file. SectionEndIndex = Content.Count End If KeyIndex = Content.FindIndex(SectionStartIndex, SectionEndIndex - SectionStartIndex, Function(line) line.StartsWith(String.Format("{0}=", KeyName), StringComparison.InvariantCultureIgnoreCase)) Case False ' INI doesn't contains Sections. GetIndex(KeyName, , Encoding) End Select ' Section.Has() End Select ' String.IsNullOrEmpty(SectionName) End Sub ''' <summary> ''' Remove an existing key name. ''' </summary> ''' <param name="KeyName">Indicates the key name to retrieve their value.</param> ''' <param name="SectionName">Indicates the Section name where to find the key name.</param> ''' <param name="Encoding">The Text encoding to read the initialization file.</param> ''' <returns>True if the operation success, otherwise False.</returns> Public Shared Function Remove(ByVal KeyName As String, Optional ByVal SectionName As String = Nothing, Optional ByVal Encoding As System.Text.Encoding = Nothing) As Boolean If Not [File]. Exist() Then Return False [Key].GetIndex(KeyName, SectionName) Select Case KeyIndex Case Is <> -1 ' Key found. ' Remove the element containing the key name. Content.RemoveAt(KeyIndex) ' Save changes. Return [File]. Write(Content, Encoding ) Case Else ' KeyName not found. Return False End Select End Function End Class Public Class Section <System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)> Private Shadows Sub ReferenceEquals() End Sub <System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)> Private Shadows Sub Equals() End Sub ''' <summary> ''' Adds a new section at bottom of the initialization file. ''' </summary> ''' <param name="SectionName">Indicates the Section name to add.</param> ''' <param name="Encoding">The Text encoding to read the initialization file.</param> ''' <returns>True if the operation success, otherwise False.</returns> Public Shared Function Add(Optional ByVal SectionName As String = Nothing, Optional ByVal Encoding As System.Text.Encoding = Nothing) As Boolean If Not [File]. Exist() Then [File]. Create() If Not SectionName Like "[[]?*[]]" Then Throw New SectionNameInvalidFormatException Exit Function End If Select Case Section.GetNames(Encoding).Where(Function(line) line.Trim.Equals(SectionName.Trim, CompareMode)).Any Case False ' Any of the existing Section names is equal to given section name. ' Add the new section name. Content.Add(SectionName) ' Save changes. Return [File]. Write(Content, Encoding ) Case Else ' An existing Section name is equal to given section name. Return False End Select End Function ''' <summary> ''' Returns all the keys and values of an existing Section Name. ''' </summary> ''' <param name="Encoding">The Text encoding to read the initialization file.</param> ''' <param name="SectionName">Indicates the section name where to retrieve their keynames and values.</param> Public Shared Function [Get](ByVal SectionName As String, Optional ByVal Encoding As System.Text.Encoding = Nothing) As List(Of String) If Content Is Nothing Then [File]. Get(Encoding ) SectionStartIndex = Content.FindIndex(Function(line) line.Trim.Equals(SectionName.Trim, CompareMode)) SectionEndIndex = Content.FindIndex(SectionStartIndex + 1, Function(line) line.Trim Like "[[]?*[]]") If SectionEndIndex = -1 Then SectionEndIndex = Content.Count ' This fixes the value if the section is at the end of file. End If Return Content.GetRange(SectionStartIndex, SectionEndIndex - SectionStartIndex).Skip(1).ToList End Function ''' <summary> ''' Returns all the section names of the initialization file. ''' </summary> ''' <param name="Encoding">The Text encoding to read the initialization file.</param> Public Shared Function GetNames(Optional ByVal Encoding As System.Text.Encoding = Nothing) As String() If Content Is Nothing Then [File]. Get(Encoding ) ' Get the Section names. SectionNames = (From line In Content Where line.Trim Like "[[]?*[]]").ToArray ' Sort the Section names. If SectionNames.Count <> 0 Then Array.Sort(SectionNames) ' Return the Section names. Return SectionNames End Function ''' <summary> ''' Gets a value indicating whether the initialization file contains at least one Section. ''' </summary> ''' <param name="Encoding">The Text encoding to read the initialization file.</param> ''' <returns>True if the INI contains at least one section, otherwise False.</returns> Public Shared Function Has(Optional ByVal Encoding As System.Text.Encoding = Nothing) As Boolean If Content Is Nothing Then [File]. Get(Encoding ) Return (From line In Content Where line.Trim Like "[[]?*[]]").Any() End Function ''' <summary> ''' Removes an existing section with all of it's keys and values. ''' </summary> ''' <param name="SectionName">Indicates the Section name to remove with all of it's key/values.</param> ''' <param name="Encoding">The Text encoding to read the initialization file.</param> ''' <returns>True if the operation success, otherwise False.</returns> Public Shared Function Remove(Optional ByVal SectionName As String = Nothing, Optional ByVal Encoding As System.Text.Encoding = Nothing) As Boolean If Not [File]. Exist() Then Return False If Not SectionName Like "[[]?*[]]" Then Throw New SectionNameInvalidFormatException Exit Function End If Select Case [Section].GetNames(Encoding).Where(Function(line) line.Trim.Equals(SectionName.Trim, CompareMode)).Any Case True ' An existing Section name is equal to given section name. ' Get the section StartIndex and EndIndex. [Get](SectionName) ' Remove the section range index. Content.RemoveRange(SectionStartIndex, SectionEndIndex - SectionStartIndex) ' Save changes. Return [File]. Write(Content, Encoding ) Case Else ' Any of the existing Section names is equal to given section name. Return False End Select End Function End Class #End Region End Class #End Region
|
|
« Última modificación: 15 Diciembre 2014, 21:35 pm por Eleкtro »
|
En línea
|
|
|
|
Eleкtro
Ex-Staff
Desconectado
Mensajes: 9.874
|
Una función de uso genérico para delimitar un string, es decir, para tomar una porción dell texto (solo una). #Region " Delimit String " ' [ Delimit String ] ' ' // By Elektro H@ker ' ' Result: my new house today ' MsgBox(Delimit_String("Welcome to my new house today", "to")) ' Result: my new house ' MsgBox(Delimit_String("Welcome to my new house today", "to", "today")) ' Result: my new house ' MsgBox(Delimit_String("Welcome to my new house today", "TO", "tODaY", RegexOptions.IgnoreCase)) ' Result: my new house ' MsgBox(Delimit_String("Welcome to my new house today", "to", "to", RegexOptions.IgnoreCase Or RegexOptions.RightToLeft)) ' Result: Nothing (No IgnoreCase specified.) ' MsgBox(Delimit_String("Welcome to my new house today", "TO", "HoUSe")) ' Result: Nothing (Second delimiter is not found.) ' MsgBox(Delimit_String("Welcome to my new house today", "to", "tokyo", )) ''' <summary> ''' Delimit a String using Start/End delimiters. ''' </summary> ''' <param name="str">Indicates the String to delimit.</param> ''' <param name="Delimiter_A">A delimiter used to indicate the end of the string.</param> ''' <param name="Delimiter_B">An optional delimiter used to indicate the end of the string produced by the first delimiter.</param> ''' <param name="Options">Indicates options such as IgnoreCase or to start splitting from RightToLeft.</param> Private Function Delimit_String(ByVal str As String, ByVal Delimiter_A As String, Optional ByVal Delimiter_B As String = "", Optional ByVal Options As RegexOptions = RegexOptions.None) As String Dim rgx1 As New Regex(Delimiter_A, Options) Dim rgx2 As New Regex(Delimiter_B, Options) Dim m1 = rgx1.Match(str) Select Case Options.ToString.Contains(RegexOptions.RightToLeft.ToString) Case False ' Left To Right str = str.Substring(m1.Index + m1.Length) Case True ' Right To Left str = str.Substring(0, m1.Index) End Select Dim m2 = rgx2.Match(str) If Not String.IsNullOrWhiteSpace(Delimiter_B) Then Select Case Options.ToString.Contains(RegexOptions.RightToLeft.ToString) Case False ' Left To Right str = str.Substring(0, m2.Index) Case True ' Right To Left str = str.Substring(m2.Index + m2.Length) End Select End If Return str End Function #End Region
|
|
|
En línea
|
|
|
|
Eleкtro
Ex-Staff
Desconectado
Mensajes: 9.874
|
Control IteratorRecolecta uno o varios controles y realiza una operación específica en ellos. Le añadí decenas de overloads y métodos, el código es bien largo: http://pastebin.com/ypuQdKf0Ejemplos de uso: ControlIterator.Disable(CheckBox1) ControlIterator.Enable({CheckBox1, CheckBox2}) ControlIterator.Check(Of CheckBox)(Me) ControlIterator.Uncheck(Of CheckBox)(Me.GroupBox1) ControlIterator.Hide(Of CheckBox)("1") ControlIterator.PerformAction(Of CheckBox)(Sub(ctrl As CheckBox) ctrl.Visible = True) ControlIterator.AsyncPerformAction(RichTextBox1, Sub(rb As RichTextBox) For n As Integer = 0 To 9 rb.AppendText(CStr(n)) Next End Sub)
|
|
« Última modificación: 12 Diciembre 2013, 08:08 am por EleKtro H@cker »
|
En línea
|
|
|
|
Eleкtro
Ex-Staff
Desconectado
Mensajes: 9.874
|
Unos snippets para el control GeckoFX https://bitbucket.org/geckofx/ la cual necesita (una versión específica de) XulRunner http://ftp.mozilla.org/pub/mozilla.org/xulrunner/releases/- Navega a una url y espera a que la página se haya cargado complétamente. ' [GeckoFX] - Navigate And Wait ' ' // By Elektro H@cker ' ' Usage Examples: ' NavigateAndWait(GeckoWebBrowser1, "www.google.com") : MsgBox("Page fully loaded!") Private WebPageLoaded As Boolean = False ''' <summary> ''' Navigates to an url and waits the page to be loaded. ''' </summary> ''' <param name="url">Indicates the url to navigate.</param> Public Sub NavigateAndWait(Byval Browser as Gecko.GeckoWebBrowser, Byval url As String, Optional loadFlags As Gecko.GeckoLoadFlags = Gecko.GeckoLoadFlags.None, Optional referrer As String = Nothing, Optional postData As Gecko.GeckoMIMEInputStream = Nothing) Me.WebPageLoaded = False AddHandler Browser.DocumentCompleted, AddressOf GeckoWebBrowserDocumentCompleted Browser.Navigate(url, loadFlags, referrer, postData) Do Until Me.WebPageLoaded Application.DoEvents() Loop RemoveHandler Browser.DocumentCompleted, AddressOf GeckoWebBrowserDocumentCompleted End Sub ' GeckoWebBrowser [DocumentCompleted] Private Sub GeckoWebBrowserDocumentCompleted(ByVal sender As Object, e As EventArgs) Me.WebPageLoaded = True End Sub
- Elimina todas las cookies que haya generado el navegador ' [GeckoFX] - Remove All Cookies Private Sub RemoveAllCookies() Dim CookieMan As nsICookieManager2 CookieMan = Xpcom.GetService(Of nsICookieManager2)("@mozilla.org/cookiemanager;1") CookieMan = Xpcom.QueryInterface(Of nsICookieManager2)(CookieMan) CookieMan.RemoveAll() End Sub
- Establece algunas preferencias interesantes del navegador Private Sub SetNavigatorPreferences() ' Pipelining reduces network load and can reduce page loading times over high-latency connections, ' but not all servers support it. ' Some servers may even behave incorrectly if they receive pipelined requests. ' If a proxy server is not configured, this preference controls whether to attempt to use pipelining. ' Value = Attempt to use pipelining in HTTP 1.1 connections or not. Gecko.GeckoPreferences.Default("network.http.pipelining") = True ' Many problems with pipelining are related to broken proxy servers sitting between the user and the destination web site. ' Since this is not a problem with SSL, it is possible to turn on pipelining for SSL websites only. ' This preference controls whether to use pipelining for secure websites, regardless of network.http.pipelining. ' Value = Use HTTP pipelining for secure websites or not. Gecko.GeckoPreferences.Default("network.http.pipelining.ssl") = True ' Value = The maximum number of requests to pipeline at once when pipelining is enabled. Gecko.GeckoPreferences.Default("network.http.pipelining.maxrequests") = 10 ' Value = Total number of HTTP connections the application can make to a single server. Gecko.GeckoPreferences.Default("network.http.max-connections-per-server") = 20 ' HTTP keep-alive connections can be re-used for multiple requests, ' as opposed to non-keep-alive connections, which are limited to one request. ' Using keep-alive connections improves performance. ' Value = The maximum number of HTTP keep-alive connections the application can have open at once to a single server. (Default: 2) Gecko.GeckoPreferences.Default("network.http.max-persistent-connections-per-server") = 5 ' Display what's been received of a page before the entire page has been downloaded. ' Value = The number of milliseconds to wait before first displaying the page. (Default: 250) Gecko.GeckoPreferences.Default("nglayout.initialpaint.delay") = 0 ' Value = Attempt to use pipelining in HTTP 1.1 connections to the proxy server or not. Gecko.GeckoPreferences.Default("network.http.proxy.pipelining") = True ' Rather than wait until a page has completely downloaded to display it to the user, ' Mozilla applications will periodically render what has been received to that point. ' Because reflowing the page every time additional data is received greatly slows down total page load time, ' a timer was added so that the page would not reflow too often. ' Value = The maximum number of times the content will do timer-based reflows. ' After this number has been reached, the page will only reflow once it is finished downloading. Gecko.GeckoPreferences.Default("content.notify.backoffcount") = 5 ' Value = Displays the full path of a installed plugin file or not. Gecko.GeckoPreferences.Default("plugin.expose_full_path") = True ' Value = The delay in milliseconds between hovering over a menu option with a submenu and the submenu appearing. Gecko.GeckoPreferences.Default("ui.submenuDelay") = 0 ' Pages that were recently visited are stored in memory in such a way that they don't have to be re-parsed (this is different from the memory cache). ' This improves performance when pressing Back and Forward. ' Value = The maximum number of pages stored in memory. Gecko.GeckoPreferences.Default("Browser.sessionhistory.max_total_viewers") = 5 ' Value = The maximum number of pages in the browser's session history, ' the maximum number of URLs you can traverse purely through the Back/Forward buttons. Default value is 50. Gecko.GeckoPreferences.Default("Browser.sessionhistory.max_entries") = 60 ' When a program is minimized and left for a period of time, ' Windows will swap memory the program is using from RAM onto the hard disk in anticipation that other programs might need RAM. ' Value = Determines whether to mark memory as preferably swappable, from a minimized Mozilla Windows application. Gecko.GeckoPreferences.Default("config.trim_on_minimize") = True ' Mozilla applications will periodically retrieve a blocklist from the server specified in extensions.blocklist.url. ' While Mozilla 's add-on system is a powerful feature, it can also be a vector for malware. ' Specific extensions can be blocklisted from a central server (by default, addons.mozilla.org). ' Value = Determines wheter to retrieve a blocklist to restrict extension installation. Gecko.GeckoPreferences.Default("extensions.blocklist.enabled") = False End Sub
|
|
« Última modificación: 13 Diciembre 2013, 15:42 pm por EleKtro H@cker »
|
En línea
|
|
|
|
Eleкtro
Ex-Staff
Desconectado
Mensajes: 9.874
|
Para comprobar si la conectividad a una web está disponible y mostrar un mensaje de Status en un control... Ejemplo de uso: Private Sub Test() MsgBox(Is_Connectivity_Avaliable("Google.com")) Dim t As New Threading.Thread(AddressOf CheckConnectivity) t.Start() End Sub Private Sub CheckConnectivity() Do Until Is_Connectivity_Avaliable("qwertyqwertyqwerty.com", 10, Label1) Application.DoEvents() Loop End Sub
Private Function Is_Connectivity_Avaliable(ByVal url As String, Optional ByVal RetryInterval As Integer = -1, Optional ByVal StatusControl As Control = Nothing) As Boolean Dim NoNetworkMessage As String = "Network connection is not avaliable." Dim NoWebsiteMessage As String = "WebSite is not avaliable." Dim NoNetworkRetryMessage As String = "Network connection is not avaliable, retrying in {0} seconds..." Dim NoWebsiteRetryMessage As String = "WebSite is not avaliable, retrying in {0} seconds..." Dim YesNetworkMessage As String = "Network connection established." Dim YesWebsiteMessage As String = "WebSite connection established." Select Case My.Computer.Network.IsAvailable Case False ' No network device avaliable If RetryInterval = -1 Then ' Do not retry NetworkAvaliable(NoNetworkMessage, False, StatusControl) Return False Else ' Retry For X As Integer = 0 To RetryInterval NetworkAvaliable(String.Format(NoNetworkRetryMessage, RetryInterval - X), True, StatusControl) Next X Is_Connectivity_Avaliable(url, RetryInterval, StatusControl) End If ' RetryInterval Case True ' Network device is avaliable ' Inform that network device is avaliable. NetworkAvaliable(YesNetworkMessage, False, StatusControl) Try ' Try connect to the given url My.Computer.Network.Ping(url) ' Inform that Website connection is avaliable. NetworkAvaliable(YesWebsiteMessage, False, StatusControl) Return True Catch ex As Net.NetworkInformation.PingException If RetryInterval = -1 Then ' Do not retry NetworkAvaliable(NoWebsiteMessage, False, StatusControl) Return False Else ' Retry For X As Integer = 0 To RetryInterval NetworkAvaliable(String.Format(NoWebsiteRetryMessage, RetryInterval - X), True, StatusControl) Next X Is_Connectivity_Avaliable(url, RetryInterval, StatusControl) End If ' RetryInterval Catch ex As InvalidOperationException If RetryInterval = -1 Then ' Do not retry NetworkAvaliable(NoNetworkMessage, False, StatusControl) Return False Else ' Retry For X As Integer = 0 To RetryInterval NetworkAvaliable(String.Format(NoNetworkRetryMessage, RetryInterval - X), True, StatusControl) Next Is_Connectivity_Avaliable(url, RetryInterval, StatusControl) End If ' RetryInterval End Try End Select End Function Private Sub NetworkAvaliable(ByVal Message As String, ByVal Wait As Boolean, Optional ByVal StatusControl As Control = Nothing) If Wait Then Threading.Thread.Sleep(1000) If StatusControl IsNot Nothing Then StatusControl.Invoke(Sub() StatusControl.Text = Message) Else End If End Sub
Un snippet para colorear los elementos de un Listbox, esto lo posteé hace tiempo pero lo he extendido... #Region " [ListBox] Colorize Items " ' [ [ListBox] Colorize Items ] ' ' // By Elektro H@cker ' ' Instructions: ' 1. Set ListBox "Drawmode" property to "OwnerDrawFixed" to make this work. ' ListBox1.DrawMode = DrawMode.OwnerDrawFixed ' ' Examples : ' ' Colorize only selected item: ' Colorize_Item(ListBox1, Colorize_ListBox_Items.Selected, Brushes.YellowGreen, Brushes.Black) ' ' Colorize all Non-Selected items ' Colorize_Item(ListBox1, Colorize_ListBox_Items.Non_Selected, Brushes.Red, Brushes.YellowGreen) ' ' Colorize all items: ' Colorize_Item(ListBox1, Colorize_ListBox_Items.All, Brushes.Yellow, Brushes.Yellow) ' ' Colorize any item: ' Colorize_Item(ListBox1, Colorize_ListBox_Items.None, Nothing, Nothing) ' ' Colorize specific items: ' Colorize_Item(ListBox1, {0, (ListBox1.Items.Count \ 2), (ListBox1.Items.Count - 1)}, Brushes.HotPink, Nothing) ' Stores the brush colors to paint their items Private ListBox_BackColor As Brush = Brushes.YellowGreen Private ListBox_ForeColor As Brush = Brushes.Black Private Enum ListBoxItems As Short Selected = 0 Non_Selected = 1 All = 2 None = 3 End Enum ''' <summary> ''' Colorizes the items of a ListBox. ''' </summary> ''' <param name="ListBox">Indicates the ListBox control.</param> ''' <param name="Colorize">Indicates the items to colorize them.</param> ''' <param name="BackColor">Indicates the backcolor for the colorized items.</param> ''' <param name="Forecolor">Indicates the forecolor for the colorized items.</param> Private Sub Colorize_Item(ByVal ListBox As ListBox, _ ByVal Colorize As ListBoxItems, _ ByVal BackColor As Brush, ByVal Forecolor As Brush) ' Stores the Enum value ListBox.Tag = Colorize.ToString ListBox_BackColor = BackColor ListBox_ForeColor = Forecolor End Sub ''' <summary> ''' Colorizes the items of a ListBox. ''' </summary> ''' <param name="ListBox">Indicates the ListBox control.</param> ''' <param name="Colorize">Indicates the items to colorize them.</param> ''' <param name="BackColor">Indicates the backcolor for the colorized items.</param> ''' <param name="Forecolor">Indicates the forecolor for the colorized items.</param> Private Sub Colorize_Item(ByVal ListBox As ListBox, ByVal Colorize As Integer(), ByVal BackColor As Brush, ByVal Forecolor As Brush) ' Stores the index items ListBox.Tag = String.Join(Convert.ToChar(Keys.Space), Colorize) ListBox_BackColor = BackColor ListBox_ForeColor = Forecolor End Sub ' ListBox [DrawItem] Private Sub ListBox_DrawItem(ByVal sender As Object, ByVal e As DrawItemEventArgs) _ Handles ListBox_Genres.DrawItem e.DrawBackground() Select Case sender.tag Case ListBoxItems.Selected.ToString ' Colorize Selected Items If (e.State And DrawItemState.Selected) = DrawItemState.Selected Then e.Graphics.FillRectangle(ListBox_BackColor, e.Bounds) e.Graphics.DrawString(sender.GetItemText(sender.Items(e.Index)), e.Font, ListBox_ForeColor, e.Bounds) Else Using b As New SolidBrush(e.ForeColor) e.Graphics.DrawString(sender.GetItemText(sender.Items(e.Index)), e.Font, b, e.Bounds) End Using End If Case ListBoxItems.Non_Selected.ToString ' Colorize Non-Selected Items If (e.State And DrawItemState.Selected) = DrawItemState.None Then e.Graphics.FillRectangle(ListBox_BackColor, e.Bounds) e.Graphics.DrawString(sender.GetItemText(sender.Items(e.Index)), e.Font, ListBox_ForeColor, e.Bounds) Else Using b As New SolidBrush(e.ForeColor) e.Graphics.DrawString(sender.GetItemText(sender.Items(e.Index)), e.Font, b, e.Bounds) End Using End If Case ListBoxItems.All.ToString ' Colorize all e.Graphics.FillRectangle(ListBox_BackColor, e.Bounds) e.Graphics.DrawString(sender.GetItemText(sender.Items(e.Index)), e.Font, ListBox_ForeColor, e.Bounds) Case ListBoxItems.None.ToString ' Colorize none Using b As New SolidBrush(ListBox.DefaultBackColor) e.Graphics.FillRectangle(b, e.Bounds) End Using Using b As New SolidBrush(ListBox.DefaultForeColor) e.Graphics.DrawString(sender.GetItemText(sender.Items(e.Index)), e.Font, b, e.Bounds) End Using Case Else ' Colorize at specific index If Not String.IsNullOrEmpty(sender.tag) _ AndAlso sender.tag.ToString.Split.Contains(CStr(e.Index)) Then e.Graphics.FillRectangle(ListBox_BackColor, e.Bounds) e.Graphics.DrawString(sender.GetItemText(sender.Items(e.Index)), e.Font, ListBox_ForeColor, e.Bounds) Else Using b As New SolidBrush(e.ForeColor) e.Graphics.DrawString(sender.GetItemText(sender.Items(e.Index)), e.Font, b, e.Bounds) End Using End If End Select e.DrawFocusRectangle() End Sub #End Region
Otro snippet que he extendido, para ordenar los los items de un ListView: ''' <summary> ''' Sorts the column content of a ListView. ''' </summary> ''' <param name="LV">Indicates the ListView to sort.</param> ''' <param name="Column">Indicates the columnd to index.</param> ''' <param name="Order">Indicates the sort order.</param> Private Sub SortListView(ByVal LV As ListView, ByVal Column As Integer, ByVal Order As SortOrder) LV.ListViewItemSorter = New ListViewSorter(Column, Order) LV.Sort() End Sub ' ListView [ColumnClick] Private Sub ListView_ColumnClick(ByVal sender As Object, ByVal e As ColumnClickEventArgs) _ Handles ListView1.ColumnClick If String.IsNullOrEmpty(sender.Columns.Item(0).Tag) Then sender.Columns.Item(0).Tag = SortOrder.Ascending.ToString Else sender.Columns.Item(0).Tag = [Enum].GetValues(GetType(SortOrder)). Cast(Of Integer). Where(Function(n) n <> [Enum].Parse(GetType(SortOrder), sender.Columns.Item(0).Tag)). First() End If SortListView(sender, e.Column, [Enum].Parse(GetType(SortOrder), sender.Columns.Item(0).Tag)) End Sub #Region " ListViewSorter " Public Class ListViewSorter : Implements IComparer Private ColumnIndex As Integer Private SortOrder As SortOrder Public Sub New(ByVal ColumnIndex As Integer, ByVal SortOrder As SortOrder) Me.ColumnIndex = ColumnIndex Me.SortOrder = SortOrder End Sub Public Function Sort(ByVal x As Object, ByVal y As Object) As Integer _ Implements IComparer.Compare Dim item_x As ListViewItem = DirectCast(x, ListViewItem) Dim item_y As ListViewItem = DirectCast(y, ListViewItem) Dim string_x As String Dim string_y As String string_x = If(Not item_x.SubItems.Count <= ColumnIndex, item_x.SubItems(ColumnIndex).Text, "") string_y = If(Not item_y.SubItems.Count <= ColumnIndex, item_y.SubItems(ColumnIndex).Text, "") Select Case SortOrder Case SortOrder.Ascending If Double.TryParse(string_x, New Double) AndAlso Double.TryParse(string_y, New Double) Then Return Double.Parse(string_x).CompareTo(Double.Parse(string_y)) ElseIf Date.TryParse(string_x, New Date) AndAlso Date.TryParse(string_y, New Date) Then Return DateTime.Parse(string_x).CompareTo(DateTime.Parse(string_y)) Else Return String.Compare(string_x, string_y, False) End If Case Else If Double.TryParse(string_x, New Double) AndAlso Double.TryParse(string_y, New Double) Then Return Double.Parse(string_y).CompareTo(Double.Parse(string_x)) ElseIf Date.TryParse(string_x, New Date) AndAlso Date.TryParse(string_y, New Date) Then Return DateTime.Parse(string_y).CompareTo(DateTime.Parse(string_x)) Else Return String.Compare(string_y, string_x, False) End If End Select End Function End Class #End Region
|
|
|
En línea
|
|
|
|
Eleкtro
Ex-Staff
Desconectado
Mensajes: 9.874
|
Elektro Listbox, un ListBox User Control para WindowsForms. Características: · Estado ReadOnly, al activarse no se podrá seleccionar ningún item, pero a diferencia del estado Disabled se podrá seguir usando la scrollbar. · Propiedades para especificar un color para los items seleccionados/deseleccionados en diferentes estados (Enabled / Disabled / ReadOnly) · Método para seleccionar múltiples items sin saltar a la posición del item como sucede con el ListBox por defecto. · Método para comprobar si existen duplicados en los items. · Método para eliminar los items duplicados. · Método para Seleccionar/Deseleccionar todos los items de una vez. Una imagen: Que lo disfruteis. EDITO: Código extendido y mejorado. ' /* *\ ' |#* Elektro ListBox *#| ' \* *************** */ ' ' // By Elektro H@cker ' ' ----------- ' Properties: ' ----------- ' ' ReadOnly ' ReadOnly_Enabled_Cursor ' ReadOnly_Disabled_Cursor ' State_Enabled_ItemSelected_BackColor ' State_Enabled_ItemSelected_ForeColor ' State_Enabled_ItemUnselected_BackColor ' State_Enabled_ItemUnselected_ForeColor ' State_Disabled_ItemSelected_BackColor ' State_Disabled_ItemSelected_ForeColor ' State_Disabled_ItemUnselected_BackColor ' State_Disabled_ItemUnselected_ForeColor ' State_ReadOnly_ItemSelected_BackColor ' State_ReadOnly_ItemSelected_ForeColor ' State_ReadOnly_ItemUnselected_BackColor ' State_ReadOnly_ItemUnselected_ForeColor ' ' -------- ' Methods: ' -------- ' ' HasDuplicatedItems ' RemoveDuplicatedItems ' SetSelected_WithoutJump ' MoveItem ' ' ------- ' Events: ' ------- ' ' ReadOnlyChanged Public Class ElektroListBox : Inherits ListBox #Region " Members " #Region " Variables " ''' <summary> ''' Indicates the BackColor to paint the selected ListBox items when the ListBox is enabled. ''' </summary> Private _State_Enabled_ItemSelected_BackColor As SolidBrush = New SolidBrush(ListBox.DefaultBackColor) ''' <summary> ''' Indicates the ForeColor to paint the selected ListBox items when the ListBox is enabled. ''' </summary> Private _State_Enabled_ItemSelected_ForeColor As SolidBrush = New SolidBrush(ListBox.DefaultForeColor) ''' <summary> ''' Indicates the BackColor to paint the unselected ListBox items when the ListBox is enabled. ''' </summary> Private _State_Enabled_ItemUnselected_BackColor As SolidBrush = New SolidBrush(ListBox.DefaultBackColor) ''' <summary> ''' Indicates the Forecolor to paint the unselected ListBox items when the ListBox is enabled. ''' </summary> Private _State_Enabled_ItemUnselected_ForeColor As SolidBrush = New SolidBrush(ListBox.DefaultForeColor) ''' <summary> ''' Indicates the BackColor to paint the selected ListBox items when the ListBox is disabled. ''' </summary> Private _State_Disabled_ItemSelected_BackColor As SolidBrush = New SolidBrush(ListBox.DefaultBackColor) ''' <summary> ''' Indicates the Forecolor to paint the selected ListBox items when the ListBox is disabled. ''' </summary> Private _State_Disabled_ItemSelected_ForeColor As SolidBrush = New SolidBrush(ListBox.DefaultForeColor) ''' <summary> ''' Indicates the BackColor to paint the unselected ListBox items when the ListBox is disabled. ''' </summary> Private _State_Disabled_ItemUnselected_BackColor As SolidBrush = New SolidBrush(ListBox.DefaultBackColor) ''' <summary> ''' Indicates the Forecolor to paint the unselected ListBox items when the ListBox is disabled. ''' </summary> Private _State_Disabled_ItemUnselected_ForeColor As SolidBrush = New SolidBrush(ListBox.DefaultForeColor) ''' <summary> ''' Indicates the BackColor to paint the selected ListBox items when the ListBox is ReadOnly. ''' </summary> Private _State_ReadOnly_ItemSelected_BackColor As SolidBrush = New SolidBrush(ListBox.DefaultBackColor) ''' <summary> ''' Indicates the Forecolor to paint the selected ListBox items when the ListBox is ReadOnly. ''' </summary> Private _State_ReadOnly_ItemSelected_ForeColor As SolidBrush = New SolidBrush(ListBox.DefaultForeColor) ''' <summary> ''' Indicates the BackColor to paint the unselected ListBox items when the ListBox is ReadOnly. ''' </summary> Private _State_ReadOnly_ItemUnselected_BackColor As SolidBrush = New SolidBrush(ListBox.DefaultBackColor) ''' <summary> ''' Indicates the Forecolor to paint the unselected ListBox items when the ListBox is ReadOnly. ''' </summary> Private _State_ReadOnly_ItemUnselected_ForeColor As SolidBrush = New SolidBrush(ListBox.DefaultForeColor) ''' <summary> ''' Stores a value indicating whether the Listbox is in ReadOnly mode. ''' </summary> Private _ReadOnly As Boolean = False ''' <summary> ''' Stores the Cursor to use when the ListBox enters to ReadOnly mode. ''' </summary> Private _ReadOnly_Enabled_Cursor As Cursor = Cursors.No ''' <summary> ''' Stores the Cursor to use when the ListBox exits from ReadOnly mode. ''' </summary> Private _ReadOnly_Disabled_Cursor As Cursor = Cursors.Default #End Region #Region " Properties " ''' <summary> ''' Indicates the BackColor to paint the selected ListBox items when the ListBox is enabled. ''' </summary> Public Property State_Enabled_ItemSelected_BackColor As Color Get Return _State_Enabled_ItemSelected_BackColor.Color End Get Set(value As Color) If Not _State_Enabled_ItemSelected_BackColor.Color = value Then _State_Enabled_ItemSelected_BackColor = New SolidBrush(value) Me.Invalidate(False) End If End Set End Property ''' <summary> ''' Indicates the ForeColor to paint the selected ListBox items when the ListBox is enabled. ''' </summary> Public Property State_Enabled_ItemSelected_ForeColor As Color Get Return _State_Enabled_ItemSelected_ForeColor.Color End Get Set(value As Color) If Not _State_Enabled_ItemSelected_ForeColor.Color = value Then _State_Enabled_ItemSelected_ForeColor = New SolidBrush(value) Me.Invalidate(False) End If End Set End Property ''' <summary> ''' Indicates the BackColor to paint the unselected ListBox items when the ListBox is enabled. ''' </summary> Public Property State_Enabled_ItemUnselected_BackColor As Color Get Return _State_Enabled_ItemUnselected_BackColor.Color End Get Set(value As Color) If Not _State_Enabled_ItemUnselected_BackColor.Color = value Then _State_Enabled_ItemUnselected_BackColor = New SolidBrush(value) Me.Invalidate(False) End If End Set End Property ''' <summary> ''' Indicates the Forecolor to paint the unselected ListBox items when the ListBox is enabled. ''' </summary> Public Property State_Enabled_ItemUnselected_ForeColor As Color Get Return _State_Enabled_ItemUnselected_ForeColor.Color End Get Set(value As Color) If Not _State_Enabled_ItemUnselected_ForeColor.Color = value Then _State_Enabled_ItemUnselected_ForeColor = New SolidBrush(value) Me.Invalidate(False) End If End Set End Property ''' <summary> ''' Indicates the BackColor to paint the selected ListBox items when the ListBox is disabled. ''' </summary> Public Property State_Disabled_ItemSelected_BackColor As Color Get Return _State_Disabled_ItemSelected_BackColor.Color End Get Set(value As Color) If Not _State_Disabled_ItemSelected_BackColor.Color = value Then _State_Disabled_ItemSelected_BackColor = New SolidBrush(value) Me.Invalidate(False) End If End Set End Property ''' <summary> ''' Indicates the Forecolor to paint the selected ListBox items when the ListBox is disabled. ''' </summary> Public Property State_Disabled_ItemSelected_ForeColor As Color Get Return _State_Disabled_ItemSelected_ForeColor.Color End Get Set(value As Color) If Not _State_Disabled_ItemSelected_ForeColor.Color = value Then _State_Disabled_ItemSelected_ForeColor = New SolidBrush(value) Me.Invalidate(False) End If End Set End Property ''' <summary> ''' Indicates the BackColor to paint the unselected ListBox items when the ListBox is disabled. ''' </summary> Public Property State_Disabled_ItemUnselected_BackColor As Color Get Return _State_Disabled_ItemUnselected_BackColor.Color End Get Set(value As Color) If Not _State_Disabled_ItemUnselected_BackColor.Color = value Then _State_Disabled_ItemUnselected_BackColor = New SolidBrush(value) Me.Invalidate(False) End If End Set End Property ''' <summary> ''' Indicates the Forecolor to paint the unselected ListBox items when the ListBox is disabled. ''' </summary> Public Property State_Disabled_ItemUnselected_ForeColor As Color Get Return _State_Disabled_ItemUnselected_ForeColor.Color End Get Set(value As Color) If Not _State_Disabled_ItemUnselected_ForeColor.Color = value Then _State_Disabled_ItemUnselected_ForeColor = New SolidBrush(value) Me.Invalidate(False) End If End Set End Property ''' <summary> ''' Indicates the BackColor to paint the selected ListBox items when the ListBox is ReadOnly. ''' </summary> Public Property State_ReadOnly_ItemSelected_BackColor As Color Get Return _State_ReadOnly_ItemSelected_BackColor.Color End Get Set(value As Color) If Not _State_ReadOnly_ItemSelected_BackColor.Color = value Then _State_ReadOnly_ItemSelected_BackColor = New SolidBrush(value) Me.Invalidate(False) End If End Set End Property ''' <summary> ''' Indicates the Forecolor to paint the selected ListBox items when the ListBox is ReadOnly. ''' </summary> Public Property State_ReadOnly_ItemSelected_ForeColor As Color Get Return _State_ReadOnly_ItemSelected_ForeColor.Color End Get Set(value As Color) If Not _State_ReadOnly_ItemSelected_ForeColor.Color = value Then _State_ReadOnly_ItemSelected_ForeColor = New SolidBrush(value) Me.Invalidate(False) End If End Set End Property ''' <summary> ''' Indicates the BackColor to paint the unselected ListBox items when the ListBox is ReadOnly. ''' </summary> Public Property State_ReadOnly_ItemUnselected_BackColor As Color Get Return _State_ReadOnly_ItemUnselected_BackColor.Color End Get Set(value As Color) If Not _State_ReadOnly_ItemUnselected_BackColor.Color = value Then _State_ReadOnly_ItemUnselected_BackColor = New SolidBrush(value) Me.Invalidate(False) End If End Set End Property ''' <summary> ''' Indicates the Forecolor to paint the unselected ListBox items when the ListBox is ReadOnly. ''' </summary> Public Property State_ReadOnly_ItemUnselected_ForeColor As Color Get Return _State_ReadOnly_ItemUnselected_ForeColor.Color End Get Set(value As Color) If Not _State_ReadOnly_ItemUnselected_ForeColor.Color = value Then _State_ReadOnly_ItemUnselected_ForeColor = New SolidBrush(value) Me.Invalidate(False) End If End Set End Property ''' <summary> ''' Gets or sets a value indicating whether the Listbox is in ReadOnly mode. ''' </summary> Public Property [ReadOnly]() As Boolean Get Return _ReadOnly End Get Set(value As Boolean) If Not _ReadOnly = value Then _ReadOnly = value RaiseEvent ReadOnlyChanged(Me, New ReadOnlyChangedEventArgs With {.IsReadOnly = value}) End If End Set End Property ''' <summary> ''' Gets or sets the Cursor to use when the ListBox enters in ReadOnly mode. ''' </summary> Public Property ReadOnly_Enabled_Cursor As Cursor Get Return _ReadOnly_Enabled_Cursor End Get Set(value As Cursor) If Not _ReadOnly_Enabled_Cursor = value Then _ReadOnly_Enabled_Cursor = value DesignTimeInvalidator(False) End If End Set End Property ''' <summary> ''' Gets or sets the Cursor to use when the ListBox exits from ReadOnly mode. ''' </summary> Public Property ReadOnly_Disabled_Cursor As Cursor Get Return _ReadOnly_Disabled_Cursor End Get Set(value As Cursor) If Not _ReadOnly_Disabled_Cursor = value Then _ReadOnly_Disabled_Cursor = value DesignTimeInvalidator(False) End If End Set End Property #End Region #Region " Enumerations " ''' <summary> ''' Indicates the state of a Listbox Item. ''' </summary> Public Enum ItemState ''' <summary> ''' Select the listbox Item. ''' </summary> Selected = 0 ''' <summary> ''' Unselect the listbox Item. ''' </summary> Unselected = 1 End Enum ''' <summary> ''' Indicates the items to select. ''' </summary> Public Enum ListBoxItems As Short ''' <summary> ''' Select all items of the ListBox. ''' </summary> All = 1 ''' <summary> ''' Select any ListBox items. ''' </summary> None = 2 End Enum ''' <summary> ''' Indicates some Known Windows Message Identifiers to manage. ''' </summary> Private Enum KnownMessages As Integer WM_LBUTTONDOWN = &H201 WM_KEYDOWN = &H100 End Enum #End Region #Region " Events " ''' <summary> ''' Event raised when the ReadOnly state of the ListBox changes. ''' </summary> Private Event ReadOnlyChanged As EventHandler(Of ReadOnlyChangedEventArgs) Private Class ReadOnlyChangedEventArgs : Inherits EventArgs Public Property IsReadOnly As Boolean End Class #End Region #End Region #Region " Constructor " Public Sub New() Me.DoubleBuffered = True Me.DrawMode = DrawMode.OwnerDrawFixed End Sub #End Region #Region " Public Methods " ''' <summary> ''' Returns a value indicating whether the ListBox items contains duplicates. ''' </summary> Public Function HasDuplicatedItems() As Boolean Return Me.Items.Count - Me.Items.Cast(Of String).Distinct().Count End Function ''' <summary> ''' Remove all duplicated items in ListBox. ''' </summary> Public Sub RemoveDuplicatedItems() If HasDuplicatedItems() Then Dim ItemArray As IEnumerable(Of String) = Me.Items.Cast(Of String).Distinct() Me.Items.Clear() Me.Items.AddRange(ItemArray.ToArray) End If End Sub ''' <summary> ''' Selects or unselects a ListBox Item without jumping to the Item position. ''' </summary> ''' <param name="ItemIndex">Indicates the index of the Item to set.</param> ''' <param name="ItemState">Indicates the state for the item.</param> Public Sub SetSelected_WithoutJump(ItemIndex As Integer, ItemState As ItemState) Dim i As Integer = Me.TopIndex ' Store the selected item index. Me.BeginUpdate() ' Disable drawing on control. Me.SetSelected(ItemIndex, ItemState) ' Select the item. Me.TopIndex = i ' Jump to the previous selected item. Me.EndUpdate() ' Eenable drawing. End Sub ''' <summary> ''' Selects or unselects ListBox Items without jumping to the Item position. ''' </summary> ''' <param name="ItemIndex">Indicates the index of the Items to set.</param> ''' <param name="ItemState">Indicates the state for the items.</param> Public Sub SetSelected_WithoutJump(ItemIndex As Integer(), ItemState As ItemState) Dim i As Integer = Me.TopIndex ' Store the selected item index. Me.BeginUpdate() ' Disable drawing on control. For Each Index As Integer In ItemIndex Select Case ItemState Case ItemState.Selected Me.SetSelected(Index, True) ' Select the item. Case ItemState.Unselected Me.SetSelected(Index, False) ' Unselect the item. End Select Next Index Me.TopIndex = i ' Jump to the previous selected item. Me.EndUpdate() ' Eenable drawing. End Sub ''' <summary> ''' Selects or unselects all ListBox Item without jumping to the Item position. ''' </summary> ''' <param name="ListBoxItems">Indicates the Items to set.</param> ''' <param name="ItemState">Indicates the state for the items.</param> Public Sub SetSelected_WithoutJump(ListBoxItems As ListBoxItems, ItemState As ItemState) Dim i As Integer = Me.TopIndex ' Store the selected item index. Me.BeginUpdate() ' Disable drawing on control. Select Case ItemState Case ItemState.Selected ' Select all the items. For Item As Integer = 0 To Me.Items.Count - 1 Me.SetSelected(Item, True) Next Item Case ItemState.Unselected ' Unselect all the items. Me.SelectedItems.Clear() End Select Me.TopIndex = i ' Jump to the previous selected item. Me.EndUpdate() ' Eenable drawing. End Sub ''' <summary> ''' Moves an item to other position. ''' </summary> ''' <param name="ItemPosition">Indicates the position to move from.</param> ''' <param name="NewItemPosition">Indicates the new position for the item.</param> Public Sub MoveItem(ByVal ItemPosition As Integer, ByVal NewItemPosition As Integer) Dim oldItem As Object = Me.Items.Item(ItemPosition) Dim newItem As Object = Me.Items.Item(NewItemPosition) Me.Items.Item(ItemPosition) = newItem Me.Items.Item(NewItemPosition) = oldItem End Sub #End Region #Region " Private Methods " ''' <summary> ''' Invalidates the Control to update changes at Design-Time. ''' </summary> ''' <param name="InvalidateChildren">Indicates whether to invalidate the child controls of the control.</param> Private Sub DesignTimeInvalidator(InvalidateChildren As Boolean) If Me.DesignMode Then Me.Invalidate(InvalidateChildren) End If End Sub #End Region #Region " Event Handlers " ''' <summary> ''' This happens when the ListBox 'ReadOnly' state has changed. ''' </summary> Private Sub OnReadOnly() _ Handles Me.ReadOnlyChanged Me.BeginUpdate() If Me.ReadOnly Then Me.Cursor = _ReadOnly_Enabled_Cursor Else Me.Cursor = _ReadOnly_Disabled_Cursor End If Me.EndUpdate() End Sub ''' <summary> ''' Colorize the ListBox Items. ''' </summary> Private Sub Colorize(ByVal sender As Object, ByVal e As DrawItemEventArgs) _ Handles Me.DrawItem If Me.Items.Count <> 0 Then If Me.Enabled AndAlso Not Me.ReadOnly Then e.DrawBackground() If (e.State And DrawItemState.Selected) = DrawItemState.Selected Then e.Graphics.FillRectangle(_State_Enabled_ItemSelected_BackColor, e.Bounds) e.Graphics.DrawString(Me.GetItemText(Me.Items(e.Index)), e.Font, _State_Enabled_ItemSelected_ForeColor, e.Bounds) ElseIf (e.State And DrawItemState.Selected) = DrawItemState.None Then e.Graphics.FillRectangle(_State_Enabled_ItemUnselected_BackColor, e.Bounds) e.Graphics.DrawString(Me.GetItemText(Me.Items(e.Index)), e.Font, _State_Enabled_ItemUnselected_ForeColor, e.Bounds) End If e.DrawFocusRectangle() ElseIf Not Me.Enabled Then e.DrawBackground() If (e.State And DrawItemState.Selected) = DrawItemState.Selected Then e.Graphics.FillRectangle(_State_Disabled_ItemSelected_BackColor, e.Bounds) e.Graphics.DrawString(Me.GetItemText(Me.Items(e.Index)), e.Font, _State_Disabled_ItemSelected_ForeColor, e.Bounds) ElseIf (e.State And DrawItemState.Selected) = DrawItemState.None Then e.Graphics.FillRectangle(_State_Disabled_ItemUnselected_BackColor, e.Bounds) e.Graphics.DrawString(Me.GetItemText(Me.Items(e.Index)), e.Font, _State_Disabled_ItemUnselected_ForeColor, e.Bounds) End If e.DrawFocusRectangle() ElseIf Me.ReadOnly Then e.DrawBackground() If (e.State And DrawItemState.Selected) = DrawItemState.Selected Then e.Graphics.FillRectangle(_State_ReadOnly_ItemSelected_BackColor, e.Bounds) e.Graphics.DrawString(Me.GetItemText(Me.Items(e.Index)), e.Font, _State_ReadOnly_ItemSelected_ForeColor, e.Bounds) ElseIf (e.State And DrawItemState.Selected) = DrawItemState.None Then e.Graphics.FillRectangle(_State_ReadOnly_ItemUnselected_BackColor, e.Bounds) e.Graphics.DrawString(Me.GetItemText(Me.Items(e.Index)), e.Font, _State_ReadOnly_ItemUnselected_ForeColor, e.Bounds) End If e.DrawFocusRectangle() End If End If End Sub #End Region #Region " Windows Messages " ''' <summary> ''' Processes the Windows Messages for this window. ''' </summary> Protected Overrides Sub WndProc(ByRef m As Message) If Me.[ReadOnly] AndAlso (m.Msg = KnownMessages.WM_LBUTTONDOWN OrElse m.Msg = KnownMessages.WM_KEYDOWN) Then Return ' Disable left click on the ListBox. End If MyBase.WndProc(m) End Sub #End Region End Class
|
|
« Última modificación: 19 Diciembre 2013, 12:37 pm por ElektroSoft »
|
En línea
|
|
|
|
Eleкtro
Ex-Staff
Desconectado
Mensajes: 9.874
|
Una nueva versión actualizada de mi Helper Class para manejar hotkeys globales. ' *********************************************************************** ' Author : Elektro ' Created : 01-09-2014 ' Modified : 01-11-2014 ' *********************************************************************** ' <copyright file="GlobalHotkeys.vb" company="Elektro Studios"> ' Copyright (c) Elektro Studios. All rights reserved. ' </copyright> ' *********************************************************************** #Region " Usage Examples " 'Public Class Form1 ' ''' <summary> ' ''' Define the system-wide hotkey object. ' ''' </summary> ' Private WithEvents Hotkey As GlobalHotkey = Nothing ' ''' <summary> ' ''' Initializes a new instance of this class. ' ''' </summary> ' Public Sub New() ' InitializeComponent() ' ' Registers a new global hotkey on the system. (Alt + Ctrl + A) ' Hotkey = New GlobalHotkey(GlobalHotkey.KeyModifier.Alt Or GlobalHotkey.KeyModifier.Ctrl, Keys.A) ' ' Replaces the current registered hotkey with a new one. (Alt + Escape) ' Hotkey = New GlobalHotkey([Enum].Parse(GetType(GlobalHotkey.KeyModifier), "Alt", True), ' [Enum].Parse(GetType(Keys), "Escape", True)) ' ' Set the tag property. ' Hotkey.Tag = "I'm an example tag" ' End Sub ' ''' <summary> ' ''' Handles the Press event of the HotKey object. ' ''' </summary> ' Private Sub HotKey_Press(ByVal sender As GlobalHotkey, ByVal e As GlobalHotkey.HotKeyEventArgs) _ ' Handles Hotkey.Press ' MsgBox(e.Count) ' The times that the hotkey was pressed. ' MsgBox(e.ID) ' The unique hotkey identifier. ' MsgBox(e.Key.ToString) ' The assigned key. ' MsgBox(e.Modifier.ToString) ' The assigned key-modifier. ' MsgBox(sender.Tag) ' The hotkey tag object. ' ' Unregister the hotkey. ' Hotkey.Unregister() ' ' Register it again. ' Hotkey.Register() ' ' Is Registered? ' MsgBox(Hotkey.IsRegistered) ' End Sub 'End Class #End Region #Region " Imports " Imports System.ComponentModel Imports System.Runtime.InteropServices #End Region #Region " Global Hotkey " ''' <summary> ''' Class to perform system-wide hotkey operations. ''' </summary> Friend NotInheritable Class GlobalHotkey : Inherits NativeWindow : Implements IDisposable #Region " API " ''' <summary> ''' Native API Methods. ''' </summary> Private Class NativeMethods ''' <summary> ''' Defines a system-wide hotkey. ''' </summary> ''' <param name="hWnd">The hWND.</param> ''' <param name="id">The identifier of the hotkey. ''' If the hWnd parameter is NULL, then the hotkey is associated with the current thread rather than with a particular window. ''' If a hotkey already exists with the same hWnd and id parameters.</param> ''' <param name="fsModifiers">The keys that must be pressed in combination with the key specified by the uVirtKey parameter ''' in order to generate the WM_HOTKEY message. ''' The fsModifiers parameter can be a combination of the following values.</param> ''' <param name="vk">The virtual-key code of the hotkey.</param> ''' <returns> ''' <c>true</c> if the function succeeds, otherwise <c>false</c> ''' </returns> <DllImport("user32.dll", SetLastError:=True)> Public Shared Function RegisterHotKey( ByVal hWnd As IntPtr, ByVal id As Integer, ByVal fsModifiers As UInteger, ByVal vk As UInteger ) As <MarshalAs(UnmanagedType.Bool)> Boolean End Function ''' <summary> ''' Unregisters a hotkey previously registered. ''' </summary> ''' <param name="hWnd">The hWND.</param> ''' <param name="id">The identifier of the hotkey to be unregistered.</param> ''' <returns> ''' <c>true</c> if the function succeeds, otherwise <c>false</c> ''' </returns> <DllImport("user32.dll", SetLastError:=True)> Public Shared Function UnregisterHotKey( ByVal hWnd As IntPtr, ByVal id As Integer ) As <MarshalAs(UnmanagedType.Bool)> Boolean End Function End Class #End Region #Region " Members " #Region " Properties " ''' <summary> ''' Indicates the key assigned to the hotkey. ''' </summary> Public ReadOnly Property Key As Keys Get Return Me.PressEventArgs.Key End Get End Property ''' <summary> ''' Indicates the Key-Modifier assigned to the hotkey. ''' </summary> Public ReadOnly Property Modifier As KeyModifier Get Return Me.PressEventArgs.Modifier End Get End Property ''' <summary> ''' Indicates the unique identifier assigned to the hotkey. ''' </summary> Public ReadOnly Property ID As Integer Get Return Me.PressEventArgs.ID End Get End Property ''' <summary> ''' Indicates user-defined data associated with this object. ''' </summary> Public Property Tag As Object = Nothing ''' <summary> ''' Indicates how many times was pressed the hotkey. ''' </summary> Public ReadOnly Property Count As Integer Get Return _Count End Get End Property #End Region #Region " Enumerations " ''' <summary> ''' Key-modifiers to assign to a hotkey. ''' </summary> <Flags> Public Enum KeyModifier As Integer ''' <summary> ''' Any modifier. ''' </summary> None = &H0 ''' <summary> ''' The Alt key. ''' </summary> Alt = &H1 ''' <summary> ''' The Control key. ''' </summary> Ctrl = &H2 ''' <summary> ''' The Shift key. ''' </summary> Shift = &H4 ''' <summary> ''' The Windows key. ''' </summary> Win = &H8 End Enum ''' <summary> ''' Known Windows Message Identifiers. ''' </summary> <Description("Messages to process in WndProc")> Public Enum KnownMessages As Integer ''' <summary> ''' Posted when the user presses a hot key registered by the RegisterHotKey function. ''' The message is placed at the top of the message queue associated with the thread that registered the hot key. ''' <paramref name="WParam"/> ''' The identifier of the hot key that generated the message. ''' If the message was generated by a system-defined hot key. ''' <paramref name="LParam"/> ''' The low-order word specifies the keys that were to be pressed in ''' combination with the key specified by the high-order word to generate the WM_HOTKEY message. ''' </summary> WM_HOTKEY = &H312 End Enum #End Region #Region " Events " ''' <summary> ''' Event that is raised when a hotkey is pressed. ''' </summary> Public Event Press As EventHandler(Of HotKeyEventArgs) ''' <summary> ''' Event arguments for the Press event. ''' </summary> Public Class HotKeyEventArgs : Inherits EventArgs ''' <summary> ''' Indicates the Key assigned to the hotkey. ''' </summary> ''' <value>The key.</value> Friend Property Key As Keys ''' <summary> ''' Indicates the Key-Modifier assigned to the hotkey. ''' </summary> ''' <value>The modifier.</value> Friend Property Modifier As KeyModifier ''' <summary> ''' Indicates the unique identifier assigned to the hotkey. ''' </summary> ''' <value>The identifier.</value> Friend Property ID As Integer ''' <summary> ''' Indicates how many times was pressed the hotkey. ''' </summary> Friend Property Count As Integer End Class #End Region #Region " Exceptions " ''' <summary> ''' Exception that is thrown when a hotkey tries to register but is already registered. ''' </summary> <Serializable> Private Class IsRegisteredException : Inherits Exception ''' <summary> ''' Initializes a new instance of the <see cref="IsRegisteredException"/> class. ''' </summary> Sub New() MyBase.New("Unable to register. Hotkey is already registered.") End Sub End Class ''' <summary> ''' Exception that is thrown when a hotkey tries to unregister but is not registered. ''' </summary> <Serializable> Private Class IsNotRegisteredException : Inherits Exception ''' <summary> ''' Initializes a new instance of the <see cref="IsNotRegisteredException"/> class. ''' </summary> Sub New() MyBase.New("Unable to unregister. Hotkey is not registered.") End Sub End Class #End Region #Region " Other " ''' <summary> ''' Stores an counter indicating how many times was pressed the hotkey. ''' </summary> Private _Count As Integer = 0 ''' <summary> ''' Stores the Press Event Arguments. ''' </summary> Protected PressEventArgs As New HotKeyEventArgs #End Region #End Region #Region " Constructor " ''' <summary> ''' Creates a new system-wide hotkey. ''' </summary> ''' <param name="Modifier"> ''' Indicates the key-modifier to assign to the hotkey. ''' ( Can use one or more modifiers ) ''' </param> ''' <param name="Key"> ''' Indicates the key to assign to the hotkey. ''' </param> ''' <exception cref="IsRegisteredException"></exception> <DebuggerStepperBoundary()> Public Sub New(ByVal Modifier As KeyModifier, ByVal Key As Keys) MyBase.CreateHandle(New CreateParams) Me.PressEventArgs.ID = MyBase.GetHashCode() Me.PressEventArgs.Key = Key Me.PressEventArgs.Modifier = Modifier Me.PressEventArgs.Count = 0 If Not NativeMethods.RegisterHotKey(MyBase.Handle, Me.ID, Me.Modifier, Me.Key) Then Throw New IsRegisteredException End If End Sub #End Region #Region " Event Handlers " ''' <summary> ''' Occurs when a hotkey is pressed. ''' </summary> Private Sub OnHotkeyPress() Handles Me.Press _Count += 1 End Sub #End Region #Region "Public Methods " ''' <summary> ''' Determines whether this hotkey is registered on the system. ''' </summary> ''' <returns> ''' <c>true</c> if this hotkey is registered; otherwise, <c>false</c>. ''' </returns> Public Function IsRegistered() As Boolean DisposedCheck() ' Try to unregister the hotkey. Select Case NativeMethods.UnregisterHotKey(MyBase.Handle, Me.ID) Case False ' Unregistration failed. Return False ' Hotkey is not registered. Case Else ' Unregistration succeeds. Register() ' Re-Register the hotkey before return. Return True ' Hotkey is registeres. End Select End Function ''' <summary> ''' Registers this hotkey on the system. ''' </summary> ''' <exception cref="IsRegisteredException"></exception> Public Sub Register() DisposedCheck() If Not NativeMethods.RegisterHotKey(MyBase.Handle, Me.ID, Me.Modifier, Me.Key) Then Throw New IsRegisteredException End If End Sub ''' <summary> ''' Unregisters this hotkey from the system. ''' After calling this method the hotkey turns unavaliable. ''' </summary> ''' <returns> ''' <c>true</c> if unregistration succeeds, <c>false</c> otherwise. ''' </returns> Public Function Unregister() As Boolean DisposedCheck() If Not NativeMethods.UnregisterHotKey(MyBase.Handle, Me.ID) Then Throw New IsNotRegisteredException End If End Function #End Region #Region " Hidden methods " ' These methods and properties are purposely hidden from Intellisense just to look better without unneeded methods. ' NOTE: The methods can be re-enabled at any-time if needed. ''' <summary> ''' Assigns the handle. ''' </summary> <EditorBrowsable(EditorBrowsableState.Never)> Public Shadows Sub AssignHandle() End Sub ''' <summary> ''' Creates the handle. ''' </summary> <EditorBrowsable(EditorBrowsableState.Never)> Public Shadows Sub CreateHandle() End Sub ''' <summary> ''' Creates the object reference. ''' </summary> <EditorBrowsable(EditorBrowsableState.Never)> Public Shadows Sub CreateObjRef() End Sub ''' <summary> ''' Definitions the WND proc. ''' </summary> <EditorBrowsable(EditorBrowsableState.Never)> Public Shadows Sub DefWndProc() End Sub ''' <summary> ''' Destroys the window and its handle. ''' </summary> <EditorBrowsable(EditorBrowsableState.Never)> Public Shadows Sub DestroyHandle() End Sub ''' <summary> ''' Equalses this instance. ''' </summary> <EditorBrowsable(EditorBrowsableState.Never)> Public Shadows Sub Equals() End Sub ''' <summary> ''' Gets the hash code. ''' </summary> <EditorBrowsable(EditorBrowsableState.Never)> Public Shadows Sub GetHashCode() End Sub ''' <summary> ''' Gets the lifetime service. ''' </summary> <EditorBrowsable(EditorBrowsableState.Never)> Public Shadows Sub GetLifetimeService() End Sub ''' <summary> ''' Initializes the lifetime service. ''' </summary> <EditorBrowsable(EditorBrowsableState.Never)> Public Shadows Sub InitializeLifetimeService() End Sub ''' <summary> ''' Releases the handle associated with this window. ''' </summary> <EditorBrowsable(EditorBrowsableState.Never)> Public Shadows Sub ReleaseHandle() End Sub ''' <summary> ''' Gets the handle for this window. ''' </summary> <EditorBrowsable(EditorBrowsableState.Never)> Public Shadows Property Handle() #End Region #Region " WndProc " ''' <summary> ''' Invokes the default window procedure associated with this window to process messages for this Window. ''' </summary> ''' <param name="m"> ''' A <see cref="T:System.Windows.Forms.Message" /> that is associated with the current Windows message. ''' </param> Protected Overrides Sub WndProc(ByRef m As Message) Select Case m.Msg Case KnownMessages.WM_HOTKEY ' A hotkey is pressed. ' Update the pressed counter. Me.PressEventArgs.Count += 1 ' Raise the Event RaiseEvent Press(Me, Me.PressEventArgs) Case Else MyBase.WndProc(m) End Select End Sub #End Region #Region " IDisposable " ''' <summary> ''' To detect redundant calls when disposing. ''' </summary> Private IsDisposed As Boolean = False ''' <summary> ''' Prevent calls to methods after disposing. ''' </summary> ''' <exception cref="System.ObjectDisposedException"></exception> Private Sub DisposedCheck() If Me.IsDisposed Then Throw New ObjectDisposedException(Me.GetType().FullName) End If End Sub ''' <summary> ''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources. ''' </summary> Public Sub Dispose() Implements IDisposable.Dispose Dispose(True) GC.SuppressFinalize(Me) End Sub ''' <summary> ''' Releases unmanaged and - optionally - managed resources. ''' </summary> ''' <param name="IsDisposing"> ''' <c>true</c> to release both managed and unmanaged resources; ''' <c>false</c> to release only unmanaged resources. ''' </param> Protected Sub Dispose(IsDisposing As Boolean) If Not Me.IsDisposed Then If IsDisposing Then NativeMethods.UnregisterHotKey(MyBase.Handle, Me.ID) End If End If Me.IsDisposed = True End Sub #End Region End Class #End Region
|
|
« Última modificación: 12 Enero 2014, 09:28 am 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,875
|
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,081
|
3 Febrero 2014, 20:19 pm
por Eleкtro
|
|
|
Librería de Snippets para Delphi
« 1 2 »
Programación General
|
crack81
|
15
|
21,151
|
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
|
|