#Region " Caret "
 
' [ Caret Class ]
'
' // By Elektro H@cker
'
' Examples:
' Dim bmp As New Bitmap("C:\Image.jpg")
' Caret.Create(TextBox1, 7)
' Caret.Create(TextBox1, bmp, 20)
' Caret.BlinkTime(500)
' Caret.Hide(TextBox1)
' Caret.Show(TextBox1)
' Caret.Destroy()
 
Public Class Caret
 
#Region " API's "
 
    Private Declare Function CreateCaret Lib "user32" (ByVal hwnd As IntPtr, ByVal hBitmap As IntPtr, ByVal nWidth As Int64, ByVal nHeight As Int64) As Int64
    Private Declare Function HideCaret Lib "user32" (ByVal hwnd As IntPtr) As Int64
    Private Declare Function ShowCaret Lib "user32" (ByVal hwnd As IntPtr) As Int64
    Private Declare Function SetCaretBlinkTime Lib "user32" (ByVal wMSeconds As Int64) As Int64
    Private Declare Function SetCaretPos Lib "user32" (ByVal x As Int64, ByVal y As Int64) As Int64
    Private Declare Function DestroyCaret Lib "user32" () As Int64
 
#End Region
 
#Region " Funcs & Procs "
 
    ''' <summary>
    ''' Create a new caret.
    ''' </summary>
    ''' <param name="ctrl">The name of the control.</param>
    ''' <param name="Width">The Width of the caret cursor.</param>
    ''' <param name="Height">The name of the caret cursor.</param>
    Public Shared Sub Create(ByVal ctrl As Control, _
                             ByVal Width As Int32, _
                             Optional ByVal Height As Int32 = 0)
 
        If Height = 0 Then
            CreateCaret(ctrl.Handle, IntPtr.Zero, Width, (ctrl.Font.Size * 2))
        Else
            CreateCaret(ctrl.Handle, IntPtr.Zero, Width, Height)
        End If
 
        Show(ctrl)
 
    End Sub
 
    ''' <summary>
    ''' Create a new caret with Bitmap image.
    ''' </summary>
    ''' <param name="ctrl">The name of the control.</param>
    ''' <param name="bmp">The Bitmap image to use.</param>
    ''' <param name="Width">The Width of the caret cursor.</param>
    ''' <param name="Height">The name of the caret cursor.</param>
    Public Shared Sub Create(ByVal ctrl As Control, _
                             ByVal bmp As Bitmap, _
                             ByVal Width As Int32, _
                             Optional ByVal Height As Int32 = 0)
 
 
        If Height = 0 Then
            bmp = Resize_Bitmap(bmp, Width, (ctrl.Font.Size * 2))
            CreateCaret(ctrl.Handle, bmp.GetHbitmap, Width, (ctrl.Font.Size * 2))
        Else
            bmp = Resize_Bitmap(bmp, Width, Height)
            CreateCaret(ctrl.Handle, bmp.GetHbitmap, Width, Height)
        End If
 
        Show(ctrl)
 
    End Sub
 
    ''' <summary>
    ''' Hide the caret.
    ''' </summary>
    ''' <param name="ctrl">The name of the control.</param>
    Public Shared Sub Hide(ByVal ctrl As Control)
        HideCaret(ctrl.Handle)
    End Sub
 
    ''' <summary>
    ''' Show the caret.
    ''' </summary>
    ''' <param name="ctrl">The name of the control.</param>
    Public Shared Sub Show(ByVal ctrl As Control)
        ShowCaret(ctrl.Handle)
    End Sub
 
    ''' <summary>
    ''' Set the blinking time of the caret.
    ''' </summary>
    ''' <param name="ms">Blink interval in Milliseconds.</param>
    Public Shared Sub BlinkTime(ByVal ms As Int64)
        SetCaretBlinkTime(ms)
    End Sub
 
    ''' <summary>
    ''' Set the position of the caret.
    ''' </summary>
    ''' <param name="x">X coordinate.</param>
    ''' <param name="y">Y coordinate.</param>
    Public Shared Sub Position(ByVal X As Int32, ByVal Y As Int32)
        SetCaretPos(X, Y)
    End Sub
 
    ''' <summary>
    ''' Destroy the caret.
    ''' </summary>
    Public Shared Sub Destroy()
        DestroyCaret()
    End Sub
 
    ' Resizes a Bitmap Image
    Private Shared Function Resize_Bitmap(ByVal bmp As Bitmap, ByVal Width As Int32, ByVal Height As Int32) As Bitmap
        Dim Bitmap_Source As New Bitmap(bmp)
        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
 
End Class
 
#End Region

    Private Sub Button1_Click(ByVal sender As Object, ByVal e As EventArgs) _
    Handles Button1.Click
 
        ' Creamos una expresión regular con el patrón de direcciones válidas.
        Dim SoundCloud_RegEx As New System.Text.RegularExpressions.Regex("(http://|https://)(www\.)?soundcloud.com/.+?")
        ' Patrón de búsqueda:
        ' http://soundcloud.com/Texto
        ' https://soundcloud.com/Texto
        ' http://www.soundcloud.com/Texto
        ' https://www.soundcloud.com/Texto
 
        ' Aquí almacenaremos la url del TextBox.
        Dim URL As Uri
 
        Try
            ' Seteamos la Url del TextBox.
            URL = New Uri(TextBox1.Text.ToLower)
        Catch 'ex As Exception
            MessageBox.Show("El formato de la URL no es correcto, intente de nuevo.", _
                            "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            Exit Sub
        End Try
 
        ' Comprobamos la longitud de la url del TextBox.
        Select Case URL.ToString.Length
 
            Case 0 ' La longitud es 0.
 
                MessageBox.Show("El campo de la URL está vacío, porfavor introduzca una URL.", _
                                "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
                Exit Sub
 
            Case Else ' La longitud es diferente a 0.
 
                ' Comprobamos si el RegEx encuentra coincidencias con la URL del TextBox.
                If Not SoundCloud_RegEx.IsMatch(URL.ToString) Then
                    MessageBox.Show("La URL introducida no corresponde a Soundcloud, intente de nuevo.", _
                                    "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
                End If
 
        End Select
 
    End Sub

MessageBoxIcon.[Error]

    Private Sub Button1_Click(ByVal sender As Object, ByVal e As EventArgs) _
    Handles Button1.Click
 
        ' Seteamos en un Array las urls que consideramos válidas.
        Dim Valid_URLs() As String = "http://www.soundcloud.com/ https://www.soundcloud.com/ http://soundcloud.com/ https://soundcloud.com/".ToLower.Split(ChrW(32)).ToArray
 
        ' Aquí almacenaremos la url del TextBox.
        Dim URL As Uri
 
        Try
            ' Seteamos la Url del TextBox.
            URL = New Uri(TextBox1.Text.ToLower)
        Catch 'ex As Exception
            MessageBox.Show("El formato de la URL no es correcto, intente de nuevo.", _
                            "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            Exit Sub
        End Try
 
        ' Comprobamos la longitud de la url del TextBox.
        Select Case URL.ToString.Length
 
            Case 0 ' La longitud es 0.
 
                MessageBox.Show("El campo de la URL está vacío, porfavor introduzca una URL.", _
                                "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
                Exit Sub
 
            Case Else ' La longitud es diferente a 0.
 
                For Each Valid_URL As String In Valid_URLs
                    If URL.ToString.StartsWith(Valid_URL) Then
                        ' Se encontró una URL válida, así que salimos del ciclo y de la subrutina.
                        Exit Sub
                    End If
                Next
 
                ' Si hemos llegado hasta aquí significa que no se encontró ninguna URL válida.
                MessageBox.Show("La URL introducida no corresponde a Soundcloud, intente de nuevo.", _
                                "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
 
        End Select
 
    End Sub

'  /*               *\
' |#* RichTextLabel *#|
'  \*               */
'
' // By Elektro H@cker
'
'   Description:
'   ............
' · A RichTextbox used as a Label to set text using various colors.
'
'   Methods:
'   ........
' · AppendText (Overload)
 
' Examples:
' RichTextLabel1.AppendText("My ", Color.White, , New Font("Arial", 12, FontStyle.Bold))
' RichTextLabel1.AppendText("RichText-", Color.White, , New Font("Arial", 12, FontStyle.Bold))
' RichTextLabel1.AppendText("Label", Color.YellowGreen, Color.Black, New Font("Lucida console", 16, FontStyle.Italic))
 
Imports System.ComponentModel
 
Public Class RichTextLabel : Inherits RichTextBox
 
    Public Sub New()
        MyBase.Enabled = False
        MyBase.Size = New Point(200, 20)
    End Sub
 
#Region " Overrided Properties "
 
    ''' <summary>
    ''' Turn the control backcolor to transparent.
    ''' </summary>
    Protected Overrides ReadOnly Property CreateParams() As CreateParams
        Get
            Dim cp As CreateParams = MyBase.CreateParams
            cp.ExStyle = (cp.ExStyle Or 32)
            Return cp
        End Get
    End Property
 
