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

[arts]

Checkar si un número está entre un rango de números.

PD: Si conocen un método mejor porfavor postéenlo

Código (vbnet) [Seleccionar] Expandir

#Region " Number Is In Range Function "

   ' [ Number Is In Range Function ]
   '
   ' // By Elektro H@cker
   '
   ' Examples :
   ' MsgBox(NumberIsInRange(50, 0, 100))
   ' If NumberIsInRange(5, 1, 10) then...

    Private Function NumberIsInRange(ByVal Number As Integer, ByVal MIN As Integer, ByVal MAX As Integer) As Boolean
        Select Case Number
            Case MIN To MAX : Return True
            Case Else : Return False
        End Select
    End Function

#End Region


A mi se me ocurre otra manera pero no tengo ni idea de cual es más rápida.

Código (vbnet) [Seleccionar] Expandir

Function numero(ByVal MIN As Integer, ByVal MAX As Integer) As Boolean
        Dim N As Integer
        N = InputBox("Escribe un nº cualquiera", "hola", 0)

        If N >= MIN And N <= MAX Then
            MsgBox("EL NUMERO SE ENCUENTRA ENTRE " & MIN & " Y " & MAX)
        Else
            MsgBox("EL NUMERO NO SE ENCUENTRA ENTRE LOS VALORES")
        End If
    End Function

[Eleкtro]

@arts
la verdad es que según tengo entendido entre las comprbocaciones de IF y Select Case no hay diferencia así que creo que deben ser igual.




Generador de captchas.

Código (vbnet) [Seleccionar] Expandir

#Region " Captcha Generator Function "

    ' [ Captcha Generator Function ]
    '
    ' Instructions:
    ' Copy the Captcha Class into a new Class "Captcha.vb"
    '
    ' Examples :
    ' Dim myCaptcha As New Captcha
    ' PictureBox1.Image = myCaptcha.GenerateCaptcha(5) ' Generate a captcha of 5 letters
    ' MsgBox(myCaptcha.Check(TextBox1.Text, True)) ' Check if the given text is correct


    ' Captcha.vb
