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

[Eleкtro]

Redimensionar una imágen:

Código (vbnet) [Seleccionar] Expandir

#Region " Resize Image "

    ' [ Save Resize Image Function ]
    '
    ' Examples :
    '
    ' PictureBox1.Image = Resize_Image(System.Drawing.Image.FromFile("C:\Image.png"), 256, 256)

    Private Function Resize_Image(ByVal img As Image, ByVal Width As Int32, ByVal Height As Int32) As Bitmap
        Dim Bitmap_Source As New Bitmap(img)
        Dim Bitmap_Dest As New Bitmap(CInt(Width), CInt(Height))
        Dim Graphic As Graphics = Graphics.FromImage(Bitmap_Dest)
        Graphic.DrawImage(Bitmap_Source, 0, 0, Bitmap_Dest.Width + 1, Bitmap_Dest.Height + 1)
        Return Bitmap_Dest
    End Function

#End Region





Redimensionar una imágen a escala:

Código (vbnet) [Seleccionar] Expandir

#Region " Scale Image "

    ' [ Save Scale Image Function ]
    '
    ' Examples :
    '
    ' PictureBox1.Image = Scale_Image(System.Drawing.Image.FromFile("C:\Image.png"), 3) ' Scales to x3 of original size

    Private Function Scale_Image(ByVal img As Image, ByVal ScaleFactor As Single)
        Dim Bitmap_Source As New Bitmap(img)
        Dim Bitmap_Dest As New Bitmap(CInt(Bitmap_Source.Width * ScaleFactor), CInt(Bitmap_Source.Height * ScaleFactor))
        Dim Graphic As Graphics = Graphics.FromImage(Bitmap_Dest)
        Graphic.DrawImage(Bitmap_Source, 0, 0, Bitmap_Dest.Width + 1, Bitmap_Dest.Height + 1)
        Return Bitmap_Dest
    End Function

#End Region

[Eleкtro]

Reproducir, pausar, detener archivos MP3/WAV/MIDI

Código (vbnet) [Seleccionar] Expandir

   ' PlayFile
   '
   ' Examples:
   ' Dim Audio As New PlayFile("C:\File.mp3")
   ' Audio.Play()
   ' Audio.Pause()
   ' Audio.Resume()
   ' Audio.Stop()

#Region " PlayFile Class"

