Tema: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets) (Leído 529,365 veces)
Eleкtro
Ex-Staff
Desconectado
Mensajes: 9.878
Una función genérica para agregar un item a un array de 2 dimensiones
#Region " Add Item Array 2D "
' [ Add Item Array 2D ]
'
' // By Elektro H@cker
'
' Examples :
'
'// Create an Array 2D (2,2)
' Dim MyArray As String(,) = {{"Item 0,0", "Item 0,1"}, {"Item 1,0", "Item 1,1"}, {"Item 2,0", "Item 2,1"}}
'// Add an Item
' Add_Item_Array_2D(MyArray, {"Item 3,0", "Item 3,1"})
Private Sub Add_Item_Array_2D( ByRef Array_2D As String ( ,) , _
ByVal Items As String ( ) )
Dim tmp_array( Array_2D.GetUpperBound ( 0 ) + 1 , Array_2D.GetUpperBound ( 1 ) ) As String
For x As Integer = 0 To Array_2D.GetUpperBound ( 0 )
tmp_array( x, 0 ) = Array_2D( x, 0 )
tmp_array( x, 1 ) = Array_2D( x, 1 )
Next
For x As Integer = 0 To Items.Count - 1
tmp_array( tmp_array.GetUpperBound ( 0 ) , x) = Items( x)
Next
Array_2D = tmp_array
End Sub
#End Region
Un ejemplo de como ordenar un documento XML según un elemento dado:
#Region " Sort XML By Element "
' [ Sort XML By Element ]
'
' // By Elektro H@cker
'
' Example usage :
' Dim XML As XDocument = Sort_XML_By_Element(XDocument.Load("C:\File.xml"), "Song", "Name")
' Example XML File:
'
'<?xml version="1.0" encoding="Windows-1252"?>
'<Songs>
' <Song><Name>My Song 2.mp3</Name><Year>2007</Year></Song>
' <Song><Name>My Song 1.mp3</Name><Year>2009</Year></Song>
' <Song><Name>My Song 3.mp3</Name><Year>2008</Year></Song>
'</Songs>
' Example output:
'
'<?xml version="1.0" encoding="Windows-1252"?>
'<Songs>
' <Song><Name>My Song 1.mp3</Name><Year>2009</Year></Song>
' <Song><Name>My Song 2.mp3</Name><Year>2007</Year></Song>
' <Song><Name>My Song 3.mp3</Name><Year>2008</Year></Song>
'</Songs>
Private Function Sort_XML_By_Element( ByVal XML As XDocument, _
ByVal Root_Element As String , _
ByVal Element_to_sort As String ) As XDocument
Dim xdoc As XDocument
Try
xdoc = XML
xdoc.Root .ReplaceNodes ( XML.Root .Elements ( Root_Element) _
.OrderBy ( Function ( sort) sort.Element ( Element_to_sort) .Value ) )
Return xdoc
Catch ex As Exception
Throw New Exception( ex.Message )
Finally
xdoc = Nothing
End Try
End Function
#End Region
Un ejemplo de como convertir los elementos de un documento XML a un type anónimo:
#Region " Convert XML to Anonymous Type "
'Dim xml As XDocument = XDocument.Load(xmlfile)
Dim xml As XDocument = _
<?xml version= "1.0" encoding= "Windows-1252" ?>
<!-- XML Songs Database.-- >
<Songs>
<Song><Name>My Song 1 .mp3 </ Name><Year>2007 </ Year><Genre>Dance</ Genre><Bitrate>320 </ Bitrate><Length>04:55 </ Length><Size>4 ,80 </ Size></ Song>
<Song><Name>My Song 2 .mp3 </ Name><Year>2009 </ Year><Genre>Electro</ Genre><Bitrate>192 </ Bitrate><Length>06:44 </ Length><Size>8 ,43 </ Size></ Song>
<Song><Name>My Song 3 .mp3 </ Name><Year>2008 </ Year><Genre>UK Hardcore</ Genre><Bitrate>128 </ Bitrate><Length>05:12 </ Length><Size>4 ,20 </ Size></ Song>
</ Songs>
Dim SongsList = From song In xml.<Songs>.<Song>
Select New With { _
song.<Name>.Value ,
song.<Year>.Value ,
song.<Genre>.Value ,
song.<Bitrate>.Value ,
song.<Length>.Value ,
song.<Size>.Value _
}
For Each song In SongsList
MsgBox ( String .Format ( "Name:{1}{0}Year:{2}{0}Genre:{3}{0}Bitrate:{4}{0}Length:{5}{0}Size:{6}" , _
Environment.NewLine , _
song.Name , song.Year , song.Genre , song.Bitrate , song.Length , song.Size ) )
' Output:
'
'Name:My Song 1.mp3
'Year:2007
'Genre:Dance
'Bitrate:320
'Length:04:55
'Size:4,80
Next
#End Region
Un ejemplo de como convertir los elementos de un documento XML a Tuplas
#Region " Convert XML to IEnumerable(Of Tuple) "
'Dim xml As XDocument = XDocument.Load(xmlfile)
Dim xml As XDocument = _
<?xml version= "1.0" encoding= "Windows-1252" ?>
<!-- XML Songs Database.-- >
<Songs>
<Song><Name>My Song 1 .mp3 </ Name><Year>2007 </ Year><Genre>Dance</ Genre><Bitrate>320 </ Bitrate><Length>04:55 </ Length><Size>4 ,80 </ Size></ Song>
<Song><Name>My Song 2 .mp3 </ Name><Year>2009 </ Year><Genre>Electro</ Genre><Bitrate>192 </ Bitrate><Length>06:44 </ Length><Size>8 ,43 </ Size></ Song>
<Song><Name>My Song 3 .mp3 </ Name><Year>2008 </ Year><Genre>UK Hardcore</ Genre><Bitrate>128 </ Bitrate><Length>05:12 </ Length><Size>4 ,20 </ Size></ Song>
</ Songs>
Dim SongsList As IEnumerable( Of Tuple( Of String , String , String , String , String , String ) ) = _
From song In xml.<Songs>.<Song>
Select Tuple.Create ( _
song.<Name>.Value ,
song.<Year>.Value ,
song.<Genre>.Value ,
song.<Bitrate>.Value ,
song.<Length>.Value ,
song.<Size>.Value _
)
For Each song In SongsList
MsgBox ( String .Format ( "Name:{1}{0}Year:{2}{0}Genre:{3}{0}Bitrate:{4}{0}Length:{5}{0}Size:{6}" , _
Environment.NewLine , _
song.Item1 , song.Item2 , song.Item3 , song.Item4 , song.Item5 , song.Item6 ) )
' Output:
'
'Name:My Song 1.mp3
'Year:2007
'Genre:Dance
'Bitrate:320
'Length:04:55
'Size:4,80
Next
#End Region
Un ejemplo de como usar Arrays 2D
' Create Array 2D (2,2)
Dim MyArray As String ( ,) = { { "Item 0,0" , "Item 0,1" } , { "Item 1,0" , "Item 1,1" } , { "Item 2,0" , "Item 2,1" } }
' Set value
MyArray( 0 , 1 ) = "New Item 0,1"
' Get Value
MsgBox ( MyArray( 0 , 1 ) )
' Loop over the Array 2D
For x As Integer = 0 To MyArray.GetUpperBound ( 0 )
MsgBox ( String .Format ( "Array 2D {1},0: {2}{0}Array 2D {1},1: {3}" , Environment.NewLine , _
x, MyArray( x, 0 ) , MyArray( x, 1 ) ) )
Next
Un ejemplo de como crear un Type propio:
Public Class Type1
Private _Name As String
Private _Age As Short
Public Property Name( ) As String
Get
Return _Name
End Get
Set ( ByVal value As String )
_Name = value
End Set
End Property
Public Property Age( ) As Short
Get
Return _Age
End Get
Set ( ByVal value As Short)
_Age = value
End Set
End Property
End Class
'Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'
' ' Create a list of our own Type and add Elements:
' Dim Contacts As New List(Of Type1) From { _
' New Type1 With {.Name = "Lucia", .Age = 19}, _
' New Type1 With {.Name = "Pepe", .Age = 40} _
' }
'
' ' Add another Element
' Contacts.Add(New Type1 With {.Name = "Pablo", .Age = 32})
'
' ' Find an Element:
' Dim Contact As Type1 = Contacts.Find(Function(x) x.Name = "Lucia")
'
' ' Display Element members:
' MsgBox(String.Format("Name: {1}{0}Age: {2}", _
' Environment.NewLine, _
' Contact.Name, Contact.Age))
'
' ' Loop over all Elements:
' For Each Element As Type1 In Contacts
' MsgBox(String.Format("Name: {1}{0}Age: {2}", _
' Environment.NewLine, _
' Element.Name, Element.Age))
' Next
'
'End Sub
Una función genérica para obtener el serial de la CPU
(Este snippet fue de los primeros que posteé, le he dado un repaso al código)
#Region " Get CPU ID "
' [ Get CPU ID ]
'
'// By Elektro H@cker
'
' INSTRUCTIONS:
' 1. Add a reference to "System.Management"
'
' Examples :
' Dim ProcID As String = Get_CPU_ID()
' MsgBox(Get_CPU_ID())
Private Function Get_CPU_ID( ) As String
Dim wmi As Management.ManagementObjectSearcher = _
New Management.ManagementObjectSearcher ( "select * from Win32_Processor" )
Dim val As String = wmi.Get ( 0 ) ( "ProcessorID" )
wmi.Dispose ( )
Return val .ToString
End Function
#End Region
Una función genérica para obtener el serial de la placa base
(Este snippet fue de los primeros que posteé, le he dado un repaso al código)
#Region " Get Motherboard ID "
' [ Get Motherboard ID ]
'
'// By Elektro H@cker
'
' INSTRUCTIONS:
' 1. Add a reference to "System.Management"
'
' Examples :
' Dim MotherID As String = Get_Motherboard_ID()
' MsgBox(Get_Motherboard_ID())
Private Function Get_Motherboard_ID( ) As String
Dim wmi As Management.ManagementObjectSearcher = _
New Management.ManagementObjectSearcher ( "select * from Win32_BaseBoard" )
Dim val As String = wmi.Get ( 0 ) ( "SerialNumber" )
wmi.Dispose ( )
Return val
End Function
#End Region
Y por último, unos ejemplos muy sencillos de como manejar un documento XML (sencillo)...
(Uso un XMLTextWritter en lugar de un XMLWriter por la libertad de indentación)
' [ Song XML Writer Helper ]
'
' // By Elektro H@cker
'
' Example usage :
'
'Private Sub Test()
'
' ' Set an XML file to create
' Dim xmlfile As String = "C:\My XML File.xml"
'
' ' Create the XmlWriter object
' Dim XmlWriter As Xml.XmlTextWriter = _
' New Xml.XmlTextWriter(xmlfile, System.Text.Encoding.Default) _
' With {.Formatting = Xml.Formatting.Indented}
'
' ' Write the Xml declaration.
' XMLHelper.Write_Beginning(XmlWriter)
' ' Output at this point:
' ' <?xml version="1.0" encoding="Windows-1252"?>
'
' ' Write a comment.
' XMLHelper.Write_Comment(XmlWriter, "XML Songs Database", Xml.Formatting.Indented)
' ' Output at this point:
' ' <!--XML Songs Database-->
'
' ' Write the root element.
' XMLHelper.Write_Beginning_Root_Element(XmlWriter, "Songs", Xml.Formatting.Indented)
' ' Output at this point:
' ' <Songs>
'
' ' Write the start of a song element.
' XMLHelper.Write_Beginning_Root_Element(XmlWriter, "Song", Xml.Formatting.Indented)
' ' Output at this point:
' ' <Song>
'
' ' Write a song element.
' XMLHelper.Write_Elements(XmlWriter, { _
' {"Name", "My Song file.mp3"}, _
' {"Year", "2013"}, _
' {"Genre", "Rock"} _
' }, Xml.Formatting.None)
' ' Output at this point:
' ' <Name>My Song file.mp3</Name><Year>2007</Year><Genre>Dance</Genre>
'
' ' Write the end of a song element.
' XMLHelper.Write_End_Root_Element(XmlWriter, Xml.Formatting.None)
' ' Output at this point:
' ' </Song>
'
' ' Write the end of the Root element.
' XMLHelper.Write_End_Root_Element(XmlWriter, Xml.Formatting.Indented)
' ' Output at this point:
' ' </Songs>
'
' ' Write the xml end of file.
' XMLHelper.Write_End(XmlWriter)
'
' ' Start the file and exit
' Process.Start(xmlfile) : Application.Exit()
'
' ' Final output:
' '
' '<?xml version="1.0" encoding="Windows-1252"?>
' '<!--XML Songs Database-->
' '<Songs>
' ' <Song><Name>My Song file.mp3</Name><Year>2007</Year><Genre>Dance</Genre></Song>
' '</Songs>
'
'End Sub
#Region " XML Helper "
Class XMLHelper
''' <summary>
''' Writes the Xml beginning declaration.
''' </summary>
Shared Sub Write_Beginning( ByVal XmlWriter As Xml.XmlTextWriter )
Try
XmlWriter.WriteStartDocument ( )
Catch ex As InvalidOperationException
Dim errormsg As String = "This is not the first write method called after the constructor. "
Throw New Exception( errormsg & Environment.NewLine & ex.StackTrace )
' MessageBox.Show(errormsg)
Catch ex As Exception
Throw New Exception( ex.Message & Environment.NewLine & ex.StackTrace )
End Try
End Sub
''' <summary>
''' Writes a comment.
''' </summary>
Shared Sub Write_Comment( ByVal XmlWriter As Xml.XmlTextWriter , _
ByVal Comment As String , _
Optional ByVal Indentation As Xml.Formatting = Xml.Formatting .Indented )
Try
XmlWriter.Formatting = Indentation
XmlWriter.WriteComment ( Comment)
XmlWriter.Formatting = Not Indentation
Catch ex As ArgumentException
Dim errormsg As String = "The text would result in a non-well formed XML document"
Throw New Exception( errormsg & Environment.NewLine & ex.StackTrace )
' MessageBox.Show(errormsg)
Catch ex As InvalidOperationException
Dim errormsg As String = "The " "WriteState" " property is Closed"
Throw New Exception( errormsg & Environment.NewLine & ex.StackTrace )
' MessageBox.Show(errormsg)
Catch ex As Exception
Throw New Exception( ex.Message & Environment.NewLine & ex.StackTrace )
End Try
End Sub
''' <summary>
''' Writes the beginning of a root element.
''' </summary>
Shared Sub Write_Beginning_Root_Element( ByVal XmlWriter As Xml.XmlTextWriter , _
ByVal Element As String , _
Optional ByVal Indentation As Xml.Formatting = Xml.Formatting .Indented )
Try
XmlWriter.Formatting = Indentation
XmlWriter.WriteStartElement ( Element)
XmlWriter.Formatting = Not Indentation
Catch ex As System.Text .EncoderFallbackException
Dim errormsg As String = "There is a character in the buffer that is a valid XML character but is not valid for the output encoding."
Throw New Exception( errormsg & Environment.NewLine & ex.StackTrace )
' MessageBox.Show(errormsg)
Catch ex As InvalidOperationException
Dim errormsg As String = "The XmlTextWriter is closed or An XmlTextWriter method was called before a previous asynchronous operation finished."
Throw New Exception( errormsg & Environment.NewLine & ex.StackTrace )
' MessageBox.Show(errormsg)
Catch ex As Exception
Throw New Exception( ex.Message & Environment.NewLine & ex.StackTrace )
End Try
End Sub
''' <summary>
''' Writes the end of a root element.
''' </summary>
Shared Sub Write_End_Root_Element( ByVal XmlWriter As Xml.XmlTextWriter , _
Optional ByVal Indentation As Xml.Formatting = Xml.Formatting .Indented )
Try
XmlWriter.Formatting = Indentation
XmlWriter.WriteEndElement ( )
XmlWriter.Formatting = Not Indentation
Catch ex As System.Text .EncoderFallbackException
Dim errormsg As String = "There is a character in the buffer that is a valid XML character but is not valid for the output encoding."
Throw New Exception( errormsg & Environment.NewLine & ex.StackTrace )
' MessageBox.Show(errormsg)
Catch ex As InvalidOperationException
Dim errormsg As String = "The XmlTextWriter is closed or An XmlTextWriter method was called before a previous asynchronous operation finished."
Throw New Exception( errormsg & Environment.NewLine & ex.StackTrace )
' MessageBox.Show(errormsg)
Catch ex As Exception
Throw New Exception( ex.Message & Environment.NewLine & ex.StackTrace )
End Try
End Sub
''' <summary>
''' Writes an element.
''' </summary>
Shared Sub Write_Element( ByVal XmlWriter As Xml.XmlTextWriter , _
ByVal StartElement As String , _
ByVal Element As String , _
Optional ByVal Indentation As Xml.Formatting = Xml.Formatting .Indented )
Try
XmlWriter.Formatting = Indentation
XmlWriter.WriteStartElement ( StartElement)
XmlWriter.WriteString ( Element)
XmlWriter.WriteEndElement ( )
XmlWriter.Formatting = Not Indentation
Catch ex As System.Text .EncoderFallbackException
Dim errormsg As String = "There is a character in the buffer that is a valid XML character but is not valid for the output encoding."
Throw New Exception( errormsg & Environment.NewLine & ex.StackTrace )
' MessageBox.Show(errormsg)
Catch ex As InvalidOperationException
Dim errormsg As String = "The XmlTextWriter is closed or An XmlTextWriter method was called before a previous asynchronous operation finished."
Throw New Exception( errormsg & Environment.NewLine & ex.StackTrace )
' MessageBox.Show(errormsg)
Catch ex As Exception
Throw New Exception( ex.Message & Environment.NewLine & ex.StackTrace )
End Try
End Sub
''' <summary>
''' Writes multiple elements.
''' </summary>
Shared Sub Write_Elements( ByVal XmlWriter As Xml.XmlTextWriter , _
ByVal Elements As String ( ,) , _
Optional ByVal Indentation As Xml.Formatting = Xml.Formatting .Indented )
Try
XmlWriter.Formatting = Indentation
For x As Integer = 0 To Elements.GetUpperBound ( 0 )
XmlWriter.WriteStartElement ( Elements( x, 0 ) )
XmlWriter.WriteString ( Elements( x, 1 ) )
XmlWriter.WriteEndElement ( )
Next
XmlWriter.Formatting = Not Indentation
Catch ex As System.Text .EncoderFallbackException
Dim errormsg As String = "There is a character in the buffer that is a valid XML character but is not valid for the output encoding."
Throw New Exception( errormsg & Environment.NewLine & ex.StackTrace )
' MessageBox.Show(errormsg)
Catch ex As InvalidOperationException
Dim errormsg As String = "The XmlTextWriter is closed or An XmlTextWriter method was called before a previous asynchronous operation finished."
Throw New Exception( errormsg & Environment.NewLine & ex.StackTrace )
' MessageBox.Show(errormsg)
Catch ex As Exception
Throw New Exception( ex.Message & Environment.NewLine & ex.StackTrace )
End Try
End Sub
''' <summary>
''' Writes the xml end of file.
''' </summary>
Shared Sub Write_End( ByVal XmlWriter As Xml.XmlTextWriter )
Try
XmlWriter.WriteEndDocument ( )
XmlWriter.Close ( )
Catch ex As ArgumentException
Dim errormsg As String = "The XML document is invalid."
Throw New Exception( errormsg & Environment.NewLine & ex.StackTrace )
' MessageBox.Show(errormsg)
Catch ex As Exception
Throw New Exception( ex.Message & Environment.NewLine & ex.StackTrace )
End Try
End Sub
End Class
#End Region
« Última modificación: 25 Octubre 2013, 17:43 pm por EleKtro H@cker »
Eleкtro
Ex-Staff
Desconectado
Mensajes: 9.878
Dado un número, devuelve el valor más próximo de un Enum.
#Region " Get Nearest Enum Value "
' [ Get Nearest Enum Value ]
'
' // By Elektro H@cker
'
' Examples :
'
' Enum Bitrate As Short : kbps_128 = 128 : kbps_192 = 192 : kbps_256 = 256 : kbps_320 = 320 : End Enum
' MsgBox(Get_Nearest_Enum_Value(Of Bitrate)(133).ToString) ' Result: kbps_128
' MsgBox(Get_Nearest_Enum_Value(Of KnownColor)(1000)) ' Result: 174
Private Function Get_Nearest_Enum_Value( Of T) ( ByVal value As Long ) As T
Return [ Enum ] .Parse ( GetType ( T) , [ Enum ] .GetValues ( GetType ( T) ) .
Cast ( Of Object ) .
OrderBy ( Function ( br) Math.Abs ( value - br) ) .
First )
End Function
#End Region
Dado un número, devuelve el valor próximo más bajo de un Enum.
#Region " Get Nearest Lower Enum Value "
' [ Get Nearest Lower Enum Value ]
'
' // By Elektro H@cker
'
' Examples :
'
' Enum Bitrate As Short : kbps_128 = 128 : kbps_192 = 192 : kbps_256 = 256 : kbps_320 = 320 : End Enum
' MsgBox(Get_Nearest_Lower_Enum_Value(Of Bitrate)(190).ToString) ' Result: kbps_128
' MsgBox(Get_Nearest_Lower_Enum_Value(Of Bitrate)(196).ToString) ' Result: kbps_192
Private Function Get_Nearest_Lower_Enum_Value( Of T) ( ByVal value As Integer ) As T
Select Case value
Case Is < [ Enum ] .GetValues ( GetType ( T) ) .Cast ( Of Object ) .First
Return Nothing
Case Else
Return [ Enum ] .Parse ( GetType ( T) , [ Enum ] .GetValues ( GetType ( T) ) .
Cast ( Of Object ) ( ) .
Where ( Function ( enum_value) enum_value <= value) .
Last )
End Select
End Function
#End Region
Dado un número, devuelve el valor próximo más alto de un Enum.
#Region " Get Nearest Higher Enum Value "
' [ Get Nearest Higher Enum Value ]
'
' // By Elektro H@cker
'
' Examples :
'
' Enum Bitrate As Short : kbps_128 = 128 : kbps_192 = 192 : kbps_256 = 256 : kbps_320 = 320 : End Enum
' MsgBox(Get_Nearest_Higher_Enum_Value(Of Bitrate)(196).ToString) ' Result: kbps_256
' MsgBox(Get_Nearest_Higher_Enum_Value(Of KnownColor)(1000)) ' Result: 0
Private Function Get_Nearest_Higher_Enum_Value( Of T) ( ByVal value As Integer ) As T
Select Case value
Case Is > [ Enum ] .GetValues ( GetType ( T) ) .Cast ( Of Object ) .Last
Return Nothing
Case Else
Return [ Enum ] .Parse ( GetType ( T) , [ Enum ] .GetValues ( GetType ( T) ) .
Cast ( Of Object ) .
Where ( Function ( enum_value) enum_value >= value) .
FirstOrDefault )
End Select
End Function
#End Region
EDITO: Aquí todos juntos:
#Region " Get Nearest Enum Value "
' [ Get Nearest Enum Value ]
'
' // By Elektro H@cker
'
' Examples :
'
' MsgBox(Get_Nearest_Enum_Value(Of Bitrate)(133, Enum_Direction.Nearest).ToString) ' Result: kbps_128
' MsgBox(Get_Nearest_Enum_Value(Of KnownColor)(1000, Enum_Direction.Nearest)) ' Result: 174
'
' MsgBox(Get_Nearest_Enum_Value(Of Bitrate)(190, Enum_Direction.Down).ToString) ' Result: kbps_128
' MsgBox(Get_Nearest_Enum_Value(Of KnownColor)(-1, Enum_Direction.Down).ToString) ' Result: 0
'
' MsgBox(Get_Nearest_Enum_Value(Of Bitrate)(196, Enum_Direction.Up).ToString) ' Result: kbps_256
' MsgBox(Get_Nearest_Enum_Value(Of KnownColor)(1000, Enum_Direction.Up)) ' Result: 0
Private Enum Enum_Direction As Short
Down = 1
Up = 2
Nearest = 0
End Enum
Private Function Get_Nearest_Enum_Value( Of T) ( ByVal value As Long , _
Optional ByVal direction As Enum_Direction = Enum_Direction.Nearest ) As T
Select Case direction
Case Enum_Direction.Nearest ' Return nearest Enum value
Return [ Enum ] .Parse ( GetType ( T) , [ Enum ] .GetValues ( GetType ( T) ) .
Cast ( Of Object ) .
OrderBy ( Function ( br) Math.Abs ( value - br) ) .
First )
Case Enum_Direction.Down ' Return nearest lower Enum value
If value < [ Enum ] .GetValues ( GetType ( T) ) .Cast ( Of Object ) .First Then
Return Nothing
Else
Return [ Enum ] .Parse ( GetType ( T) , [ Enum ] .GetValues ( GetType ( T) ) .
Cast ( Of Object ) ( ) .
Where ( Function ( enum_value) enum_value <= value) .
Last )
End If
Case Enum_Direction.Up ' Return nearest higher Enum value
If value > [ Enum ] .GetValues ( GetType ( T) ) .Cast ( Of Object ) .Last Then
Return Nothing
Else
Return [ Enum ] .Parse ( GetType ( T) , [ Enum ] .GetValues ( GetType ( T) ) .
Cast ( Of Object ) .
Where ( Function ( enum_value) enum_value >= value) .
FirstOrDefault )
End If
End Select
End Function
#End Region
« Última modificación: 1 Noviembre 2013, 15:36 pm por EleKtro H@cker »
Eleкtro
Ex-Staff
Desconectado
Mensajes: 9.878
· Juntar múltiples listas:
#Region " Join Lists "
' [ Join Lists ]
'
' // By Elektro H@cker
'
' Examples :
'
' Dim list_A As New List(Of String) From {"a", "b"}
' Dim list_B As New List(Of String) From {"c", "d"}
' Dim newlist As List(Of String) = Join_Lists(Of String)({list_A, list_B}) ' Result: {"a", "b", "c", "d"}
Private Function Join_Lists( Of T) ( ByVal Lists( ) As List( Of T) ) As List( Of T)
Return Lists.SelectMany ( Function ( l) l) .ToList
End Function
#End Region
· Revertir un Stack:
#Region " Reverse Stack "
' [ Reverse Stack ]
'
' Examples :
'
' Dim MyStack As New Stack(Of String)
'
' MyStack.Push("S") : MyStack.Push("T") : MyStack.Push("A") : MyStack.Push("C") : MyStack.Push("K")
'
' MyStack = Reverse_Stack(Of String)(MyStack)
'
' For Each value In MyStack
' MsgBox(value)
' Next
Private Function Reverse_Stack( Of T) ( stack As Stack( Of T) ) As Stack( Of T)
Return New Stack( Of T) ( stack)
End Function
#End Region
· Eliminar las lineas vacias de un archivo de texto:
#Region " Delete Empty Lines In TextFile "
' [ Delete Empty Lines In TextFile ]
'
' // By Elektro H@cker
'
' Examples :
'
' Delete_Empty_Lines_In_TextFile("C:\File.txt")
' Delete_Empty_Lines_In_TextFile("C:\File.txt", System.Text.Encoding.GetEncoding(1252))
Private Sub Delete_Empty_Lines_In_TextFile
( ByVal file As String , _
Optional ByVal encoding As System.Text .Encoding = Nothing )
.Where ( Function ( line ) Not String .IsNullOrEmpty ( line ) ) _
, If ( encoding Is Nothing , System.Text .Encoding .Default , encoding) )
End Sub
#End Region
Y por último esta Class para dockear un Form,
le añadí lo necesario para poder bloquear la posición del form (no el tamaño, me parece irrelevante).
' [ Form Dock ]
'
' // By Elektro H@cker
#Region " Usage Examples "
' Private _formdock As New FormDock(Me) With {.LockPosition = True}
'
' Private Shadows Sub Shown() Handles MyBase.Shown
'
' _formdock.Dock(FormDock.DockPosition.WorkingArea_BottomRight)
'
' End Sub
#End Region
#Region " Form Dock "
Public Class FormDock
Inherits NativeWindow
Implements IDisposable
#Region " Variables, Properties and Enumerations "
''' <summary>
''' While the property still Enabled it will locks the formulary position.
''' </summary>
Public Property LockPosition As Boolean = False
''' <summary>
''' Stores the formulary to Dock.
''' </summary>
Private WithEvents form As Form = Nothing
''' <summary>
''' Stores the size of the formulary to Dock.
''' </summary>
Private UI_Size As Size = Nothing
''' <summary>
''' Stores the Dock positions.
''' </summary>
Private Dock_Positions
As Dictionary ( Of DockPosition, Point
)
''' <summary>
''' Dock Positions.
''' </summary>
Public Enum DockPosition As Short
Center_Screen = 0
Bounds_BottomLeft = 1
Bounds_BottomRight = 2
Bounds_TopLeft = 3
Bounds_TopRight = 4
WorkingArea_BottomLeft = 5
WorkingArea_BottomRight = 6
WorkingArea_TopLeft = 7
WorkingArea_TopRight = 8
End Enum
#End Region
#Region " New Constructor "
Public Sub New ( ByVal form As Form)
Me .form = form
SetHandle( )
End Sub
#End Region
#Region " Public Procedures "
''' <summary>
''' Docks the form.
''' </summary>
Public Sub Dock( ByVal Position As DockPosition)
If Dock_Positions Is Nothing Then
Renew_Positions( form)
End If
form.Location = Dock_Positions( Position)
End Sub
#End Region
#Region " Miscellaneous Procedures "
''' <summary>
''' Renews the Dock positions according to the the current form Size.
''' </summary>
Private Sub Renew_Positions( ByVal form As Form)
UI_Size = form.Size
Dock_Positions
= New Dictionary ( Of DockPosition, Point
) _
From {
{ DockPosition.Center_Screen ,
New Point( ( Screen.PrimaryScreen .Bounds .Width - UI_Size.Width ) \ 2 ,
( Screen.PrimaryScreen .Bounds .Height - UI_Size.Height ) \ 2 ) } ,
{ DockPosition.Bounds_BottomLeft ,
New Point( Screen.PrimaryScreen .Bounds .X ,
Screen.PrimaryScreen .Bounds .Height - UI_Size.Height ) } ,
{ DockPosition.Bounds_BottomRight ,
New Point( Screen.PrimaryScreen .Bounds .Width - UI_Size.Width ,
Screen.PrimaryScreen .Bounds .Height - UI_Size.Height ) } ,
{ DockPosition.Bounds_TopLeft ,
New Point( Screen.PrimaryScreen .Bounds .X ,
Screen.PrimaryScreen .Bounds .Y ) } ,
{ DockPosition.Bounds_TopRight ,
New Point( Screen.PrimaryScreen .Bounds .Width - UI_Size.Width ,
Screen.PrimaryScreen .Bounds .Y ) } ,
{ DockPosition.WorkingArea_BottomLeft ,
New Point( Screen.PrimaryScreen .WorkingArea .X ,
Screen.PrimaryScreen .WorkingArea .Height - UI_Size.Height ) } ,
{ DockPosition.WorkingArea_BottomRight ,
New Point( Screen.PrimaryScreen .WorkingArea .Width - UI_Size.Width ,
Screen.PrimaryScreen .WorkingArea .Height - UI_Size.Height ) } ,
{ DockPosition.WorkingArea_TopLeft ,
New Point( Screen.PrimaryScreen .WorkingArea .X ,
Screen.PrimaryScreen .WorkingArea .Y ) } ,
{ DockPosition.WorkingArea_TopRight ,
New Point( Screen.PrimaryScreen .WorkingArea .Width - UI_Size.Width ,
Screen.PrimaryScreen .WorkingArea .Y ) }
}
End Sub
#End Region
#Region " Form EventHandlers "
''' <summary>
''' Renews the Dock positions according to the the current form Size,
''' when Form is Shown.
''' </summary>
Private Sub OnShown( ) _
Handles form.Shown
If Not UI_Size.Equals ( Me .form .Size ) Then
Renew_Positions( Me .form )
End If
End Sub
''' <summary>
''' Renews the Dock positions according to the the current form Size,
''' When Form is resized.
''' </summary>
Private Sub OnResizeEnd( ) _
Handles form.ResizeEnd
If Not UI_Size.Equals ( Me .form .Size ) Then
Renew_Positions( Me .form )
End If
End Sub
''' <summary>
''' SetHandle
''' Assign the handle of the target form to this NativeWindow,
''' necessary to override WndProc.
''' </summary>
Private Sub SetHandle( ) Handles _
form.HandleCreated ,
form.Load ,
form.Shown
Try
If Not Me .Handle .Equals ( Me .form .Handle ) Then
Me .AssignHandle ( Me .form .Handle )
End If
Catch ex As InvalidOperationException
End Try
End Sub
''' <summary>
''' Releases the Handle.
''' </summary>
Private Sub OnHandleDestroyed( ) _
Handles form.HandleDestroyed
Me .ReleaseHandle ( )
End Sub
#End Region
#Region " Windows Messages "
''' <summary>
''' WndProc Message Interception.
''' </summary>
Protected Overrides Sub WndProc( ByRef m As Message)
If Me .LockPosition Then
Select Case m.Msg
Case & HA1
' Cancels any attempt to drag the window by it's caption.
If m.WParam .ToInt32 = & H2 Then Return
Case & H112
' Cancels any clicks on the Move system menu item.
If ( m.WParam .ToInt32 And & HFFF0) = & HF010& Then Return
End Select
End If
' Return control to base message handler.
MyBase .WndProc ( m)
End Sub
#End Region
#Region " IDisposable "
''' <summary>
''' Disposes the objects generated by this instance.
''' </summary>
Public Sub Dispose( ) Implements IDisposable.Dispose
Dispose( True )
GC.SuppressFinalize ( Me )
End Sub
Protected Overridable Sub Dispose( IsDisposing As Boolean )
Static IsBusy As Boolean ' To detect redundant calls.
If Not IsBusy AndAlso IsDisposing Then
Me .LockPosition = False
Me .ReleaseHandle ( )
End If
IsBusy = True
End Sub
#End Region
End Class
#End Region
« Última modificación: 11 Noviembre 2013, 16:38 pm por EleKtro H@cker »
Eleкtro
Ex-Staff
Desconectado
Mensajes: 9.878
Una nueva versión de mi Listview, que tiene muchas cosas interesantes como poder dibujar una barra de progreso en una celda...
Ahora le añadí lo básico para hacer undo/redo para añadir o eliminar items.
Una pequeña demostración:
VIDEO Un ejemplo de uso:
Public Class Form1
Private Sub Form_Load( sender As Object , e As EventArgs) Handles MyBase .Load
' Enable the Undo/Redo Manager
ListView_Elektro1.Enable_UndoRedo_Manager = True
' Create an Item
Dim LVItem As New ListViewItem With { .Text = "Hello World" }
' Add the item
ListView_Elektro1.AddItem ( LVItem)
' Remove the item
'ListView_Elektro1.RemoveItem(LVItem)
End Sub
' Undo an operation
Private Sub Button_Undo_Click( sender As Object , e As EventArgs) Handles Button_Undo.Click
ListView_Elektro1.Undo ( )
End Sub
' Redo an operation
Private Sub Button_Redo_Click( sender As Object , e As EventArgs) Handles Button_Redo.Click
ListView_Elektro1.Redo ( )
End Sub
' Handles when an Undo or Redo operation is performed
Private Sub UndoRedo_Performed( sender As Object , e As ListView_Elektro.UndoneRedoneEventArgs ) _
Handles ListView_Elektro1.UndoRedo_IsPerformed
MsgBox ( e.Operation .ToString )
MsgBox ( e.Method .ToString )
MsgBox ( e.Item .Text )
End Sub
' Handles when a Undo or Redo stack size changed
Private Sub UndoRedo_StackSizeChanged( sender As Object , e As ListView_Elektro.StackSizeChangedEventArgs ) _
Handles ListView_Elektro1.UndoRedo_StackSizeChanged
MsgBox ( e.UndoStackIsEmpty )
MsgBox ( e.RedoStackIsEmpty )
End Sub
End Class
El código completo del UserControl listo para ser compilado:
' /* *\
' |#* ListView Elektro *#|
' \* */
'
' // By Elektro H@cker
'
' Properties:
' -----------
' · Disable_Flickering
' · Double_Buffer
' · GridLineColor
' · ItemHighlightColor
' · ItemNotFocusedHighlighColor
' · DrawCustomGridLines
' · UseDefaultGridLines
' · Enable_ProgressBar
' · Progressbar_Column
' · ProgressBar_BackColor
' · ProgressBar_BorderColor
' · ProgressBar_FillColor1
' · ProgressBar_FillColor2
' · Percent
' · Percent_Decimal
' · Percent_Font
' · Percent_Text
' · Percent_Forecolor
' · Percent_Text_Allignment
' · Enable_UndoRedo_Manager
' Events:
' -------
' · ItemAdded
' · ItemRemoved
' · UndoRedo_IsPerformed
' · UndoRedo_StackSizeChanged
'
' Methods:
' --------
' · AddItem
' · AddItems
' · RemoveItem
' · RemoveItems
' · Undo
' · Redo
Public Class ListView_Elektro : Inherits ListView
Public Event ItemAdded As EventHandler( Of ItemAddedEventArgs)
Public Class ItemAddedEventArgs : Inherits EventArgs
Property Item As ListViewItem
End Class
Public Event ItemRemoved As EventHandler( Of ItemRemovedEventArgs)
Public Class ItemRemovedEventArgs : Inherits EventArgs
Property Item As ListViewItem
End Class
Private _Disable_Flickering As Boolean = True
Private _gridLines As Boolean = False
Private _useDefaultGridLines As Boolean = False
Private _gridLineColor As Color = Color.Black
Private _itemHighlightColor As Color = Color.FromKnownColor ( KnownColor.Highlight )
Private _itemNotFocusedHighlighColor As Color = Color.FromKnownColor ( KnownColor.MenuBar )
Private _enable_progressbar As Boolean = False
Private _progressbar_column As Integer = Nothing
Private _percent As Double = 0
Private _percent_decimal As Short = 2
Private _percent_text As String = "%"
Private _percent_text_allignment As StringAlignment = StringAlignment.Center
Private _percent_stringformat As StringFormat = New StringFormat With { .Alignment = _percent_text_allignment}
Private _percent_font As Font = Me .Font
Private _percent_forecolor As SolidBrush = New SolidBrush( Color.Black )
Private _progressBar_backcolor As SolidBrush = New SolidBrush( Color.Red )
Private _progressBar_bordercolor As Pen = New Pen( Color.LightGray )
Private _progressBar_fillcolor1 As Color = Color.YellowGreen
Private _progressBar_fillcolor2 As Color = Color.White
Public Sub New ( )
Me .Name = "ListView_Elektro"
Me .DoubleBuffered = True
Me .UseDefaultGridLines = True
' Set Listview OwnerDraw to True, so we can draw the progressbar inside.
If Me .Enable_ProgressBar Then Me .OwnerDraw = True
Me .GridLines = True
Me .FullRowSelect = True
Me .MultiSelect = True
Me .View = View.Details
End Sub
#Region " Properties "
''' <summary>
''' Enable/Disable any flickering effect on the ListView.
''' </summary>
Protected Overrides ReadOnly Property CreateParams( ) As CreateParams
Get
If _Disable_Flickering Then
Dim cp As CreateParams = MyBase .CreateParams
cp.ExStyle = cp.ExStyle Or & H2000000
Return cp
Else
Return MyBase .CreateParams
End If
End Get
End Property
''' <summary>
''' Set the Double Buffer.
''' </summary>
Public Property Double_Buffer( ) As Boolean
Get
Return Me .DoubleBuffered
End Get
Set ( ByVal Value As Boolean )
Me .DoubleBuffered = Value
End Set
End Property
''' <summary>
''' Enable/Disable the flickering effects on this ListView.
'''
''' This property turns off any Flicker effect on the ListView
''' ...but also reduces the performance (speed) of the ListView about 30% slower.
''' This don't affect to the performance of the application itself, only to the performance of this control.
''' </summary>
Public Property Disable_Flickering( ) As Boolean
Get
Return _Disable_Flickering
End Get
Set ( ByVal Value As Boolean )
Me ._Disable_Flickering = Value
End Set
End Property
''' <summary>
''' Changes the gridline color.
''' </summary>
Public Property GridLineColor( ) As Color
Get
Return _gridLineColor
End Get
Set ( ByVal value As Color)
If value <> _gridLineColor Then
_gridLineColor = value
If _gridLines Then
Me .Invalidate ( )
End If
End If
End Set
End Property
''' <summary>
''' Changes the color when item is highlighted.
''' </summary>
Public Property ItemHighlightColor( ) As Color
Get
Return _itemHighlightColor
End Get
Set ( ByVal value As Color)
If value <> _itemHighlightColor Then
_itemHighlightColor = value
Me .Invalidate ( )
End If
End Set
End Property
''' <summary>
''' Changes the color when the item is not focused.
''' </summary>
Public Property ItemNotFocusedHighlighColor( ) As Color
Get
Return _itemNotFocusedHighlighColor
End Get
Set ( ByVal value As Color)
If value <> _itemNotFocusedHighlighColor Then
_itemNotFocusedHighlighColor = value
Me .Invalidate ( )
End If
End Set
End Property
Private ReadOnly Property DrawCustomGridLines( ) As Boolean
Get
Return ( _gridLines And Not _useDefaultGridLines)
End Get
End Property
Public Shadows Property GridLines( ) As Boolean
Get
Return _gridLines
End Get
Set ( ByVal value As Boolean )
_gridLines = value
End Set
End Property
''' <summary>
''' use the default gridlines.
''' </summary>
Public Property UseDefaultGridLines( ) As Boolean
Get
Return _useDefaultGridLines
End Get
Set ( ByVal value As Boolean )
If _useDefaultGridLines <> value Then
_useDefaultGridLines = value
End If
MyBase .GridLines = value
MyBase .OwnerDraw = Not value
End Set
End Property
#End Region
#Region " Procedures "
''' <summary>
''' Adds an Item to the ListView,
''' to monitor when an Item is added to the ListView.
''' </summary>
Public Function AddItem( ByVal Item As ListViewItem) As ListViewItem
Me .Items .Add ( Item)
RaiseEvent ItemAdded( Me , New ItemAddedEventArgs With { .Item = Item} )
Return Item
End Function
Public Function AddItem( ByVal Text As String ) As ListViewItem
Dim NewItem As New ListViewItem( Text)
Me .Items .Add ( NewItem)
RaiseEvent ItemAdded( Me , New ItemAddedEventArgs With { .Item = NewItem} )
Return NewItem
End Function
''' <summary>
''' Removes an Item from the ListView
''' to monitor when an Item is removed from the ListView.
''' </summary>
Public Sub RemoveItem( ByVal Item As ListViewItem)
Me .Items .Remove ( Item)
RaiseEvent ItemRemoved( Me , New ItemRemovedEventArgs With { .Item = Item} )
End Sub
''' <summary>
''' Removes an Item from the ListView at given Index
''' to monitor when an Item is removed from the ListView.
''' </summary>
Public Sub RemoveItem_At( ByVal Index As Integer )
RemoveItem( Me .Items .Item ( Index) )
End Sub
''' <summary>
''' Removes an Item from the ListView at given Index
''' to monitor when an Item is removed from the ListView.
''' </summary>
Public Sub RemoveItems_At( ByVal Indexes As Integer ( ) )
Array .Sort ( Indexes)
Array .Reverse ( Indexes)
For Each Index As Integer In Indexes
RemoveItem( Me .Items .Item ( Index) )
Next
End Sub
''' <summary>
''' Adds a range of Items to the ListView,
''' to monitor when an Item is added to the ListView.
''' </summary>
Public Sub AddItems( ByVal Items As ListViewItem( ) )
For Each item As ListViewItem In Items
AddItem( item)
Next
End Sub
Public Sub AddItems( ByVal Items As ListViewItemCollection)
For Each item As ListViewItem In Items
AddItem( item)
Next
End Sub
''' <summary>
''' Removes a range of Items from the ListView
''' to monitor when an Item is removed from the ListView.
''' </summary>
Public Sub RemoveItems( ByVal Items As ListViewItem( ) )
For Each item As ListViewItem In Items
RemoveItem( item)
Next
End Sub
Public Sub RemoveItems( ByVal Items As ListViewItemCollection)
For Each item As ListViewItem In Items
RemoveItem( item)
Next
End Sub
Public Sub RemoveItems( ByVal Items As SelectedListViewItemCollection)
For Each item As ListViewItem In Items
RemoveItem( item)
Next
End Sub
Protected Overrides Sub OnDrawColumnHeader( ByVal e As System.Windows .Forms .DrawListViewColumnHeaderEventArgs )
e.DrawDefault = True
MyBase .OnDrawColumnHeader ( e)
End Sub
Protected Overrides Sub OnLostFocus( ByVal e As System.EventArgs )
For Each selectedIndex As Integer In MyBase .SelectedIndices
MyBase .RedrawItems ( selectedIndex, selectedIndex, False )
Next
MyBase .OnLostFocus ( e)
End Sub
Protected Overrides Sub OnDrawSubItem( ByVal e As System.Windows .Forms .DrawListViewSubItemEventArgs )
Dim drawAsDefault As Boolean = False
Dim highlightBounds As Rectangle = Nothing
Dim highlightBrush As SolidBrush = Nothing
'FIRST DETERMINE THE COLOR
If e.Item .Selected Then
If MyBase .Focused Then
highlightBrush = New SolidBrush( _itemHighlightColor)
ElseIf HideSelection Then
drawAsDefault = True
Else
highlightBrush = New SolidBrush( _itemNotFocusedHighlighColor)
End If
Else
drawAsDefault = True
End If
If drawAsDefault Then
e.DrawBackground ( )
Else
'NEXT DETERMINE THE BOUNDS IN WHICH TO DRAW THE BACKGROUND
If FullRowSelect Then
highlightBounds = e.Bounds
Else
highlightBounds = e.Item .GetBounds ( ItemBoundsPortion.Label )
End If
'ONLY DRAW HIGHLIGHT IN 1 OF 2 CASES
'CASE 1 - FULL ROW SELECT (AND DRAWING ANY ITEM)
'CASE 2 - NOT FULL ROW SELECT (AND DRAWING 1ST ITEM)
If FullRowSelect Then
e.Graphics .FillRectangle ( highlightBrush, highlightBounds)
ElseIf e.ColumnIndex = 0 Then
e.Graphics .FillRectangle ( highlightBrush, highlightBounds)
Else
e.DrawBackground ( )
End If
End If
e.DrawText ( )
If _gridLines Then
e.Graphics .DrawRectangle ( New Pen( _gridLineColor) , e.Bounds )
End If
If FullRowSelect Then
e.DrawFocusRectangle ( e.Item .GetBounds ( ItemBoundsPortion.Entire ) )
Else
e.DrawFocusRectangle ( e.Item .GetBounds ( ItemBoundsPortion.Label ) )
End If
MyBase .OnDrawSubItem ( e)
End Sub
#End Region
#Region " ProgressBar Properties "
''' <summary>
''' Enables the drawing of a ProgressBar
''' This property should be "True" to use any of the ProgressBar properties.
''' </summary>
Public Property Enable_ProgressBar As Boolean
Get
Return _enable_progressbar
End Get
Set ( ByVal value As Boolean )
Me .OwnerDraw = value
_enable_progressbar = value
End Set
End Property
''' <summary>
''' The column index to draw the ProgressBar
''' </summary>
Public Property Progressbar_Column As Integer
Get
Return _progressbar_column
End Get
Set ( ByVal value As Integer )
_progressbar_column = value
End Set
End Property
''' <summary>
''' The ProgressBar progress percentage
''' </summary>
Public Property Percent As Double
Get
Return _percent
End Get
Set ( ByVal value As Double )
_percent = value
End Set
End Property
''' <summary>
''' The decimal factor which should be displayed for the ProgressBar progress percentage
''' </summary>
Public Property Percent_Decimal As Short
Get
Return _percent_decimal
End Get
Set ( ByVal value As Short)
_percent_decimal = value
End Set
End Property
''' <summary>
''' The Font to be used as the ProgressBar Percent text
''' </summary>
Public Property Percent_Font As Font
Get
Return _percent_font
End Get
Set ( ByVal value As Font)
_percent_font = value
End Set
End Property
''' <summary>
''' The additional text to add to the ProgressBar Percent value
''' </summary>
Public Property Percent_Text As String
Get
Return _percent_text
End Get
Set ( ByVal value As String )
_percent_text = value
End Set
End Property
''' <summary>
''' The ForeColor of the ProgressBar Percent Text
''' </summary>
Public Property Percent_Forecolor As Color
Get
Return _percent_forecolor.Color
End Get
Set ( ByVal value As Color)
_percent_forecolor = New SolidBrush( value)
End Set
End Property
''' <summary>
''' The text allignment to use for the ProgressBar
''' </summary>
Public Property Percent_Text_Allignment As StringAlignment
Get
Return _percent_stringformat.Alignment
End Get
Set ( ByVal value As StringAlignment)
_percent_stringformat.Alignment = value
End Set
End Property
''' <summary>
''' The ProgressBar BackColor
''' </summary>
Public Property ProgressBar_BackColor As Color
Get
Return _progressBar_backcolor.Color
End Get
Set ( ByVal value As Color)
_progressBar_backcolor = New SolidBrush( value)
End Set
End Property
''' <summary>
''' The ProgressBar BorderColor
''' </summary>
Public Property ProgressBar_BorderColor As Color
Get
Return _progressBar_bordercolor.Color
End Get
Set ( ByVal value As Color)
_progressBar_bordercolor = New Pen( value)
End Set
End Property
''' <summary>
''' The First ProgressBar Gradient color
''' </summary>
Public Property ProgressBar_FillColor1 As Color
Get
Return _progressBar_fillcolor1
End Get
Set ( ByVal value As Color)
_progressBar_fillcolor1 = value
End Set
End Property
''' <summary>
''' The Last ProgressBar Gradient color
''' </summary>
Public Property ProgressBar_FillColor2 As Color
Get
Return _progressBar_fillcolor2
End Get
Set ( ByVal value As Color)
_progressBar_fillcolor2 = value
End Set
End Property
#End Region
#Region " ProgressBar EventHandlers "
' ListView [DrawColumnHeader]
Public Sub Me_DrawColumnHeader( ByVal sender As Object , ByVal e As DrawListViewColumnHeaderEventArgs) _
Handles Me .DrawColumnHeader
e.DrawDefault = True ' Draw default ColumnHeader.
End Sub
' ListView [DrawItem]
Public Sub Me_DrawItem( ByVal sender As Object , ByVal e As DrawListViewItemEventArgs) _
Handles Me .DrawItem
e.DrawDefault = False ' Draw default main item.
End Sub
' ListView [DrawSubItem]
Public Sub Me_DrawSubItem( ByVal sender As Object , ByVal e As DrawListViewSubItemEventArgs) _
Handles Me .DrawSubItem
If Not Enable_ProgressBar OrElse Progressbar_Column = Nothing Then
Exit Sub
End If
' Item is highlighted.
' If (e.ItemState And ListViewItemStates.Selected) <> 0 Then
' e.Graphics.FillRectangle(SystemBrushes.Highlight, e.Bounds)
' End If
' Draw the progressbar.
If e.ColumnIndex = Progressbar_Column Then
' Background color of the progressbar.
e.Graphics .FillRectangle ( _progressBar_backcolor, e.Bounds )
' Gradient to fill the progressbar.
Dim brGradient As Brush = _
New System.Drawing .Drawing2D .LinearGradientBrush ( New Rectangle( e.Bounds .X , e.Bounds .Y , e.Bounds .Width , e.Bounds .Height ) , _
ProgressBar_FillColor1, ProgressBar_FillColor2, 270 , True )
' Draw the actual progressbar.
e.Graphics .FillRectangle ( brGradient, _
e.Bounds .X + 1 , e.Bounds .Y + 2 , _
CInt ( ( ( Percent) / 100 ) * ( e.Bounds .Width - 2 ) ) , e.Bounds .Height - 3 )
' Draw the percentage number and percent sign.
e.Graphics .DrawString ( Percent.ToString ( "n" & Percent_Decimal) & Percent_Text, _
Percent_Font, _percent_forecolor, _
CSng( e.Bounds .X + ( e.Bounds .Width / 2 ) ) , e.Bounds .Y + 3 , _
_percent_stringformat)
' Draw a light gray rectangle/border around the progressbar.
e.Graphics .DrawRectangle ( _progressBar_bordercolor, _
e.Bounds .X , e.Bounds .Y + 1 , _
e.Bounds .Width - 1 , e.Bounds .Height - 2 )
Else
' e.DrawDefault = True
End If
End Sub
#End Region
#Region " Undo/Redo Manager "
''' <summary>
''' Enable or disble the Undo/Redo monitoring.
''' </summary>
Public Property Enable_UndoRedo_Manager As Boolean = False
' Stacks to store Undo/Redo actions.
Public Undostack As New Stack( Of ListView_Action)
Public Redostack As New Stack( Of ListView_Action)
' Flags to check if it is doing a Undo/Redo operation.
Private IsDoingUndo As Boolean = False
Private IsDoingRedo As Boolean = False
' Delegate to Add an Item for Undo/Redo operations.
Private Delegate Sub AddDelegate( item As ListViewItem)
' Delegate to Remove an Item for Undo/Redo operations.
Private Delegate Sub RemoveDelegate( item As ListViewItem)
' The Undo/Redo action.
Private action As ListView_Action = Nothing
' The operation.
Public Enum Operation As Short
Undo = 0
Redo = 1
End Enum
' The method for the Undo/Redo operation.
Public Enum Method As Short
Add = 0
Remove = 1
End Enum
''' <summary>
''' Creates a Undo/Redo Action.
''' </summary>
Class ListView_Action
''' <summary>
''' Names the Undo/Redo Action.
''' </summary>
Property Name As String
''' <summary>
''' Points to a method to excecute.
''' </summary>
Property Operation As [ Delegate ]
''' <summary>
''' Method of the Undo/Redo operation.
''' </summary>
Property Method As Method
''' <summary>
''' Data Array for the method to excecute.
''' </summary>
Property Data As ListViewItem
End Class
''' <summary>
''' This event is raised after an Undo/Redo action is performed.
''' </summary>
Public Event UndoRedo_IsPerformed As EventHandler( Of UndoneRedoneEventArgs)
Public Class UndoneRedoneEventArgs : Inherits EventArgs
Property Operation As Operation
Property Method As Method
Property Item As ListViewItem
Property UndoStack As Stack( Of ListView_Action)
Property RedoStack As Stack( Of ListView_Action)
End Class
''' <summary>
''' This event is raised when Undo/Redo Stack size changed.
''' </summary>
Public Event UndoRedo_StackSizeChanged As EventHandler( Of StackSizeChangedEventArgs)
Public Class StackSizeChangedEventArgs : Inherits EventArgs
Property UndoStack As Stack( Of ListView_Action)
Property RedoStack As Stack( Of ListView_Action)
Property UndoStackIsEmpty As Boolean
Property RedoStackIsEmpty As Boolean
End Class
''' <summary>
''' Undo the last action.
''' </summary>
Public Sub Undo( )
If Me .Undostack .Count = 0 Then Exit Sub ' Nothing to Undo.
Me .IsDoingUndo = True
Me .action = Me .Undostack .Pop ' Get the Action from the Stack and remove it.
Me .action .Operation .DynamicInvoke ( Me .action .Data ) ' Invoke the undo Action.
Me .IsDoingUndo = False
Raise_UndoRedo_IsPerformed( Operation.Undo , Me .action .Method , Me .action .Data )
End Sub
''' <summary>
''' Redo the last action.
''' </summary>
Public Sub Redo( )
If Me .Redostack .Count = 0 Then Exit Sub ' Nothing to Redo.
Me .IsDoingRedo = True
Me .action = Me .Redostack .Pop ( ) ' Get the Action from the Stack and remove it.
Me .action .Operation .DynamicInvoke ( Me .action .Data ) ' Invoke the redo Action.
Me .IsDoingRedo = False
Raise_UndoRedo_IsPerformed( Operation.Redo , Me .action .Method , Me .action .Data )
End Sub
' Reverses an Undo/Redo action
Private Function GetReverseAction( ByVal e As UndoneRedoneEventArgs) As ListView_Action
Me .action = New ListView_Action
Me .action .Name = e.Item .Text
Me .action .Data = e.Item
Me .action .Operation = If ( e.Method = Method .Add , _
New RemoveDelegate( AddressOf Me .RemoveItem ) , _
New AddDelegate( AddressOf Me .AddItem ) )
Me .action .Method = If ( e.Method = Method .Add , _
Method .Remove , _
Method .Add )
Return Me .action
End Function
' Raises the "UndoRedo_IsPerformed" Event
Private Sub Raise_UndoRedo_IsPerformed( ByVal Operation As Operation, _
ByVal Method As Method , _
ByVal Item As ListViewItem)
RaiseEvent UndoRedo_IsPerformed( Me , New UndoneRedoneEventArgs _
With { .Item = Item, _
.Method = Method , _
.Operation = Operation, _
.UndoStack = Me .Undostack , _
.RedoStack = Me .Redostack } )
Raise_UndoRedo_StackSizeChanged( )
End Sub
' Raises the "UndoRedo_StackSizeChanged" Event
Private Sub Raise_UndoRedo_StackSizeChanged( )
RaiseEvent UndoRedo_StackSizeChanged( Me , New StackSizeChangedEventArgs _
With { .UndoStack = Me .Undostack , _
.RedoStack = Me .Redostack , _
.UndoStackIsEmpty = Me .Undostack .Count = 0 , _
.RedoStackIsEmpty = Me .Redostack .Count = 0 } )
End Sub
' This handles when an Undo or Redo operation is performed.
Private Sub UndoneRedone( ByVal sender As Object , ByVal e As UndoneRedoneEventArgs) _
Handles Me .UndoRedo_IsPerformed
Select Case e.Operation
Case Operation.Undo
' Create a Redo Action for the undone action.
Me .Redostack .Push ( GetReverseAction( e) )
Case Operation.Redo
' Create a Undo Action for the redone action.
Me .Undostack .Push ( GetReverseAction( e) )
End Select
End Sub
' Monitors when an Item is added to create an Undo Operation.
Private Sub OnItemAdded( sender As Object , e As ItemAddedEventArgs) _
Handles Me .ItemAdded
If Me .Enable_UndoRedo_Manager _
AndAlso ( Not Me .IsDoingUndo And Not Me .IsDoingRedo ) Then
Me .Redostack .Clear ( )
' // Crate an Undo Action
Me .action = New ListView_Action
Me .action .Name = e.Item .Text
Me .action .Operation = New RemoveDelegate( AddressOf Me .RemoveItem )
Me .action .Data = e.Item
Me .action .Method = Method .Remove
Me .Undostack .Push ( action)
Raise_UndoRedo_StackSizeChanged( )
End If
End Sub
' Monitors when an Item is removed to create an Undo Operation.
Private Sub OnItemRemoved( sender As Object , e As ItemRemovedEventArgs) _
Handles Me .ItemRemoved
If Me .Enable_UndoRedo_Manager _
AndAlso ( Not Me .IsDoingUndo And Not Me .IsDoingRedo ) Then
Me .Redostack .Clear ( )
' // Crate an Undo Action
Me .action = New ListView_Action
Me .action .Name = e.Item .Text
Me .action .Operation = New AddDelegate( AddressOf Me .AddItem )
Me .action .Data = e.Item
Me .action .Method = Method .Add
Me .Undostack .Push ( action)
Raise_UndoRedo_StackSizeChanged( )
End If
End Sub
#End Region
End Class
« Última modificación: 11 Noviembre 2013, 01:26 am por EleKtro H@cker »
Eleкtro
Ex-Staff
Desconectado
Mensajes: 9.878
Una versión mejorada de mi ayudante para la aplicación mp3gain... mejoré lo que pude el código y le añadi algunos eventos esenciales...
Un ejemplo de uso:
Public Class Form1
Private WithEvents _mp3gain As New mp3gain _
With { .mp3gain_location = "C:\windows\system32\mp3gain.exe" ,
.CheckFileExist = True }
Private Sub Test( ) Handles MyBase .Shown
' Checks if mp3gain executable is avaliable.
MsgBox ( _mp3gain.Is_Avaliable ( ) )
' Checks if file contains APEv2 mp3gain tag
MsgBox ( _mp3gain.File_Has_MP3Gain_Tag ( "C:\File.mp3" ) )
' Set the global volume Gain of file to "89" db (In a scale of "0-100"),
' and preserve the datetime of file.
_mp3gain.Set_Gain ( "C:\File.mp3" , 89 , True )
' Apply a volume change of +5 db,
' in the curent global volume gain of file.
_mp3gain.Apply_Gain ( "C:\File.mp3" , + 5 )
' Apply a volume change of -5 db,
' in the curent global volume gain of file.
_mp3gain.Apply_Gain ( "C:\File.mp3" , - 5 )
' Apply a volume change of +10 db,
' in the curent volume gain of the Left channel of an Stereo file.
_mp3gain.Apply_Channel_Gain ( "C:\File.mp3" , mp3gain.Channel .Left , + 10 )
' Apply a volume change of -10 db,
' in the curent volume gain of the Right channel of an Stereo file.
_mp3gain.Apply_Channel_Gain ( "C:\File.mp3" , mp3gain.Channel .Right , - 10 )
' Undos all volume gain changes made in file.
_mp3gain.Undo_Gain ( "C:\File.mp3" )
End Sub
' mp3gain [Started]
Private Sub mp3gain_Started( ByVal sender As Process, ByVal e As mp3gain.StartedEventArgs ) _
Handles _mp3gain.Started
ProgressBar1.Value = ProgressBar1.Minimum
Dim sb As New System.Text .StringBuilder
sb.AppendLine ( String .Format ( "Started an " "{0}" " operation" , e.Operation .ToString ) )
sb.
AppendLine ( String .
Format ( "Input file is: " "{0}" "" , e.
File ) ) sb.AppendLine ( String .Format ( "mp3gain process PID is: " "{0}" "" , CStr ( sender.Id ) ) )
MessageBox.Show ( sb.ToString , "mp3gain" , MessageBoxButtons.OK , MessageBoxIcon.Information )
End Sub
' mp3gain [Exited]
Private Sub mp3gain_Exited( ByVal sender As Process, ByVal e As mp3gain.ExitedEventArgs ) _
Handles _mp3gain.Exited
Dim sb As New System.Text .StringBuilder
If e.Operation <> mp3gain.Operation .Check_Tag Then
sb.AppendLine ( String .Format ( "Finished an " "{0}" " operation" , e.Operation .ToString ) )
sb.
AppendLine ( String .
Format ( "Input file is: " "{0}" "" , e.
File ) ) sb.AppendLine ( String .Format ( "mp3gain process PID is: {0}" , CStr ( sender.Id ) ) )
If Not String .IsNullOrEmpty ( e.InfoMessage ) Then
sb.AppendLine ( String .Format ( "Operation Information: {0}" , e.InfoMessage ) )
End If
If Not String .IsNullOrEmpty ( e.ErrorMessage ) Then
sb.AppendLine ( String .Format ( "Error Information: {0}" , e.ErrorMessage ) )
End If
If e.db <> 0 Then
sb.AppendLine ( String .Format ( "Volume gain change: {0}" , CStr ( e.db ) ) )
End If
MessageBox.Show ( sb.ToString , "mp3gain" , MessageBoxButtons.OK , MessageBoxIcon.Information )
End If
End Sub
' mp3gain [Progress]
Sub mp3gain_Progress( sender As Process, e As mp3gain.ProgressEventArgs ) _
Handles _mp3gain.Progress
ProgressBar1.Value = e.Percent
End Sub
End Class
El ayudante:
' [ mp3gain Helper ] #region " mp3gain Helper "
Public Class mp3gain : Implements IDisposable
#Region " CommandLine parametter legend "
' /c - Ignore clipping warning when applying gain.
' /d - Set global gain.
' /e - Skip Album analysis, even if multiple files listed.
' /g - apply gain
' /p - Preserve original file timestamp.
' /r - apply Track gain automatically (all files set to equal loudness)
' /t - Writes modified data to temp file, then deletes original instead of modifying bytes in original file.
' /u - Undo changes made (based on stored APEv2 mp3gain tag info).
' /s c - Check stored APEv2 mp3gain tag info.
#End Region
#Region " Variables, Properties, Enumerations "
''' <summary>
''' Gets or sets the mp3gain.exe executable path.
''' </summary>
Public Property mp3gain_location As String = ".\mp3gain.exe"
''' <summary>
''' Indicates if should check that the file exist before realize an operation.
''' If True, an exception would be launched if file does not exist.
''' </summary>
Public Property CheckFileExist As Boolean = False
''' <summary>
''' Sets a Flag to indicate if file has APEv2 mp3gain tag or not.
''' </summary>
Private HasTag As Boolean = False
''' <summary>
''' Stores the StandardOutput.
''' </summary>
Private Output As String ( ) = Nothing
''' <summary>
''' Stores an information message of the realized operation (if any).
''' </summary>
Private InfoMessage As String = String .Empty
''' <summary>
''' Stores an error message of the realized operation (if any).
''' </summary>
Private ErrorMessage As String = String .Empty
''' <summary>
''' Stores the volume gain level change applied to file (if any).
''' </summary>
Private db As Integer = 0
''' <summary>
''' Gets some information about the file.
''' </summary>
Private db_RegEx As New System.Text .RegularExpressions .Regex ( "Applying.+change of (.*) to" ,
System.Text .RegularExpressions .RegexOptions .None )
''' <summary>
''' Process to realize an operation,
''' for files that already contains APEv2 mp3gain tag.
''' Also is used to realize a single TagCheck operation.
''' </summary>
Private Process_For_Tag As Process =
New Process With { .StartInfo =
New ProcessStartInfo With {
.CreateNoWindow = True ,
.UseShellExecute = False ,
.RedirectStandardError = False ,
.RedirectStandardOutput = True
}
}
''' <summary>
''' Process to realize an operation,
''' for files that does not contains mp3gain Tag.
''' </summary>
Private Process_For_NonTag As Process =
New Process With { .StartInfo =
New ProcessStartInfo With {
.CreateNoWindow = True ,
.UseShellExecute = False ,
.RedirectStandardError = True ,
.RedirectStandardOutput = True
}
}
''' <summary>
''' Stores the StartedEventArgs Arguments.
''' </summary>
Private StartedArgs As New StartedEventArgs
''' <summary>
''' Stores the ExitedEventArgs Arguments.
''' </summary>
Private ExitedArgs As New ExitedEventArgs
''' <summary>
''' Stores the ProgressEventArgs Arguments.
''' </summary>
Private ProgressArgs As New ProgressEventArgs
''' <summary>
''' File Stereo Channel.
''' </summary>
Public Enum Channel As Short
Left = 0 ' /l 0
Right = 1 ' /l 1
End Enum
''' <summary>
''' MP3Gain Type Of Operation.
''' </summary>
Public Enum Operation
Check_Tag = 0
Apply_Gain = 1
Apply_Channel_Gain = 2
Set_Gain = 3
Undo_Gain = 4
End Enum
#End Region
#Region " Events "
''' <summary>
''' Event raised when the process has started.
''' </summary>
Public Event Started As EventHandler( Of StartedEventArgs)
Public Class StartedEventArgs : Inherits EventArgs
''' <summary>
''' Gets the file that was passed as argument to the process.
''' </summary>
Public Property File As String ''' <summary>
''' Gets the type of operation to realize.
''' </summary>
Public Property Operation As Operation
End Class
''' <summary>
''' Event raised when the process has exited.
''' </summary>
Public Event Exited As EventHandler( Of ExitedEventArgs)
Public Class ExitedEventArgs : Inherits EventArgs
''' <summary>
''' Gets the file that was passed as argument to the process.
''' </summary>
Public Property File As String ''' <summary>
''' Gets the type of operation to realize.
''' </summary>
Public Property Operation As Operation
''' <summary>
''' Gets the information message of the realized operation (if any).
''' </summary>
Public Property InfoMessage As String
''' <summary>
''' Gets the error message of the realized operation (if any).
''' </summary>
Public Property ErrorMessage As String
''' <summary>
''' Gets the volume gain level change applied to file (if any).
''' </summary>
Public Property db As Integer
End Class
''' <summary>
''' Event raised when the process progress changes.
''' </summary>
Public Event Progress As EventHandler( Of ProgressEventArgs)
Public Class ProgressEventArgs : Inherits EventArgs
''' <summary>
''' Gets the process operation percent done.
''' </summary>
Public Property Percent As Integer
End Class
#End Region
#Region " MP3Gain Procedures "
''' <summary>
''' Checks if mp3gain.exe process is avaliable.
''' </summary>
Public Function Is_Avaliable( ) As Boolean
Return IO.
File .
Exists ( Me .
mp3gain_location ) End Function
''' <summary>
''' Checks if APEv2 mp3gain tag exists in file.
''' </summary>
Public Function File_Has_MP3Gain_Tag( ByVal MP3_File As String ) As Boolean
Run_MP3Gain( MP3_File,
Operation.Check_Tag ,
String .Format ( "/s c " "{0}" "" , MP3_File) ,
True )
Return HasTag
End Function
''' <summary>
''' Set the global volume gain of file.
''' </summary>
Public Sub Set_Gain( ByVal MP3_File As String ,
ByVal Gain As Integer ,
Optional ByVal Preserve_Datestamp As Boolean = True )
File_Has_MP3Gain_Tag( MP3_File)
Run_MP3Gain( MP3_File,
Operation.Set_Gain ,
String .Format ( "/c /e /r /t {1} /d {2} " "{0}" "" ,
MP3_File,
If ( Preserve_Datestamp, "/p" , "" ) ,
If ( Gain < 0 , Gain + 89.0 , Gain - 89.0 ) ) ,
False )
End Sub
''' <summary>
''' Apply a volume gain change to file.
''' </summary>
Public Sub Apply_Gain( ByVal MP3_File As String ,
ByVal Gain As Integer ,
Optional ByVal Preserve_Datestamp As Boolean = True )
File_Has_MP3Gain_Tag( MP3_File)
Run_MP3Gain( MP3_File,
Operation.Apply_Gain ,
String .Format ( "/c /e /r /t {1} /g {2} " "{0}" "" ,
MP3_File,
If ( Preserve_Datestamp, "/p" , "" ) ,
Gain) ,
False )
End Sub
''' <summary>
''' Apply a volume gain change to file only in left or right channel.
''' Only works for Stereo MP3 files.
''' </summary>
Public Sub Apply_Channel_Gain( ByVal MP3_File As String ,
ByVal Channel As Channel,
ByVal Gain As Integer ,
Optional ByVal Preserve_Datestamp As Boolean = True )
File_Has_MP3Gain_Tag( MP3_File)
Run_MP3Gain( MP3_File,
Operation.Apply_Channel_Gain ,
String .Format ( "/c /e /r /l {2} {3} " "{0}" "" ,
MP3_File,
If ( Preserve_Datestamp, "/p" , "" ) ,
If ( Channel = Channel.Left , 0 , 1 ) ,
Gain) ,
False )
End Sub
''' <summary>
''' Undos all mp3gain volume changes made in a file,
''' based on stored APEv2 mp3gain tag info.
''' </summary>
Public Sub Undo_Gain( ByVal MP3_File As String ,
Optional ByVal Preserve_Datestamp As Boolean = True )
File_Has_MP3Gain_Tag( MP3_File)
Run_MP3Gain( MP3_File,
Operation.Undo_Gain ,
String .Format ( "/c /t {1} /u " "{0}" "" ,
MP3_File,
If ( Preserve_Datestamp, "/p" , "" ) ) ,
False )
End Sub
#End Region
#Region " Run Procedures "
''' <summary>
''' Run MP3Gain process.
''' </summary>
Private Sub Run_MP3Gain( ByVal MP3_File As String ,
ByVal operation As Operation,
ByVal Parametters As String ,
ByVal IsCheckTagOperation As Boolean )
If Me .CheckFileExist Then
FileExist( MP3_File)
End If
With Process_For_Tag.StartInfo
.FileName = Me .mp3gain_location
.Arguments = Parametters
End With
With Process_For_NonTag.StartInfo
.FileName = Me .mp3gain_location
.Arguments = Parametters
End With
' Reset Variables before relaize the operation.
InfoMessage = Nothing
ErrorMessage = Nothing
db = 0
' Check if file has APEv2 mp3gain tag or not,
' before doing any other operation.
If IsCheckTagOperation Then
Run_MP3Gain_For_Tag( Process_For_Tag, MP3_File, operation.Check_Tag , True )
Exit Sub ' If only would to check the tag then exit from this sub.
Else ' Else, continue with the operation (Modify volume gain)...
Select Case HasTag
Case True
Run_MP3Gain_For_Tag( Process_For_Tag, MP3_File, operation, False )
Case False
Run_MP3Gain_For_NonTag( Process_For_NonTag, MP3_File, operation)
End Select ' HasTag
End If ' IsCheckTagOperation
End Sub
''' <summary>
''' Runs mp3gain for files that already contains APEv2 mp3gain tag.
''' </summary>
Private Sub Run_MP3Gain_For_Tag( ByVal p As Process,
ByVal MP3_File As String ,
ByVal operation As Operation,
ByVal IsTagCheckOperation As Boolean )
p.Start ( )
RaiseEvent_Started( p, MP3_File, operation)
p.WaitForExit ( )
If IsTagCheckOperation Then
HasTag = CBool ( p.StandardOutput .ReadToEnd .Trim .Split ( Environment.NewLine ) .Count - 1 )
End If
ProgressArgs.Percent = 100
RaiseEvent Progress( p, ProgressArgs)
SetMessages( p.StandardOutput .ReadToEnd ( ) )
RaiseEvent_Exited( p,
MP3_File,
operation,
If ( IsTagCheckOperation, "File Has Tag?: " & CStr ( HasTag) , InfoMessage) ,
ErrorMessage,
db)
' p.Close()
End Sub
''' <summary>
''' Runs mp3gain for files that doesn't contains APEv2 mp3gain tag.
''' </summary>
Private Sub Run_MP3Gain_For_NonTag( ByVal p As Process,
ByVal MP3_File As String ,
ByVal operation As Operation)
p.Start ( )
RaiseEvent_Started( p, MP3_File, operation)
Do Until p.HasExited
Try
ProgressArgs.Percent = CInt ( p.StandardError .ReadLine .Split ( "%" ) .First .Trim )
If ProgressArgs.Percent < 101 Then
RaiseEvent Progress( p, ProgressArgs)
End If
Catch
End Try
Loop
ProgressArgs.Percent = 100
RaiseEvent Progress( p, ProgressArgs)
SetMessages( p.StandardOutput .ReadToEnd ( ) )
RaiseEvent_Exited( p,
MP3_File,
operation,
InfoMessage,
ErrorMessage,
db)
' p.Close()
End Sub
#End Region
#Region " Miscellaneous Procedures "
''' <summary>
''' Checks if a file exists.
''' </summary>
Private Sub FileExist
( ByVal File As String )
Throw New Exception
( String .
Format ( "File doesn't exist: " "{0}" "" ,
File ) ) ' MessageBox.Show(String.Format("File doesn't exist: ""{0}""", File), "mp3gain", MessageBoxButtons.OK, MessageBoxIcon.Error)
End If
End Sub
''' <summary>
''' Raises the Event Started
''' </summary>
Private Sub RaiseEvent_Started( ByVal p As Process,
ByVal operation As Operation)
With StartedArgs
.Operation = operation
End With
RaiseEvent Started( p, StartedArgs)
End Sub
''' <summary>
''' Raises the Event Exited
''' </summary>
Private Sub RaiseEvent_Exited( ByVal p As Process,
ByVal operation As Operation,
ByVal InfoMessage As String ,
ByVal ErrorMessage As String ,
ByVal db As Integer )
With ExitedArgs
.Operation = operation
.InfoMessage = InfoMessage
.ErrorMessage = ErrorMessage
.db = db
End With
RaiseEvent Exited( p, ExitedArgs)
End Sub
''' <summary>
''' Sets the InfoMessage, ErrorMessage and db variables.
''' </summary>
Private Sub SetMessages( ByVal StandardOutput As String )
Output = StandardOutput.
Split ( Environment.NewLine ) .
Select ( Function ( line ) line .Replace ( Environment.NewLine , "" ) .Trim ) .
Where ( Function ( null ) Not String .IsNullOrEmpty ( null ) ) .ToArray
For Each line In Output
Select Case True
Case line .StartsWith ( "No changes" )
InfoMessage = "No volume gain changes are necessary."
Case line .StartsWith ( "Applying" )
db = db_RegEx.Match ( line ) .Groups ( 1 ) .Value
If String .IsNullOrEmpty ( InfoMessage) Then
InfoMessage = line
End If
Case line .StartsWith ( "Can't" )
ErrorMessage = line
End Select
Next line
End Sub
#End Region
#Region " IDisposable "
''' <summary>
''' Disposes the objects generated by this instance.
''' </summary>
Public Sub Dispose( ) Implements IDisposable.Dispose
Dispose( True )
GC.SuppressFinalize ( Me )
End Sub
Protected Overridable Sub Dispose( IsDisposing As Boolean )
Static IsBusy As Boolean ' To detect redundant calls.
If Not IsBusy AndAlso IsDisposing Then
Process_For_Tag.Dispose ( )
Process_For_NonTag.Dispose ( )
End If
IsBusy = True
End Sub
#End Region
End Class
#End Region
« Última modificación: 11 Noviembre 2013, 01:39 am por EleKtro H@cker »
Eleкtro
Ex-Staff
Desconectado
Mensajes: 9.878
Una versión mejorada de mi ayudante para la aplicación CoreConverter... mejoré lo que pude el código y le añadi algunos eventos esenciales...
Un ejemplo de uso:
Public Class Form1
Private WithEvents _converter As New CoreConverter _
With { .CoreConverter_location = "C:\windows\system32\coreconverter.exe" ,
.CheckFileExist = True }
Private Sub Test( ) Handles MyBase .Shown
' Checks if CoreConverter executable is avaliable.
MsgBox ( _converter.Is_Avaliable ( ) )
' Convert a file to MP3
_converter.Convert_To_MP3 ( "C:\Input.wav" , "C:\Output.mp3" ,
CoreConverter.Lame_Bitrate .kbps_320 ,
CoreConverter.Lame_Bitrate_Mode .cbr ,
CoreConverter.Lame_Profile .SLOW ,
CoreConverter.Lame_Quality .Q0_Maximum ,
CoreConverter.Lame_Khz .Same_As_Source ,
CoreConverter.Lame_Channels .auto ,
{
CoreConverter.DSP_Effects .Delete_Output_File_on_Error ,
CoreConverter.DSP_Effects .Recycle_Source_File_After_Conversion
} ,
False ,
CoreConverter.Priority .normal )
' Convert a file to WAV
_converter.Convert_To_WAV_Uncompressed ( "C:\Input.mp3" , "C:\Output.wav" , _
CoreConverter.WAV_Uncompressed_Bitrate .Same_As_Source , _
CoreConverter.WAV_Uncompressed_Khz .Same_As_Source , _
CoreConverter.WAV_Uncompressed_Channels .Same_As_Source , , False )
' Convert a file to WMA
_converter.Convert_To_WMA ( "C:\Input.mp3" , "C:\Output.wma" , _
CoreConverter.WMA_9_2_BitRates .Kbps_128 , _
CoreConverter.WMA_9_2_Khz .Khz_44100 , _
CoreConverter.WMA_9_2_Channels .stereo , , False )
End Sub
' CoreConverter [Started]
Private Sub CoreConverter_Started( ByVal sender As Process, ByVal e As CoreConverter.StartedEventArgs ) _
Handles _converter.Started
ProgressBar1.Value = ProgressBar1.Minimum
Dim sb As New System.Text .StringBuilder
sb.AppendLine ( String .Format ( "Started an " "{0}" " operation" , e.Operation .ToString ) )
sb.
AppendLine ( String .
Format ( "Input file is: " "{0}" "" , e.
File ) ) sb.AppendLine ( String .Format ( "CoreConverter process PID is: " "{0}" "" , CStr ( sender.Id ) ) )
MessageBox.Show ( sb.ToString , "CoreConverter" , MessageBoxButtons.OK , MessageBoxIcon.Information )
End Sub
' CoreConverter [Exited]
Private Sub CoreConverter_Exited( ByVal sender As Process, ByVal e As CoreConverter.ExitedEventArgs ) _
Handles _converter.Exited
Dim sb As New System.Text .StringBuilder
sb.AppendLine ( String .Format ( "Finished an " "{0}" " operation" , e.Operation .ToString ) )
sb.
AppendLine ( String .
Format ( "Input file is: " "{0}" "" , e.
File ) ) sb.AppendLine ( String .Format ( "CoreConverter process PID is: {0}" , CStr ( sender.Id ) ) )
If Not String .IsNullOrEmpty ( e.InfoMessage ) Then
sb.AppendLine ( String .Format ( "Operation Information: {0}" , e.InfoMessage ) )
End If
If Not String .IsNullOrEmpty ( e.ErrorMessage ) Then
sb.AppendLine ( String .Format ( "Error Information: {0}" , e.ErrorMessage ) )
End If
If Not String .IsNullOrEmpty ( e.ElapsedTime ) Then
sb.AppendLine ( String .Format ( "Total elapsed time: {0}" , e.ElapsedTime ) )
End If
MessageBox.Show ( sb.ToString , "CoreConverter" , MessageBoxButtons.OK , MessageBoxIcon.Information )
End Sub
' CoreConverter [Progress]
Sub CoreConverter_Progress( sender As Process, e As CoreConverter.ProgressEventArgs ) _
Handles _converter.Progress
ProgressBar1.Value = e.Percent
End Sub
End Class
El ayudante:
' [ CoreConverter Helper ] #Region " CoreConverter Helper "
Public Class CoreConverter : Implements IDisposable
#Region " Variables, Properties, Enumerations "
''' <summary>
''' Gets or sets CoreConverter.exe executable path.
''' </summary>
Public Property CoreConverter_location As String = ".\CoreConverter.exe"
''' <summary>
''' Indicates if should check that the file exist before realize an operation.
''' If True, an exception would be launched if file does not exist.
''' </summary>
Public Property CheckFileExist As Boolean = False
''' <summary>
''' Stores the converter process progress
''' </summary>
Private CurrentProgress As Integer = 0
''' <summary>
''' Stores an information message of the realized operation (if any).
''' </summary>
Private InfoMessage As String = Nothing
''' <summary>
''' Stores an error message of the realized operation (if any).
''' </summary>
Private ErrorMessage As String = Nothing
''' <summary>
''' Stores the next converter process output character.
''' </summary>
Private OutputCharacter As Char = Nothing
''' <summary>
''' Stores the DSP Effects formatted string.
''' </summary>
Private Effects As String = Nothing
''' <summary>
''' Stores the total elapsed time of conversion.
''' </summary>
Private ElapsedTime As String = Nothing
''' <summary>
''' Stores additional information about the conversion.
''' </summary>
Private ExtraInfo( ) As String = Nothing
''' <summary>
''' Stores the StartedEventArgs Arguments.
''' </summary>
Private StartedArgs As New StartedEventArgs
''' <summary>
''' Stores the ExitedEventArgs Arguments.
''' </summary>
Private ExitedArgs As New ExitedEventArgs
''' <summary>
''' Stores the ProgressEventArgs Arguments.
''' </summary>
Private ProgressArgs As New ProgressEventArgs
''' <summary>
''' CoreConverter Type Of Operation.
''' </summary>
Public Enum Operation
MP3_Conversion = 0
WAV_Conversion = 1
WMA_Conversion = 2
End Enum
''' <summary>
''' Priority level of CoreConverter process.
''' </summary>
Public Enum Priority
idle
low
normal
high
End Enum
''' <summary>
''' DSP Effects.
''' </summary>
Public Enum DSP_Effects
Delete_Output_File_on_Error ' Delete failed conversion (not deletes source file).
Delete_Source_File_After_Conversion ' Delete source file after conversion.
Recycle_Source_File_After_Conversion ' Send source file to recycle bin after conversion.
Karaoke_Remove_Voice ' Remove voice from file.
Karaoke_Remove_Instrument ' Remove instruments from file.
Reverse ' Reverse complete audio file.
Write_Silence ' Write silence at start of file.
End Enum
''' <summary>
''' CoreConverter Process.
''' </summary>
Private p As Process =
New Process With { .StartInfo =
New ProcessStartInfo With {
.CreateNoWindow = True , _
.UseShellExecute = False , _
.RedirectStandardError = True , _
.RedirectStandardOutput = True , _
.StandardErrorEncoding = System.Text .Encoding .Unicode , _
.StandardOutputEncoding = System.Text .Encoding .Unicode
}
}
#End Region
#Region " Events "
''' <summary>
''' Event raised when CoreConverter operation progress changes.
''' </summary>
Public Event Progress As EventHandler( Of ProgressEventArgs)
Public Class ProgressEventArgs : Inherits EventArgs
''' <summary>
''' Gets the CoreConverter operation percent done.
''' </summary>
Public Property Percent As Integer
End Class
''' <summary>
''' Event raised when CoreConverter process has started.
''' </summary>
Public Event Started As EventHandler( Of StartedEventArgs)
Public Class StartedEventArgs : Inherits EventArgs
''' <summary>
''' Gets the file that was passed as argument to the process.
''' </summary>
Public Property File As String ''' <summary>
''' Gets the type of operation to realize.
''' </summary>
Public Property Operation As Operation
End Class
''' <summary>
''' Event raised when CoreConverter process has exited.
''' </summary>
Public Event Exited As EventHandler( Of ExitedEventArgs)
Public Class ExitedEventArgs : Inherits EventArgs
''' <summary>
''' Gets the file that was passed as argument to the process.
''' </summary>
Public Property File As String ''' <summary>
''' Gets the type of operation to realize.
''' </summary>
Public Property Operation As Operation
''' <summary>
''' Gets an information message of the realized operation.
''' </summary>
Public Property InfoMessage As String
''' <summary>
''' Gets an error message of the realized operation (if any).
''' </summary>
Public Property ErrorMessage As String
''' <summary>
''' Gets the total elapsed time of the operation.
''' </summary>
Public Property ElapsedTime As String
End Class
#End Region
#Region " Codec Enumerations "
#Region " MP3 Lame "
Public Enum Lame_Bitrate
kbps_8 = 8
kbps_16 = 16
kbps_24 = 24
kbps_32 = 32
kbps_40 = 40
kbps_48 = 48
kbps_56 = 56
kbps_64 = 64
kbps_80 = 80
kbps_96 = 96
kbps_112 = 112
kbps_128 = 128
kbps_144 = 144
kbps_160 = 160
kbps_192 = 192
kbps_224 = 224
kbps_256 = 256
kbps_320 = 320
End Enum
Public Enum Lame_Bitrate_Mode
cbr
abr
End Enum
Public Enum Lame_Profile
NORMAL
FAST
SLOW
End Enum
Public Enum Lame_Quality
Q0_Maximum = 0
Q1 = 1
Q2 = 2
Q3 = 3
Q4 = 4
Q5 = 5
Q6 = 6
Q7 = 7
Q8 = 8
Q9_Minimum = 9
End Enum
Public Enum Lame_Khz
Same_As_Source
khz_8000 = 8000
khz_11025 = 11025
khz_12000 = 12000
khz_16000 = 16000
khz_22050 = 22050
khz_24000 = 24000
khz_32000 = 32000
khz_44100 = 44100
khz_48000 = 48000
End Enum
Public Enum Lame_Channels
auto
mono
stereo
joint_stereo
forced_joint_stereo
forced_stereo
dual_channels
End Enum
#End Region
#Region " WAV Uncompressed "
Public Enum WAV_Uncompressed_Bitrate
Same_As_Source
bits_8 = 8
bits_16 = 16
bits_24 = 24
bits_32 = 32
End Enum
Public Enum WAV_Uncompressed_Khz
Same_As_Source
khz_8000 = 8000
khz_11025 = 11025
khz_12000 = 12000
khz_16000 = 16000
khz_22050 = 22050
khz_24000 = 24000
khz_32000 = 32000
khz_44100 = 44100
khz_48000 = 48000
khz_96000 = 96000
khz_192000 = 192000
End Enum
Public Enum WAV_Uncompressed_Channels
Same_As_Source
Channels_1_Mono = 1
Channels_2_Stereo = 2
Channels_3 = 3
Channels_4_Quadraphonic = 4
Channels_5_Surround = 5
Channels_6_Surround_DVD = 6
Channels_7 = 7
Channels_8_Theater = 8
End Enum
#End Region
#Region " WMA 9.2 "
Public Enum WMA_9_2_BitRates
Kbps_12 = 12
Kbps_16 = 16
Kbps_20 = 20
Kbps_22 = 22
Kbps_24 = 24
Kbps_32 = 32
Kbps_40 = 40
Kbps_48 = 48
Kbps_64 = 64
Kbps_80 = 80
Kbps_96 = 96
Kbps_128 = 128
Kbps_160 = 160
Kbps_192 = 192
Kbps_256 = 256
Kbps_320 = 320
End Enum
Enum WMA_9_2_Khz
Khz_8000 = 8
Khz_16000 = 16
Khz_22050 = 22
Khz_32000 = 32
Khz_44100 = 44
Khz_48000 = 48
End Enum
Enum WMA_9_2_Channels
mono
stereo
End Enum
#End Region
#End Region
#Region " CoreConverter Procedures "
''' <summary>
''' Checks if CoreConverter process is avaliable.
''' </summary>
Public Function Is_Avaliable( ) As Boolean
Return IO.
File .
Exists ( Me .
CoreConverter_location ) End Function
''' <summary>
''' Converts a file to MP3 using Lame codec.
''' </summary>
Public Sub Convert_To_MP3( ByVal In_File As String , _
ByVal Out_File As String , _
ByVal Bitrate As Lame_Bitrate, _
ByVal Bitrate_Mode As Lame_Bitrate_Mode, _
ByVal Encoding_Profile As Lame_Profile, _
ByVal Quality As Lame_Quality, _
ByVal Khz As Lame_Khz, _
ByVal Channels As Lame_Channels, _
Optional ByVal DSP_Effects( ) As DSP_Effects = Nothing , _
Optional ByVal Update_Tag As Boolean = True , _
Optional ByVal Priority As Priority = Priority.normal , _
Optional ByVal Processor As Short = 1 )
Get_Effects( DSP_Effects)
Set_Main_Arguments( "mp3 (Lame)" ,
In_File,
Out_File,
If ( Not Update_Tag, "-noidtag" , "" ) ,
Effects,
Priority.ToString ,
Processor.ToString )
p.StartInfo .Arguments &= _
String .Format ( "-b {0} --{1} -encoding=" "{2}" " -freq=" "{3}" " -channels=" "{4}" " --noreplaygain --extracli=" "-q {5}" "" , _
CInt ( Bitrate) , _
Bitrate_Mode.ToString , _
Encoding_Profile.ToString , _
If ( Khz = Lame_Khz.Same_As_Source , "" , CInt ( Khz) ) , _
If ( Channels = Lame_Channels.auto , "" , Channels) , _
CInt ( Quality) )
Run_CoreConverter( In_File, Operation.MP3_Conversion )
End Sub
''' <summary>
''' Converts a file to Uncompressed WAV.
''' </summary>
Public Sub Convert_To_WAV_Uncompressed( ByVal In_File As String , _
ByVal Out_File As String , _
ByVal Bitrate As WAV_Uncompressed_Bitrate, _
ByVal Khz As WAV_Uncompressed_Khz, _
ByVal Channels As WAV_Uncompressed_Channels, _
Optional ByVal DSP_Effects( ) As DSP_Effects = Nothing , _
Optional ByVal Update_Tag As Boolean = True , _
Optional ByVal Priority As Priority = Priority.normal , _
Optional ByVal Processor As Short = 1 )
Get_Effects( DSP_Effects)
Set_Main_Arguments( "Wave" ,
In_File,
Out_File,
If ( Not Update_Tag, "-noidtag" , "" ) ,
Effects,
Priority.ToString ,
Processor.ToString )
p.StartInfo .Arguments &= _
String .Format ( "-compression=" "PCM" " -bits=" "{0}" " -freq=" "{1}" " -channels=" "{2}" "" , _
If ( Bitrate = WAV_Uncompressed_Bitrate.Same_As_Source , "" , CInt ( Bitrate) ) , _
If ( Khz = WAV_Uncompressed_Khz.Same_As_Source , "" , CInt ( Khz) ) , _
If ( Channels = WAV_Uncompressed_Channels.Same_As_Source , "" , CInt ( Channels) ) )
Run_CoreConverter( In_File, Operation.WAV_Conversion )
End Sub
''' <summary>
''' Converts a file to WMA v9.2
''' </summary>
Public Sub Convert_To_WMA( ByVal In_File As String , _
ByVal Out_File As String , _
ByVal Bitrate As WMA_9_2_BitRates, _
ByVal Khz As WMA_9_2_Khz, _
ByVal Channels As WMA_9_2_Channels, _
Optional ByVal DSP_Effects( ) As DSP_Effects = Nothing , _
Optional ByVal Update_Tag As Boolean = True , _
Optional ByVal Priority As Priority = Priority.normal , _
Optional ByVal Processor As Short = 1 )
Get_Effects( DSP_Effects)
Set_Main_Arguments( "Windows Media Audio 10" ,
In_File,
Out_File,
If ( Not Update_Tag, "-noidtag" , "" ) ,
Effects,
Priority.ToString ,
Processor.ToString )
p.StartInfo .Arguments &= _
String .Format ( "-codec=" "Windows Media Audio 9.2" " -settings=" "{0} kbps, {1} kHz, {2} CBR" "" ,
CInt ( Bitrate) , _
CInt ( Khz) , _
Channels.ToString )
Run_CoreConverter( In_File, Operation.WMA_Conversion )
End Sub
#End Region
#Region " Run Procedure "
''' <summary>
''' Runs a specific operation of CoreConverter.
''' </summary>
Private Sub Run_CoreConverter
( ByVal file As String ,
ByVal operation As Operation)
If Me .CheckFileExist Then
End If
CurrentProgress = 0
p.StartInfo .FileName = Me .CoreConverter_location
p.Start ( )
With StartedArgs
.Operation = operation
End With
RaiseEvent Started( p, StartedArgs)
While Not p.HasExited
OutputCharacter = ChrW ( p.StandardOutput .Read )
If OutputCharacter = "*" Then
ProgressArgs.Percent = CInt ( ( Threading.Interlocked .Increment ( CurrentProgress) / 59 ) * 100 )
RaiseEvent Progress( p, ProgressArgs)
End If
If CurrentProgress = 59 Then
' I store the last line(s) because it has interesting information:
' Example Output: "Conversion completed in 30 seconds x44 realtime encoding"
InfoMessage = p.StandardOutput .ReadToEnd .Trim
End If
End While
' Stores the Error Message (If any)
ErrorMessage = p.StandardError .ReadToEnd .Trim
If Not String .IsNullOrEmpty ( InfoMessage) Then
' Stores additional information
ExtraInfo = InfoMessage.Split ( Environment.NewLine )
Select Case ExtraInfo.Length
Case 1
ElapsedTime = ExtraInfo.Last .Split ( ) ( 3 ) & " " & ExtraInfo.Last .Split ( ) ( 4 ) ' Example: "50,2 seconds"
Case 2
ElapsedTime = ExtraInfo.Last .Split ( ) ( 4 ) & " " & ExtraInfo.Last .Split ( ) ( 5 ) ' Example: "50,2 seconds"
Case Is < 1 , Is > 2
Throw New Exception( "Unmanaged Process Output Length" )
End Select
End If
With ExitedArgs
.Operation = operation
.InfoMessage = InfoMessage
.ErrorMessage = ErrorMessage
.ElapsedTime = ElapsedTime
End With
RaiseEvent Exited( p, ExitedArgs)
' CoreConverter.Close()
End Sub
#End Region
#Region " Miscellaneous procedures "
''' <summary>
''' Checks if a file exists.
''' </summary>
Private Sub FileExist
( ByVal File As String )
' Throw New Exception("File doesn't exist: " & File)
MessageBox.
Show ( "File doesn't exist: " & File ,
"CoreConverter" , MessageBoxButtons.
OK , MessageBoxIcon.
Error ) End If
End Sub
''' <summary>
''' Sets the static arguments of CoreConverter process.
''' </summary>
Private Sub Set_Main_Arguments( ByVal Codec_Name As String , _
ByVal In_File As String , _
ByVal Out_File As String , _
ByVal Update_Tag As String , _
ByVal Effects As String , _
ByVal Priority As String , _
ByVal Processor As String )
p.StartInfo .Arguments = _
String .Format ( "-infile=" "{0}" " -outfile=" "{1}" " -convert_to=" "{2}" " {3} {4} -priority=" "{5}" " -processor=" "{6}" " " ,
In_File,
Out_File,
Codec_Name,
Update_Tag,
Effects,
Priority,
Processor)
End Sub
''' <summary>
''' Join all DSP Effects and returns a formatted string.
''' </summary>
Private Function Get_Effects( ByVal DSP_Effects( ) As DSP_Effects) As String
If DSP_Effects Is Nothing Then
Return Nothing
Else
For Effect As Integer = 0 To DSP_Effects.Length - 1
Effects &= String .Format ( " -dspeffect{0}={1}" , _
Effect + 1 , _
Format_DSP_Effect( DSP_Effects( Effect) .ToString ) )
Next Effect
Return Effects
End If
End Function
''' <summary>
''' Returns a formatted string of a single DSP Effects.
''' </summary>
Private Shared Function Format_DSP_Effect( ByVal Effect As String )
Select Case Effect
Case "Reverse"
Return "" "Reverse" ""
Case "Delete_Output_File_on_Error"
Return "" "Delete Destination File on Error=" ""
Case "Recycle_Source_File_After_Conversion"
Return "" "Delete Source File=-recycle" ""
Case "Delete_Source_File_After_Conversion"
Return "" "Delete Source File=" ""
Case "Karaoke_Remove_Voice"
Return "" "Karaoke (Voice_ Instrument Removal)=" ""
Case "Karaoke_Remove_Instrument"
Return "" "Karaoke (Voice_ Instrument Removal)=-i" ""
Case "Write_Silence"
Return "" "Write Silence=-lengthms={qt}2000{qt}" "" ' 2 seconds
Case Else
Return String .Empty
End Select
End Function
#End Region
#Region " IDisposable "
''' <summary>
''' Disposes the objects generated by this instance.
''' </summary>
Public Sub Dispose( ) Implements IDisposable.Dispose
Dispose( True )
GC.SuppressFinalize ( Me )
End Sub
Protected Overridable Sub Dispose( IsDisposing As Boolean )
Static IsBusy As Boolean ' To detect redundant calls.
If Not IsBusy AndAlso IsDisposing Then
p.Dispose ( )
End If
IsBusy = True
End Sub
#End Region
End Class
#End Region
Eleкtro
Ex-Staff
Desconectado
Mensajes: 9.878
Una versión mejorada de mi ayudante para la aplicación mp3val... mejoré lo que pude el código y le añadi algunos eventos esenciales...
Un ejemplo de uso:
Public Class Form1
Private WithEvents _mp3val As New mp3val _
With { .mp3val_location = "C:\windows\system32\mp3val.exe" ,
.CheckFileExist = True }
Private Sub Test( ) Handles MyBase .Shown
MsgBox ( _mp3val.Is_Avaliable ( ) ) ' Checks if mp3gain executable is avaliable.
MsgBox ( _mp3val.Get_Tags ( New IO.FileInfo ( "C:\File.mp3" ) ) ) ' Return the TagTypes of an MP3 file.
_mp3val.Analyze ( "C:\File.mp3" ) ' Analyzes an MP3 file.
_mp3val.Fix ( "C:\File.mp3" ) ' Fix an MP3 file.
End Sub
' mp3val [Started]
Private Sub mp3val_Started( ByVal sender As Process, ByVal e As mp3val.StartedEventArgs ) _
Handles _mp3val.Started
Dim sb As New System.Text .StringBuilder
sb.AppendLine ( String .Format ( "Started an " "{0}" " operation" , e.Operation .ToString ) )
sb.
AppendLine ( String .
Format ( "Input file is: " "{0}" "" , e.
File ) ) sb.AppendLine ( String .Format ( "mp3val process PID is: " "{0}" "" , CStr ( sender.Id ) ) )
MessageBox.Show ( sb.ToString , "mp3val" , MessageBoxButtons.OK , MessageBoxIcon.Information )
End Sub
' mp3val [Exited]
Private Sub mp3val_Exited( ByVal sender As Process, ByVal e As mp3val.ExitedEventArgs ) _
Handles _mp3val.Exited
Dim sb As New System.Text .StringBuilder
sb.AppendLine ( String .Format ( "Finished an " "{1}" " operation in file " "{2}" "{0}" ,
Environment.NewLine ,
e.Operation .ToString ,
sb.AppendLine ( String .Format ( "File information:{0}{1}{0}" ,
Environment.NewLine ,
e.Info ) )
sb.AppendLine ( "Warnings found:" )
If e.Warnings .Count Then
For Each wrn As String In e.Warnings
sb.AppendLine ( wrn)
Next wrn
Else
sb.AppendLine ( "Any" & Environment.NewLine )
End If
sb.AppendLine ( "Errors found:" )
If e.Errors .Count Then
For Each err As String In e.
Errors Else
sb.AppendLine ( "Any" & Environment.NewLine )
End If
If e.Operation = mp3val.Operation .Fix Then
sb.AppendLine ( String .Format ( "File was fixed?: {0}" ,
e.FileIsFixed ) )
End If
MessageBox.Show ( sb.ToString ,
"mp3val" ,
MessageBoxButtons.OK ,
MessageBoxIcon.Information )
End Sub
End Class
El ayudante:
' [ mp3val Helper ] #Region " mp3val Helper "
Public Class mp3val : Implements IDisposable
#Region " CommandLine parametter legend "
' -f | try to fix errors
' -nb | delete .bak file
' -t | keep file timestamp
#End Region
#Region " Variables, Properties, Enums "
''' <summary>
''' Gets or sets the mp3val executable path.
''' </summary>
Public Property mp3val_location As String = ".\mp3val.exe"
''' <summary>
''' Indicates if should check that the MP3 file exist before realize an operation.
''' If True, an exception will be launched if file does not exist.
''' </summary>
Public Property CheckFileExist As Boolean = False
''' <summary>
''' Stores the process StandardOutput.
''' </summary>
Private StandardOutput As String = String .Empty
''' <summary>
''' Stores the process StandardError.
''' </summary>
Private StandardError As String = String .Empty
''' <summary>
''' Stores some information about the file.
''' </summary>
Private Info As String = String .Empty
''' <summary>
''' Stores all the warnings of the file.
''' </summary>
Private Warnings As New List( Of String )
''' <summary>
''' Stores all the errors of the file.
''' </summary>
Private Errors As New List( Of String )
''' <summary>
''' Stores the tags of the file.
''' </summary>
Private Tags As String = String .Empty
''' <summary>
''' Gets some information about the file.
''' </summary>
Private Info_RegEx As New System.Text .RegularExpressions .Regex ( "INFO:.*:\s(.*)" ,
System.Text .RegularExpressions .RegexOptions .Multiline )
''' <summary>
''' Gets all the warning occurences.
''' </summary>
Private Warning_RegEx As New System.Text .RegularExpressions .Regex ( "WARNING:.*:\s(.*)" ,
System.Text .RegularExpressions .RegexOptions .Multiline )
''' <summary>
''' Gets a value indicating if the file was fixed or not.
''' </summary>
Private Fixed_RegEx As New System.Text .RegularExpressions .Regex ( "^FIXED:" ,
System.Text .RegularExpressions .RegexOptions .Multiline )
''' <summary>
''' mp3val Process
''' </summary>
Private p As Process =
New Process With { .StartInfo =
New ProcessStartInfo With {
.CreateNoWindow = True ,
.UseShellExecute = False ,
.RedirectStandardError = True ,
.RedirectStandardOutput = True _
}
}
''' <summary>
''' Stores the StartedEventArgs Arguments.
''' </summary>
Private StartedArgs As New StartedEventArgs
''' <summary>
''' Stores the ExitedEventArgs Arguments.
''' </summary>
Private ExitedArgs As New ExitedEventArgs
''' <summary>
''' MP3Val Type Of Operation.
''' </summary>
Public Enum Operation As Short
Analyze = 0
Fix = 1
Get_Tags = 2
End Enum
#End Region
#Region " Events "
''' <summary>
''' Event raised when the process has started.
''' </summary>
Public Event Started As EventHandler( Of StartedEventArgs)
Public Class StartedEventArgs : Inherits EventArgs
''' <summary>
''' Gets the file that was passed as argument to the process.
''' </summary>
Public Property File As String ''' <summary>
''' Gets the type of operation to realize.
''' </summary>
Public Property Operation As Operation
End Class
''' <summary>
''' Event raised when the process has exited.
''' </summary>
Public Event Exited As EventHandler( Of ExitedEventArgs)
Public Class ExitedEventArgs : Inherits EventArgs
''' <summary>
''' Gets the file that was passed as argument to the process.
''' </summary>
Public Property File As String ''' <summary>
''' Gets the type of operation to realize.
''' </summary>
Public Property Operation As Operation
''' <summary>
''' Gets some information about the file.
''' </summary>
Public Property Info As String
''' <summary>
''' Gets the warnings found.
''' </summary>
Public Property Warnings As New List( Of String )
''' <summary>
''' Gets the errors found.
''' </summary>
Public Property Errors As New List( Of String )
''' <summary>
''' Gets a value indicating if file was fixed.
''' This is only usefull when doing a Fix operation.
''' </summary>
Public Property FileIsFixed As Boolean
End Class
#End Region
#Region " MP3Val Procedures "
''' <summary>
''' Checks if mp3val process is avaliable.
''' </summary>
Public Function Is_Avaliable( ) As Boolean
Return IO.
File .
Exists ( Me .
mp3val_location ) End Function
''' <summary>
''' Analyzes a file and returns the problems (if any).
''' </summary>
Public Function Analyze( ByVal MP3_File As String ) As List( Of String )
Return Run_MP3VAL( MP3_File,
Operation.Analyze ,
ControlChars.Quote & MP3_File & ControlChars.Quote )
End Function
''' <summary>
''' Analyzes a file and returns the problems (if any).
''' </summary>
Public Function Analyze( ByVal MP3_File As IO.FileInfo ) As List( Of String )
Return Run_MP3VAL( MP3_File.FullName ,
Operation.Analyze ,
ControlChars.Quote & MP3_File.FullName & ControlChars.Quote )
End Function
''' <summary>
''' Try to Fix/Rebuild problems of a file,
''' and returns a value indicating if file was fixed or not.
''' </summary>
Public Function Fix ( ByVal MP3_File As String ,
Optional ByVal Delete_Backup_File As Boolean = False ,
Optional ByVal Preserve_Datestamp As Boolean = True ) As Boolean
Return Run_MP3VAL( MP3_File,
Operation.Fix ,
String .Format ( "-f {0} {1} " "{2}" "" ,
If ( Delete_Backup_File, "-nb" , "" ) ,
If ( Preserve_Datestamp, "-t" , "" ) ,
MP3_File) )
End Function
''' <summary>
''' Try to Fix/Rebuild problems of a file,
''' and returns a value indicating if file was fixed or not.
''' </summary>
Public Function Fix ( ByVal MP3_File As IO.FileInfo ,
Optional ByVal Delete_Backup_File As Boolean = False ,
Optional ByVal Preserve_Datestamp As Boolean = True ) As Boolean
Return Run_MP3VAL( MP3_File.FullName ,
Operation.Fix ,
String .Format ( "-f {0} {1} " "{2}" "" ,
If ( Delete_Backup_File, "-nb" , "" ) ,
If ( Preserve_Datestamp, "-t" , "" ) ,
MP3_File.FullName ) )
End Function
''' <summary>
''' Return the metadata ID types of a file.
''' </summary>
Public Function Get_Tags( ByVal MP3_File As String ) As String
Return Run_MP3VAL( MP3_File,
Operation.Get_Tags ,
ControlChars.Quote & MP3_File & ControlChars.Quote )
End Function
''' <summary>
''' Return the metadata ID types of a file.
''' </summary>
Public Function Get_Tags( ByVal MP3_File As IO.FileInfo ) As String
Return Run_MP3VAL( MP3_File.FullName ,
Operation.Get_Tags ,
ControlChars.Quote & MP3_File.FullName & ControlChars.Quote )
End Function
#End Region
#Region " Run Procedure "
''' <summary>
''' Runs mp3val process.
''' </summary>
Private Function Run_MP3VAL( ByVal MP3_File As String ,
ByVal operation As Operation,
ByVal arguments As String ) As Object
If Me .CheckFileExist Then
FileExist( MP3_File)
End If
With p.StartInfo
.FileName = Me .mp3val_location
.Arguments = arguments
End With
Warnings.Clear ( ) : Errors.Clear ( )
p.Start ( )
RaiseEvent_Started( MP3_File, operation)
p.WaitForExit ( )
StandardError = p.StandardError .ReadToEnd
StandardOutput = p.StandardOutput .ReadToEnd
Info = Info_RegEx.Match ( StandardOutput) .Groups ( 1 ) .Value .Trim
For Each m As System.Text .RegularExpressions .Match In Warning_RegEx.Matches ( StandardOutput)
Warnings.Add ( m.Groups ( 1 ) .Value )
Next m
For Each e As String In StandardError.Split ( Environment.NewLine )
If Not String .IsNullOrEmpty ( e.Trim ) Then
Errors.Add ( e)
End If
Next e
Select Case operation
Case mp3val.Operation .Analyze
RaiseEvent_Exited( MP3_File,
operation.Analyze ,
Info,
Warnings.Distinct .ToList ,
Errors,
False )
Return Warnings.Concat ( Errors) .Distinct .ToList
Case mp3val.Operation .Fix
RaiseEvent_Exited( MP3_File,
operation.Fix ,
Info,
Warnings.Distinct .ToList ,
Errors,
Fixed_RegEx.IsMatch ( StandardOutput) )
Return Fixed_RegEx.IsMatch ( StandardOutput)
Case mp3val.Operation .Get_Tags
RaiseEvent_Exited( MP3_File,
operation.Get_Tags ,
Info,
Warnings.Distinct .ToList ,
Errors,
False )
If Not String .IsNullOrEmpty ( Info) Then
Tags = Info.Split ( "," ) ( 1 ) .Trim
If Tags = "no tags" Then
Return "No tags"
Else
Return Tags.Substring ( 1 ) .Replace ( "+" , ", " )
End If
Else
Return "Can't examine tag type."
End If
Case Else
Return Nothing
End Select
End Function
#End Region
#Region " Miscellaneous preocedures "
''' <summary>
''' Checks if a file exists.
''' </summary>
Private Sub FileExist
( ByVal File As String )
Throw New Exception
( String .
Format ( "File doesn't exist: " "{0}" "" ,
File ) ) ' MessageBox.Show(String.Format("File doesn't exist: ""{0}""", File), "mp3val", MessageBoxButtons.OK, MessageBoxIcon.Error)
End If
End Sub
''' <summary>
''' Raises the Event Started
''' </summary>
Private Sub RaiseEvent_Started
( ByVal File As String ,
ByVal Operation As Operation)
With StartedArgs
.Operation = Operation
End With
RaiseEvent Started( p, StartedArgs)
End Sub
''' <summary>
''' Raises the Event Exited
''' </summary>
Private Sub RaiseEvent_Exited
( ByVal File As String ,
ByVal Operation As Operation,
ByVal Info As String ,
ByVal Warnings As List( Of String ) ,
ByVal Errors As List( Of String ) ,
ByVal IsFixed As Boolean )
With ExitedArgs
.Operation = Operation
.Info = Info
.Warnings = Warnings
.Errors = Errors
.FileIsFixed = IsFixed
End With
RaiseEvent Exited( p, ExitedArgs)
End Sub
#End Region
#Region " IDisposable "
''' <summary>
''' Disposes the objects generated by this instance.
''' </summary>
Public Sub Dispose( ) Implements IDisposable.Dispose
Dispose( True )
GC.SuppressFinalize ( Me )
End Sub
Protected Overridable Sub Dispose( IsDisposing As Boolean )
Static IsBusy As Boolean ' To detect redundant calls.
If Not IsBusy AndAlso IsDisposing Then
p.Dispose ( )
End If
IsBusy = True
End Sub
#End Region
End Class
#End Region
Eleкtro
Ex-Staff
Desconectado
Mensajes: 9.878
Un pequeño hook para capturar los mensajes del menú de edición del menú contextual (por defecto) de un Textbox (las opciones de copiar, pegar, cortar, y eliminar).
En un post anterior posteé la forma de capturarl dichos mensajes heredando el Textbox, pero este código es diferente, no depende de ningun control, se puede usar como otra Class cualquiera para capturar los mensajes en cualquier textbox (menos los textbox de Krypton y otros...) sin necesidad de heredar el control.
PD: El código no es del todo de mi propiedad, me han ayudado un poquito.
#Region " Capture Windows ContextMenu Edit Options "
' [ Capture Windows ContextMenu Edit Options ]
'
' Examples :
'
' Public Class Form1
'
' Private WithEvents EditMenu As New EditMenuHook
'
' Protected Overrides Sub OnLoad(e As EventArgs)
' MyBase.OnLoad(e)
' ' Capture the EditMenu Messages for TextBox1 and TextBox2
' EditMenuHook.Controls = {TextBox1, TextBox2}
' ' Enable the Hook
' EditMenuHook.Enable(True)
' End Sub
'
' Protected Overrides Sub OnClosed(e As EventArgs)
' ' Disable the Hook
' EditMenuHook.Enable(False)
' MyBase.OnClosed(e)
' End Sub
'
' Private Sub TextBox_OnTextCommand(sender As Object, e As EditMenuHook.TextCommandEventArgs) _
' Handles EditMenu.OnCopy, EditMenu.OnCut, EditMenu.OnPaste, EditMenu.OnDelete
'
' MessageBox.Show(String.Format("Control:{0} Message:{1}", sender.name, e.Command.ToString))
'
' End Sub
'
' End Class
Imports System.Runtime .InteropServices
Friend Class EditMenuHook
<DllImport( "User32.dll" , CharSet:= CharSet.Auto , CallingConvention:= CallingConvention.StdCall ) > _
Public Overloads Shared Function SetWindowsHookEx _
( ByVal idHook As Integer , ByVal HookProc As CallBack, ByVal hInstance As IntPtr, ByVal wParam As Integer ) As Integer
End Function
<DllImport( "User32.dll" , CharSet:= CharSet.Auto , CallingConvention:= CallingConvention.StdCall ) > _
Public Overloads Shared Function CallNextHookEx _
( ByVal idHook As Integer , ByVal nCode As Integer , ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
End Function
<DllImport( "User32.dll" , CharSet:= CharSet.Auto , CallingConvention:= CallingConvention.StdCall ) > _
Public Overloads Shared Function UnhookWindowsHookEx _
( ByVal idHook As Integer ) As Boolean
End Function
Public Enum TextCommandMessage
WM_CUT = & H300
WM_COPY = & H301
WM_PASTE = & H302
WM_DELETE = & H303
End Enum
Public Structure CWPSTRUCT
Public lParam As IntPtr
Public wParam As IntPtr
Public message As UInt32
Public hWnd As IntPtr
End Structure
Public Delegate Function CallBack( _
ByVal nCode As Integer , _
ByVal wParam As IntPtr, _
ByVal lParam As IntPtr) As Integer
Private Shared WithEvents CopyOrCut_Timer As New Timer _
With { .Interval = 50 , .Enabled = False }
' The Control to monitor and report the TextCommand Messages.
Public Shared Controls As Control( ) = Nothing
Public Shared MessagesEnabled As Boolean = True
Private Shared CopyMessageEnabled As Boolean = True
Shared hHook As Integer = 0
Private Shared cwp As CWPSTRUCT
Private Const WH_CALLWNDPROC = 4
'Keep the reference so that the delegate is not garbage collected.
Private Shared hookproc As CallBack
Public Class TextCommandEventArgs
Inherits EventArgs
Public Property Command As TextCommandMessage
End Class
Shared Event OnCut( sender As Object , e As TextCommandEventArgs)
Shared Event OnCopy( sender As Object , e As TextCommandEventArgs)
Shared Event OnPaste( sender As Object , e As TextCommandEventArgs)
Shared Event OnDelete( sender As Object , e As TextCommandEventArgs)
Friend Shared Sub Enable( enable As Boolean )
If hHook = 0 AndAlso enable = True Then
hookproc = AddressOf EditCommandHook
hHook = SetWindowsHookEx( WH_CALLWNDPROC, _
hookproc, _
IntPtr.Zero , _
AppDomain.GetCurrentThreadId ( ) )
If hHook.Equals ( 0 ) Then
MsgBox ( "SetWindowsHookEx Failed" )
Return
End If
ElseIf hHook <> 0 AndAlso enable = False Then
Dim ret As Boolean = UnhookWindowsHookEx( hHook)
If ret.Equals ( False ) Then
MsgBox ( "UnhookWindowsHookEx Failed" )
Return
Else
hHook = 0
End If
End If
End Sub
Private Shared Function EditCommandHook( ByVal nCode As Integer , _
ByVal wParam As IntPtr, _
ByVal lParam As IntPtr) As Integer
If nCode < 0 Then
Return CallNextHookEx( hHook, nCode, wParam, lParam)
End If
cwp = DirectCast( Marshal.PtrToStructure ( lParam, GetType ( CWPSTRUCT) ) , CWPSTRUCT)
For Each ctrl As Control In Controls
If cwp.hWnd = ctrl.Handle Then
Select Case cwp.message
Case TextCommandMessage.WM_CUT
CopyMessageEnabled = False
RaiseEvent OnCut( ctrl, New TextCommandEventArgs( ) _
With { .Command = TextCommandMessage.WM_CUT } )
Case TextCommandMessage.WM_COPY
If CopyMessageEnabled Then
RaiseEvent OnCopy( ctrl, New TextCommandEventArgs( ) _
With { .Command = TextCommandMessage.WM_COPY } )
Else
CopyMessageEnabled = True
End If
Case TextCommandMessage.WM_PASTE
RaiseEvent OnPaste( ctrl, New TextCommandEventArgs( ) _
With { .Command = TextCommandMessage.WM_PASTE } )
Case TextCommandMessage.WM_DELETE
RaiseEvent OnDelete( ctrl, New TextCommandEventArgs( ) _
With { .Command = TextCommandMessage.WM_DELETE } )
End Select
End If
Next
Return CallNextHookEx( hHook, nCode, wParam, lParam)
End Function
End Class
#End Region
« Última modificación: 11 Noviembre 2013, 01:45 am por EleKtro H@cker »
Eleкtro
Ex-Staff
Desconectado
Mensajes: 9.878
Devuelve un Array con las ocurrencias que se encuentren de una Value en un Diccionario
#Region " Match Dictionary Values "
' [ Match Dictionary Values ]
'
' // By Elektro H@cker
'
' Examples :
'
' MsgBox(Match_Dictionary_Values(New Dictionary(Of Integer, String) From {{1, "Hello World!"}},
' "hello", False, StringComparison.CurrentCultureIgnoreCase).First.Value)
Private Function Match_Dictionary_Values( Of K) (
ByVal Value As String ,
ByVal MatchWholeWord As Boolean ,
ByVal IgnoreCase As StringComparison) As KeyValuePair( Of K, String ) ( )
If MatchWholeWord Then
Return ( From kp
As KeyValuePair
( Of K,
String ) In
Dictionary Where String .Compare ( kp.Value , Value, IgnoreCase) = 0 ) .ToArray
Else
Return ( From kp
As KeyValuePair
( Of K,
String ) In
Dictionary Where kp.Value .IndexOf ( Value, 0 , IgnoreCase) > - 1 ) .ToArray
End If
End Function
#End Region
Devuelve un Array con las ocurrencias que se encuentren de una Key en un Diccionario
#Region " Match Dictionary Keys "
' [ Match Dictionary Keys ]
'
' // By Elektro H@cker
'
' Examples :
'
' MsgBox(Match_Dictionary_Keys(New Dictionary(Of String, Integer) From {{"Hello World!", 1}},
' "hello", False, StringComparison.CurrentCultureIgnoreCase).First.Key)
Private Function Match_Dictionary_Keys( Of V) (
ByVal Key As String ,
ByVal MatchWholeWord As Boolean ,
ByVal IgnoreCase As StringComparison) As KeyValuePair( Of String , V) ( )
If MatchWholeWord Then
Return ( From kp
As KeyValuePair
( Of String , V
) In
Dictionary Where String .Compare ( kp.Key , Key, IgnoreCase) = 0 ) .ToArray
Else
Return ( From kp
As KeyValuePair
( Of String , V
) In
Dictionary Where kp.Key .IndexOf ( Key, 0 , IgnoreCase) > - 1 ) .ToArray
End If
End Function
#End Region
Devuelve True si se encuentra alguna ocurrencia de un Value en un Diccionario.
#Region " Find Dictionary Value "
' [ Find Dictionary Value ]
'
' // By Elektro H@cker
'
' Examples :
'
' MsgBox(Find_Dictionary_Value(
' New Dictionary(Of Integer, String) From {{1, "ABC"}},
' "abc", True, StringComparison.CurrentCultureIgnoreCase))
Private Function Find_Dictionary_Value( Of K) (
ByVal Value As String ,
ByVal MatchWholeWord As Boolean ,
ByVal IgnoreCase As StringComparison) As Boolean
If MatchWholeWord Then
Return ( From kp
As KeyValuePair
( Of K,
String ) In
Dictionary Where String .Compare ( kp.Value , Value, IgnoreCase) = 0 ) .Any
Else
Return ( From kp
As KeyValuePair
( Of K,
String ) In
Dictionary Where kp.Value .IndexOf ( Value, 0 , IgnoreCase) > - 1 ) .Any
End If
End Function
#End Region
Devuelve True si se encuentra alguna ocurrencia de una Key en un Diccionario.
#Region " Find Dictionary Key "
' [ Find Dictionary Key ]
'
' // By Elektro H@cker
'
' Examples :
'
' MsgBox(Find_Dictionary_Key(
' New Dictionary(Of String, Integer) From {{"ABC", 1}},
' "abc", True, StringComparison.CurrentCultureIgnoreCase))
Private Function Find_Dictionary_Key( Of V) (
ByVal Key As String ,
ByVal MatchWholeWord As Boolean ,
ByVal IgnoreCase As StringComparison) As Boolean
If MatchWholeWord Then
Return ( From kp
As KeyValuePair
( Of String , V
) In
Dictionary Where String .Compare ( kp.Key , Key, IgnoreCase) = 0 ) .Any
Else
Return ( From kp
As KeyValuePair
( Of String , V
) In
Dictionary Where kp.Key .IndexOf ( Key, 0 , IgnoreCase) > - 1 ) .Any
End If
End Function
#End Region
Eleкtro
Ex-Staff
Desconectado
Mensajes: 9.878
Quiero compartir con ustedes este SystemMenu Manager, como su nombre indica, es un ayudante para manejar el SystemMenu, le añadi infinidad de métodos y el uso de eventos para manejar de forma sencilla los items que agreguemos... además lo he documentado todo muy bien, aunque me he dejado bastantes comentarios XML (es bastante tedioso), a pesar de las 1.600 lineas de código, aun le faltaría añadir bastantes métodos más, pero bueno, por el momento así está muy bien, espero que lo disfruten.
Unas imágenes:
Un ejemplo de uso:
( Nótese que todos los métodos tienen su overload para utilizar una posición de item en lugar de un item predefinido. ) Public Class Form1
Private WithEvents SystemMenu As New SystemMenuManager( Me )
Private Shadows Sub Shown( ) Handles MyBase .Shown
' Gets the total amount of menu items.
' MsgBox(SystemMenu.GetItemCount())
' Sets the menu background color.
SystemMenu.SetMenuBackColor ( Color.Teal )
' Sets the menu style.
' SystemMenu.SetMenuStyle(SystemMenuManager.MenuStyle.AUTODISMIS)
' Sets the state of the Close button and menu item.
' SystemMenu.SetItemState(SystemMenuManager.Item.Close, SystemMenuManager.ItemState.Disabled)
' Sets the Bitmap image of the Move menu item.
' SystemMenu.SetItemBitmap(SystemMenuManager.Item.Move, New Bitmap("C:\File.png"))
' Gets the Bitmap image of the Move menu item.
' Dim bmp As Bitmap = SystemMenu.GetItemBitmap(SystemMenuManager.Item.Move)
' Removes the Bitmap image of the Move menu item.
' SystemMenu.RemoveItemBitmap(SystemMenuManager.Item.Move)
' Adds a separator at the bottom.
SystemMenu.AddSeparator ( SystemMenuManager.DefaultPositions .Last )
' Adds an item at the bottom.
SystemMenu.AddItem ( "Hello World!" , 666 , SystemMenuManager.DefaultPositions .Last )
' Gets the ID of an item.
' MsgBox(SystemMenu.GetItemState(SystemMenuManager.Item.Move).ToString)
' Gets the text of an item.
' MsgBox(SystemMenu.GetItemText(SystemMenuManager.Item.Move))
' Gets the state of an item.
' MsgBox(SystemMenu.GetItemState(SystemMenuManager.Item.Move).ToString)
' Sets the text of an item.
' SystemMenu.SetItemText(SystemMenuManager.Item.Move, "Muéveme")
' Checks if a handle is a menu handle.
' MsgBox(SystemMenu.IsMenuHandle(IntPtr.Zero))
' Disable all the menu items.
' SystemMenu.DisableAllItems()
' Re-enable all the menu items.
' SystemMenu.EnableAllItems()
' Remove all the menu items.
' SystemMenu.RemoveAllItems()
' Restore the menu to defaults.
' SystemMenu.Restore_Menu()
' Dispose the SystemMenuManager Object.
' SystemMenu.Dispose()
End Sub
' SystemMenu [MenuItemClicked]
Private Sub SystemMenu_MenuItemClicked(
ByVal MenuHandle As IntPtr,
ByVal e As SystemMenuManager.ItemClickedEventArgs
) Handles SystemMenu.ItemClicked
Dim sr As New System.Text .StringBuilder
sr.AppendLine ( String .Format ( "Item ID : {0}" , CStr ( e.ID ) ) )
sr.AppendLine ( String .Format ( "Item Text : {0}" , e.Text ) )
sr.AppendLine ( String .Format ( "Item Type : {0}" , e.Type .ToString ) )
sr.AppendLine ( String .Format ( "Item State: {0}" , e.State .ToString ) )
MessageBox.Show ( sr.ToString , "SystemMenuManager" , MessageBoxButtons.OK , MessageBoxIcon.Information )
End Sub
End Class
La Class la pueden ver en
ESTE enlace de pastebin (no cabe en este post).
« Última modificación: 13 Noviembre 2013, 06:27 am por EleKtro H@cker »
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,890
2 Agosto 2013, 17:13 pm0xDani
[APORTE] [VBS] Snippets para manipular reglas de bloqueo del firewall de Windows Scripting
Eleкtro
1
4,084
3 Febrero 2014, 20:19 pmEleкtro
Librería de Snippets para Delphi « 1 2 » Programación General
crack81
15
21,166
25 Marzo 2016, 18:39 pmcrack81
Una organización en Github para subir, proyectos, snippets y otros? Sugerencias y dudas sobre el Foro
z3nth10n
0
3,074
21 Febrero 2017, 10:47 amz3nth10n
índice de la Librería de Snippets para VB.NET !! .NET (C#, VB.NET, ASP)
Eleкtro
7
6,545
4 Julio 2018, 21:35 pmEleкtro
Autor
En línea