#Region " Captcha Class "

    Imports System.Drawing
    Imports System.Drawing.Drawing2D

    Public Class Captcha

        Dim cap As String

        Public ReadOnly Property CaptchaString As String
            Get
                Return cap
            End Get
        End Property

        ' Generate Captcha
        Function GenerateCaptcha(ByVal NumberOfCharacters As Integer) As Bitmap
            Dim R As New Random
            Dim VerticalLineSpaceing As Integer = R.Next(5, 10) ' The space between each horizontal line
            Dim HorisontalLineSpaceing As Integer = R.Next(5, 10) ' The space between each Vertical line
            Dim CWidth As Integer = (NumberOfCharacters * 120) 'Generating the width
            Dim CHeight As Integer = 180 ' the height
            Dim CAPTCHA As New Bitmap(CWidth, CHeight)
            Dim allowedCharacters() As Char = "qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM123456789".ToCharArray 'Guess
            Dim str(NumberOfCharacters - 1) As Char ' The String to turn into a captcha

            For i = 0 To NumberOfCharacters - 1
                str(i) = allowedCharacters(R.Next(0, 61)) ' Generating random characters
            Next

            Using g As Graphics = Graphics.FromImage(CAPTCHA)

                ' the gradient brush for the background
                Dim gradient As New Drawing2D.LinearGradientBrush(New Point(0, CInt(CHeight / 2)), New Point(CWidth, CInt(CHeight / 2)), Drawing.Color.FromArgb(R.Next(&HFF7D7D7D, &HFFFFFFFF)), Drawing.Color.FromArgb(R.Next(&HFF7D7D7D, &HFFFFFFFF)))

                g.FillRectangle(gradient, New Rectangle(0, 0, CWidth, CHeight))
                Dim plist As New List(Of Point) ' the list of points the curve goes through

                For i = 0 To str.Length - 1
                    Dim FHeight As Integer = R.Next(60, 100) 'Font height in EM
                    Dim Font As New Font("Arial", FHeight)
                    Dim Y As Integer = R.Next(0, (CHeight - FHeight) - 40) 'Generating the Y value of a char: will be between the top  and (bottom - 40) to prevent half characters
                    Dim X As Integer = CInt((((i * CWidth) - 10) / NumberOfCharacters))  'Some formula that made sense At the time that I typed it to generate the X value
                    Dim p As New Point(X, Y)

                    g.DrawString(str(i).ToString, Font, Brushes.Black, p)

                    plist.Add(New Point(X, R.Next(CInt((CHeight / 2) - 40), CInt((CHeight / 2) + 40)))) ' add the points to the array
                Next

                plist.Add(New Point(CWidth, CInt(CHeight / 2))) 'for some reason it doesn't go to the end so we manually add the last point
                Dim ppen As New Pen(Brushes.Black, R.Next(5, 10)) ' the pen used to draw the curve
                g.DrawCurve(ppen, plist.ToArray)
                Dim pen As New Pen(Brushes.SteelBlue, CSng(R.Next(1, 2))) 'the pen that will draw the horisontal and vertical lines.

                ' Drawing the vertical lines
                For i = 1 To CWidth
                    Dim ptop As New Point(i * VerticalLineSpaceing, 0)
                    Dim pBottom As New Point(i * VerticalLineSpaceing, CHeight)
                    g.DrawLine(pen, ptop, pBottom)
                Next

                ' Drawing the horizontal lines
                For i = 1 To CHeight
                    Dim ptop As New Point(0, i * HorisontalLineSpaceing)
                    Dim pBottom As New Point(CWidth, i * HorisontalLineSpaceing)
                    g.DrawLine(pen, ptop, pBottom)
                Next

                ' Drawing the Black noise particles
                Dim numnoise As Integer = CInt(CWidth * CHeight / 25) 'calculating the  number of noise for the block. This will generate 1 Noise per 25X25 block of pixels if im correct

                For i = 1 To numnoise / 2
                    Dim X As Integer = R.Next(0, CWidth)
                    Dim Y As Integer = R.Next(0, CHeight)
                    Dim int As Integer = R.Next(1, 2)
                    g.FillEllipse(Brushes.Black, New Rectangle(X, Y, R.Next(2, 5), R.Next(2, 5))) 'Size of the white noise
                Next

                ' Drawing the white noise particles
                For i = 1 To numnoise / 2
                    Dim X As Integer = R.Next(0, CWidth)
                    Dim Y As Integer = R.Next(0, CHeight)
                    Dim int As Integer = R.Next(1, 2)
                    g.FillEllipse(Brushes.White, New Rectangle(X, Y, R.Next(2, 5), R.Next(2, 5))) 'Size of the white noise
                Next

            End Using

            cap = str
            Return CAPTCHA
        End Function

        ' Check captcha
        Function Check(ByVal captcha As String, Optional ByVal IgnoreCase As Boolean = False) As Boolean
            If IgnoreCase Then
                If captcha.ToLower = CaptchaString.ToLower Then
                    Return True
                Else
                    Return False
                End If
            Else
                If captcha = CaptchaString Then
                    Return True
                Else
                    Return False
                End If
            End If
        End Function

    End Class

#End Region

#End Region

[Eleкtro]

Código [Seleccionar] Expandir

Minimizar la IDE del VisualStudio cuando la APP está en debug:

[code=vbnet]#Region " Minimize VS IDE when APP is in execution "

   Declare Function ShowWindow Lib "User32.dll" (ByVal hwnd As IntPtr, ByVal nCmdShow As UInteger) As Boolean

   ' Minimize VS IDE when APP is in execution
   Private Sub Minimize_VS_IDE_when_APP_is_in_execution(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
#If DEBUG Then
       Dim Pr() As Process = Process.GetProcesses
       For Each P As Process In Pr
           If P.MainWindowTitle.Contains(My.Application.Info.AssemblyName) Then
               Dim hwnd As IntPtr = P.MainWindowHandle
               ShowWindow(hwnd, 6)
               Exit For
           End If
       Next
#End If
   End Sub

#End Region



Redondear los bordes de cualquier control:

Código (vbnet) [Seleccionar] Expandir

#Region " Round Borders "

   ' [ Round Borders ]
   '
   ' Examples :
   ' Round_Border(TextBox1)
   ' Round_Border(PictureBox1, 100)

   Private Sub Round_Borders(ByVal vbObject As Object, Optional ByVal RoundSize As Integer = 20)
       Try
           Dim p As New Drawing2D.GraphicsPath()
           p.StartFigure()
           p.AddArc(New Rectangle(0, 0, RoundSize, RoundSize), 180, 90)
           p.AddLine(RoundSize, 0, vbObject.Width - RoundSize, 0)
           p.AddArc(New Rectangle(vbObject.Width - RoundSize, 0, RoundSize, RoundSize), -90, 90)
           p.AddLine(vbObject.Width, RoundSize, vbObject.Width, vbObject.Height - RoundSize)
           p.AddArc(New Rectangle(vbObject.Width - RoundSize, vbObject.Height - RoundSize, RoundSize, RoundSize), 0, 90)
           p.AddLine(vbObject.Width - RoundSize, vbObject.Height, RoundSize, vbObject.Height)
           p.AddArc(New Rectangle(0, vbObject.Height - RoundSize, RoundSize, RoundSize), 90, 90)
           p.CloseFigure()
           vbObject.Region = New Region(p)
       Catch ex As Exception : Throw New Exception(ex.Message)
       End Try
   End Sub

#End Region



Decodificar URL:

Código (vbnet) [Seleccionar] Expandir

#Region " URL Decode Function "

   ' [ URL Decode Function ]
   '
   ' Examples :
   ' Dim URL As String = URL_Decode("http%3A%2F%2Fwww%2Esomesite%2Ecom%2Fpage%2Easp%3Fid%3D5%26test%3DHello+World")

   Public Function URL_Decode(ByVal Source As String) As String
       Dim x As Integer = 0
       Dim CharVal As Byte = 0
       Dim sb As New System.Text.StringBuilder()
       For x = 0 To (Source.Length - 1)
           Dim c As Char = Source(x)
           If (c = "+") Then
               sb.Append(" ")
           ElseIf c <> "%" Then
               sb.Append(c)
           Else
               CharVal = Int("&H" & Source(x + 1) & Source(x + 2))
               sb.Append(Chr(CharVal))
               x += 2
           End If
       Next
       Return sb.ToString()
   End Function

#End Region



Codificar URL:

Código (vbnet) [Seleccionar] Expandir

#Region " URL Encode Function "

   ' [ URL Encode Function ]
   '
   ' Examples :
   ' Dim URL As String = URL_Encode("http://www.somesite.com/page.asp?id=5&test=Hello World")

   Public Function URL_Encode(ByVal Source As String) As String
       Dim chars() As Char = Source.ToCharArray()
       Dim sb As New System.Text.StringBuilder()
       For Each c As Char In chars
           If c Like "[A-Z-a-z-0-9]" Then
               sb.Append(c)
           ElseIf c = " " Then
               sb.Append("+")
           Else
               Dim sHex As String = Hex(Asc(c))
               sHex = "%" & sHex.PadLeft(2, "0")
               sb.Append(sHex)
           End If
       Next
       Erase chars ' Clean Up
       Return sb.ToString()
   End Function

#End Region

[/code]

[Eleкtro]

Grabar audio del PC:

Código (vbnet) [Seleccionar] Expandir

#Region " Rec Sound Function "

    ' [ Rec Sound Function ]
    '
    ' Examples :
    ' Rec_Sound("C:\Audio.wav", Rec.Start_Record)
    ' Rec_Sound("C:\Audio.wav", Rec.Stop_Record)

    Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Integer, ByVal hwndCallback As Integer) As Integer

    Public Enum Rec
        Start_Record
        Stop_Record
    End Enum

    Private Function Rec_Sound(ByVal Path As String, ByVal Rec As Rec) As Boolean
        Select Case Rec
            Case Rec.Start_Record
                mciSendString("open new Type waveaudio Alias recsound", "", 0, 0)
                mciSendString("record recsound", "", 0, 0)
                Return True
            Case Rec.Stop_Record
                mciSendString("save recsound " & Path & "", "", 0, 0)
                mciSendString("close recsound", "", 0, 0)
                Return True
            Case Else : Return Nothing
        End Select
    End Function

#End Region

[Eleкtro]

Esta función es para escribir "hints" (o "cues") en los TextBox por ejemplo.

Código (vbnet) [Seleccionar] Expandir

