Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Eleкtro:
Dos métodos de extensión que nos permiten, de forma simple y sencilla usado solamente una línea de código, desactivar o activar una o varias pestañas de un TabControl, lo que no se limita solamente a desactivar la página (propiedad: TabPage.Enabled), sino también a prohibir o permitir que las pestañas puedan seleccionarse en el TabControl.
Modo de empleo:
Para desactivar una o varias pestañas:
Código
TabControl1.DisableTabs(TabPage1, TabPage2)
Para (re)activar una o varias pestañas:
Código
TabControl1.EnableTabs(TabPage1, TabPage2)
El Código:
Código
Imports System.Runtime.CompilerServices
''' <summary>
''' Provides extension methods for a <see cref="TabControl"/> control.
''' </summary>
<HideModuleName>
Public Module TabControlExtensions
''' <summary>
''' Collection used to store tab pages whose tab header need to remain disabled on a <see cref="TabControl"/>.
''' <para></para>
''' This collection depends on <see cref="TabControlExtensions.DisableOrEnableTabs_Internal"/> method.
''' </summary>
Private disabledTabs As HashSet(Of TabPage)
''' <summary>
''' Collection used to store tab controls whose its <see cref="TabControl.Selecting"/> event
''' has been associated to <see cref="TabControlExtensions.disableTabPageHandler"/>.
''' <para></para>
''' This collection depends on <see cref="TabControlExtensions.DisableOrEnableTabs_Internal"/> method.
''' </summary>
Private tabHandlerAddedControls As HashSet(Of TabControl)
''' <summary>
''' A <see cref="TabControlCancelEventHandler"/> delegate used for disabling tabs on a <see cref="TabControl"/>.
''' <para></para>
''' This handler depends on <see cref="TabControlExtensions.DisableOrEnableTabs_Internal"/> method.
''' </summary>
Private tabDisablerHandler As TabControlCancelEventHandler
''' <summary>
''' Disables one or multiple <see cref="TabPage"/>,
''' making the tabs unselectable in the source <see cref="TabControl"/>.
''' </summary>
'''
''' <param name="tabControl">
''' The source <see cref="TabControl"/>.
''' </param>
'''
''' <param name="tabPages">
''' An Array of <see cref="TabPage"/> to disable.
''' </param>
<Extension>
<DebuggerStepThrough>
Public Sub DisableTabs(tabControl As TabControl, ParamArray tabPages As TabPage())
TabControlExtensions.DisableOrEnableTabs_Internal(tabControl, enabled:=False, tabPages)
End Sub
''' <summary>
''' Enables one or multiple <see cref="TabPage"/> that were previously
''' disabled by a call to <see cref="TabControlExtensions.DisableTabPages"/> method,
''' making the tabs selectable again in the source <see cref="TabControl"/>.
''' </summary>
'''
''' <param name="tabControl">
''' The source <see cref="TabControl"/>.
''' </param>
'''
''' <param name="tabPages">
''' An Array of <see cref="TabPage"/> to enable.
''' </param>
<Extension>
<DebuggerStepThrough>
Public Sub EnableTabs(tabControl As TabControl, ParamArray tabPages As TabPage())
TabControlExtensions.DisableOrEnableTabs_Internal(tabControl, enabled:=True, tabPages)
End Sub
''' <summary>
''' *** FOR INTERNAL USE ONLY ***
''' <para></para>
''' Disables or enables one or multiple <see cref="TabPage"/>,
''' denying or allowing their tab selection in the source <see cref="TabControl"/>.
''' </summary>
'''
''' <param name="tabControl">
''' The source <see cref="TabControl"/>.
''' </param>
'''
''' <param name="enabled">
''' If <see langword="False"/>, disables the tab pages and make them unselectable in the source <see cref="TabControl"/>;
''' otherwise, enable the tab pages and allows to be selected in the source <see cref="TabControl"/>.
''' </param>
'''
''' <param name="tabPages">
''' An Array of the tab pages to disable or enable.
''' </param>
<DebuggerStepThrough>
Private Sub DisableOrEnableTabs_Internal(tabControl As TabControl, enabled As Boolean, ParamArray tabPages As TabPage())
If tabControl Is Nothing Then
Throw New ArgumentNullException(paramName:=NameOf(tabControl))
End If
If tabPages Is Nothing Then
Throw New ArgumentNullException(paramName:=NameOf(tabPages))
End If
' Initialize collections.
If TabControlExtensions.disabledTabs Is Nothing Then
TabControlExtensions.disabledTabs = New HashSet(Of TabPage)
End If
If TabControlExtensions.tabHandlerAddedControls Is Nothing Then
TabControlExtensions.tabHandlerAddedControls = New HashSet(Of TabControl)
End If
' Initialize handler.
If TabControlExtensions.tabDisablerHandler Is Nothing Then
TabControlExtensions.tabDisablerHandler =
Sub(sender As Object, e As TabControlCancelEventArgs)
If e.TabPageIndex < 0 Then
Exit Sub
End If
Select Case e.Action
Case TabControlAction.Selecting, TabControlAction.Selected
e.Cancel = TabControlExtensions.disabledTabs.Contains(e.TabPage)
Case Else
Exit Sub
End Select
End Sub
End If
For Each tabPage As TabPage In tabPages
If tabPage Is Nothing Then
Throw New NullReferenceException($"{NameOf(tabPage)} object is null.")
End If
' Disable or enable the tab page.
tabPage.Enabled = enabled
If Not enabled Then ' Disable the tab header.
Dim success As Boolean = disabledTabs.Add(tabPage)
If success AndAlso Not TabControlExtensions.tabHandlerAddedControls.Contains(tabControl) Then
AddHandler tabControl.Selecting, TabControlExtensions.tabDisablerHandler
TabControlExtensions.tabHandlerAddedControls.Add(tabControl)
End If
Else ' Enable the tab header.
Dim success As Boolean = disabledTabs.Remove(tabPage)
If success AndAlso TabControlExtensions.tabHandlerAddedControls.Contains(tabControl) AndAlso
Not TabControlExtensions.disabledTabs.Any() Then
RemoveHandler tabControl.Selecting, TabControlExtensions.tabDisablerHandler
TabControlExtensions.tabHandlerAddedControls.Remove(tabControl)
End If
End If
Next tabPage
End Sub
End Module
Eleкtro:
Un método de extensión para impedir que un ToolStripMenuItem se cierre al hacer click en uno de sus items hijos.
Ejemplo de uso:
Código
Dim menuItem As ToolStripMenuItem = Me.ToolStripMenuItem1
Dim preventClosure As Boolean = True
Dim recursive As Boolean = False
menuItem.SetClosureBehaviorOnClick(preventClosure, recursive)
El código:
Código
' ***********************************************************************
' Author : ElektroStudios
' Modified : 12-April-2024
' ***********************************************************************
#Region " Public Members Summary "
' ToolStripMenuItem.SetClosureBehaviorOnClick(Boolean, Boolean)
#End Region
#Region " Option Statements "
Option Strict On
Option Explicit On
Option Infer Off
#End Region
#Region " Imports "
Imports System.Collections.Generic
Imports System.ComponentModel
Imports System.Linq
Imports System.Runtime.CompilerServices
Imports System.Windows.Forms
#End Region
#Region " ToolStripMenuItem Extensions "
Namespace DevCase.Core.Extensions
''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Provides extension methods to use with the <see cref="ToolStripMenuItem"/> class.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
<HideModuleName>
Public Module ToolStripMenuItemExtensions
#Region " Public Extension Methods "
''' <summary>
''' A <see cref="ToolStripDropDownClosingEventHandler"/> delegate used to control
''' the <see cref="ToolStripDropDown.Closing"/> event of a <see cref="ToolStripDropDown"/>.
''' <para></para>
''' This handler depends on <see cref="ToolStripMenuItemExtensions.SetClosureBehaviorOnClick"/> method.
''' </summary>
Private closingHandler As ToolStripDropDownClosingEventHandler
''' <summary>
''' A collection of <see cref="ToolStripDropDown"/> items
''' whose <see cref="ToolStripDropDown.Closing"/> event
''' has been associated to <see cref="ToolStripMenuItemExtensions.closingHandler"/>.
''' <para></para>
''' This collection depends on <see cref="ToolStripMenuItemExtensions.SetClosureBehaviorOnClick"/> method.
''' </summary>
Private closingHandlerAssociatedItems As HashSet(Of ToolStripDropDown)
''' <summary>
''' Sets the closure behavior for the source <see cref="ToolStripMenuItem"/> when its drop-down items are clicked.
''' </summary>
'''
''' <remarks>
''' This method associates the underlying
''' <see cref="ToolStripMenuItem.DropDown"/>'s <see cref="ToolStripDropDown.Closing"/> event
''' with a handler to control the closure behavior.
''' </remarks>
'''
''' <example> This is a code example.
''' <code language="VB">
''' Dim menuItem As ToolStripMenuItem = Me.ToolStripMenuItem1
''' Dim preventClosure As Boolean = True
''' Dim recursive As Boolean = True
'''
''' menuItem.SetClosureBehaviorOnClick(preventClosure, recursive)
''' </code>
''' </example>
'''
''' <param name="menuItem">
''' The <see cref="ToolStripMenuItem"/> to set the closure behavior for.
''' </param>
'''
''' <param name="preventClosure">
''' <see langword="True"/> to prevent closure of the source <see cref="ToolStripMenuItem"/>
''' when its drop-down items are clicked; otherwise, <see langword="False"/>.
''' </param>
<DebuggerStepThrough>
<Extension>
<EditorBrowsable(EditorBrowsableState.Always)>
Public Sub SetClosureBehaviorOnClick(menuItem As ToolStripMenuItem, preventClosure As Boolean, recursive As Boolean)
If menuItem Is Nothing Then
Throw New ArgumentNullException(paramName:=NameOf(menuItem))
End If
If Not menuItem.HasDropDown Then
Throw New InvalidOperationException(
"The ToolStripDropDownItem.DropDown for the ToolStripDropDownItem has not been created.")
End If
If ToolStripMenuItemExtensions.closingHandler Is Nothing Then
ToolStripMenuItemExtensions.closingHandler =
Sub(sender As Object, e As ToolStripDropDownClosingEventArgs)
e.Cancel = (e.CloseReason = ToolStripDropDownCloseReason.ItemClicked)
End Sub
End If
If ToolStripMenuItemExtensions.closingHandlerAssociatedItems Is Nothing Then
ToolStripMenuItemExtensions.closingHandlerAssociatedItems = New HashSet(Of ToolStripDropDown)
End If
Dim dropdownAction As Action(Of ToolStripDropDown) =
Sub(dropdown As ToolStripDropDown)
If preventClosure Then
If Not ToolStripMenuItemExtensions.closingHandlerAssociatedItems.Contains(dropdown) Then
AddHandler dropdown.Closing, ToolStripMenuItemExtensions.closingHandler
ToolStripMenuItemExtensions.closingHandlerAssociatedItems.Add(dropdown)
End If
Else
If ToolStripMenuItemExtensions.closingHandlerAssociatedItems.Contains(dropdown) Then
RemoveHandler dropdown.Closing, ToolStripMenuItemExtensions.closingHandler
ToolStripMenuItemExtensions.closingHandlerAssociatedItems.Remove(dropdown)
End If
End If
End Sub
Dim queue As New Queue(Of ToolStripDropDown)
' Root level items iteration.
If recursive Then
queue.Enqueue(menuItem.DropDown)
Else
If TypeOf menuItem Is ToolStripMenuItem Then
dropdownAction(menuItem.DropDown)
End If
End If
' Recursive items iteration.
While queue.Any()
Dim currentItem As ToolStripDropDown = queue.Dequeue()
dropdownAction(currentItem)
If currentItem.HasChildren Then
For Each subMenuItem As ToolStripMenuItem In currentItem.Items.OfType(Of ToolStripMenuItem)
If subMenuItem.HasDropDown Then
queue.Enqueue(subMenuItem.DropDown)
End If
Next
End If
End While
End Sub
#End Region
End Module
End Namespace
#End Region
Eleкtro:
En esta ocasión comparto el código fuente de un control de tipo NumericUpDown para poder usarlo en una barra ToolStrip o StatusStrip, y también un control de tipo TrackBar con la misma finalidad.
ToolStripNumericUpDown.vb
Código
' ***********************************************************************
' Author : ElektroStudios
' Modified : 19-April-2024
' ***********************************************************************
#Region " Option Statements "
Option Strict On
Option Explicit On
Option Infer Off
#End Region
#Region " Imports "
Imports System.ComponentModel
Imports System.Drawing
Imports System.Runtime.InteropServices
Imports System.Windows.Forms
Imports System.Windows.Forms.Design
#End Region
#Region " ToolStripNumericUpDown "
' ReSharper disable once CheckNamespace
Namespace DevCase.UI.Components
''' <summary>
''' Represents a selectable Windows spin box <see cref="ToolStripItem"/> that displays numeric values.
''' </summary>
''' <seealso cref="ToolStripControlHost"/>
<
ComVisible(True),
DebuggerStepThrough,
DefaultEvent(NameOf(ToolStripNumericUpDown.ValueChanged)),
DefaultProperty(NameOf(ToolStripNumericUpDown.Value)),
DefaultBindingProperty(NameOf(ToolStripNumericUpDown.Value)),
Description("Represents a selectable Windows spin box ToolStripItem that displays numeric values."),
Designer("System.Windows.Forms.Design.ToolStripItemDesigner, System.Design, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a"),
DesignerCategory(NameOf(DesignerCategoryAttribute.Generic)),
DesignTimeVisible(False),
DisplayName(NameOf(ToolStripNumericUpDown)),
Localizable(True),
ToolboxBitmap(GetType(NumericUpDown), "NumericUpDown.bmp"),
ToolboxItem(False),
ToolboxItemFilter("System.Windows.Forms", ToolboxItemFilterType.Allow),
ToolStripItemDesignerAvailability(ToolStripItemDesignerAvailability.ToolStrip Or ToolStripItemDesignerAvailability.StatusStrip)
>
Public Class ToolStripNumericUpDown : Inherits ToolStripControlHost
#Region " Properties "
''' <summary>
''' Gets the <see cref="NumericUpDown"/> control that is hosted by this <see cref="ToolStripNumericUpDown"/>.
''' </summary>
<
Browsable(True), EditorBrowsable(EditorBrowsableState.Advanced),
DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden),
Category("Components"), Description("The NumericUpDown control that is hosted by this control.")
>
Public Shadows ReadOnly Property Control As NumericUpDown
Get
Return DirectCast(MyBase.Control, NumericUpDown)
End Get
End Property
''' <summary>
''' Gets or sets the numeric value assigned to this <see cref="ToolStripNumericUpDown"/>.
''' </summary>
'''
''' <value>
''' The numeric value assigned to this <see cref="ToolStripNumericUpDown"/>.
''' </value>
<
Bindable(True),
DefaultValue(0D),
Category("Appearance"), Description("The numeric value assigned to this control.")
>
Public Property Value As Decimal
Get
Return Me.Control.Value
End Get
Set(value As Decimal)
Me.Control.Value = value
End Set
End Property
''' <summary>
''' Gets or sets the text to be displayed in this <see cref="ToolStripNumericUpDown"/>.
''' </summary>
'''
''' <value>
''' The text to be displayed in this <see cref="ToolStripNumericUpDown"/>.
''' </value>
<
Browsable(False), EditorBrowsable(EditorBrowsableState.Never),
Bindable(False),
DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden),
Category("Behavior"), Description("The text to be displayed in this control.")
>
Public Overrides Property Text As String
Get
Return Me.Control.Text
End Get
Set(value As String)
Me.Control.Text = value
End Set
End Property
''' <summary>
''' This property is not applicable for this control.
''' </summary>
<
Browsable(False), EditorBrowsable(EditorBrowsableState.Never),
Category("Not Applicable"), Description("This property is not applicable for this control.")
>
Public Overrides Property BackgroundImage As Image
Get
Return Nothing
End Get
Set(value As Image)
MyBase.BackgroundImage = Nothing
End Set
End Property
''' <summary>
''' This property is not applicable for this control.
''' </summary>
<
Browsable(False), EditorBrowsable(EditorBrowsableState.Never),
Category("Not Applicable"), Description("This property is not applicable for this control.")
>
Public Overrides Property BackgroundImageLayout As ImageLayout
Get
Return MyBase.BackgroundImageLayout
End Get
Set(value As ImageLayout)
MyBase.BackgroundImageLayout = value
End Set
End Property
''' <summary>
''' This property is not applicable for this control.
''' </summary>
<
Browsable(False), EditorBrowsable(EditorBrowsableState.Never),
Category("Not Applicable"), Description("This property is not applicable for this control.")
>
Public Overrides Property Image As Image
Get
Return Nothing
End Get
Set(value As Image)
MyBase.Image = Nothing
End Set
End Property
#End Region
#Region " Events "
''' <summary>
''' Occurs whenever the <see cref="ToolStripNumericUpDown.Value"/> property is changed.
''' </summary>
<
Category("Action"), Description("Occurs whenever the Value property is changed.")
>
Public Event ValueChanged As EventHandler
#End Region
#Region " Constructors "
''' <summary>
''' Initializes a new instance of the <see cref="ToolStripNumericUpDown"/> class.
''' </summary>
Public Sub New()
MyBase.New(ToolStripNumericUpDown.CreateControlInstance())
End Sub
#End Region
#Region " Event Invocators "
''' <summary>
''' Raises the <see cref="ToolStripNumericUpDown.ValueChanged"/> event.
''' </summary>
'''
''' <param name="sender">
''' The source of the event.
''' </param>
'''
''' <param name="e">
''' The <see cref="EventArgs"/> instance containing the event data.
''' </param>
Private Sub OnValueChanged(sender As Object, e As EventArgs)
If Me.ValueChangedEvent IsNot Nothing Then
RaiseEvent ValueChanged(Me, e)
End If
End Sub
#End Region
#Region " Event Invocators (Overriden) "
''' <summary>
''' Subscribes events from the hosted control
''' </summary>
'''
''' <param name="control">
''' The control from which to subscribe events.
''' </param>
Protected Overrides Sub OnSubscribeControlEvents(control As Control)
MyBase.OnSubscribeControlEvents(control)
AddHandler DirectCast(control, NumericUpDown).ValueChanged, AddressOf Me.OnValueChanged
End Sub
''' <summary>
''' Unsubscribes events from the hosted control
''' </summary>
'''
''' <param name="control">
''' The control from which to unsubscribe events.
''' </param>
Protected Overrides Sub OnUnsubscribeControlEvents(control As Control)
MyBase.OnUnsubscribeControlEvents(control)
RemoveHandler DirectCast(control, NumericUpDown).ValueChanged, AddressOf Me.OnValueChanged
End Sub
#End Region
#Region " Private Methods "
''' <summary>
''' Creates the control instance.
''' </summary>
'''
''' <returns>
''' The control.
''' </returns>
Private Shared Function CreateControlInstance() As Control
Return New NumericUpDown() With {.AutoSize = True}
End Function
#End Region
End Class
End Namespace
#End Region
ToolStripTrackBar.vb
Código
' ***********************************************************************
' Author : ElektroStudios
' Modified : 19-April-2024
' ***********************************************************************
#Region " Option Statements "
Option Strict On
Option Explicit On
Option Infer Off
#End Region
#Region " Imports "
Imports System.ComponentModel
Imports System.Drawing
Imports System.Runtime.InteropServices
Imports System.Windows.Forms
Imports System.Windows.Forms.Design
#End Region
#Region " ToolStripTrackBar "
' ReSharper disable once CheckNamespace
Namespace DevCase.UI.Components
''' <summary>
''' Represents a selectable track bar <see cref="ToolStripItem"/>.
''' </summary>
''' <seealso cref="ToolStripControlHost"/>
<
ComVisible(True),
DebuggerStepThrough,
DefaultEvent(NameOf(ToolStripTrackBar.Scroll)),
DefaultProperty(NameOf(ToolStripTrackBar.Value)),
DefaultBindingProperty(NameOf(ToolStripTrackBar.Value)),
Description("Represents a selectable track bar ToolStripItem."),
Designer("System.Windows.Forms.Design.ToolStripItemDesigner, System.Design, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a"),
DesignerCategory(NameOf(DesignerCategoryAttribute.Generic)),
DesignTimeVisible(False),
DisplayName(NameOf(ToolStripTrackBar)),
Localizable(True),
ToolboxBitmap(GetType(TrackBar), "TrackBar.bmp"),
ToolboxItem(False),
ToolboxItemFilter("System.Windows.Forms", ToolboxItemFilterType.Allow),
ToolStripItemDesignerAvailability(ToolStripItemDesignerAvailability.ToolStrip Or ToolStripItemDesignerAvailability.StatusStrip)
>
Public Class ToolStripTrackBar : Inherits ToolStripControlHost
#Region " Properties "
''' <summary>
''' Gets the <see cref="TrackBar"/> control that is hosted by this <see cref="ToolStripTrackBar"/>.
''' </summary>
<
Browsable(True), EditorBrowsable(EditorBrowsableState.Advanced),
DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden),
Category("Components"), Description("The TrackBar control that is hosted by this control.")
>
Public Shadows ReadOnly Property Control As TrackBar
Get
Return DirectCast(MyBase.Control, TrackBar)
End Get
End Property
''' <summary>
''' Gets or sets a numeric value that represents the current position of the scroll box on this <see cref="ToolStripTrackBar"/>.
''' </summary>
'''
''' <value>
''' The numeric value that represents the current position of the scroll box on this <see cref="ToolStripTrackBar"/>.
''' </value>
<
Bindable(True),
DefaultValue(0I),
Category("Behavior"), Description("The numeric value that represents the current position of the scroll box on this control.")
>
Public Property Value As Integer
Get
Return Me.Control.Value
End Get
Set(value As Integer)
Me.Control.Value = value
End Set
End Property
''' <summary>
''' Gets or sets the lower limit of the range this <see cref="ToolStripTrackBar"/> is working with.
''' </summary>
'''
''' <value>
''' The minimum value for this <see cref="ToolStripTrackBar"/>. The default is 0.
''' </value>
<
Bindable(True),
DefaultValue(0I),
RefreshProperties(RefreshProperties.All),
Category("Behavior"), Description("The minimum value for this control.")
>
Public Property Minimum As Integer
Get
Return Me.Control.Minimum
End Get
Set(value As Integer)
Me.Control.Minimum = value
End Set
End Property
''' <summary>
''' Gets or sets the upper limit of the range this <see cref="ToolStripTrackBar"/> is working with.
''' </summary>
'''
''' <value>
''' The maximum value for this <see cref="ToolStripTrackBar"/>. The default is 10.
''' </value>
<
Bindable(True),
DefaultValue(10I),
RefreshProperties(RefreshProperties.All),
Category("Behavior"), Description("The maximum value for this control.")
>
Public Property Maximum As Integer
Get
Return Me.Control.Maximum
End Get
Set(value As Integer)
Me.Control.Maximum = value
End Set
End Property
''' <summary>
''' This property is not applicable for this control.
''' </summary>
<
Browsable(False), EditorBrowsable(EditorBrowsableState.Never),
Category("Not Applicable"), Description("This property is not applicable for this control.")
>
Public Overrides Property BackgroundImage As Image
Get
Return Nothing
End Get
Set(value As Image)
MyBase.BackgroundImage = Nothing
End Set
End Property
''' <summary>
''' This property is not applicable for this control.
''' </summary>
<
Browsable(False), EditorBrowsable(EditorBrowsableState.Never),
Category("Not Applicable"), Description("This property is not applicable for this control.")
>
Public Overrides Property BackgroundImageLayout As ImageLayout
Get
Return MyBase.BackgroundImageLayout
End Get
Set(value As ImageLayout)
MyBase.BackgroundImageLayout = value
End Set
End Property
''' <summary>
''' This property is not applicable for this control.
''' </summary>
<
Browsable(False), EditorBrowsable(EditorBrowsableState.Never),
Category("Not Applicable"), Description("This property is not applicable for this control.")
>
Public Overrides Property Image As Image
Get
Return Nothing
End Get
Set(value As Image)
MyBase.Image = Nothing
End Set
End Property
#End Region
#Region " Events "
''' <summary>
''' Occurs when either a mouse or keyboard action moves the scroll box.
''' </summary>
<
Category("Behavior"), Description("Occurs when either a mouse or keyboard action moves the scroll box.")
>
Public Event Scroll As EventHandler
''' <summary>
''' Occurs when the <see cref="ToolStripTrackBar.Value"/> property changes,
''' either by movement of the scroll box or by manipulation in code.
''' </summary>
<
Category("Action"), Description("Occurs when the Value property changes, either by movement of the scroll box or by manipulation in code.")
>
Public Event ValueChanged As EventHandler
#End Region
#Region " Constructors "
''' <summary>
''' Initializes a new instance of the <see cref="ToolStripTrackBar"/> class.
''' </summary>
Public Sub New()
MyBase.New(ToolStripTrackBar.CreateControlInstance())
End Sub
#End Region
#Region " Event Invocators "
''' <summary>
''' Raises the <see cref="ToolStripTrackBar.Scroll"/> event.
''' </summary>
'''
''' <param name="sender">
''' The source of the event.
''' </param>
'''
''' <param name="e">
''' The <see cref="EventArgs"/> instance containing the event data.
''' </param>
Private Sub OnScroll(sender As Object, e As EventArgs)
If Me.ScrollEvent IsNot Nothing Then
RaiseEvent Scroll(Me, e)
End If
End Sub
''' <summary>
''' Raises the <see cref="ToolStripTrackBar.Scroll"/> event.
''' </summary>
'''
''' <param name="sender">
''' The source of the event.
''' </param>
'''
''' <param name="e">
''' The <see cref="EventArgs"/> instance containing the event data.
''' </param>
Private Sub OnValueChanged(sender As Object, e As EventArgs)
If Me.ValueChangedEvent IsNot Nothing Then
RaiseEvent ValueChanged(Me, e)
End If
End Sub
#End Region
#Region " Event Invocators (Overriden) "
''' <summary>
''' Subscribes events from the hosted control
''' </summary>
'''
''' <param name="control">
''' The control from which to subscribe events.
''' </param>
Protected Overrides Sub OnSubscribeControlEvents(control As Control)
MyBase.OnSubscribeControlEvents(control)
AddHandler DirectCast(control, TrackBar).Scroll, AddressOf Me.OnScroll
AddHandler DirectCast(control, TrackBar).ValueChanged, AddressOf Me.OnValueChanged
End Sub
''' <summary>
''' Unsubscribes events from the hosted control
''' </summary>
'''
''' <param name="control">
''' The control from which to unsubscribe events.
''' </param>
Protected Overrides Sub OnUnsubscribeControlEvents(control As Control)
MyBase.OnUnsubscribeControlEvents(control)
RemoveHandler DirectCast(control, TrackBar).Scroll, AddressOf Me.OnScroll
RemoveHandler DirectCast(control, TrackBar).ValueChanged, AddressOf Me.Onvaluechanged
End Sub
#End Region
#Region " Private Methods "
''' <summary>
''' Creates the control instance.
''' </summary>
'''
''' <returns>
''' The control.
''' </returns>
Private Shared Function CreateControlInstance() As Control
Using ts As New ToolStrip()
Return New TrackBar() With {
.AutoSize = False,
.Size = New Size(80, ts.Height)
}
End Using
End Function
#End Region
End Class
End Namespace
#End Region
Eleкtro:
El siguiente código es un ejemplo oficial de Microsoft que sirve para modificar el fondo de pantalla (wallpaper) del escritorio.
El código está escrito originalmente en C#, lo he convertido a VB.NET, pero no lo he refactorizado, lo comparto tal cual.
Modo de empleo:
Código
Dim supportJpgAsWallpaper As Boolean = Wallpaper.SupportJpgAsWallpaper
Dim supportFitFillWallpaperStyles As Boolean = Wallpaper.SupportFitFillWallpaperStyles
Debug.WriteLine($"{NameOf(supportJpgAsWallpaper)}: {supportJpgAsWallpaper}")
Debug.WriteLine($"{NameOf(supportFitFillWallpaperStyles)}: {supportFitFillWallpaperStyles}")
' If supportJpgAsWallpaper AndAlso supportFitFillWallpaperStyles Then
Wallpaper.SetDesktopWallpaper("C:\wallpaper.jpg", WallpaperStyle.Fill)
' Else
' ...
' End If
Wallpaper.vb
Código
Imports Microsoft.Win32
Imports System.ComponentModel
Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.IO
Imports System.Runtime.InteropServices
'''********************************* Module Header ***********************************\
'''Module Name: Wallpaper.cs
'''Project: CSSetDesktopWallpaper
'''Copyright (c) Microsoft Corporation.
'''
'''The file defines a wallpaper helper class.
'''
''' Wallpaper.SetDesktopWallpaper(string fileName, WallpaperStyle style)
'''
'''This is the key method that sets the desktop wallpaper. The method body is composed of
'''configuring the wallpaper style in the registry and setting the wallpaper with
'''SystemParametersInfo.
'''
'''This source is subject to the Microsoft Public License.
'''See http://www.microsoft.com/opensource/licenses.mspx#Ms-PL.
'''All other rights reserved.
'''
'''THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
'''EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
'''MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
'''\************************************************************************************
Public Module Wallpaper
''' <summary>
''' Determine if the fit and fill wallpaper styles are supported in
''' the current operating system. The styles are not supported before
''' Windows 7.
''' </summary>
Public ReadOnly Property SupportFitFillWallpaperStyles As Boolean
Get
Return (Environment.OSVersion.Version >= New Version(6, 1))
End Get
End Property
''' <summary>
''' Determine if .jpg files are supported as wallpaper in the current
''' operating system. The .jpg wallpapers are not supported before
''' Windows Vista.
''' </summary>
Public ReadOnly Property SupportJpgAsWallpaper As Boolean
Get
Return (Environment.OSVersion.Version >= New Version(6, 0))
End Get
End Property
''' <summary>
''' Set the desktop wallpaper.
''' </summary>
''' <param name="fileName">Path of the wallpaper</param>
''' <param name="style">Wallpaper style</param>
Public Sub SetDesktopWallpaper(path As String, style As WallpaperStyle)
' Set the wallpaper style and tile.
' Two registry values are set in the Control Panel\Desktop key.
' TileWallpaper
' 0: The wallpaper picture should not be tiled
' 1: The wallpaper picture should be tiled
' WallpaperStyle
' 0: The image is centered if TileWallpaper=0 or tiled if TileWallpaper=1
' 2: The image is stretched to fill the screen
' 6: The image is resized to fit the screen while maintaining the aspect
' ratio. (Windows 7 and later)
' 10: The image is resized and cropped to fill the screen while
' maintaining the aspect ratio. (Windows 7 and later)
Dim key As RegistryKey = Registry.CurrentUser.OpenSubKey("Control Panel\Desktop", True)
Select Case style
Case WallpaperStyle.Tile
key.SetValue("WallpaperStyle", "0")
key.SetValue("TileWallpaper", "1")
Case WallpaperStyle.Center
key.SetValue("WallpaperStyle", "0")
key.SetValue("TileWallpaper", "0")
Case WallpaperStyle.Stretch
key.SetValue("WallpaperStyle", "2")
key.SetValue("TileWallpaper", "0")
Case WallpaperStyle.Fit ' (Windows 7 and later)
key.SetValue("WallpaperStyle", "6")
key.SetValue("TileWallpaper", "0")
Case WallpaperStyle.Fill ' (Windows 7 and later)
key.SetValue("WallpaperStyle", "10")
key.SetValue("TileWallpaper", "0")
End Select
key.Close()
' If the specified image file is neither .bmp nor .jpg, - or -
' if the image is a .jpg file but the operating system is Windows Server
' 2003 or Windows XP/2000 that does not support .jpg as the desktop
' wallpaper, convert the image file to .bmp and save it to the
' %appdata%\Microsoft\Windows\Themes folder.
Dim ext As String = System.IO.Path.GetExtension(path)
If (Not ext.Equals(".bmp", StringComparison.OrdinalIgnoreCase) AndAlso Not ext.Equals(".jpg", StringComparison.OrdinalIgnoreCase)) OrElse (ext.Equals(".jpg", StringComparison.OrdinalIgnoreCase) AndAlso Not SupportJpgAsWallpaper) Then
Using image As Image = System.Drawing.Image.FromFile(path)
path = String.Format("{0}\Microsoft\Windows\Themes\{1}.bmp", Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData), System.IO.Path.GetFileNameWithoutExtension(path))
image.Save(path, ImageFormat.Bmp)
End Using
End If
' Set the desktop wallpapaer by calling the NativeMethods API SystemParametersInfo
' with the SPI_SETDESKWALLPAPER desktop parameter. The changes should
' persist, and also be immediately visible.
If Not SafeNativeMethods.SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, path, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE) Then
Throw New Win32Exception()
End If
End Sub
Friend NotInheritable Class SafeNativeMethods
<DllImport("user32.dll", CharSet:=CharSet.Unicode, SetLastError:=True)>
Public Shared Function SystemParametersInfo(uiAction As UInteger, uiParam As UInteger, pvParam As String, fWinIni As UInteger) As <MarshalAs(UnmanagedType.Bool)> Boolean
End Function
End Class
Private Const SPI_SETDESKWALLPAPER As UInteger = 20
Private Const SPIF_UPDATEINIFILE As UInteger = &H1
Private Const SPIF_SENDWININICHANGE As UInteger = &H2
End Module
Public Enum WallpaperStyle
Tile
Center
Stretch
Fit
Fill
End Enum
Eleкtro:
El siguiente código es un módulo por nombre 'Wildcard' que representa un algoritmo de coincidencia de cadenas con uso de comodines * (wildcards). Sirve como alternativa al operador Like de VB.NET.
Ejemplo de uso:
Código
Dim input As String = "Hello World!"
Dim pattern As String = "*e*l*o *!"
Console.WriteLine($"{NameOf(Wildcard.IsMatch)} {Wildcard.IsMatch(input, pattern)}")
El código lo he extraído del código fuente de la aplicación "RomyView" escrita en C#:
https://drive.google.com/drive/folders/1BGKnttu1RbOpA-liID69IXYdW0lRd9nD?usp=sharinghttps://psycodedeveloper.wordpress.com/2019/08/02/all-the-c-source-code-of-the-last-few-articles-and-then-some/
Lo he convertido a VB.NET de forma automática, y lo comparto tal cual, sin modificaciones ni adiciones. Lo he probado con varias cadenas y combinaciones de patrones de comodines, y parece funcionar a la perfección.
Wildcard.vb
Código
''' <summary>The IsMatch function below was downloaded from:
''' <a href="https://www.c-sharpcorner.com/uploadfile/b81385/efficient-string-matching-algorithm-with-use-of-wildcard-characters/">
''' Efficient String Matching Algorithm with Use of Wildcard Characters</a></summary>
Public Module Wildcard
''' <summary>Tests whether specified string can be matched against provided pattern string, where
''' the pattern string may contain wildcards as follows: ? to replace any single character, and *
''' to replace any string.</summary>
''' <param name="input">String which is matched against the pattern.</param>
''' <param name="pattern">Pattern against which string is matched.</param>
''' <returns>true if <paramref name="pattern"/> matches the string <paramref name="input"/>; otherwise false.</returns>
Public Function IsMatch(input As String, pattern As String) As Boolean
Return IsMatch(input, pattern, "?"c, "*"c)
End Function
''' <summary>Tests whether specified string can be matched against provided pattern string.
''' Pattern may contain single- and multiple-replacing wildcard characters.</summary>
''' <param name="input">String which is matched against the pattern.</param>
''' <param name="pattern">Pattern against which string is matched.</param>
''' <param name="singleWildcard">Character which can be used to replace any single character in input string.</param>
''' <param name="multipleWildcard">Character which can be used to replace zero or more characters in input string.</param>
''' <returns>true if <paramref name="pattern"/> matches the string <paramref name="input"/>; otherwise false.</returns>
Public Function IsMatch(input As String, pattern As String, singleWildcard As Char, multipleWildcard As Char) As Boolean
Dim inputPosStack(((input.Length + 1) * (pattern.Length + 1)) - 1) As Integer ' Stack containing input positions that should be tested for further matching
Dim patternPosStack(inputPosStack.Length - 1) As Integer ' Stack containing pattern positions that should be tested for further matching
Dim stackPos As Integer = -1 ' Points to last occupied entry in stack; -1 indicates that stack is empty
Dim pointTested()() As Boolean = {
New Boolean(input.Length) {},
New Boolean(pattern.Length) {}
}
Dim inputPos As Integer = 0 ' Position in input matched up to the first multiple wildcard in pattern
Dim patternPos As Integer = 0 ' Position in pattern matched up to the first multiple wildcard in pattern
' Match beginning of the string until first multiple wildcard in pattern
Do While inputPos < input.Length AndAlso patternPos < pattern.Length AndAlso pattern.Chars(patternPos) <> multipleWildcard AndAlso (input.Chars(inputPos) = pattern.Chars(patternPos) OrElse pattern.Chars(patternPos) = singleWildcard)
inputPos += 1
patternPos += 1
Loop
' Push this position to stack if it points to end of pattern or to a general wildcard
If patternPos = pattern.Length OrElse pattern.Chars(patternPos) = multipleWildcard Then
pointTested(0)(inputPos) = True
pointTested(1)(patternPos) = True
stackPos += 1
inputPosStack(stackPos) = inputPos
patternPosStack(stackPos) = patternPos
End If
Dim matched As Boolean = False
' Repeat matching until either string is matched against the pattern or no more parts remain on stack to test
Do While stackPos >= 0 AndAlso Not matched
inputPos = inputPosStack(stackPos) ' Pop input and pattern positions from stack
patternPos = patternPosStack(stackPos) ' Matching will succeed if rest of the input string matches rest of the pattern
stackPos -= 1
If inputPos = input.Length AndAlso patternPos = pattern.Length Then
matched = True ' Reached end of both pattern and input string, hence matching is successful
Else
' First character in next pattern block is guaranteed to be multiple wildcard
' So skip it and search for all matches in value string until next multiple wildcard character is reached in pattern
For curInputStart As Integer = inputPos To input.Length - 1
Dim curInputPos As Integer = curInputStart
Dim curPatternPos As Integer = patternPos + 1
If curPatternPos = pattern.Length Then ' Pattern ends with multiple wildcard, hence rest of the input string is matched with that character
curInputPos = input.Length
Else
Do While curInputPos < input.Length AndAlso curPatternPos < pattern.Length AndAlso pattern.Chars(curPatternPos) <> multipleWildcard AndAlso (input.Chars(curInputPos) = pattern.Chars(curPatternPos) OrElse pattern.Chars(curPatternPos) = singleWildcard)
curInputPos += 1
curPatternPos += 1
Loop
End If
' If we have reached next multiple wildcard character in pattern without breaking the matching sequence, then we have another candidate for full match
' This candidate should be pushed to stack for further processing
' At the same time, pair (input position, pattern position) will be marked as tested, so that it will not be pushed to stack later again
If ((curPatternPos = pattern.Length AndAlso curInputPos = input.Length) OrElse (curPatternPos < pattern.Length AndAlso pattern.Chars(curPatternPos) = multipleWildcard)) AndAlso Not pointTested(0)(curInputPos) AndAlso Not pointTested(1)(curPatternPos) Then
pointTested(0)(curInputPos) = True
pointTested(1)(curPatternPos) = True
stackPos += 1
inputPosStack(stackPos) = curInputPos
patternPosStack(stackPos) = curPatternPos
End If
Next curInputStart
End If
Loop
Return matched
End Function
End Module
Navegación
[#] Página Siguiente
[*] Página Anterior