''' <summary>
''' This class is a wrapper for the Windows API calls to play wave, midi or mp3 files.
''' </summary>
''' <remarks>
''' </remarks>
Public Class PlayFile
   '***********************************************************************************************************
   '        Class:  PlayFile
   '   Written By:  Blake Pell (bpell@indiana.edu)
   ' Initial Date:  03/31/2007
   ' Last Updated:  02/04/2009
   '***********************************************************************************************************

   ' Windows API Declarations
   Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Int32, ByVal hwndCallback As Int32) As Int32

   ''' <summary>
   ''' Constructor:  Location is the filename of the media to play.  Wave files and Mp3 files are the supported formats.
   ''' </summary>
   ''' <param name="Location"></param>
   ''' <remarks></remarks>
   Public Sub New(ByVal location As String)
       Me.Filename = location
   End Sub

   ''' <summary>
   ''' Plays the file that is specified as the filename.
   ''' </summary>
   ''' <remarks></remarks>
   Public Sub Play()

       If _filename = "" Or Filename.Length <= 4 Then Exit Sub

       Select Case Right(Filename, 3).ToLower
           Case "mp3"
               mciSendString("open """ & _filename & """ type mpegvideo alias audiofile", Nothing, 0, IntPtr.Zero)

               Dim playCommand As String = "play audiofile from 0"

               If _wait = True Then playCommand += " wait"

               mciSendString(playCommand, Nothing, 0, IntPtr.Zero)
           Case "wav"
               mciSendString("open """ & _filename & """ type waveaudio alias audiofile", Nothing, 0, IntPtr.Zero)
               mciSendString("play audiofile from 0", Nothing, 0, IntPtr.Zero)
           Case "mid", "idi"
               mciSendString("stop midi", "", 0, 0)
               mciSendString("close midi", "", 0, 0)
               mciSendString("open sequencer!" & _filename & " alias midi", "", 0, 0)
               mciSendString("play midi", "", 0, 0)
           Case Else
               Throw New Exception("File type not supported.")
               Call Close()
       End Select

       IsPaused = False

   End Sub

   ''' <summary>
   ''' Pause the current play back.
   ''' </summary>
   ''' <remarks></remarks>
   Public Sub Pause()
       mciSendString("pause audiofile", Nothing, 0, IntPtr.Zero)
       IsPaused = True
   End Sub

   ''' <summary>
   ''' Resume the current play back if it is currently paused.
   ''' </summary>
   ''' <remarks></remarks>
   Public Sub [Resume]()
       mciSendString("resume audiofile", Nothing, 0, IntPtr.Zero)
       IsPaused = False
   End Sub

   ''' <summary>
   ''' Stop the current file if it's playing.
   ''' </summary>
   ''' <remarks></remarks>
   Public Sub [Stop]()
       mciSendString("stop audiofile", Nothing, 0, IntPtr.Zero)
   End Sub

   ''' <summary>
   ''' Close the file.
   ''' </summary>
   ''' <remarks></remarks>
   Public Sub Close()
       mciSendString("close audiofile", Nothing, 0, IntPtr.Zero)
   End Sub

   Private _wait As Boolean = False
   ''' <summary>
   ''' Halt the program until the .wav file is done playing.  Be careful, this will lock the entire program up until the
   ''' file is done playing.  It behaves as if the Windows Sleep API is called while the file is playing (and maybe it is, I don't
   ''' actually know, I'm just theorizing).  :P
   ''' </summary>
   ''' <value></value>
   ''' <returns></returns>
   ''' <remarks></remarks>
   Public Property Wait() As Boolean
       Get
           Return _wait
       End Get
       Set(ByVal value As Boolean)
           _wait = value
       End Set
   End Property

   ''' <summary>
   ''' Sets the audio file's time format via the mciSendString API.
   ''' </summary>
   ''' <value></value>
   ''' <returns></returns>
   ''' <remarks></remarks>
   ReadOnly Property Milleseconds() As Integer
       Get
           Dim buf As String = Space(255)
           mciSendString("set audiofile time format milliseconds", Nothing, 0, IntPtr.Zero)
           mciSendString("status audiofile length", buf, 255, IntPtr.Zero)

           buf = Replace(buf, Chr(0), "") ' Get rid of the nulls, they muck things up

           If buf = "" Then
               Return 0
           Else
               Return CInt(buf)
           End If
       End Get
   End Property

   ''' <summary>
   ''' Gets the status of the current playback file via the mciSendString API.
   ''' </summary>
   ''' <value></value>
   ''' <returns></returns>
   ''' <remarks></remarks>
   ReadOnly Property Status() As String
       Get
           Dim buf As String = Space(255)
           mciSendString("status audiofile mode", buf, 255, IntPtr.Zero)
           buf = Replace(buf, Chr(0), "")  ' Get rid of the nulls, they muck things up
           Return buf
       End Get
   End Property

   ''' <summary>
   ''' Gets the file size of the current audio file.
   ''' </summary>
   ''' <value></value>
   ''' <returns></returns>
   ''' <remarks></remarks>
   ReadOnly Property FileSize() As Integer
       Get
           Try
               Return My.Computer.FileSystem.GetFileInfo(_filename).Length
           Catch ex As Exception
               Return 0
           End Try
       End Get
   End Property

   ''' <summary>
   ''' Gets the channels of the file via the mciSendString API.
   ''' </summary>
   ''' <value></value>
   ''' <returns></returns>
   ''' <remarks></remarks>
   ReadOnly Property Channels() As Integer
       Get
           Dim buf As String = Space(255)
           mciSendString("status audiofile channels", buf, 255, IntPtr.Zero)

           If IsNumeric(buf) = True Then
               Return CInt(buf)
           Else
               Return -1
           End If
       End Get
   End Property

   ''' <summary>
   ''' Used for debugging purposes.
   ''' </summary>
   ''' <value></value>
   ''' <returns></returns>
   ''' <remarks></remarks>
   ReadOnly Property Debug() As String
       Get
           Dim buf As String = Space(255)
           mciSendString("status audiofile channels", buf, 255, IntPtr.Zero)

           Return Str(buf)
       End Get
   End Property

   Private _isPaused As Boolean = False
   ''' <summary>
   ''' Whether or not the current playback is paused.
   ''' </summary>
   ''' <value></value>
   ''' <returns></returns>
   ''' <remarks></remarks>
   Public Property IsPaused() As Boolean
       Get
           Return _isPaused
       End Get
       Set(ByVal value As Boolean)
           _isPaused = value
       End Set
   End Property

   Private _filename As String
   ''' <summary>
   ''' The current filename of the file that is to be played back.
   ''' </summary>
   ''' <value></value>
   ''' <returns></returns>
   ''' <remarks></remarks>
   Public Property Filename() As String
       Get
           Return _filename
       End Get
       Set(ByVal value As String)

           If My.Computer.FileSystem.FileExists(value) = False Then
               Throw New System.IO.FileNotFoundException
               Exit Property
           End If

           _filename = value
       End Set
   End Property
End Class

#End Region




Ejemplos de uso del Windows Media Player control:

Código (vbnet) [Seleccionar] Expandir

#Region " Windows Media Player "

       AxWindowsMediaPlayer1.Visible = False
       AxWindowsMediaPlayer1.URL = "C:\Audio.mp3"
       AxWindowsMediaPlayer1.URL = "C:\Video.avi"
       AxWindowsMediaPlayer1.settings.volume = 50
       AxWindowsMediaPlayer1.settings.setMode("autoRewind", False) ' Mode indicating whether the tracks are rewound to the beginning after playing to the end. Default state is true.
       AxWindowsMediaPlayer1.settings.setMode("loop", False) ' Mode indicating whether the sequence of tracks repeats itself. Default state is false.
       AxWindowsMediaPlayer1.settings.setMode("showFrame", False) ' Mode indicating whether the nearest video key frame is displayed at the current position when not playing. Default state is false. Has no effect on audio tracks.
       AxWindowsMediaPlayer1.settings.setMode("shuffle", False) ' Mode indicating whether the tracks are played in random order. Default state is false.
       AxWindowsMediaPlayer1.Ctlcontrols.play()
       AxWindowsMediaPlayer1.Ctlcontrols.stop()

#End Region

[Eleкtro]

Un ColorDialog "por defecto" que tiene las propiedades "Title" y "Location",
Además se puede handlear el color que hay seleccionado en cualquier momento en el modo "Full open", para obtener el color sin tener que confirmar el diálogo.

PD: Hay que instanciarlo siempre para handlear el .Currentcolor

Ejemplos de uso:

Código (vbnet) [Seleccionar] Expandir

Public Class Form1

    Private WithEvents PicBox As New PictureBox
    Private WithEvents ColorDlg As ColorDialog_RealTime.Colordialog_Realtime = Nothing

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        PicBox.BackColor = Color.Blue
        Me.Controls.Add(PicBox)
    End Sub

    Private Sub PicBox_Click(sender As Object, e As EventArgs) Handles PicBox.Click
        ColorDlg = New ColorDialog_RealTime.Colordialog_Realtime
        ColorDlg.Title = "Hello!"
        ColorDlg.Location = New Point(Me.Right, Me.Top)
        ColorDlg.Color = sender.backcolor
        If ColorDlg.ShowDialog() = Windows.Forms.DialogResult.OK Then
            sender.BackColor = ColorDlg.Color
        End If
        ColorDlg = Nothing
    End Sub

    Private Sub ColorDlg_CurrentColor(c As System.Drawing.Color) Handles ColorDlg.CurrentColor
        PicBox.BackColor = c
    End Sub

End Class

Código (vbnet) [Seleccionar] Expandir

Public Class Colordialog_Realtime
   Inherits ColorDialog

   Public Event CurrentColor(ByVal c As Color)

   Private Const GA_ROOT As Integer = 2
   Private Const WM_PAINT As Integer = &HF
   Private Const WM_CTLCOLOREDIT As Integer = &H133

   Public Declare Function GetAncestor Lib "user32.dll" _
       (ByVal hWnd As IntPtr, ByVal gaFlags As Integer) As IntPtr

   Private EditWindows As List(Of ApiWindow) = Nothing

   Public Sub New()
       Me.FullOpen = True
   End Sub

   <Runtime.InteropServices.DllImport("user32.dll")> _
   Private Shared Function SetWindowText(hWnd As IntPtr, lpString As String) As Boolean
   End Function

   Private Const SWP_NOSIZE As Integer = &H1
   Private Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" _
       (ByVal hwnd As IntPtr, ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) As Integer

   Private m_title As String = String.Empty
   Private titleSet As Boolean = False

   Public Property Title() As String
       Get
           Return m_title
       End Get
       Set(value As String)
           If value IsNot Nothing AndAlso value <> m_title Then
               m_title = value
               titleSet = False
           End If
       End Set
   End Property

   Private m_location As Point = Point.Empty
   Private locationSet As Boolean = False

   Public Property Location() As Point
       Get
           Return m_location
       End Get
       Set(value As Point)
           If Not value.Equals(Point.Empty) AndAlso Not value.Equals(m_location) Then
               m_location = value
               locationSet = False
           End If
       End Set
   End Property

   <System.Security.Permissions.PermissionSetAttribute(System.Security.Permissions.SecurityAction.Demand, Name:="FullTrust")> _
   Protected Overrides Function HookProc(ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
       Select Case msg
           Case WM_PAINT
               If Not titleSet AndAlso Title <> String.Empty Then
                   SetWindowText(GetAncestor(hWnd, GA_ROOT), Title)
                   titleSet = True
               End If
               If Not locationSet AndAlso Not m_location.Equals(Point.Empty) Then
                   SetWindowPos(GetAncestor(hWnd, GA_ROOT), 0, m_location.X, m_location.Y, 0, 0, SWP_NOSIZE)
                   locationSet = True
               End If

           Case WM_CTLCOLOREDIT
               If IsNothing(EditWindows) Then
                   Dim mainWindow As IntPtr = GetAncestor(hWnd, GA_ROOT)
                   If Not mainWindow.Equals(IntPtr.Zero) Then
                       EditWindows = New List(Of ApiWindow)((New WindowsEnumerator).GetChildWindows(mainWindow, "Edit"))
                   End If
               End If

               If Not IsNothing(EditWindows) AndAlso EditWindows.Count = 6 Then
                   Dim strRed As String = WindowsEnumerator.WindowText(EditWindows(3).hWnd)
                   Dim strGreen As String = WindowsEnumerator.WindowText(EditWindows(4).hWnd)
                   Dim strBlue As String = WindowsEnumerator.WindowText(EditWindows(5).hWnd)

                   Dim Red, Green, Blue As Integer
                   If Integer.TryParse(strRed, Red) Then
                       If Integer.TryParse(strGreen, Green) Then
                           If Integer.TryParse(strBlue, Blue) Then
                               RaiseEvent CurrentColor(Color.FromArgb(Red, Green, Blue))
                           End If
                       End If
                   End If
               End If
       End Select

       Return MyBase.HookProc(hWnd, msg, wParam, lParam)
   End Function

End Class

Class ApiWindow
   Public hWnd As IntPtr
   Public ClassName As String
   Public MainWindowTitle As String
End Class

Class WindowsEnumerator

   Private Delegate Function EnumCallBackDelegate(ByVal hwnd As IntPtr, ByVal lParam As Integer) As Integer

   Private Declare Function EnumWindows Lib "user32" _
       (ByVal lpEnumFunc As EnumCallBackDelegate, ByVal lParam As Integer) As Integer

   Private Declare Function EnumChildWindows Lib "user32" _
       (ByVal hWndParent As IntPtr, ByVal lpEnumFunc As EnumCallBackDelegate, ByVal lParam As Integer) As Integer

   Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
       (ByVal hwnd As IntPtr, ByVal lpClassName As System.Text.StringBuilder, ByVal nMaxCount As Integer) As Integer

   Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As IntPtr) As Integer

   Private Declare Function GetParent Lib "user32" (ByVal hwnd As IntPtr) As Integer

   Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
       (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer

   Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
       (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As System.Text.StringBuilder) As Integer

   Private _listChildren As New List(Of ApiWindow)
   Private _listTopLevel As New List(Of ApiWindow)

   Private _topLevelClass As String = String.Empty
   Private _childClass As String = String.Empty

   Public Overloads Function GetTopLevelWindows() As ApiWindow()
       EnumWindows(AddressOf EnumWindowProc, &H0)
       Return _listTopLevel.ToArray
   End Function

   Public Overloads Function GetTopLevelWindows(ByVal className As String) As ApiWindow()
       _topLevelClass = className
       Return Me.GetTopLevelWindows()
   End Function

   Public Overloads Function GetChildWindows(ByVal hwnd As Int32) As ApiWindow()
       _listChildren.Clear()
       EnumChildWindows(hwnd, AddressOf EnumChildWindowProc, &H0)
       Return _listChildren.ToArray
   End Function

   Public Overloads Function GetChildWindows(ByVal hwnd As Int32, ByVal childClass As String) As ApiWindow()
       _childClass = childClass
       Return Me.GetChildWindows(hwnd)
   End Function

   Private Function EnumWindowProc(ByVal hwnd As Int32, ByVal lParam As Int32) As Int32
       If GetParent(hwnd) = 0 AndAlso IsWindowVisible(hwnd) Then
           Dim window As ApiWindow = GetWindowIdentification(hwnd)
           If _topLevelClass.Length = 0 OrElse window.ClassName.ToLower() = _topLevelClass.ToLower() Then
               _listTopLevel.Add(window)
           End If
       End If
       Return 1
   End Function

   Private Function EnumChildWindowProc(ByVal hwnd As Int32, ByVal lParam As Int32) As Int32
       Dim window As ApiWindow = GetWindowIdentification(hwnd)
       If _childClass.Length = 0 OrElse window.ClassName.ToLower() = _childClass.ToLower() Then
           _listChildren.Add(window)
       End If
       Return 1
   End Function

   Private Function GetWindowIdentification(ByVal hwnd As Integer) As ApiWindow
       Dim classBuilder As New System.Text.StringBuilder(64)
       GetClassName(hwnd, classBuilder, 64)

       Dim window As New ApiWindow
       window.ClassName = classBuilder.ToString()
       window.MainWindowTitle = WindowText(hwnd)
       window.hWnd = hwnd
       Return window
   End Function

   Public Shared Function WindowText(ByVal hwnd As IntPtr) As String
       Const W_GETTEXT As Integer = &HD
       Const W_GETTEXTLENGTH As Integer = &HE

       Dim SB As New System.Text.StringBuilder
       Dim length As Integer = SendMessage(hwnd, W_GETTEXTLENGTH, 0, 0)
       If length > 0 Then
           SB = New System.Text.StringBuilder(length + 1)
           SendMessage(hwnd, W_GETTEXT, SB.Capacity, SB)
       End If
       Return SB.ToString
   End Function

End Class

[Eleкtro]

Una class para grabar tareas del mouse (mover el mouse aquí, clickar botón izquierdo hallá, etc)

De momento solo he conseguido implementar los botones del mouse izquierdo/derecho.

Saludos.

Código (vbnet) [Seleccionar] Expandir

#Region " Record Mouse Class "

' [ Record Mouse Functions ]
'
' // By Elektro H@cker
'
' Examples :
' Record_Mouse.Start_Record()
' Record_Mouse.Stop_Record()
' Record_Mouse.Play() : While Not Record_Mouse.Play_Is_Completed : Application.DoEvents() : End While
' Record_Mouse.Mouse_Speed = 50

Public Class Record_Mouse

    ''' <summary>
    ''' Sets the speed of recording/playing the mouse actions.
    ''' Default value is 25.
    ''' </summary>
    Public Shared Mouse_Speed As Int64 = 30

    ''' <summary>
    ''' Gets the status pf the current mouse play.
    ''' False = Mouse task is still playing.
    ''' True = Mouse task play is done.
    ''' </summary>
    Public Shared Play_Is_Completed As Boolean

    ' Where the mouse coordenates will be stored:
    Private Shared Coordenates_List As New List(Of Point)
    ' Where the mouse clicks will be stored:
    Private Shared Clicks_Dictionary As New Dictionary(Of Int64, MouseButton)
    ' Timer to record the mouse:
    Private Shared WithEvents Record_Timer As New Timer
    ' Button click count to rec/play clicks:
    Private Shared Click_Count As Int32 = 0
    ' Thread to reproduce the mouse actions:
    Private Shared Thread_MousePlay_Var As System.Threading.Thread = New Threading.Thread(AddressOf Thread_MousePlay)
    ' API to record the current mouse button state:
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    ' API to reproduce a mouse button click:
    Private Declare Sub Mouse_Event Lib "User32" Alias "mouse_event" (ByVal dwFlags As MouseButton, ByVal dx As Integer, ByVal dy As Integer, ByVal dwData As Integer, ByVal dwExtraInfo As Integer)
    ' GetAsyncKeyState buttons status
    Private Shared Last_ClickState_Left As Int64 = -1
    Private Shared Last_ClickState_Right As Int64 = -1
    Private Shared Last_ClickState_Middle As Int64 = -1

    Enum MouseButton

        Left_Down = &H2    ' Left button (hold)
        Left_Up = &H4      ' Left button (release)

        Right_Down = &H8   ' Right button (hold)
        Right_Up = &H10    ' Right button (release)

        Middle_Down = &H20 ' Middle button (hold)
        Middle_Up = &H40   ' Middle button (release)

        Left               ' Left   button (press)
        Right              ' Right  button (press)
        Middle             ' Middle button (press)

    End Enum

    ''' <summary>
    ''' Starts recording the mouse actions over the screen.
    ''' It records the position of the mouse and left/right button clicks.
    ''' </summary>
    Public Shared Sub Start_Record()

        ' Reset vars:
        Play_Is_Completed = False
        Coordenates_List.Clear() : Clicks_Dictionary.Clear()
        Last_ClickState_Left = -1 : Last_ClickState_Right = -1 : Last_ClickState_Middle = -1
        Click_Count = 0

        ' Set Mouse Speed
        Record_Timer.Interval = Mouse_Speed

        ' Start Recording:
        Record_Timer.Start()

    End Sub

    ''' <summary>
    ''' Stop recording the mouse actions.
    ''' </summary>
    Public Shared Sub Stop_Record()
        Record_Timer.Stop()
    End Sub

    ''' <summary>
    ''' Reproduce the mouse actions.
    ''' </summary>
    Public Shared Sub Play()
        Thread_MousePlay_Var = New Threading.Thread(AddressOf Thread_MousePlay)
        Thread_MousePlay_Var.IsBackground = True
        Thread_MousePlay_Var.Start()
    End Sub

    ' Procedure used to store the mouse actions
    Private Shared Sub Record_Timer_Tick(sender As Object, e As EventArgs) Handles Record_Timer.Tick

        Coordenates_List.Add(Control.MousePosition)

        ' Record Left click
        If Not Last_ClickState_Left = GetAsyncKeyState(1) Then
            Last_ClickState_Left = GetAsyncKeyState(1)
            If GetAsyncKeyState(1) = 32768 Then
                Click_Count += 1
                Coordenates_List.Add(Nothing)
                Clicks_Dictionary.Add(Click_Count, MouseButton.Left_Down)
            ElseIf GetAsyncKeyState(1) = 0 Then
                Click_Count += 1
                Coordenates_List.Add(Nothing)
                Clicks_Dictionary.Add(Click_Count, MouseButton.Left_Up)
            End If
        End If

        ' Record Right click
        If Not Last_ClickState_Right = GetAsyncKeyState(2) Then
            Last_ClickState_Right = GetAsyncKeyState(2)
            If GetAsyncKeyState(2) = 32768 Then
                Click_Count += 1
                Coordenates_List.Add(Nothing)
                Clicks_Dictionary.Add(Click_Count, MouseButton.Right_Down)
            ElseIf GetAsyncKeyState(2) = 0 Then
                Click_Count += 1
                Coordenates_List.Add(Nothing)
                Clicks_Dictionary.Add(Click_Count, MouseButton.Right_Up)
            End If
        End If

        ' Record Middle click
        If Not Last_ClickState_Middle = GetAsyncKeyState(4) Then
            Last_ClickState_Middle = GetAsyncKeyState(4)
            If GetAsyncKeyState(4) = 32768 Then
                Click_Count += 1
                Coordenates_List.Add(Nothing)
                Clicks_Dictionary.Add(Click_Count, MouseButton.Middle_Down)
            ElseIf GetAsyncKeyState(4) = 0 Then
                Click_Count += 1
                Coordenates_List.Add(Nothing)
                Clicks_Dictionary.Add(Click_Count, MouseButton.Middle_Up)
            End If
        End If

    End Sub

    ' Procedure to play a mouse button (click)
    Private Shared Sub Mouse_Click(ByVal MouseButton As MouseButton)
        Select Case MouseButton
            Case MouseButton.Left : Mouse_Event(MouseButton.Left_Down, 0, 0, 0, 0) : Mouse_Event(MouseButton.Left_Up, 0, 0, 0, 0)
            Case MouseButton.Right : Mouse_Event(MouseButton.Right_Down, 0, 0, 0, 0) : Mouse_Event(MouseButton.Right_Up, 0, 0, 0, 0)
            Case MouseButton.Middle : Mouse_Event(MouseButton.Middle_Down, 0, 0, 0, 0) : Mouse_Event(MouseButton.Middle_Up, 0, 0, 0, 0)
            Case Else : Mouse_Event(MouseButton, 0, 0, 0, 0)
        End Select
    End Sub

    ' Thread used for reproduce the mouse actions
    Private Shared Sub Thread_MousePlay()

        Click_Count = 0
        Clicks_Dictionary.Item(0) = Nothing

        For Each Coordenate In Coordenates_List

            Threading.Thread.Sleep(Mouse_Speed)

            If Coordenate = Nothing Then
                Click_Count += 1
                If Click_Count > 1 Then
                    Mouse_Click(Clicks_Dictionary.Item(Click_Count))
                End If
            Else
                Cursor.Position = Coordenate
            End If

        Next

        Mouse_Click(MouseButton.Left_Up)
        Mouse_Click(MouseButton.Right_Up)
        Mouse_Click(MouseButton.Middle_Up)

        Play_Is_Completed = True

    End Sub

End Class

#End Region

[Eleкtro]

Sección de ayuda para aplicaciones CommandLine.

Código (vbnet) [Seleccionar] Expandir

#Region " Help Section "

    Private Sub Help()

        Dim Logo As String = <a><![CDATA[
.____                         
|    |    ____   ____   ____ 
|    |   /  _ \ / ___\ /  _ \
|    |__(  <_> ) /_/  >  <_> )
|_______ \____/\___  / \____/
        \/    /_____/    By Elektro H@cker
]]></a>.Value

        Dim Help As String = <a><![CDATA[   
                           
[+] Syntax:

    Program.exe [FILE] [SWITCHES]

[+] Switches:

    /Switch1   | Description.    (Default Value: X)
    /Switch2   | Description.
    /? (or) -? | Show this help.

[+] Switch value Syntax:

    /Switch1   (ms)
    /Switch2   (X,Y)

[+] Usage examples:

    Program.exe "C:\File.txt" /Switch1
    (Short explanation)

]]></a>.Value

        Console.WriteLine(Logo & Help)
        Application.Exit()

    End Sub

#End Region

[Eleкtro]

Descarga el código fuente de una URL al disco duro

Código (vbnet) [Seleccionar] Expandir

#Region " Download URL SourceCode "

    ' [ Download URL SourceCode ]
    '
    ' Examples :
    ' Download_URL_SourceCode("http://www.elhacker.net", "C:\Source.html")

    Private Sub Download_URL_SourceCode(ByVal url As String, ByVal OutputFile As String)

        Try
            Using TextFile As New IO.StreamWriter(OutputFile, False, System.Text.Encoding.Default)
                TextFile.WriteLine(New System.IO.StreamReader(System.Net.HttpWebRequest.Create(url).GetResponse().GetResponseStream()).ReadToEnd())
            End Using

        Catch ex As Exception
            MsgBox(ex.Message)
        End Try

    End Sub

#End Region



Devuelve el código fuente de una URL

Código (vbnet) [Seleccionar] Expandir

#Region " Get URL SourceCode "

    ' [ Get URL SourceCode Function ]
    '
    ' Examples :
    ' MsgBox(Get_URL_SourceCode("http://www.google.com"))
    ' Clipboard.SetText(Get_URL_SourceCode("http://www.google.com"))

    Private Function Get_URL_SourceCode(ByVal url As String, Optional ByVal OutputFile As String = Nothing) As String

        Try
            Return New System.IO.StreamReader(System.Net.HttpWebRequest.Create(url).GetResponse().GetResponseStream()).ReadToEnd()
        Catch ex As Exception
            MsgBox(ex.Message)
            Return Nothing
        End Try

    End Function

#End Region




Parsear un HTML usando RegEx

Código (vbnet) [Seleccionar] Expandir

    Private Sub Parse_HTML(ByVal TextFile As String)

        ' RegEx
        Dim RegEx_Url As New System.Text.RegularExpressions.Regex("http://www.mp3crank.com.*\.html?")
        Dim RegEx_Year As New System.Text.RegularExpressions.Regex("[1-2][0-9][0-9][0-9]")

        Dim Line As String = Nothing
        Dim Text As New IO.StringReader(My.Computer.FileSystem.ReadAllText(TextFile))

        Do

            Line = Text.ReadLine()

            If Line Is Nothing Then

                Exit Do ' End of file

            Else

                ' Strip Year
                '
                ' Example:
                ' <span class="year">2009</span>
                '
                If Line.Contains(<a><![CDATA[<span class="year">]]></a>.Value) Then
                    MsgBox(RegEx_Year.Match(Line).Groups(0).ToString)
                End If

                ' Strip URL
                '
                ' Example:
                ' <div class="album"><h2><a href="http://www.mp3crank.com/echo-movement/in-the-ocean.htm"</a></h2></div>
                '
                If Line.Contains(<a><![CDATA[<div class="album">]]></a>.Value) Then
                    MsgBox(RegEx_Url.Match(Line).Groups(0).ToString)
                End If

            End If

        Loop

        Text.Close() : Text.Dispose()

    End Sub

[Eleкtro]

Elimina un Item de un Array

Código (vbnet) [Seleccionar] Expandir

#Region " Remove Item From Array "

    ' [ Remove Item From Array ]
    '
    ' Examples :
    ' Dim MyArray() As String = {"Elektro", "H@cker", "Christian"}
    ' Remove_Item_From_Array(MyArray, 0)               ' Remove first element => {"H@cker", "Christian"}
    ' Remove_Item_From_Array(MyArray, UBound(MyArray)) ' Remove last element => {"Elektro", "H@cker"}

    Public Sub Remove_Item_From_Array(Of T)(ByRef Array_Name() As T, ByVal Index As Integer)
        Array.Copy(Array_Name, Index + 1, Array_Name, Index, UBound(Array_Name) - Index)
        ReDim Preserve Array_Name(UBound(Array_Name) - 1)
    End Sub

#End Region



Concatena un array, con opción de enumerarlo...

Código (vbnet) [Seleccionar] Expandir

#Region " Join Array "

    ' [ Join Array Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' Dim MyArray() As String = {"Hola", "que", "ase?"}
    ' MsgBox(Join_Array(MyArray, vbNewLine))
    ' MsgBox(Join_Array(MyArray, vbNewLine, True))

    Private Function Join_Array(ByRef Array_Name As Array, ByVal Separator As String, _
                                Optional ByVal Enumerate As Boolean = False) As String

        Try
            If Enumerate Then
                Dim Index As Int64 = 0
                Dim Joined_str As String = String.Empty

                For Each Item In Array_Name
                    Joined_str += Index & ". " & Item & Separator
                    Index += 1
                Next

                Return Joined_str
            Else
                Return String.Join(Separator, Array_Name)
            End If

        Catch ex As Exception
            MsgBox(ex.Message)
            Return Nothing
        End Try

    End Function

#End Region



Revierte el contenido de un texto

Código (vbnet) [Seleccionar] Expandir

#Region " Reverse TextFile "

    ' [ Reverse TextFile ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' Reverse_TextFile("C:\File.txt")

    Private Sub Reverse_TextFile(ByVal File As String)

        Try

            Dim strArray() As String = IO.File.ReadAllLines(File)
            Array.Reverse(strArray)

            Using WriteFile As New IO.StreamWriter(File, False, System.Text.Encoding.Default)
                WriteFile.WriteLine(String.Join(vbNewLine, strArray))
            End Using

        Catch ex As Exception
            MsgBox(ex.Message)
        End Try

    End Sub

#End Region



Elimina una línea de un texto

Código (vbnet) [Seleccionar] Expandir

#Region " Delete Line From TextFile "

    ' [ Delete Line From TextFile Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' Delete_Line_From_TextFile("C:\File.txt", 3)
    ' Delete_Line_From_TextFile("C:\File.txt", 3, True)

    Private Sub Delete_Line_From_TextFile(ByVal File As String, ByVal Line_Number As Int64, _
                                          Optional ByVal Make_Empty_Line As Boolean = False)

        Dim Line_Length As Int64 = 0
        Line_Number -= 1

        Try
            Line_Length = IO.File.ReadAllLines(File).Length
        Catch ex As Exception
            MsgBox(ex.Message)
            Exit Sub
        End Try

        Select Case Line_Number

            Case Is <= (0 Or 1), Is > Line_Length

                MsgBox("Want to cut first " & (Line_Number - 1) & " lines" & vbNewLine & _
                       "But """ & File & """ have " & Line_Length & " lines.")
                Exit Sub

            Case Else

                Dim strArray() As String = IO.File.ReadAllLines(File)

                If Make_Empty_Line Then
                    Array.Copy(strArray, Line_Number + 1, strArray, Line_Number, UBound(strArray) - Line_Number)
                    ReDim Preserve strArray(UBound(strArray) - 1)
                End If

                MsgBox(String.Join(vbNewLine, strArray))

                Using WriteFile As New IO.StreamWriter(File, False, System.Text.Encoding.Default)
                    WriteFile.WriteLine(String.Join(vbNewLine, strArray))
                End Using

        End Select

    End Sub

#End Region



Elimina las primeras X líneas de un archivo de texto

Código (vbnet) [Seleccionar] Expandir

#Region " Cut First Lines From TextFile "

    ' [ Cut First Lines From TextFile Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' Cut_First_Lines_From_TextFile("C:\File.txt", 3)

    Private Sub Cut_First_Lines_From_TextFile(ByVal File As String, ByVal Lines As Int64)

        Dim Line_Length As Int64 = 0
        Lines += 1

        Try
            Line_Length = IO.File.ReadAllLines(File).Length
        Catch ex As Exception
            MsgBox(ex.Message)
            Exit Sub
        End Try

        Select Case Lines

            Case Is <= (0 Or 1), Is > Line_Length

                MsgBox("Want to cut first " & (Lines - 1) & " lines" & vbNewLine & _
                       "But """ & File & """ have " & Line_Length & " lines.")
                Exit Sub

            Case Else

                Dim strArray() As String = IO.File.ReadAllLines(File)
                Array.Reverse(strArray)
                ReDim Preserve strArray(strArray.Length - (Lines))
                Array.Reverse(strArray)

                Using WriteFile As New IO.StreamWriter(File, False, System.Text.Encoding.Default)
                    WriteFile.WriteLine(String.Join(vbNewLine, strArray))
                End Using

        End Select

    End Sub

#End Region



Elimina las últimas X líneas de un archivo de texto

Código (vbnet) [Seleccionar] Expandir

#Region " Cut Last Lines From TextFile "

    ' [ Cut Last Lines From TextFile Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' Cut_Last_Lines_From_TextFile("C:\File.txt", 3)

    Private Sub Cut_Last_Lines_From_TextFile(ByVal File As String, ByVal Lines As Int64)

        Dim Line_Length As Int64 = 0
        Lines += 1

        Try
            Line_Length = IO.File.ReadAllLines(File).Length
        Catch ex As Exception
            MsgBox(ex.Message)
            Exit Sub
        End Try

        Select Case Lines

            Case Is <= (0 Or 1), Is > Line_Length

                MsgBox("Want to cut last " & (Lines - 1) & " lines" & vbNewLine & _
                       "But """ & File & """ have " & Line_Length & " lines.")
                Exit Sub

            Case Else

                Dim strArray() As String = IO.File.ReadAllLines(File)
                ReDim Preserve strArray(strArray.Length - (Lines))

                Using WriteFile As New IO.StreamWriter(File, False, System.Text.Encoding.Default)
                    WriteFile.WriteLine(String.Join(vbNewLine, strArray))
                End Using

        End Select

    End Sub

#End Region



Guarda las primmeras X líneas y elimina el resto de líneas de un archivo de texto.

Código (vbnet) [Seleccionar] Expandir

#Region " Keep First Lines From TextFile "

    ' [ Keep First Lines From TextFile Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' Keep_First_Lines_From_TextFile("C:\File.txt", 3)

    Private Sub Keep_First_Lines_From_TextFile(ByVal File As String, ByVal Lines As Int64)

        Dim Line_Length As Int64 = 0
        Lines -= 1

        Try
            Line_Length = IO.File.ReadAllLines(File).Length
        Catch ex As Exception
            MsgBox(ex.Message)
            Exit Sub
        End Try

        Select Case Lines

            Case Is < 0, Is >= Line_Length

                MsgBox("Want to keep first " & (Lines + 1) & " lines" & vbNewLine & _
                       "But """ & File & """ have " & Line_Length & " lines.")
                Exit Sub

            Case Else

                Dim strArray() As String = IO.File.ReadAllLines(File)
                ReDim Preserve strArray(Lines)

                Using WriteFile As New IO.StreamWriter(File, False, System.Text.Encoding.Default)
                    WriteFile.WriteLine(String.Join(vbNewLine, strArray))
                End Using

        End Select

    End Sub

#End Region



Guarda las últimas X líneas y elimina el resto de líneas de un archivo de texto.

Código (vbnet) [Seleccionar] Expandir

#Region " Keep Last Lines From TextFile "

    ' [ Keep Last Lines From TextFile Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' Keep_Last_Lines_From_TextFile("C:\File.txt", 3)

    Private Sub Keep_Last_Lines_From_TextFile(ByVal File As String, ByVal Lines As Int64)

        Dim Line_Length As Int64 = 0
        Lines -= 1

        Try
            Line_Length = IO.File.ReadAllLines(File).Length
        Catch ex As Exception
            MsgBox(ex.Message)
            Exit Sub
        End Try

        Select Case Lines

            Case Is < 0, Is >= Line_Length

                MsgBox("Want to keep last " & (Lines + 1) & " lines" & vbNewLine & _
                       "But """ & File & """ have " & Line_Length & " lines.")
                Exit Sub

            Case Else

                Dim strArray() As String = IO.File.ReadAllLines(File)
                Array.Reverse(strArray)
                ReDim Preserve strArray(Lines)
                Array.Reverse(strArray)

                Using WriteFile As New IO.StreamWriter(File, False, System.Text.Encoding.Default)
                    WriteFile.WriteLine(String.Join(vbNewLine, strArray))
                End Using

        End Select

    End Sub

#End Region



Devuelve el el total de líneas de un archivo de texto, con opción de incluir líneas en blanco

Código (vbnet) [Seleccionar] Expandir

#Region " Get TextFile Total Lines "

    ' [ Get TextFile Total Lines Function ]
    '
    ' Examples :
    '
    ' MsgBox(Get_TextFile_Total_Lines("C:\File.txt"))
    ' MsgBox(Get_TextFile_Total_Lines("C:\File.txt", False))

    Private Function Get_TextFile_Total_Lines(ByVal File As String, _
                                              Optional ByVal Include_BlankLines As Boolean = True) As Int64
        Try
            If Include_BlankLines Then
                Return IO.File.ReadAllLines(File).Length
            Else
                Dim LineCount As Int64
                For Each Line In IO.File.ReadAllLines(File)
                    If Not Line = String.Empty Then LineCount += 1
                    ' Application.DoEvents()
                Next
                Return LineCount
            End If
        Catch ex As Exception
            MsgBox(ex.Message)
            Return -1
        End Try
    End Function

#End Region

[Eleкtro]

Unos snippets especiálmente para un RichTextBox:

Devuelve la posición actual del cursor.

Código (vbnet) [Seleccionar] Expandir

#Region " Get RichTextBox Cursor Position "

    ' [ Get RichTextBox Cursor Position Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' MsgBox(Get_RichTextBox_Cursor_Position(RichTextBox1))
    ' RichTextBox1.SelectionStart = (Get_RichTextBox_Cursor_Position(RichTextBox1) + 1) : RichTextBox1.Focus()

    Public Function Get_RichTextBox_Cursor_Position(ByVal RichTextBox_Object As RichTextBox) As Int64
        Return RichTextBox_Object.SelectionStart
    End Function

#End Region



Copia todo el texto del RichTextBox al portapapeles

Código (vbnet) [Seleccionar] Expandir

#Region " Copy All RichTextBox Text "

    ' [ Copy All RichTextBox Text Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' Copy_All_RichTextBox_Text(RichTextBox1)

    Public Sub Copy_All_RichTextBox_Text(ByVal RichTextBox_Object As RichTextBox)

        ' Save the current cursor position
        Dim Caret_Position As Int64 = RichTextBox_Object.SelectionStart

        ' Save the current selected text (If any)
        Dim Selected_Text_Start As Int64, Selected_Text_Length As Int64
        If RichTextBox_Object.SelectionLength > 0 Then
            Selected_Text_Start = RichTextBox_Object.SelectionStart
            Selected_Text_Length = RichTextBox_Object.SelectionLength
        End If

        RichTextBox_Object.SelectAll() ' Select all text
        RichTextBox_Object.Copy() ' Copy all text
        RichTextBox_Object.Select(Selected_Text_Start, Selected_Text_Length) ' Returns to the previous selected text
        RichTextBox_Object.SelectionStart = Caret_Position ' Returns to the previous cursor position
        ' RichTextBox_Object.Focus() ' Focus again the richtextbox

    End Sub

#End Region



Desactiva un menú contextual si el RichTextBox no contiene texto, activa el menú si el RichTextBox contiene texto.

Código (vbnet) [Seleccionar] Expandir

#Region " Toggle RichTextBox Menu "

    ' [ Toggle RichTextBox Menu ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' Private Sub RichTextBox1_TextChanged(sender As Object, e As EventArgs) Handles RichTextBox1.TextChanged
    '     Toogle_RichTextBox_Menu(sender, ContextMenuStrip1)
    ' End Sub

    Private Sub Toggle_RichTextBox_Menu(ByVal RichTextBox As RichTextBox, ByVal ContextMenuStrip As ContextMenuStrip)
        If RichTextBox.Lines.Count > 0 Then
            ContextMenuStrip.Enabled = True
        Else
            ContextMenuStrip.Enabled = False
        End If
    End Sub

#End Region



Seleccionar líneas enteras

Código (vbnet) [Seleccionar] Expandir

     ' RichTextBox [ MouseDown ]
    Private Sub RichTextBox1_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) Handles RichTextBox1.MouseDown

        Try
            Dim line = sender.GetLineFromCharIndex(sender.GetCharIndexFromPosition(e.Location))
            Dim lineStart = sender.GetFirstCharIndexFromLine(line)
            Dim lineEnd = sender.GetFirstCharIndexFromLine(line + 1) - 1
            sender.SelectionStart = lineStart

            If (lineEnd - lineStart) > 0 Then
                sender.SelectionLength = lineEnd - lineStart
            Else
                sender.SelectionLength = lineStart - lineEnd ' Reverse the values because is the last line of RichTextBox
            End If

        Catch ex As Exception : MsgBox(ex.Message)
        End Try

    End Sub



Abrir links en el navegador

Código (vbnet) [Seleccionar] Expandir

    ' RichTextBox [ LinkClicked ]
    Private Sub RichTextBox1_LinkClicked(sender As Object, e As LinkClickedEventArgs) Handles RichTextBox1.LinkClicked
        Process.Start(e.LinkText)
    End Sub

[Eleкtro]

Comprobar la conectividad de red

Código (vbnet) [Seleccionar] Expandir

#Region " Is Connectivity Avaliable? function "

    ' [ Is Connectivity Avaliable? Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' MsgBox(Is_Connectivity_Avaliable())
    ' While Not Is_Connectivity_Avaliable() : Application.DoEvents() : End While

    Private Function Is_Connectivity_Avaliable()

        Dim WebSites() As String = {"Google.com", "Facebook.com", "Microsoft.com"}

        If My.Computer.Network.IsAvailable Then
            For Each WebSite In WebSites
                Try
                    My.Computer.Network.Ping(WebSite)
                    Return True ' Network connectivity is OK.
                Catch : End Try
            Next
            Return False ' Network connectivity is down.
        Else
            Return False ' No network adapter is connected.
        End If

    End Function

#End Region



Comprobar si un número es negativo

Código (vbnet) [Seleccionar] Expandir


#Region " Number Is Negavite "

    ' [ Number Is Negavite? Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' MsgBox(Number_Is_Negavite(-5)) ' Result: True
    ' MsgBox(Number_Is_Negavite(5))  ' Result: False

    Private Function Number_Is_Negavite(ByVal Number As Int64) As Boolean
        Return Number < 0
    End Function

#End Region



Comprobar si un número es positivo

Código (vbnet) [Seleccionar] Expandir

#Region " Number Is Positive "

    ' [ Number Is Positive? Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' MsgBox(Number_Is_Positive(5))  ' Result: True
    ' MsgBox(Number_Is_Positive(-5)) ' Result: False

    Private Function Number_Is_Positive(ByVal Number As Int64) As Boolean
        Return Number > 0
    End Function

#End Region



Convierte un color html a rgb

Código (vbnet) [Seleccionar] Expandir

#Region " HTML To RGB "

    ' [ HTML To RGB Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' MsgBox(HTML_To_RGB("#FFFFFF"))        ' Result: 255,255,255
    ' MsgBox(HTML_To_RGB("#FFFFFF", RGB.R)) ' Result: 255

    Public Enum RGB As Int16
        RGB
        R
        G
        B
    End Enum

    Private Function HTML_To_RGB(ByVal HTML_Color As String, Optional ByVal R_G_B As RGB = RGB.RGB) As String
        Dim Temp_Color As Color = ColorTranslator.FromHtml(HTML_Color)

        Select Case R_G_B
            Case RGB.R : Return Temp_Color.R
            Case RGB.G : Return Temp_Color.G
            Case RGB.B : Return Temp_Color.B
            Case RGB.RGB : Return (Temp_Color.R & "," & Temp_Color.G & "," & Temp_Color.B)
            Case Else : Return Nothing
        End Select

    End Function

#End Region



Convierte color hexadecimal a html

Código (vbnet) [Seleccionar] Expandir

#Region " HTML To HEX "

    ' [ HTML To HEX Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' MsgBox(HTML_To_HEX("#FFFFFF")) ' Result: 0xFFFFFF

    Private Function HTML_To_HEX(ByVal HTML_Color As String) As String
        Dim Temp_Color As Color = ColorTranslator.FromHtml(HTML_Color)
        Return ("0x" & Hex(Temp_Color.R) & Hex(Temp_Color.G) & Hex(Temp_Color.B))
    End Function

#End Region



color rgb a html

Código (vbnet) [Seleccionar] Expandir

#Region " RGB To HTML "

    ' [ RGB To HTML Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' MsgBox(RGB_To_HTML(255, 255, 255)) ' Result: #FFFFFF
    ' PictureBox1.BackColor = ColorTranslator.FromHtml(RGB_To_HTML(255, 255, 255))

    Private Function RGB_To_HTML(ByVal R As Int16, ByVal G As Int16, ByVal B As Int16) As String
        Return ColorTranslator.ToHtml(Color.FromArgb(R, G, B))
    End Function

#End Region



color rgb a hexadecimal

Código (vbnet) [Seleccionar] Expandir

#Region " RGB To HEX "

    ' [ RGB To HEX Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' MsgBox(RGB_To_HEX(255, 255, 255)) ' Result: 0xFFFFFF

    Private Function RGB_To_HEX(ByVal R As Int16, ByVal G As Int16, ByVal B As Int16) As String
        Return ("0x" & Hex(R) & Hex(G) & Hex(B))
    End Function

#End Region



color conocido a rgb

Código (vbnet) [Seleccionar] Expandir

#Region " Color To RGB "

    ' [ Color To RGB Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' MsgBox(Color_To_RGB(Color.White))
    ' MsgBox(Color_To_RGB(Color.White, RGB.R))
    ' PictureBox1.BackColor = Color.FromArgb(Color_To_RGB(Color.Red, RGB.R), Color_To_RGB(Color.Red, RGB.G), Color_To_RGB(Color.Red, RGB.B))

    Public Enum RGB As Int16
        RGB
        R
        G
        B
    End Enum

    Private Function Color_To_RGB(ByVal Color As Color, Optional ByVal R_G_B As RGB = RGB.RGB) As String

        Select Case R_G_B
            Case RGB.R : Return Color.R
            Case RGB.G : Return Color.G
            Case RGB.B : Return Color.B
            Case RGB.RGB : Return (Color.R & "," & Color.G & "," & Color.B)
            Case Else : Return Nothing
        End Select

    End Function

#End Region



color conocido a html

Código (vbnet) [Seleccionar] Expandir

#Region " Color To HTML "

    ' [ Color To HTML Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' MsgBox(Color_To_HTML(Color.White))
    ' PictureBox1.BackColor = ColorTranslator.FromHtml(Color_To_HTML(Color.White))

    Private Function Color_To_HTML(ByVal Color As Color) As String
        Return ColorTranslator.ToHtml(Color.FromArgb(Color.R, Color.G, Color.B))
    End Function

#End Region



color conocido a hexadecimal

Código (vbnet) [Seleccionar] Expandir

#Region " Color To Hex "

    ' [ Color To Hex Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' MsgBox(Color_To_Hex(Color.White))

    Private Function Color_To_Hex(ByVal Color As Color) As String
        Return ("0x" & Hex(Color.R) & Hex(Color.G) & Hex(Color.B))
    End Function

#End Region



Guardar configuración en archivo INI

Código (vbnet) [Seleccionar] Expandir

       ' By Elektro H@cker
       '
       ' Example content of Test.ini:
       '
       ' File=C:\File.txt
       ' SaveFile=True

       Dim INI_File As String = ".\Test.ini"

    ' Save INI Settings
    Private Sub Save_INI_Settings()

        Dim Current_Settings As String = _
            "File=" & TextBox_file.Text & Environment.NewLine & _
            "SaveFile=" & CheckBox_SaveFile.Checked

        My.Computer.FileSystem.WriteAllText(INI_File, Current_Settings, False)

    End Sub



Descargar imágen web

Código (vbnet) [Seleccionar] Expandir

#Region " Get Url Image Function "

    ' [ Get Url Image Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    '
    ' PictureBox1.Image = Get_URL_Image("http://www.google.com/recaptcha/static/images/smallCaptchaSpaceWithRoughAlpha.png")

    Public Function Get_URL_Image(ByVal URL As String) As System.Drawing.Bitmap
        Try
            Return New System.Drawing.Bitmap(New IO.MemoryStream(New System.Net.WebClient().DownloadData(URL)))
        Catch ex As Exception
          MsgBox(ex.Message)
          Return Nothing
        End Try
    End Function

#End Region



Cargar configuración desde archivo INI
(Este snippet es una versión mejorada del otro que posteé)

Código (vbnet) [Seleccionar] Expandir

       ' By Elektro H@cker
       '
       ' Example content of Test.ini:
       '
       ' File=C:\File.txt
       ' SaveFile=True

       Dim INI_File As String = ".\Test.ini"
     
       ' Load INI Settings
       Private Sub Load_INI_Settings()
     
           Dim xRead As IO.StreamReader = IO.File.OpenText(INI_File)
           Dim Line As String = String.Empty
           Dim Delimiter As String = "="
           Dim ValueName As String = String.Empty
           Dim Value As Object
     
           Do Until xRead.EndOfStream
     
               Line = xRead.ReadLine().ToLower
               ValueName = Line.Split(Delimiter).First
               Value = Line.Split(Delimiter).Last
     
               Select Case ValueName.ToLower
                   Case "File".ToLower : TextBox_File.Text = Value
                   Case "SaveFile".ToLower : CheckBox_SaveFile.Checked()
               End Select
     
               Application.DoEvents()
     
           Loop
     
           xRead.Close() : xRead.Dispose()
     
       End Sub



Obtener respuesta http

Código (vbnet) [Seleccionar] Expandir

#Region " Get Http Response "

    ' [ Validate URL Function ]
    '
    ' Examples :
    '
    ' Dim Response As System.Net.HttpWebResponse = Get_Http_Response(System.Net.HttpWebRequest.Create("http://www.google.com/StatusCode404"))
    ' If Response.StatusCode = System.Net.HttpStatusCode.NotFound Then MsgBox("Error 404")

    Public Shared Function Get_Http_Response(request As System.Net.HttpWebRequest) As System.Net.HttpWebResponse
        Try : Return DirectCast(request.GetResponse(), System.Net.HttpWebResponse)
        Catch ex As System.Net.WebException
            If ex.Response Is Nothing OrElse ex.Status <> System.Net.WebExceptionStatus.ProtocolError Then Throw
            Return DirectCast(ex.Response, System.Net.HttpWebResponse)
        End Try
    End Function

#End Region

[Eleкtro]

Cancelar el evento OnMove

Código (vbnet) [Seleccionar] Expandir

    #Region " Cancel Move Form "
     
       ' Examples:
       ' Me.Moveable = False
       ' Me.Moveable = True
     
       Private Declare Function EnableMenuItem Lib "user32.dll" Alias "EnableMenuItem" (ByVal hMenu As IntPtr, ByVal uIDEnableItem As Int32, ByVal uEnable As Int32) As Int32
     
       Private bMoveable As Boolean = True
     
       Public Overridable Property Moveable() As Boolean
           Get
               Return bMoveable
           End Get
           Set(ByVal Value As Boolean)
               If bMoveable <> Value Then
                   bMoveable = Value
               End If
           End Set
       End Property
     
       Protected Overrides Sub WndProc(ByRef m As Message)
     
           If m.Msg = &H117& Then
               'Handles popup of system menu.
               If m.LParam.ToInt32 \ 65536 <> 0 Then 'divide by 65536 to get hiword.
                   Dim AbleFlags As Int32 = &H0&
                   If Not Moveable Then AbleFlags = &H2& Or &H1&
                   EnableMenuItem(m.WParam, &HF010&, &H0& Or AbleFlags)
               End If
           End If
     
           If Not Moveable Then
               'Cancels any attempt to drag the window by it's caption.
               If m.Msg = &HA1 Then If m.WParam.ToInt32 = &H2 Then Return
               'Redundant but cancels any clicks on the Move system menu item.
               If m.Msg = &H112 Then If (m.WParam.ToInt32 And &HFFF0) = &HF010& Then Return
           End If
     
           'Return control to base message handler.
           MyBase.WndProc(m)
     
       End Sub
     
    #End Region