#Region " Set Control Hint Function "

   ' [ Set Control Hint Function ]
   '
   ' Examples :
   ' Set_Control_Hint(TextBox1, "Put text here...")

   <System.Runtime.InteropServices.DllImport("user32.dll", CharSet:=System.Runtime.InteropServices.CharSet.Auto)> _
   Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wParam As Integer, <System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.LPWStr)> ByVal lParam As String) As Int32
   End Function

   Private Function Set_Control_Hint(ByVal control As Control, ByVal text As String) As Boolean
       Try
           SendMessage(control.Handle, &H1501, 0, text)
           Return True
       Catch ex As Exception
           Throw New Exception(ex.Message)
       End Try
   End Function

#End Region



Enviar POST por PHP:

Código (vbnet) [Seleccionar] Expandir

#Region " Send POST PHP Function "

   ' [ Send POST PHP Function ]
   '
   ' Examples :
   ' Dim htmlcode As String = PHP("http://somesite.com/somephpfile.php", "POST", "name=Jim&age=27&pizza=suasage")

   Public Function Send_POST_PHP(ByVal URL As String, ByVal Method As String, ByVal Data As String) As String
       Try
           Dim request As System.Net.WebRequest = System.Net.WebRequest.Create(URL)
           request.Method = Method
           Dim postData = Data
           Dim byteArray As Byte() = System.Text.Encoding.UTF8.GetBytes(postData)
           request.ContentType = "application/x-www-form-urlencoded"
           request.ContentLength = byteArray.Length
           Dim dataStream As System.IO.Stream = request.GetRequestStream()
           dataStream.Write(byteArray, 0, byteArray.Length)
           dataStream.Close()
           Dim response As System.Net.WebResponse = request.GetResponse()
           dataStream = response.GetResponseStream()
           Dim reader As New System.IO.StreamReader(dataStream)
           Dim responseFromServer As String = reader.ReadToEnd()
           reader.Close()
           dataStream.Close()
           response.Close()
           Return (responseFromServer)
       Catch ex As Exception
           Dim PHP_Error As String = ErrorToString()
           If PHP_Error = "Invalid URI: The format of the URI could not be determined." Then
               MsgBox("ERROR! Must have HTTP:// before the URL.")
           Else
               Throw New Exception(ex.Message)
           End If
           Return ("ERROR")
       End Try
   End Function

#End Region

[Eleкtro]

FTP Uploader:

Código (vbnet) [Seleccionar] Expandir

#Region " FTP Upload Function "

    ' [ FTP Upload Function ]
    '
    ' Examples :
    ' FTP_Upload("C:\File.txt", "ftp://127.0.0.1/File.txt", "User")
    ' MsgBox(FTP_Upload("C:\File.txt", "ftp://127.0.0.1/File.txt", "User", "Pass"))

    Public Function FTP_Upload(ByVal FilePath As String, ByVal FTP_FilePath As String, _
                    Optional ByVal User As String = Nothing, _
                    Optional ByVal Pass As String = Nothing) As Boolean

        Dim FTP_request As System.Net.FtpWebRequest
        Dim FTP_stream As System.IO.Stream
        Dim FTP_bytes() As Byte

        Try
            FTP_request = DirectCast(System.Net.WebRequest.Create(FTP_FilePath), System.Net.FtpWebRequest)
            FTP_request.Credentials = New System.Net.NetworkCredential(User, Pass)
            FTP_request.Method = System.Net.WebRequestMethods.Ftp.UploadFile
            FTP_stream = FTP_request.GetRequestStream()
            FTP_bytes = System.IO.File.ReadAllBytes(FilePath)

            With FTP_stream
                .Write(FTP_bytes, 0, FTP_bytes.Length)
                .Close()
                .Dispose()
            End With

            Return True

        Catch ex As Exception : Return False
        End Try

    End Function

#End Region

[Eleкtro]

¡ PACK DE SNIPPETS ACTUALIZADO EN EL POST PRINCIPAL !

Ya puedes descargar la colección completa de 178 funciones útiles.

PD: Y no te olvides de ser generoso compartiendo tu conocimiento con los demás en este post...

[Eleкtro]

Copiar un archivo con posibilidad de cancelar la operación y reemplazar:

Código (vbnet) [Seleccionar] Expandir