#End Region
 
#Region " Shadowed Properties "
 
    ' AcceptsTab
    ' Just hidden from the designer and editor.
    <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
    Public Shadows Property AcceptsTab() As Boolean
        Get
            Return MyBase.AcceptsTab
        End Get
        Set(value As Boolean)
            MyBase.AcceptsTab = False
        End Set
    End Property
 
    ' AutoWordSelection
    ' Just hidden from the designer and editor.
    <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
    Public Shadows Property AutoWordSelection() As Boolean
        Get
            Return MyBase.AutoWordSelection
        End Get
        Set(value As Boolean)
            MyBase.AutoWordSelection = False
        End Set
    End Property
 
    ' BackColor
    ' Not hidden, but little hardcoded 'cause the createparams transparency.
    <Browsable(True), EditorBrowsable(EditorBrowsableState.Always)>
    Public Shadows Property BackColor() As Color
        Get
            Return MyBase.BackColor
        End Get
        Set(value As Color)
            MyBase.SelectionStart = 0
            MyBase.SelectionLength = MyBase.TextLength
            MyBase.SelectionBackColor = value
            MyBase.BackColor = value
        End Set
    End Property
 
    ' BorderStyle
    ' Just hidden from the designer and editor.
    <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
    Public Shadows Property BorderStyle() As BorderStyle
        Get
            Return MyBase.BorderStyle
        End Get
        Set(value As BorderStyle)
            MyBase.BorderStyle = BorderStyle.None
        End Set
    End Property
 
    ' Cursor
    ' Hidden from the designer and editor,
    ' because while the control is disabled the cursor always be the default even if changed.
    <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
    Public Shadows Property Cursor() As Cursor
        Get
            Return MyBase.Cursor
        End Get
        Set(value As Cursor)
            MyBase.Cursor = Cursors.Default
        End Set
    End Property
 
    ' Enabled
    ' Hidden from the but not from the editor,
    ' because to prevent exceptions when doing loops over a control collection to disable/enable controls.
    <Browsable(False), EditorBrowsable(EditorBrowsableState.Always)>
    Public Shadows Property Enabled() As Boolean
        Get
            Return MyBase.Enabled
        End Get
        Set(value As Boolean)
            MyBase.Enabled = False
        End Set
    End Property
 
    ' HideSelection
    ' Just hidden from the designer and editor.
    <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
    Public Shadows Property HideSelection() As Boolean
        Get
            Return MyBase.HideSelection
        End Get
        Set(value As Boolean)
            MyBase.HideSelection = True
        End Set
    End Property
 
    ' MaxLength
    ' Just hidden from the designer and editor.
    <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
    Public Shadows Property MaxLength() As Integer
        Get
            Return MyBase.MaxLength
        End Get
        Set(value As Integer)
            MyBase.MaxLength = 2147483646
        End Set
    End Property
 
    ' ReadOnly
    ' Just hidden from the designer and editor.
    <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
    Public Shadows Property [ReadOnly]() As Boolean
        Get
            Return MyBase.ReadOnly
        End Get
        Set(value As Boolean)
            MyBase.ReadOnly = True
        End Set
    End Property
 
    ' ScrollBars
    ' Just hidden from the designer and editor.
    <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
    Public Shadows Property ScrollBars() As RichTextBoxScrollBars
        Get
            Return MyBase.ScrollBars
        End Get
        Set(value As RichTextBoxScrollBars)
            MyBase.ScrollBars = RichTextBoxScrollBars.None
        End Set
    End Property
 
    ' ShowSelectionMargin
    ' Just hidden from the designer and editor.
    <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
    Public Shadows Property ShowSelectionMargin() As Boolean
        Get
            Return MyBase.ShowSelectionMargin
        End Get
        Set(value As Boolean)
            MyBase.ShowSelectionMargin = False
        End Set
    End Property
 
    ' TabStop
    ' Just hidden from the designer and editor.
    <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
    Public Shadows Property TabStop() As Boolean
        Get
            Return MyBase.TabStop
        End Get
        Set(value As Boolean)
            MyBase.TabStop = False
        End Set
    End Property
 
#End Region
 
#Region " Funcs & Procs "
 
    ''' <summary>
    ''' Append text to the current text.
    ''' </summary>
    ''' <param name="text">The text to append</param>
    ''' <param name="forecolor">The font color</param>
    ''' <param name="backcolor">The Background color</param>
    ''' <param name="font">The font of the appended text</param>
    Public Overloads Sub AppendText(ByVal text As String, _
                          ByVal forecolor As Color, _
                          Optional ByVal backcolor As Color = Nothing, _
                          Optional ByVal font As Font = Nothing)
 
        Dim index As Int32 = MyBase.TextLength
        MyBase.AppendText(text)
        MyBase.SelectionStart = index
        MyBase.SelectionLength = MyBase.TextLength - index
        MyBase.SelectionColor = forecolor
 
        If Not backcolor = Nothing _
        Then MyBase.SelectionBackColor = backcolor _
        Else MyBase.SelectionBackColor = DefaultBackColor
 
        If font IsNot Nothing Then MyBase.SelectionFont = font
 
        ' Reset selection
        MyBase.SelectionStart = MyBase.TextLength
        MyBase.SelectionLength = 0
 
    End Sub
 
#End Region
 
End Class