#Region " Copy File In Chunks "

    ' [ Copy File In Chunks Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' Copy_File_In_Chunks("C:\BigFile.mkv", "C:\BigFile_copy.mkv")
    ' Copy_File_In_Chunks("C:\BigFile.mkv", "C:\BigFile_copy.mkv", 9999, True, True)

    Dim Cancel_Copy As Boolean = False

    Public Function Copy_File_In_Chunks(ByVal InputFile As String, ByVal OutputFile As String, _
                                        Optional ByVal BufferSize As Int16 = 1024, _
                                        Optional ByVal Overwrite As Boolean = False, _
                                        Optional ByVal DeleteFileOnCancel As Boolean = False) As Boolean

        Dim InputStream As New IO.FileStream(InputFile, IO.FileMode.Open, IO.FileAccess.Read)
        Dim OutputStream As IO.FileStream

        If Overwrite Then
            OutputStream = New IO.FileStream(OutputFile, IO.FileMode.Create, IO.FileAccess.Write)
        Else
            OutputStream = New IO.FileStream(OutputFile, IO.FileMode.CreateNew, IO.FileAccess.Write)
        End If

        Dim Buffer = New Byte(BufferSize) {}
        Dim BytesRead As Integer = 0

        Do : If Cancel_Copy Then : GoTo Close_Copy
            Else
                Application.DoEvents() ' Remove it if you don't like...
                BytesRead = InputStream.Read(Buffer, 0, Buffer.Length)
                If BytesRead > 0 Then OutputStream.Write(Buffer, 0, BytesRead)
            End If
        Loop While (BytesRead > 0)

Close_Copy:

        OutputStream.Flush() : InputStream.Close() : OutputStream.Close()

        If DeleteFileOnCancel Then
            Try : IO.File.Delete(OutputFile) : Catch : End Try
            Return False
        Else : Return True
        End If

    End Function

#End Region

[Eleкtro]

Form Docking

Junta un form secundario al borde del form principal (para que se muevan sincronizádamente...)

Código (vbnet) [Seleccionar] Expandir


    Public Moving_From_Secondary_Form As Boolean = False

    ' Move Event Main Form
    Private Sub Form1_Move(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Move
        If Not Moving_From_Secondary_Form Then Form2.Location = New Point(Me.Right, Me.Top)
    End Sub

    ' Move Event Secondary Form
    Private Sub Form2_Move(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Move
        Form1.Moving_From_Secondary_Form = True
        Form1.Location = New Point(Me.Left - Form1.Width, Me.Top)
        Form1.Moving_From_Secondary_Form = False
    End Sub

[Eleкtro]

· Unir argumentos:

Código (vbnet) [Seleccionar] Expandir

#Region " Join Arguments Function "

   ' [ Join Arguments Function ]
   '
   ' // By Elektro H@cker
   '
   ' Examples :
   ' MsgBox(Join_Arguments())
   ' MsgBox(Join_Arguments(";"))
   ' If Join_Arguments() Is Nothing Then MsgBox("No arguments")

   Private Function Join_Arguments(Optional Delimiter As String = " ") As String

       ' Check if exist at least one argument
       If Environment.GetCommandLineArgs().Length = 1 Then Return Nothing

       ' Store all arguments
       Dim Arguments As [String]() = Environment.GetCommandLineArgs()

       ' Delete Argument 0 (It's the name of the APP)
       For x = 1 To UBound(Arguments) : Arguments(x - 1) = Arguments(x) : Next x

       ' Redimensione the array
       ReDim Preserve Arguments(UBound(Arguments) - 1)

       ' Return the string
       Return [String].Join(Delimiter, Arguments)

   End Function

#End Region





· Ignorar excepciones:

Código (vbnet) [Seleccionar] Expandir

#Region " Ignore Exceptions "

   ' [ Ignore Exceptions ]
   '
   ' // By Elektro H@cker
   '
   ' Examples :
   ' Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
   '   IO.File.OpenText("X:\Failed_To_Open.txt")
   ' End Sub

   Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
       Try : AddHandler Application.ThreadException, AddressOf Application_Exception_Handler _
           : Application.SetUnhandledExceptionMode(UnhandledExceptionMode.CatchException, False) _
           : Catch : End Try
   End Sub

   Private Sub Application_Exception_Handler(ByVal sender As Object, ByVal e As System.Threading.ThreadExceptionEventArgs)
       ' Here you can manage the exceptions:
       ' Dim ex As Exception = CType(e.Exception, Exception)
       ' MsgBox(ex.Message)
       ' ...Or leave empty to ignore it.
   End Sub

#End Region





· Devuelve el nombre de la aplicación actual:

EDITO: Mejorado

Código (vbnet) [Seleccionar] Expandir

#Region " Get Current APP Name Function "

   ' [ Get Current APP Name Function ]
   '
   ' // By Elektro H@cker
   '
   ' Examples :
   ' MsgBox(Get_Current_APP_Name())
   ' MsgBox(Get_Current_APP_Name(False))

   Private Function Get_Current_APP_Name(Optional ByVal WithFileExtension As Boolean = True) As String
       Dim EXE_Filename As String = System.Diagnostics.Process.GetCurrentProcess().MainModule.ModuleName

       If WithFileExtension Then : Return EXE_Filename
       Else : Return EXE_Filename.Substring(0, EXE_Filename.Length - 4)
       End If

   End Function

#End Region





· Devuelve la ruta parcial o la ruta absoluta de la aplicación actual:

EDITO: SIMPLIFICADO

Código (vbnet) [Seleccionar] Expandir

#Region " Get Current APP Path Function "

   ' [ Get Current APP Path Function ]
   '
   ' // By Elektro H@cker
   '
   ' Examples :
   ' MsgBox(Get_Current_APP_Path())
   ' MsgBox(Get_Current_APP_Path(True))

   Private Function Get_Current_APP_Path(Optional ByVal FullPath As Boolean = False) As String
       If FullPath Then : Return CurDir() & "\" & System.Diagnostics.Process.GetCurrentProcess().MainModule.ModuleName
       Else : Return CurDir()
       End If
   End Function

#End Region





· Sleep

Código (vbnet) [Seleccionar] Expandir

#Region " Sleep "

   ' [ Sleep ]
   '
   ' // By Elektro H@cker
   '
   ' Examples :
   ' Sleep(5) : MsgBox("Test")
   ' Sleep(5, Measure.Seconds) : MsgBox("Test")

   Public Enum Measure
       Milliseconds = 1
       Seconds = 2
       Minutes = 3
       Hours = 4
   End Enum

   Private Sub Sleep(ByVal Duration As Int64, Optional ByVal Measure As Measure = Measure.Seconds)

       Dim Starttime = DateTime.Now

       Select Case Measure
           Case Measure.Milliseconds : Do While (DateTime.Now - Starttime).TotalMilliseconds < Duration : Application.DoEvents() : Loop
           Case Measure.Seconds : Do While (DateTime.Now - Starttime).TotalSeconds < Duration : Application.DoEvents() : Loop
           Case Measure.Minutes : Do While (DateTime.Now - Starttime).TotalMinutes < Duration : Application.DoEvents() : Loop
           Case Measure.Hours : Do While (DateTime.Now - Starttime).TotalHours < Duration : Application.DoEvents() : Loop
           Case Else
       End Select

   End Sub

#End Region





· Devuelve un color RGB aleatorio:

Código (vbnet) [Seleccionar] Expandir

#Region " Get Random RGB Color Function "

   ' [ Get Random RGB Color Function ]
   '
   ' Examples :
   ' Label1.ForeColor = Get_Random_RGB_Color()

   Private Function Get_Random_RGB_Color() As Color
       Return Color.FromArgb(255, _
           m_Rnd.Next(0, 255), _
           m_Rnd.Next(0, 255), _
           m_Rnd.Next(0, 255))
   End Function

#End Region





· Devuelve un color QB aleatorio:
http://msdn.microsoft.com/en-us/library/d2dz8078%28v=vs.80%29.aspx

Código (vbnet) [Seleccionar] Expandir

#Region " Get Random QB Color Function "

   ' [ Get Random QB Color Function ]
   '
   ' Examples :
   ' Label1.ForeColor = Get_Random_QB_Color()

   Private QB_Random As New Random
   Public Function Get_Random_QB_Color() As Color
       Return Color.FromArgb(QBColor(QB_Random.Next(0, 15)) + &HFF000000)
   End Function

#End Region