VISUAL BASIC TUTORIALES: MISCELANEA

MISCELANEA

Captura de Pantalla en Video (AVI) con Visual Basic (VB.NET)

Se trata de una pequeña aplicacion que permite grabar la captura de pantalla, completa o por zonas, en video (AVI).

Codigo:

Form1

Imports System.Runtime.InteropServices
Imports System.Drawing.Imaging

Public Class Form1
    Dim CARPETA As String
    Public COLECCION As New ArrayList

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        If FolderBrowserDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
            CARPETA = FolderBrowserDialog1.SelectedPath & "\"
            Button1.Visible = False
            Button2.Visible = True
            Button3.Visible = True
            COLECCION.Clear()
            Timer1.Interval = CInt(1000 / TextBox1.Text)
        End If
    End Sub

    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        Button2.Visible = False
        Button3.Visible = False
        Me.WindowState = FormWindowState.Minimized
        Button4.Visible = True
        Timer1.Enabled = True

    End Sub

    Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
        Button2.Visible = False
        Button3.Visible = False
        Me.WindowState = FormWindowState.Minimized
        Button4.Visible = True
        ZONA.Opacity = 0.5
        ZONA.TopMost = True
        ZONA.Show()
    End Sub
    Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click
        ZONA.Close()
        Timer1.Enabled = False
        CREARVIDEO()
        Button1.Visible = True
        Button4.Visible = False
        Me.WindowState = FormWindowState.Normal
        Me.Opacity = 1
    End Sub
    Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick

        Dim ANCHO As Integer = Screen.PrimaryScreen.WorkingArea.Width
        Dim ALTO As Integer = Screen.PrimaryScreen.WorkingArea.Height
        Dim BM As New Bitmap(ANCHO, ALTO)
        Dim DIBUJO As Graphics = Graphics.FromImage(BM)
        DIBUJO.CopyFromScreen(0, 0, 0, 0, BM.Size)
        COLECCION.Add(BM)

    End Sub

    Public Sub CREARVIDEO()

        Dim ESCRITOR As New AviWriter
        ESCRITOR.OpenAVI(CARPETA & "Mi Video.avi", CInt(1000 / Timer1.Interval))

        For I = 0 To COLECCION.Count - 1
            ESCRITOR.AddFrame(COLECCION(I))
        Next
        ESCRITOR.Close()
    End Sub

End Class

Public Class Avi

    Public Const StreamtypeVIDEO As Integer = 1935960438
    Public Const OF_SHARE_DENY_WRITE As Integer = 32
    Public Const BMP_MAGIC_COOKIE As Integer = 19778

    <StructLayout(LayoutKind.Sequential, Pack:=1)> _
    Public Structure RECTstruc
        Public left As UInt32
        Public top As UInt32
        Public right As UInt32
        Public bottom As UInt32
    End Structure

    <StructLayout(LayoutKind.Sequential, Pack:=1)> _
    Public Structure BITMAPINFOHEADERstruc
        Public biSize As UInt32
        Public biWidth As Int32
        Public biHeight As Int32
        Public biPlanes As Int16
        Public biBitCount As Int16
        Public biCompression As UInt32
        Public biSizeImage As UInt32
        Public biXPelsPerMeter As Int32
        Public biYPelsPerMeter As Int32
        Public biClrUsed As UInt32
        Public biClrImportant As UInt32
    End Structure

    <StructLayout(LayoutKind.Sequential, Pack:=1)> _
    Public Structure AVISTREAMINFOstruc
        Public fccType As UInt32
        Public fccHandler As UInt32
        Public dwFlags As UInt32
        Public dwCaps As UInt32
        Public wPriority As UInt16
        Public wLanguage As UInt16
        Public dwScale As UInt32
        Public dwRate As UInt32
        Public dwStart As UInt32
        Public dwLength As UInt32
        Public dwInitialFrames As UInt32
        Public dwSuggestedBufferSize As UInt32
        Public dwQuality As UInt32
        Public dwSampleSize As UInt32
        Public rcFrame As RECTstruc
        Public dwEditCount As UInt32
        Public dwFormatChangeCount As UInt32
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=64)> _
        Public szName As UInt16()
    End Structure

    'Initialize the AVI library
    <DllImport("avifil32.dll")> _
    Public Shared Sub AVIFileInit()
    End Sub

    'Open an AVI file
    <DllImport("avifil32.dll", PreserveSig:=True)> _
    Public Shared Function AVIFileOpen(ByRef ppfile As Integer, ByVal szFile As [String], ByVal uMode As Integer, ByVal pclsidHandler As Integer) As Integer
    End Function

    'Create a new stream in an open AVI file
    <DllImport("avifil32.dll")> _
    Public Shared Function AVIFileCreateStream(ByVal pfile As Integer, ByRef ppavi As IntPtr, ByRef ptr_streaminfo As AVISTREAMINFOstruc) As Integer
    End Function

    'Set the format for a new stream
    <DllImport("avifil32.dll")> _
    Public Shared Function AVIStreamSetFormat(ByVal aviStream As IntPtr, ByVal lPos As Int32, ByRef lpFormat As BITMAPINFOHEADERstruc, ByVal cbFormat As Int32) As Integer
    End Function

    'Write a sample to a stream
    <DllImport("avifil32.dll")> _
    Public Shared Function AVIStreamWrite(ByVal aviStream As IntPtr, ByVal lStart As Int32, ByVal lSamples As Int32, ByVal lpBuffer As IntPtr, ByVal cbBuffer As Int32, ByVal dwFlags As Int32, _
         ByVal dummy1 As Int32, ByVal dummy2 As Int32) As Integer
    End Function

    'Release an open AVI stream
    <DllImport("avifil32.dll")> _
    Public Shared Function AVIStreamRelease(ByVal aviStream As IntPtr) As Integer
    End Function

    'Release an open AVI file
    <DllImport("avifil32.dll")> _
    Public Shared Function AVIFileRelease(ByVal pfile As Integer) As Integer
    End Function

    'Close the AVI library
    <DllImport("avifil32.dll")> _
    Public Shared Sub AVIFileExit()
    End Sub

End Class

Public Class AviWriter
    Private aviFile As Integer = 0
    Private aviStream As IntPtr = IntPtr.Zero
    Private frameRate As UInt32 = 0
    Private countFrames As Integer = 0
    Private width As Integer = 0
    Private height As Integer = 0
    Private stride As UInt32 = 0
    Private fccType As UInt32 = Avi.StreamtypeVIDEO
    Private fccHandler As UInt32 = 1668707181
    Private strideInt As Integer
    Private strideU As UInteger
    Private heightU As UInteger
    Private widthU As UInteger

    Public Sub OpenAVI(ByVal fileName As String, ByVal frameRate As UInt32)
        Me.frameRate = frameRate

        Avi.AVIFileInit()

        Dim OpeningError As Integer = Avi.AVIFileOpen(aviFile, fileName, 4097, 0)
        If OpeningError <> 0 Then
            Throw New Exception("Error in AVIFileOpen: " + OpeningError.ToString())
        End If

    End Sub
    Public Sub AddFrame(ByVal bmp As Bitmap)

        bmp.RotateFlip(RotateFlipType.RotateNoneFlipY)

        Dim bmpData As BitmapData = bmp.LockBits(New Rectangle(0, 0, bmp.Width, bmp.Height), ImageLockMode.[ReadOnly], PixelFormat.Format24bppRgb)
        If countFrames = 0 Then
            Dim bmpDatStride As UInteger = bmpData.Stride
            Me.stride = bmpDatStride
            Me.width = bmp.Width
            Me.height = bmp.Height
            CreateStream()
        End If
        strideInt = stride
        Dim writeResult As Integer = Avi.AVIStreamWrite(aviStream, countFrames, 1, bmpData.Scan0, strideInt * height, 0, _
         0, 0)

        If writeResult <> 0 Then
            Throw New Exception("Error in AVIStreamWrite: " + writeResult.ToString())
        End If

        bmp.UnlockBits(bmpData)
        System.Math.Max(System.Threading.Interlocked.Increment(countFrames), countFrames - 1)
    End Sub
    Private Sub CreateStream()
        Dim strhdr As New Avi.AVISTREAMINFOstruc()
        strhdr.fccType = fccType
        strhdr.fccHandler = fccHandler
        strhdr.dwScale = 1
        strhdr.dwRate = frameRate
        strideU = stride
        heightU = height
        strhdr.dwSuggestedBufferSize = stride * strideU
        strhdr.dwQuality = 10000

        heightU = height
        widthU = width
        strhdr.rcFrame.bottom = heightU
        strhdr.rcFrame.right = widthU
        strhdr.szName = New UInt16(64) {}

        Dim createResult As Integer = Avi.AVIFileCreateStream(aviFile, aviStream, strhdr)
        If createResult <> 0 Then
            Throw New Exception("Error in AVIFileCreateStream: " + createResult.ToString())
        End If
        Dim bi As New Avi.BITMAPINFOHEADERstruc()
        Dim bisize As UInteger = Marshal.SizeOf(bi)
        bi.biSize = bisize
        bi.biWidth = width
        bi.biHeight = height
        bi.biPlanes = 1
        bi.biBitCount = 24

        strideU = stride
        heightU = height
        bi.biSizeImage = strideU * heightU
        Dim formatResult As Integer = Avi.AVIStreamSetFormat(aviStream, 0, bi, Marshal.SizeOf(bi))
        If formatResult <> 0 Then
            Throw New Exception("Error in AVIStreamSetFormat: " + formatResult.ToString())
        End If
    End Sub
    Public Sub Close()
        If aviStream <> IntPtr.Zero Then
            Avi.AVIStreamRelease(aviStream)
            aviStream = IntPtr.Zero
        End If
        If aviFile <> 0 Then
            Avi.AVIFileRelease(aviFile)
            aviFile = 0
        End If
        Avi.AVIFileExit()
    End Sub
End Class

Zona

Public Class ZONA
    Dim BANDERA As Boolean = True

    Private Sub ZONA_Click(sender As Object, e As EventArgs) Handles Me.Click
        If BANDERA = True Then
            BANDERA = False ' PARA EVITAR QUE SE EJECUTE EL CLICK SI SE CLICA SOBRE LA PANTALLA DURANTE LA GRABACION
            Me.Opacity = 0
            Timer1.Interval = Form1.Timer1.Interval
            Timer1.Enabled = True
        Else

        End If
    End Sub

    Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
        'CAPTURA DE ZONA
        Dim BM As Bitmap = New Bitmap(Me.Width - 20, Me.Height - 40)
        Dim DIBUJO As Graphics = Graphics.FromImage(BM)
        DIBUJO.CopyFromScreen(Me.Location.X + 10, Me.Location.Y + 40, 0, 0, Screen.PrimaryScreen.Bounds.Size)
        Form1.COLECCION.Add(BM)
    End Sub
End Class

Capturar las Variables de un Joystick con Visual Basic (VB.NET)

Se trata de una pequeña aplicación que permite capturar las variables (ejes, botones, POV, Etc.)de un Joystick.

Codigo:

Form1

Imports System.Runtime.InteropServices
Public Class Form1 'MAX 6 EJES
    'CODIGO BASADO EN: http://msdn.microsoft.com/en-us/library/ms709358%28d=printer,v=vs.85%29.aspx
    Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer,
                                                                   ByVal lParam As Integer) As Integer
    Declare Function joyGetPosEx Lib "winmm.dll" (ByVal uJoyID As Integer, ByRef pji As JOYINFOEX) As Integer
    <StructLayout(LayoutKind.Sequential)> _
    Public Structure JOYINFOEX
        Public dwSize As Integer 'Size, in bytes, of this structure.
        Public dwFlags As Integer 'Flags indicating the valid information returned in this structure. Members that do not contain valid information are set to zero. The following flags are defined:VER PAGINA WEB
        Public dwXpos As Integer 'Current X-coordinate.
        Public dwYpos As Integer 'Current Y-coordinate.
        Public dwZpos As Integer 'Current Z-coordinate.
        Public dwRpos As Integer 'Current position of the rudder or fourth joystick axis.
        Public dwUpos As Integer 'Current fifth axis position.
        Public dwVpos As Integer 'Current sixth axis position.
        Public dwButtons As Integer 'Current state of the 32 joystick buttons. The value of this member can be set to any combination of JOY_BUTTONn flags, where n is a value in the range of 1 through 32 corresponding to the button that is pressed.
        Public dwButtonNumber As Integer 'Current button number that is pressed.
        Public dwPOV As Integer 'Current position of the point-of-view control. Values for this member are in the range 0 through 35,900. These values represent the angle, in degrees, of each view multiplied by 100.
        Public dwReserved1 As Integer 'Reserved; do not use.
        Public dwReserved2 As Integer 'Reserved; do not use.
    End Structure
    Dim myjoyEX As JOYINFOEX
    Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
        PictureBox1.Refresh()
        SendMessage(ProgressBar1.Handle, 1040, 2, 0)
        joyGetPosEx(0, myjoyEX)
        TextBox1.Text = myjoyEX.dwXpos.ToString
        TextBox2.Text = myjoyEX.dwYpos.ToString
        TextBox3.Text = myjoyEX.dwZpos.ToString
        ProgressBar1.Value = myjoyEX.dwZpos
        TextBox4.Text = myjoyEX.dwRpos.ToString
        ProgressBar2.Value = myjoyEX.dwRpos
        TextBox5.Text = myjoyEX.dwUpos.ToString
        TextBox6.Text = myjoyEX.dwVpos.ToString
        TextBox7.Text = myjoyEX.dwButtons.ToString
        TextBox8.Text = myjoyEX.dwButtonNumber.ToString
        TextBox9.Text = (myjoyEX.dwPOV / 100).ToString
        Dim FOCO As Cursor = Cursors.NoMove2D
        Dim DIBUJO As Graphics = PictureBox1.CreateGraphics()
        Dim rectangle As New Rectangle(New Point(CInt(Math.Round((myjoyEX.dwXpos / 65535) * (PictureBox1.Width - FOCO.Size.Width))),
                                                 CInt(Math.Round((myjoyEX.dwYpos / 65535) * (PictureBox1.Height - FOCO.Size.Height)))),
                                             New Size(FOCO.Size.Width, FOCO.Size.Height))
        FOCO.Draw(DIBUJO, rectangle)
        DIBUJO.DrawLine(Pens.Red, CInt(PictureBox1.Width / 2), 0, CInt(PictureBox1.Width / 2), PictureBox1.Height)
        DIBUJO.DrawLine(Pens.Red, 0, CInt(PictureBox1.Height / 2), PictureBox1.Width, CInt(PictureBox1.Height / 2))
    End Sub
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Button1.Visible = False
        myjoyEX.dwSize = 64
        myjoyEX.dwFlags = &HFF
        Timer1.Interval = 200
        Timer1.Start()
    End Sub

End Class

Firefox, Chrome, DownloadHelper con Visual Basic (VB.NET)

Se trata de una pequeña aplicación que permite ver en Firefox y Chrome, lo que estamos viendo en el Webbrowser de Visual Studio. También permite descargar videos con DownloadHelper desde Firefox. Ayuda a ver videos embebidos.

Codigo:

Form1

Public Class Form1
Dim CARPETA As String
Dim CONTADOR As Integer = 1000

Private Sub WebBrowser1_DocumentCompleted(sender As Object, e As WebBrowserDocumentCompletedEventArgs) Handles WebBrowser1.DocumentCompleted

TextBox3.Text = WebBrowser1.Url.ToString

    End Sub
    Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
        TextBox2.Text = TextBox2.Text.Replace("%2f", "/").Replace("%3a", ":").Replace("%3f", "?").Replace("%3d", "=").Replace("""", "")
        WebBrowser1.Navigate(TextBox2.Text)
    End Sub

    Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click
        Try
            TextBox2.Text = TextBox2.Text.Replace("%2f", "/").Replace("%3a", ":").Replace("%3f", "?").Replace("%3d", "=").Replace("""", "")
            VISOR.WebBrowser1.Navigate(TextBox2.Text)
            VISOR.Show()
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try

    End Sub

    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        Try
            TextBox2.Text = TextBox2.Text.Replace("%2f", "/").Replace("%3a", ":").Replace("%3f", "?").Replace("%3d", "=").Replace("""", "")
            Clipboard.SetText(TextBox2.Text)
            Dim firefox As New System.Diagnostics.Process

            firefox.StartInfo.WorkingDirectory = "C:\Program Files(x86)\Mozilla Firefox\"
            firefox.StartInfo.FileName = "firefox.exe"
            firefox.Start()
            Timer1.Enabled = True
            Timer1.Interval = 5000
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try

End Sub

    Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
        SendKeys.SendWait("^{l}")
        SendKeys.SendWait("^{v}")
        SendKeys.SendWait("{ENTER}")
        Timer1.Enabled = False
    End Sub

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        TextBox1.Text = WebBrowser1.DocumentText
        Me.Width = 1400
    End Sub

    Private Sub Button8_Click(sender As Object, e As EventArgs) Handles Button8.Click
        Try
            TextBox2.Text = TextBox2.Text.Replace("%2f", "/").Replace("%3a", ":").Replace("%3f", "?").Replace("%3d", "=")
            Clipboard.SetText(TextBox2.Text)
            Dim chrome As New Process
            chrome.StartInfo.FileName = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"
            chrome.Start()
            Timer1.Interval = 5000
            Timer1.Enabled = True
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try

End Sub

    Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click
        Try
            Dim CLAVE As String = InputBox("ESCRIBE CLAVE")
            Dim INDICE As Integer = TextBox1.Text.IndexOf(CLAVE)
            TextBox1.Text = TextBox1.Text.Remove(0, INDICE - 100)

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

    Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click
        WebBrowser1.Navigate("GOOGLE.COM")
    End Sub

    Private Sub Button9_Click(sender As Object, e As EventArgs) Handles Button9.Click
        WebBrowser1.Navigate("BING.COM")
    End Sub
End Class

El Visor es solo un formulario con un webbrowser. No hay ningún código para el.

Simplificar la Captura de Pantalla con Visual Basic (VB.NET)

Se trata de una pequeña aplicacion que permite ahorrar pasos cuando se quieren hacer sucesivas capturas de pantalla. Evita el uso de Paint o similares.

Codigo:

Public Class Form1
    Dim CARPETA As String
    Dim CONTADOR As Integer = 10000
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        If FolderBrowserDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
            CARPETA = FolderBrowserDialog1.SelectedPath & "\"
        End If
        Timer1.Interval = CInt(TextBox1.Text)
        Timer1.Enabled = True
        WindowState = FormWindowState.Minimized
        Button1.Enabled = False
    End Sub

    Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
        If Clipboard.ContainsImage Then
            Clipboard.GetImage.Save(CARPETA & CONTADOR & ".jpg", Imaging.ImageFormat.Jpeg)
            Clipboard.Clear()
            CONTADOR += 1
        End If
    End Sub

End Class

Tabulador (VbTab) y Relleno (PadRight, PadLeft)con Visual Basic (VB.NET)

Se trata de una pequeña aplicacion para tratar de ayudar a entender los conceptos de Tabulador y Relleno en Visual Basic.

Codigo:

Public Class Form1

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

        TextBoxRESULTADO.Text = TextBoxRESULTADO.Text & TextBox1.Text & " " & TextBox2.Text & " " & TextBox3.Text & vbCrLf
        TextBox1.Text = ""
        TextBox2.Text = ""
        TextBox3.Text = ""
    End Sub
    Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
        TextBoxRESULTADO.Text = TextBoxRESULTADO.Text & TextBox1.Text & vbTab & TextBox2.Text & vbTab & TextBox3.Text & vbCrLf
        TextBox1.Text = ""
        TextBox2.Text = ""
        TextBox3.Text = ""
    End Sub
    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click

        TextBoxRESULTADO.Text = TextBoxRESULTADO.Text & TextBox1.Text.PadRight(15) & vbTab & TextBox2.Text.PadRight(15) & vbTab & TextBox3.Text & vbCrLf
        TextBox1.Text = ""
        TextBox2.Text = ""
        TextBox3.Text = ""

    End Sub

End Class

Cierre Automatico de una Aplicación con Contraseña en Visual Basic (VB.NET)

Se trata de una pequeña aplicación con contraseña que se cierra automáticamente al superar la fecha fijada en ella a la fecha del ordenador. Aplicación realizada a peticion de un usuario del Blog.

Codigo:

Form1

Public Class Form1
    Dim MES As Integer
    Dim DIA As Integer
    Dim HORA As Integer
    Dim MINUTO As Integer
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Dim CONTRASEÑA As String = "1234"
        If TextBoxCONTRASEÑA.Text = CONTRASEÑA Then
            MsgBox(" HOLA A TODOS")
        Else
            MsgBox(" CONTRASEÑA EQUIVOCADA, ENTRA UNA CONTRASEÑA CORRECTA")
        End If
    End Sub
    Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
        If DateTime.Now.Month >= MES And DateTime.Now.Day >= DIA And DateTime.Now.Hour >= HORA And
            DateTime.Now.Minute >= MINUTO Then
            Application.Exit()
        End If
    End Sub
    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        Button2.BackColor = Color.Red
        Try
            MES = CInt(TextBoxMES.Text)
            DIA = CInt(TextBoxDIA.Text)
            HORA = CInt(TextBoxHORA.Text)
            MINUTO = CInt(TextBoxMINUTO.Text)
            Timer1.Interval = CInt(TextBoxTIEMPO.Text)
            Timer1.Enabled = True
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        TextBoxCONTRASEÑA.PasswordChar = "*"
    End Sub
End Class

Teclado Numerico (NUMPAD) Virtual con Visual Basic (VB.NET)

Se trata de una pequeña aplicación para disponer de un Teclado Numerico Virtual (NUMPAD). Normalmente, el código de esta aplicación formara parte de una aplicación mas grande (Teclado Completo, Juegos, etc.).

Codigo:

Form1

Imports System.Runtime.InteropServices

Public Class Form1
    Private Const KEYEVENTF_KEYUP As Integer = &H2
    Private Const INPUT_MOUSE As Integer = 0
    Private Const INPUT_KEYBOARD As Integer = 1
    Private Const INPUT_HARDWARE As Integer = 2

    Private Structure MOUSEINPUT
        Public dx As Integer
        Public dy As Integer
        Public mouseData As Integer
        Public dwFlags As Integer
        Public time As Integer
        Public dwExtraInfo As IntPtr
    End Structure

    Private Structure KEYBDINPUT
        Public wVk As Short
        Public wScan As Short
        Public dwFlags As Integer
        Public time As Integer
        Public dwExtraInfo As IntPtr
    End Structure

    Private Structure HARDWAREINPUT
        Public uMsg As Integer
        Public wParamL As Short
        Public wParamH As Short
    End Structure

    <StructLayout(LayoutKind.Explicit)> _
    Private Structure INPUT
        <FieldOffset(0)> _
        Public type As Integer
        <FieldOffset(4)> _
        Public mi As MOUSEINPUT
        <FieldOffset(4)> _
        Public ki As KEYBDINPUT
        <FieldOffset(4)> _
        Public hi As HARDWAREINPUT
    End Structure

    Private Declare Function SendInput Lib "user32" (ByVal nInputs As Integer, ByVal pInputs() As INPUT, ByVal cbSize As Integer) As Integer
    Private Declare Function AttachThreadInput Lib "user32" (ByVal idAttach As IntPtr, ByVal idAttachTo As IntPtr, ByVal fAttach As Boolean) As Boolean
    Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As IntPtr, ByVal lpwdProcessId As IntPtr) As IntPtr
    Private Declare Function GetCurrentThreadId Lib "kernel32" () As IntPtr
    Private Declare Auto Function FindWindow Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr
    Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As IntPtr) As Boolean

Dim ENTRADA As Short

    Dim SERVICIO As Process
    Private Sub SendKey(ByVal bKey As Short)
        Dim GInput(1) As INPUT

        ' press the key
        GInput(0).type = INPUT_KEYBOARD
        GInput(0).ki.wVk = bKey
        GInput(0).ki.dwFlags = 0

        ' release the key
        GInput(1).type = INPUT_KEYBOARD
        GInput(1).ki.wVk = bKey
        GInput(1).ki.dwFlags = KEYEVENTF_KEYUP

SendInput(2, GInput, Marshal.SizeOf(GetType(INPUT)))

End Sub

    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        ENTRADA = 99
        Timer1.Enabled = True
    End Sub

    Private Sub Button8_Click(sender As Object, e As EventArgs) Handles Button8.Click
        ENTRADA = 103
        Timer1.Enabled = True
    End Sub

    Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click
        ENTRADA = 104
        Timer1.Enabled = True
    End Sub

    Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click
        ENTRADA = 105
        Timer1.Enabled = True
    End Sub

    Private Sub Button9_Click(sender As Object, e As EventArgs) Handles Button9.Click
        ENTRADA = 100
        Timer1.Enabled = True
    End Sub

    Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click
        ENTRADA = 101
        Timer1.Enabled = True
    End Sub

    Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
        ENTRADA = 102
        Timer1.Enabled = True
    End Sub

    Private Sub Button10_Click(sender As Object, e As EventArgs) Handles Button10.Click
        ENTRADA = 97
        Timer1.Enabled = True
    End Sub

    Private Sub Button7_Click(sender As Object, e As EventArgs) Handles Button7.Click
        ENTRADA = 98
        Timer1.Enabled = True
    End Sub

    Private Sub Button11_Click(sender As Object, e As EventArgs) Handles Button11.Click
        ENTRADA = 96
        Timer1.Enabled = True
    End Sub

    Private Sub Button12_Click(sender As Object, e As EventArgs) Handles Button12.Click
        ENTRADA = 13
        Timer1.Enabled = True
    End Sub
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

SERVICIO = Process.Start(TextBox1.Text & ".exe")

End Sub

Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
IR()

    End Sub
    Public Sub IR()
        Try
            If SERVICIO.WaitForInputIdle() Then

Dim hSERVICIO As IntPtr = SERVICIO.MainWindowHandle

Dim hNoteThread As IntPtr = GetWindowThreadProcessId(hSERVICIO, IntPtr.Zero)

If hNoteThread <> IntPtr.Zero Then
If AttachThreadInput(GetCurrentThreadId(), hNoteThread, True) Then

SetForegroundWindow(hSERVICIO)

                        SendKey(ENTRADA)
                        AttachThreadInput(GetCurrentThreadId(), hSERVICIO, False)
                    End If
                End If
            End If
            Timer1.Enabled = False
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try

End Sub

End Class

Crear Controles con Eventos en Tiempo de Ejecucion con VB.NET. Visor de Multiples Imágenes

Se trata de una pequeña aplicacion de un Visor Multiple de Imagenes como ejemplo para mostrar la creacion de controles con eventos en tiempo de ejecución.

Codigo:

Form1

Public Class Form1

    Dim FICHERO As String
    Dim ARCHIVOS As System.Collections.ObjectModel.ReadOnlyCollection(Of String)
    Dim CONTADOR As Integer = 0

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        CONTADOR = 0
        FlowLayoutPanel1.Controls.Clear()
        If FolderBrowserDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
            FICHERO = FolderBrowserDialog1.SelectedPath
            ARCHIVOS = My.Computer.FileSystem.GetFiles(FICHERO)

            Timer1.Enabled = True
            Button1.Enabled = False
        End If
    End Sub

    Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
        If CONTADOR <= ARCHIVOS.Count - 1 Then
            If ARCHIVOS(CONTADOR).Contains(".jpg") Or ARCHIVOS(CONTADOR).Contains(".png") Or ARCHIVOS(CONTADOR).Contains(".gif") Then
                Dim PB As New PictureBox

                PB.Name = "PB" & CONTADOR
                PB.Width = 160
                PB.Height = 120
                PB.SizeMode = PictureBoxSizeMode.Zoom
                PB.Image = System.Drawing.Bitmap.FromFile(ARCHIVOS(CONTADOR))
                AddHandler PB.Click, New System.EventHandler(AddressOf PB_Click)
                FlowLayoutPanel1.Controls.Add(PB)
                CONTADOR += 1
            Else
                CONTADOR += 1
            End If
        Else
            Timer1.Enabled = False
            Button1.Enabled = True

End If
End Sub

    Private Sub PB_Click(sender As Object, e As EventArgs)
        Dim PIC As PictureBox = TryCast(sender, PictureBox)

        IMAGEN.PictureBox1.Image = PIC.Image
        IMAGEN.Show()
    End Sub

    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        FlowLayoutPanel1.Controls.Clear()
        If FolderBrowserDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
            FICHERO = FolderBrowserDialog1.SelectedPath
            ARCHIVOS = My.Computer.FileSystem.GetFiles(FICHERO)

For I = 0 To ARCHIVOS.Count - 1
If ARCHIVOS(I).Contains(".jpg") Or ARCHIVOS(I).Contains(".png") Or ARCHIVOS(I).Contains(".gif") Then

Dim PB As New PictureBox

                    PB.Name = "PB" & I
                    PB.Width = 160
                    PB.Height = 120
                    PB.SizeMode = PictureBoxSizeMode.Zoom
                    PB.Image = System.Drawing.Bitmap.FromFile(ARCHIVOS(I))
                    AddHandler PB.Click, New System.EventHandler(AddressOf PB_Click)
                    FlowLayoutPanel1.Controls.Add(PB)
                End If
            Next

End If

End Sub
End Class

Imprimir un TextBox o un Rich TextBox con Visual Basic (VB.NET)

Se trata de una pequeña aplicación para tratar el tema de la impresión de un TextBox o un Rich TextBox, en una aplicación de Ficha de Personal.

Codigo:

Form1:

Public Class Form1

Private Sub ButtonFICHA_Click(sender As Object, e As EventArgs) Handles

ButtonFICHA.Click
        TextBoxFICHA.Text = vbCrLf & "NOMBRE: " & TextBoxNOMBRE.Text & vbCrLf &
        vbCrLf & "EDAD: " & TextBoxEDAD.Text & vbCrLf &
        vbCrLf & "TELEFONO: " & TextBoxTELEFONO.Text & vbCrLf &
        vbCrLf & "DIRECCION: " & TextBoxDIRECCION.Text & vbCrLf &
        vbCrLf & "eMAIL: " & TextBoxeMAIL.Text & vbCrLf

End Sub

Private Sub PrintDocument1_PrintPage(sender As Object, e As

Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage
        Dim LAPIZ As New SolidBrush(TextBoxFICHA.ForeColor)
        Dim AREA_IMPRESION As Graphics = e.Graphics
        AREA_IMPRESION.DrawString(TextBoxFICHA.Text, TextBoxFICHA.Font, LAPIZ, 0, 0)
    End Sub

Private Sub ButtonPREVIA_Click(sender As Object, e As EventArgs) Handles

ButtonPREVIA.Click
        If PrintDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
            PrintDocument1.Print()
        End If
    End Sub
End Class

Array , Multidimensional , ArrayList , Colecciones , Diccionario (VB.NET) , Collections , Dictionary

Se trata de una pequeña aplicacion para tratar de ayudar a entender, de forma muy elemental, los conceptos de Array , Array Multidimensional , ArrayList , Colecciones y Diccionario, en programacion. Si teneis alguna duda dejad un comentario

Video Youtube

Codigo:

Form1

Public Class Form1
    Private Sub ButtonARRAY_Click(sender As System.Object, e As System.EventArgs) Handles ButtonARRAY.Click
        MYARRAY.Show()
        Hide()
    End Sub

    Private Sub ButtonMULTID_Click(sender As System.Object, e As System.EventArgs) Handles ButtonMULTID.Click
        MULTIDIMENSIONAL.Show()
        Hide()
    End Sub

    Private Sub ButtonARRAYLIST_Click(sender As System.Object, e As System.EventArgs) Handles ButtonARRAYLIST.Click
        ARRAYLISTA.Show()
        Hide()
    End Sub

    Private Sub ButtonDICCIONARIO_Click(sender As System.Object, e As System.EventArgs) Handles ButtonDICCIONARIO.Click
        DICCIONARIO.Show()
        Hide()
    End Sub
End Class

Array:

Public Class MYARRAY
Dim MIARRAY(6) As String
Dim CONTADOR As Integer = 0

    Private Sub ButtonAÑADIRELEMENTOS_Click(sender As System.Object, e As System.EventArgs) Handles ButtonAÑADIRELEMENTOS.Click
        Try
            Label1.Text = ""
            MIARRAY(CONTADOR) = TextBox1.Text
            For INDEX = LBound(MIARRAY) To UBound(MIARRAY)
                Label1.Text = Label1.Text + MIARRAY(INDEX) + vbCrLf
            Next
            CONTADOR += 1
            TextBox1.Text = ""
            TextBox1.Focus()
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try

End Sub

    Private Sub ButtonBUSCARELEMENTO_Click(sender As System.Object, e As System.EventArgs) Handles ButtonBUSCARELEMENTO.Click
        Try
            Label2.Text = MIARRAY(TextBox2.Text)
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try

End Sub

    Private Sub ButtonBUSCARPOSICION_Click(sender As System.Object, e As System.EventArgs) Handles ButtonBUSCARPOSICION.Click
        Try
            Dim INDEX As Integer
            INDEX = Array.IndexOf(MIARRAY, TextBox3.Text)
            Label3.Text = INDEX
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try

End Sub

    Private Sub ButtonAUMENTARDIMENSION_Click(sender As System.Object, e As System.EventArgs) Handles ButtonAUMENTARDIMENSION.Click
        Try
            ReDim Preserve MIARRAY(TextBox4.Text)
            MsgBox("EL ARRAY TIENE AHORA: " & TextBox4.Text & " ELEMENTOS", , "ARRAY")
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try

End Sub

    Private Sub ButtonORDENAR_Click(sender As System.Object, e As System.EventArgs) Handles ButtonORDENAR.Click
        Array.Sort(MIARRAY)
        Label4.Text = ""
        For INDEX = LBound(MIARRAY) To UBound(MIARRAY)
            Label4.Text = Label4.Text + MIARRAY(INDEX) + vbCrLf
        Next
    End Sub

    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        Me.Close()
        Form1.Show()
    End Sub
End Class

Array Multidimensional:

Public Class MULTIDIMENSIONAL
    Dim MIARRAY(6, 4) As Integer
    Private Sub ButtonVOLVER_Click(sender As System.Object, e As System.EventArgs) Handles ButtonVOLVER.Click
        Me.Close()
        Form1.Show()
    End Sub

    Private Sub AxMSFlexGrid1_ClickEvent(sender As Object, e As System.EventArgs) Handles AxMSFlexGrid1.ClickEvent
        AxMSFlexGrid1.CellBackColor = Color.Red
    End Sub

    Private Sub ButtonACEPTAR_Click(sender As System.Object, e As System.EventArgs) Handles ButtonACEPTAR.Click
        MIARRAY(TextBox1.Text, TextBox2.Text) = 1
        For INDEXFILAS = MIARRAY.GetLowerBound(0) To MIARRAY.GetUpperBound(0)

            For INDEXCOLUMNAS = MIARRAY.GetLowerBound(1) To MIARRAY.GetUpperBound(1)
                If MIARRAY(INDEXFILAS, INDEXCOLUMNAS) = 1 Then
                    AxMSFlexGrid1.Row = INDEXFILAS
                    AxMSFlexGrid1.Col = INDEXCOLUMNAS
                    AxMSFlexGrid1.CellBackColor = Color.Red
                End If
            Next
        Next
    End Sub

    Private Sub ARRAY_MULTIDIMENSIONAL_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        'MsgBox("UN ARRAY MULTIDIMENSIONAL SE ACOSTUMBRA A DECLARAR : " + vbCrLf + vbCrLf + "1) DIM MI_ARRAY(INDEX1,INDEX2) AS INTEGER" + vbCrLf + vbCrLf)
    End Sub
End Class

ArrayList:

Public Class ARRAYLISTA
Dim MIARRAYLIST As New ArrayList()

    Private Sub ButtonAÑADIRELEMENTOS_Click(sender As System.Object, e As System.EventArgs) Handles ButtonAÑADIRELEMENTOS.Click
        MIARRAYLIST.Add(TextBox1.Text)
        Label1.Text = ""
        For INDEX = 0 To MIARRAYLIST.Count - 1
            Label1.Text = Label1.Text + MIARRAYLIST(INDEX) + vbCrLf
        Next
        TextBox1.Text = ""
        TextBox1.Focus()
    End Sub

    Private Sub ButtonORDENAR_Click(sender As System.Object, e As System.EventArgs) Handles ButtonORDENAR.Click
        MIARRAYLIST.Sort()
        Label2.Text = ""
        For INDEX = 0 To MIARRAYLIST.Count - 1
            Label2.Text = Label2.Text + MIARRAYLIST(INDEX) + vbCrLf
        Next
    End Sub

    Private Sub ButtonELEMENTO_Click(sender As System.Object, e As System.EventArgs) Handles ButtonELEMENTO.Click
        Label3.Text = MIARRAYLIST(TextBox2.Text)
    End Sub

Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
For INDEX = 0 To MIARRAYLIST.Count - 1

            If MIARRAYLIST(INDEX) = TextBox3.Text Then
                Label4.Text = INDEX
                Exit For
            End If

        Next

    End Sub

    Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
        Me.Close()
        Form1.Show()
    End Sub
End Class

Diccionario:

Public Class DICCIONARIO
Dim DICCIONARIO As New SortedDictionary(Of String, String)
Dim ENUMERADOR As IDictionaryEnumerator

    Private Sub ButtonAÑADIR_Click(sender As System.Object, e As System.EventArgs) Handles ButtonAÑADIR.Click
        DICCIONARIO.Add(TextBox1.Text, TextBox2.Text)
        Label1.Text = ""
        ENUMERADOR = DICCIONARIO.GetEnumerator
        While ENUMERADOR.MoveNext
            Label1.Text = Label1.Text + ENUMERADOR.Key + " = " + ENUMERADOR.Value + vbCrLf
        End While

End Sub

    Private Sub ButtonVALOR_Click(sender As System.Object, e As System.EventArgs) Handles ButtonVALOR.Click
        ENUMERADOR = DICCIONARIO.GetEnumerator
        While ENUMERADOR.MoveNext
            If ENUMERADOR.Key = TextBox3.Text Then
                Label2.Text = ENUMERADOR.Value
            End If
        End While
    End Sub

    Private Sub ButtonCLAVE_Click(sender As System.Object, e As System.EventArgs) Handles ButtonCLAVE.Click
        ENUMERADOR = DICCIONARIO.GetEnumerator
        While ENUMERADOR.MoveNext
            If ENUMERADOR.Value = TextBox4.Text Then
                Label3.Text = ENUMERADOR.Key
            End If
        End While
    End Sub

    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        Me.Close()
        Form1.Show()
    End Sub
End Class

Criptografia AES con Contraseña en Visual Basic (VB.NET). Encriptacion, Desencriptacion.

Se trata de una pequeña aplicación que permite encriptar y desencriptar textos, mediante contraseña. Algoritmo AES.

Codigo:

Imports System.Security.Cryptography
Imports System.IO
Imports System.Text.Encoding

Public Class Form1

Private Sub ButtonENCRIPTAR_Click(sender As Object, e As EventArgs) Handles

ButtonENCRIPTAR.Click
If TextBoxPASSWORD.Text <> "" Then

If TextBoxIN.Text <> "" Then

File.WriteAllText(Application.StartupPath & "\ORIGINAL.TXT", TextBoxIN.Text,

UTF7)
File.WriteAllText(Application.StartupPath & "\ENCRIPTADO.TXT",

TextBoxOUT.Text, UTF7)

PROCESAR(TextBoxPASSWORD.Text, Application.StartupPath &

"\ORIGINAL.TXT", Application.StartupPath & "\ENCRIPTADO.TXT", True)
TextBoxOUT.Text = File.ReadAllText(Application.StartupPath &

"\ENCRIPTADO.TXT", UTF7)
            Else
                MsgBox("NO HAS ESCRITO NADA")
            End If

        Else
            MsgBox("NO HAS PUESTO CONTRASEÑA")
        End If
    End Sub

Private Sub ButtonDESENCRIPTAR_Click(sender As Object, e As EventArgs) Handles

ButtonDESENCRIPTAR.Click
        TextBoxIN.Text = ""
        TextBoxOUT.Text = ""
        If TextBoxPASSWORD.Text <> "" Then

File.WriteAllText(Application.StartupPath & "\DESENCRIPTADO.TXT",

TextBoxIN.Text, UTF7)
If OpenFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then

TextBoxIN.Text = File.ReadAllText(OpenFileDialog1.FileName, UTF7)

PROCESAR(TextBoxPASSWORD.Text, OpenFileDialog1.FileName,

Application.StartupPath & "\DESENCRIPTADO.TXT", False)

TextBoxOUT.Text = File.ReadAllText(Application.StartupPath &

"\DESENCRIPTADO.TXT", UTF7)
                If TextBoxOUT.Text = "" Then
                    MsgBox("CONTRASEÑA INCORRECTA")
                End If

            End If
        Else
            MsgBox("NO HAS PUESTO CONTRASEÑA")
        End If

End Sub

Private Sub ButtonARCHIVO_Click(sender As Object, e As EventArgs) Handles

ButtonARCHIVO.Click
        If OpenFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
            TextBoxIN.Text = File.ReadAllText(OpenFileDialog1.FileName, UTF7)
        End If
    End Sub
    Private Sub ButtonGUARDAR_Click(sender As Object, e As EventArgs) Handles

ButtonGUARDAR.Click
If SaveFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
File.Copy(Application.StartupPath & "\ENCRIPTADO.TXT",

SaveFileDialog1.FileName & ".txt")
        End If
    End Sub
    Private Sub ButtonGUARDARDES_Click(sender As Object, e As EventArgs) Handles

ButtonGUARDARDES.Click
If SaveFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
File.Copy(Application.StartupPath & "\DESENCRIPTADO.TXT",

SaveFileDialog1.FileName & ".txt")
        End If
    End Sub
    Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles

Me.FormClosing
        File.Delete(Application.StartupPath & "\ORIGINAL.TXT")
        File.Delete(Application.StartupPath & "\ENCRIPTADO.TXT")
        File.Delete(Application.StartupPath & "\DESENCRIPTADO.TXT")
    End Sub
    Private Sub PROCESAR(ByVal PASSWORDTEXT As String, ByVal INTEXT As String,

ByVal OUTTEXT As String, ByVal ENCRIPTA As Boolean)

Using INstream As New FileStream(INTEXT, FileMode.Open, FileAccess.Read)
Using OUTstream As New FileStream(OUTTEXT, FileMode.Create,

FileAccess.Write)

Dim MIAES As New AesCryptoServiceProvider()

                ' OBTIENE EL TAMAÑO VALIDO DE KEY
                Dim KEYSIZE As Integer = 0
                For i As Integer = 1024 To 1 Step -1
                    If MIAES.ValidKeySize(i) Then
                        KEYSIZE = i
                        Exit For
                    End If
                Next i
                Debug.Assert(KEYSIZE > 0)

' OBTIENE EL TAMAÑO VALIDO DE BLOCK
Dim BLOCKSIZE As Integer = MIAES.BlockSize

                ' KEY , IV
                Dim KEY As Byte() = Nothing
                Dim IV As Byte() = Nothing

Dim salt As Byte() = {&HA9, &HE3, &HF1, &H0, &HB5, &HA4, &HC5, &HD6,

&HD1, &HF3, &HFE, &H1F, &HDD, &HAA}
Dim DERIVADOS As New Rfc2898DeriveBytes(PASSWORDTEXT, salt, 1000)

KEY = DERIVADOS.GetBytes(KEYSIZE \ 8)
IV = DERIVADOS.GetBytes(BLOCKSIZE \ 8)

                'ENCRIPTADOR/DESENCRIPTADOR.
                Dim ENCRIPTADOR As ICryptoTransform
                If ENCRIPTA = True Then
                    ENCRIPTADOR = MIAES.CreateEncryptor(KEY, IV)
                Else
                    ENCRIPTADOR = MIAES.CreateDecryptor(KEY, IV)
                End If

Try
Using CRYPTOstream As New CryptoStream(OUTstream, ENCRIPTADOR,

CryptoStreamMode.Write)

                        Const BLOCK_SIZE As Integer = 1024
                        Dim BUFFER(BLOCK_SIZE) As Byte
                        Dim LEER As Integer
                        Do
                            LEER = INstream.Read(BUFFER, 0, BLOCK_SIZE)
                            If LEER = 0 Then Exit Do
                            CRYPTOstream.Write(BUFFER, 0, LEER)
                        Loop
                        CRYPTOstream.Flush()
                        CRYPTOstream.Close()
                    End Using
                    Catch ex As Exception
                    End Try

                    ENCRIPTADOR.Dispose()
                    INstream.Close()
                    OUTstream.Close()
            End Using
        End Using
    End Sub

End Class

Clase System.Media con Visual Basic (VB.NET). Sonidos

Se trata de una pequeña aplicación para tratar la Clase System.Media de Visual Studio.

Codigo:

Form1

Imports System.Runtime.InteropServices

Public Class Form1

    Dim FRECUENCIA As Double
    Dim OCTAVA As Integer = 1
    Dim ARCHIVO As String
    <DllImport("winmm.dll")> _
    Private Shared Function mciSendString(ByVal command As String, ByVal buffer As String, ByVal bufferSize As Integer, ByVal hwndCallback As IntPtr) As Integer
    End Function
    '+++++++++++++++++++++++++++++++++++++++++++++PIANO++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

        FRECUENCIA = 130.8
        System.Console.Beep(FRECUENCIA * OCTAVA, CInt(TextBox1.Text))
        Label1.Text = FRECUENCIA * OCTAVA.ToString
    End Sub

Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click

        FRECUENCIA = 146.8
        System.Console.Beep(FRECUENCIA * OCTAVA, CInt(TextBox1.Text))
        Label1.Text = FRECUENCIA * OCTAVA.ToString
    End Sub

Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click

        FRECUENCIA = 164.8
        System.Console.Beep(FRECUENCIA * OCTAVA, CInt(TextBox1.Text))
        Label1.Text = FRECUENCIA * OCTAVA.ToString
    End Sub

Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click

        FRECUENCIA = 174.6
        System.Console.Beep(FRECUENCIA * OCTAVA, CInt(TextBox1.Text))
        Label1.Text = FRECUENCIA * OCTAVA.ToString
    End Sub

Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click

        FRECUENCIA = 196
        System.Console.Beep(FRECUENCIA * OCTAVA, CInt(TextBox1.Text))
        Label1.Text = FRECUENCIA * OCTAVA.ToString
    End Sub

Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click

        FRECUENCIA = 220
        System.Console.Beep(FRECUENCIA * OCTAVA, CInt(TextBox1.Text))
        Label1.Text = FRECUENCIA * OCTAVA.ToString
    End Sub

Private Sub Button7_Click(sender As Object, e As EventArgs) Handles Button7.Click

        FRECUENCIA = 246.9
        System.Console.Beep(FRECUENCIA * OCTAVA, CInt(TextBox1.Text))
        Label1.Text = FRECUENCIA * OCTAVA.ToString
    End Sub

    Private Sub Button20_Click(sender As Object, e As EventArgs) Handles Button20.Click
        FRECUENCIA = 130.8 * 2
        System.Console.Beep(FRECUENCIA * OCTAVA, CInt(TextBox1.Text))
        Label1.Text = FRECUENCIA * OCTAVA.ToString
    End Sub

    Private Sub Button19_Click(sender As Object, e As EventArgs) Handles Button19.Click
        FRECUENCIA = 146.8 * 2
        System.Console.Beep(FRECUENCIA * OCTAVA, CInt(TextBox1.Text))
        Label1.Text = FRECUENCIA * OCTAVA.ToString
    End Sub

    Private Sub Button18_Click(sender As Object, e As EventArgs) Handles Button18.Click
        FRECUENCIA = 164.8 * 2
        System.Console.Beep(FRECUENCIA * OCTAVA, CInt(TextBox1.Text))
        Label1.Text = FRECUENCIA * OCTAVA.ToString
    End Sub

    Private Sub Button17_Click(sender As Object, e As EventArgs) Handles Button17.Click
        FRECUENCIA = 174.6 * 2
        System.Console.Beep(FRECUENCIA * OCTAVA, CInt(TextBox1.Text))
        Label1.Text = FRECUENCIA * OCTAVA.ToString
    End Sub

Private Sub Button16_Click(sender As Object, e As EventArgs) Handles Button16.Click

        FRECUENCIA = 196 * 2
        System.Console.Beep(FRECUENCIA * OCTAVA, CInt(TextBox1.Text))
        Label1.Text = FRECUENCIA * OCTAVA.ToString
    End Sub

    Private Sub Button15_Click(sender As Object, e As EventArgs) Handles Button15.Click
        FRECUENCIA = 220 * 2
        System.Console.Beep(FRECUENCIA * OCTAVA, CInt(TextBox1.Text))
        Label1.Text = FRECUENCIA * OCTAVA.ToString
    End Sub

    Private Sub Button14_Click(sender As Object, e As EventArgs) Handles Button14.Click
        FRECUENCIA = 246.9 * 2
        System.Console.Beep(FRECUENCIA * OCTAVA, CInt(TextBox1.Text))
        Label1.Text = FRECUENCIA * OCTAVA.ToString
    End Sub
    '+++++++++++++++++++++++++++++++++++++++++++++++++++++GRABAR+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    Private Sub Button21_Click(sender As Object, e As EventArgs) Handles Button21.Click

If Button21.Text = "GRABAR" Then

            SaveFileDialog1.ShowDialog()
            ARCHIVO = SaveFileDialog1.FileName & ".WAV"
            Button21.Text = "PARAR"
            mciSendString("open new Type waveaudio Alias recsound", "", 0, 0)
            mciSendString("record recsound", "", 0, 0)

        Else
            mciSendString("save recsound " & ARCHIVO, "", 0, 0)
            mciSendString("close recsound ", "", 0, 0)
            Button21.Text = "GRABAR"
        End If

    End Sub
    'OIR
    Private Sub Button22_Click(sender As Object, e As EventArgs) Handles Button22.Click
        My.Computer.Audio.Play(ARCHIVO)
    End Sub
    '++++++++++++++++++++++++++++++++++++++++++++++TECLAS SONIDOS INDIVIDUALES+++++++++++++++++++++++++++++++++++++++++++++
    Private Sub Button23_Click(sender As Object, e As EventArgs) Handles Button23.Click
        My.Computer.Audio.PlaySystemSound(Media.SystemSounds.Asterisk)
    End Sub

    Private Sub Button24_Click(sender As Object, e As EventArgs) Handles Button24.Click
        My.Computer.Audio.PlaySystemSound(Media.SystemSounds.Beep)
    End Sub

    Private Sub Button25_Click(sender As Object, e As EventArgs) Handles Button25.Click
        My.Computer.Audio.PlaySystemSound(Media.SystemSounds.Exclamation)
    End Sub

    Private Sub Button26_Click(sender As Object, e As EventArgs) Handles Button26.Click
        My.Computer.Audio.PlaySystemSound(Media.SystemSounds.Hand)
    End Sub
    'BEEP
    Private Sub Button27_Click(sender As Object, e As EventArgs) Handles Button27.Click
        System.Console.Beep(CInt(TextBox3.Text), CInt(TextBox2.Text))

    End Sub
    '++++++++++++++++++++++++++++++++++++++++++++++++++ OCTAVAS+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Button8.BackColor = Color.Red
    End Sub
    Private Sub Button8_Click(sender As Object, e As EventArgs) Handles Button8.Click
        COLORES()
        Button8.BackColor = Color.Red
        OCTAVA = 1
    End Sub

    Private Sub Button9_Click(sender As Object, e As EventArgs) Handles Button9.Click
        COLORES()
        Button9.BackColor = Color.Red
        OCTAVA = 2
    End Sub

    Private Sub Button10_Click(sender As Object, e As EventArgs) Handles Button10.Click
        COLORES()
        Button10.BackColor = Color.Red
        OCTAVA = 4
    End Sub

    Private Sub Button13_Click(sender As Object, e As EventArgs) Handles Button13.Click
        COLORES()
        Button13.BackColor = Color.Red
        OCTAVA = 8
    End Sub

    Private Sub Button12_Click(sender As Object, e As EventArgs) Handles Button12.Click
        COLORES()
        Button12.BackColor = Color.Red
        OCTAVA = 16
    End Sub

    Private Sub Button11_Click(sender As Object, e As EventArgs) Handles Button11.Click
        COLORES()
        Button11.BackColor = Color.Red
        OCTAVA = 32
    End Sub
    '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++COLORES TECLAS OCTAVAS++++++++++++++++++++++++++++++++++++++++++
    Public Sub COLORES()
        Button8.BackColor = Color.Black
        Button9.BackColor = Color.Black
        Button10.BackColor = Color.Black
        Button11.BackColor = Color.Black
        Button12.BackColor = Color.Black
        Button13.BackColor = Color.Black
    End Sub
End Class

Crear Gif Animado con MS Gif Animator y Visual Basic (VB.NET)

Se trata de una pequeña basada en Microsoft Gif Animator para la creacion de Gifs Animados

Codigo:

Form1:

Imports System.Runtime.InteropServices
Imports System.Drawing.Imaging

Public Class Form1

    Dim CONTADOR As Integer = 0
    Dim PROGRAMA As New System.Diagnostics.Process
    <DllImport("user32.dll", SetLastError:=True)>
    Public Shared Function SetParent(hWndChild As IntPtr, hWndNewParent As IntPtr) As UInteger
    End Function
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load

        PROGRAMA.StartInfo.WorkingDirectory = Application.StartupPath & "\"
        PROGRAMA.StartInfo.FileName = "GIFANIMATOR.exe"
        PROGRAMA.Start()
        PROGRAMA.WaitForInputIdle()
        SetParent(PROGRAMA.MainWindowHandle, Panel1.Handle)
    End Sub

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        If OpenFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
            PictureBox1.Image = System.Drawing.Bitmap.FromFile(OpenFileDialog1.FileName)
        End If
    End Sub

    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        If SaveFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
            PictureBox1.Image.Save(SaveFileDialog1.FileName & ".GIF", Imaging.ImageFormat.Gif)
        End If
    End Sub

    Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
        VIDEO.Show()
    End Sub

    Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click
        Dim ARCHIVOS As System.Collections.ObjectModel.ReadOnlyCollection(Of String) = Nothing
        Dim FICHERO As String = Nothing
        Dim FICHERO2 As String = Nothing
        Dim PROCESADOS As Integer = 0
        If FolderBrowserDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then
            FICHERO = FolderBrowserDialog1.SelectedPath
            ARCHIVOS = My.Computer.FileSystem.GetFiles(FICHERO)
        End If
        If FolderBrowserDialog2.ShowDialog() = Windows.Forms.DialogResult.OK Then
            FICHERO2 = FolderBrowserDialog2.SelectedPath

        End If
        For I = 0 To ARCHIVOS.Count - 1
            If ARCHIVOS(CONTADOR).Contains(".jpg") Or ARCHIVOS(CONTADOR).Contains(".png") Or ARCHIVOS(CONTADOR).Contains(".bmp") Then
                Dim BM As Bitmap = New Bitmap(ARCHIVOS(CONTADOR))
                Dim GRAFICO As Graphics = Graphics.FromImage(BM)
                GRAFICO.DrawImage(BM, 0, 0, BM.Width, BM.Height)
                BM.Save(FICHERO2 & "\" & CONTADOR & ".gif", Imaging.ImageFormat.Gif)
                PROCESADOS += 1
                Label1.Text = PROCESADOS.ToString
            End If
            CONTADOR += 1
        Next

End Sub

    Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click
        PictureBox1.Image = Nothing
    End Sub
End Class

Video:

Imports System.Drawing.Imaging

Public Class VIDEO
    Dim CONTADOR As Integer = 1
    Dim BM As Bitmap
    Dim DIBUJO As Graphics
    Dim INTERVALO As Integer
    Dim BORDESUPERIOR As Integer = 42 ' ANCHURA DEL TITULO DEL FORMULARIO

    Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
        If OpenFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
            AxWindowsMediaPlayer1.URL = OpenFileDialog1.FileName
        End If
    End Sub

    Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
        'INAHBILITA EL BOTON MINIMIZAR PARA EVITAR ERRORES EN LAS IMAGENES,CREA UN BITMAP DEL AREA DEL FORM DONDE ESTA EL MEDIAPLAYER, LO PRESENTA EN EL PICTUREBOX Y GUARDA UNA IMAGEN,
        'LE PONE EL NUMERO DEL CONTADOR Y ADELANTA EL CONTADOR UN ENTERO.
        Me.MinimizeBox = False
        BM = New Bitmap(AxWindowsMediaPlayer1.Bounds.Width, AxWindowsMediaPlayer1.Bounds.Height, PixelFormat.Format24bppRgb)
        DIBUJO = Graphics.FromImage(BM)
        DIBUJO.CopyFromScreen(AxWindowsMediaPlayer1.Location.X, AxWindowsMediaPlayer1.Location.Y + BORDESUPERIOR, 0, 0, AxWindowsMediaPlayer1.Size, CopyPixelOperation.SourceCopy)
        'PictureBox1.Image = BM
        BM.Save(FolderBrowserDialog1.SelectedPath & "\" & CONTADOR & ".gif", Imaging.ImageFormat.Gif)
        Label2.Text = (CONTADOR - 1).ToString
        CONTADOR = CONTADOR + 1
    End Sub

    Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click
        'LEE EL TEXTBOX, CALCULA EL INTERVALO DEL TIMER,PIDE CARPETA DE GUARDADO, ELIMINA EL MARCO DEL MEDIAPLAYER, REANUDA EL VIDEO E INICIA EL GUARDADO
        Button4.BackColor = Color.Red
        INTERVALO = CInt(1000 / TextBox1.Text)
        FolderBrowserDialog1.ShowDialog()
        AxWindowsMediaPlayer1.uiMode = "none"
        AxWindowsMediaPlayer1.Ctlcontrols.play()
        Timer1.Interval = INTERVALO
        Timer1.Enabled = True
    End Sub

    Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click
        Timer1.Enabled = False
        AxWindowsMediaPlayer1.Ctlcontrols.stop()
        Button4.BackColor = Color.Black
        Label2.Text = "0"
        Me.MinimizeBox = True
    End Sub
End Class

01- Calculadora de Numeros Complejos con Visual Basic (VB.NET). Matematicas

Se trata de una pequeña calculadora que permite operar con numeros complejos, suma, resta, producto, division,modulo y argumento, en grados y radianes.

Codigo:

Form1

Public Class Form1


    Private Sub ButtonSUMA_Click(sender As Object, e As EventArgs) Handles ButtonSUMA.Click
        COLORES()
        BLANCOS()
        ButtonSUMA.BackColor = Color.Red
        Try
            Dim RE1 As Double = CDbl(TextBoxRE1.Text)
            Dim RE2 As Double = CDbl(TextBoxRE2.Text)
            Dim IM1 As Double = CDbl(TextBoxIM1.Text)
            Dim IM2 As Double = CDbl(TextBoxIM2.Text)
            Dim RESULTADOREAL As Double = Math.Round(RE1 + RE2, 2)
            Dim RESULTADOIM As Double = Math.Round(IM1 + IM2, 2)

            If RESULTADOIM >= 0 Then
                LabelRESULTADO.Text = RESULTADOREAL & " + " & RESULTADOIM & " i"
            Else
                LabelRESULTADO.Text = RESULTADOREAL & " - " & Math.Abs(RESULTADOIM) & " i"
            End If
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try

    End Sub


    Private Sub ButtonRESTA_Click(sender As Object, e As EventArgs) Handles ButtonRESTA.Click
        COLORES()
        BLANCOS()
        ButtonRESTA.BackColor = Color.Red
        Try
            Dim RE1 As Double = CDbl(TextBoxRE1.Text)
            Dim RE2 As Double = CDbl(TextBoxRE2.Text)
            Dim IM1 As Double = CDbl(TextBoxIM1.Text)
            Dim IM2 As Double = CDbl(TextBoxIM2.Text)
            Dim RESULTADOREAL As Double = Math.Round(RE1 - RE2, 2)
            Dim RESULTADOIM As Double = Math.Round(IM1 - IM2, 2)

            If RESULTADOIM >= 0 Then
                LabelRESULTADO.Text = RESULTADOREAL & " + " & RESULTADOIM & " i"
            Else
                LabelRESULTADO.Text = RESULTADOREAL & " - " & Math.Abs(RESULTADOIM) & " i"
            End If
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub

    Private Sub ButtonPRODUCTO_Click(sender As Object, e As EventArgs) Handles ButtonPRODUCTO.Click
        COLORES()
        BLANCOS()
        ButtonPRODUCTO.BackColor = Color.Red
        Try
            Dim RE1 As Double = CDbl(TextBoxRE1.Text)
            Dim RE2 As Double = CDbl(TextBoxRE2.Text)
            Dim IM1 As Double = CDbl(TextBoxIM1.Text)
            Dim IM2 As Double = CDbl(TextBoxIM2.Text)
            Dim RESULTADOREAL As Double = Math.Round((RE1 * RE2) + (IM1 * IM2 * (-1)), 2)
            Dim RESULTADOIM As Double = Math.Round((RE1 * IM2) + (IM1 * RE2), 2)
            If RESULTADOIM >= 0 Then
                LabelRESULTADO.Text = RESULTADOREAL & " + " & Math.Abs(RESULTADOIM) & " i"
            Else
                LabelRESULTADO.Text = RESULTADOREAL & " - " & Math.Abs(RESULTADOIM) & " i"
            End If


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

    Private Sub ButtonDIVISION_Click(sender As Object, e As EventArgs) Handles ButtonDIVISION.Click
        COLORES()
        BLANCOS()
        ButtonDIVISION.BackColor = Color.Red
        Try
            Dim RE1 As Double = CDbl(TextBoxRE1.Text)
            Dim RE2 As Double = CDbl(TextBoxRE2.Text)
            Dim IM1 As Double = CDbl(TextBoxIM1.Text)
            Dim IM2 As Double = CDbl(TextBoxIM2.Text)
            Dim NUMERADOR_REAL As Double = Math.Round((RE1 * RE2) + (IM1 * IM2), 2)
            Dim NUMERADOR_IM As Double = Math.Round((RE2 * IM1) - (RE1 * IM2), 2)
            Dim DENOMINADOR As Double = Math.Round((RE2 ^ 2 + IM2 ^ 2), 2)
            Dim PARTE_REAL As String = NUMERADOR_REAL & " / " & DENOMINADOR
            Dim PARTE_IM As String = NUMERADOR_IM & " / " & DENOMINADOR
            If DENOMINADOR = 0 Then

                LabelRESULTADO.Text = "DENOMINADOR 0 "
            Else
                LabelRESULTADO.Text = "(" & PARTE_REAL & ")" & " + " & "(" & PARTE_IM & ")" & " i "
            End If



        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
    Private Sub ButtonMODULO_Click(sender As Object, e As EventArgs) Handles ButtonMODULO.Click
        COLORES()
        BLANCOS()
        ButtonMODULO.BackColor = Color.Red
        Try
            Dim RE1 As Double = CDbl(TextBoxRE1.Text)
            Dim RE2 As Double = CDbl(TextBoxRE2.Text)
            Dim IM1 As Double = CDbl(TextBoxIM1.Text)
            Dim IM2 As Double = CDbl(TextBoxIM2.Text)

            Dim MODULO1 As Double = Math.Round(Math.Sqrt(RE1 ^ 2 + IM1 ^ 2), 2)
            Dim MODULO2 As Double = Math.Round(Math.Sqrt(RE2 ^ 2 + IM2 ^ 2), 2)

            LabelRESULTADO.Text = "|Z1|: " & MODULO1 & "    " & "|Z2|: " & MODULO2

        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
    Private Sub ButtonARGUMENTO_Click(sender As Object, e As EventArgs) Handles ButtonARGUMENTO.Click
        TextBoxUNIDADES.Visible = True
        COLORES()
        BLANCOS()
        ButtonARGUMENTO.BackColor = Color.Red
        Dim CTE As Double
        Dim UNIDAD As String
        Dim COMPLEMENTO As Integer
        If GRADOS.Checked = True Then
            CTE = 180 / Math.PI
            COMPLEMENTO = 180
            UNIDAD = " º"
        Else
            CTE = 1
            COMPLEMENTO = Math.PI
            UNIDAD = " Ra."
        End If
        Try
            Dim RE1 As Double = CDbl(TextBoxRE1.Text)
            Dim RE2 As Double = CDbl(TextBoxRE2.Text)
            Dim IM1 As Double = CDbl(TextBoxIM1.Text)
            Dim IM2 As Double = CDbl(TextBoxIM2.Text)

            Dim ARGUMENTO1 As Double

            If RE1 >= 0 Then
                ARGUMENTO1 = Math.Round(Math.Atan(IM1 / RE1) * CTE, 2)
            Else
                ARGUMENTO1 = Math.Round((Math.Atan(IM1 / RE1) * CTE) + COMPLEMENTO, 2)
            End If
            Dim ARGUMENTO2 As Double
            If RE2 >= 0 Then
                ARGUMENTO2 = Math.Round(Math.Atan(IM2 / RE2) * CTE, 2)
            Else
                ARGUMENTO2 = Math.Round((Math.Atan(IM2 / RE2) * CTE) + COMPLEMENTO, 2)
            End If
            LabelRESULTADO.Text = "Arg(Z1): " & ARGUMENTO1 & UNIDAD & "   " & "Arg(Z2): " & ARGUMENTO2 & UNIDAD

        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
    Private Sub ButtonCLEAR_Click(sender As Object, e As EventArgs) Handles ButtonCLEAR.Click
        TextBoxUNIDADES.Visible = False
        BORRAR()
    End Sub
    Public Sub COLORES()
        ButtonSUMA.BackColor = COLOR.Black
        ButtonRESTA.BackColor = COLOR.Black
        ButtonPRODUCTO.BackColor = Color.Black
        ButtonDIVISION.BackColor = Color.Black
        ButtonMODULO.BackColor = Color.Black
        ButtonARGUMENTO.BackColor = Color.Black
    End Sub
    Public Sub BLANCOS()
        If TextBoxIM1.Text = "" Then
            TextBoxIM1.Text = 0
        End If
        If TextBoxIM2.Text = "" Then
            TextBoxIM2.Text = 0
        End If
        If TextBoxRE1.Text = "" Then
            TextBoxRE1.Text = 0
        End If
        If TextBoxRE2.Text = "" Then
            TextBoxRE2.Text = 0
        End If
    End Sub


    Public Sub BORRAR()
        TextBoxRE1.Text = ""
        TextBoxRE2.Text = ""
        TextBoxIM1.Text = ""
        TextBoxIM2.Text = ""
        LabelRESULTADO.Text = "0"
        COLORES()
    End Sub

End Class

Uso de BackgroundWorker (Hebras o Hilos, Threads) con Visual Basic (VB.NET). MultiThreading

Codigo:

Form1

Public Class Form1

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        ' INICIA EL BACKGROUNDWORKER
        Button1.BackColor = Color.Red
        BackgroundWorker1.WorkerReportsProgress = True
        BackgroundWorker1.WorkerSupportsCancellation = True
        BackgroundWorker1.RunWorkerAsync()
    End Sub

    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        ' CANCELA EL TRABAJO
        Button2.BackColor = Color.Red
        BackgroundWorker1.CancelAsync()

    End Sub

    Private Sub BackgroundWorker1_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
        ' CREA Y ESCRIBE LINEAS EN UN FICHERO DE TEXTO
        For I = 1 To CInt(TextBox2.Text)
            My.Computer.FileSystem.WriteAllText(Application.StartupPath & "\INFORME.TXT", "LINEA: " & I & vbCrLf, True)

            ' SI SE HA CANCELADO EL TRABAJO, PARA
            If BackgroundWorker1.CancellationPending Then Exit Sub

            ' ACTUALIZA LA BARRA DE PROGRESO
            BackgroundWorker1.ReportProgress(CInt(100 * I / CInt(TextBox2.Text)))
        Next
    End Sub

    Private Sub BackgroundWorker1_ProgressChanged(sender As Object, e As System.ComponentModel.ProgressChangedEventArgs) Handles BackgroundWorker1.ProgressChanged
        ' MUESTRA EL PROGRESO DEL TRABAJO LARGO
        ProgressBar1.Value = e.ProgressPercentage
        Label1.Text = ProgressBar1.Value & " %"
    End Sub

    Private Sub BackgroundWorker1_RunWorkerCompleted(sender As Object, e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles BackgroundWorker1.RunWorkerCompleted
        ' TRABAJO TERMINADO
        'NORMALMENTE
        If Button2.BackColor = Color.Black Then
            ProgressBar1.Value = 0
            MsgBox("TRABAJO REALIZADO SATISFACTORIAMENTE")
            Button1.BackColor = Color.Black
            Button2.BackColor = Color.Black

            'POR CANCELACION
        Else
            ProgressBar1.Value = 0
            Label1.Text = "CANCELADO"
            MsgBox("TRABAJO CANCELADO")
            Button1.BackColor = Color.Black
            Button2.BackColor = Color.Black
        End If
        BackgroundWorker1.Dispose()
    End Sub


End Class

Visualizador de Imagenes con Sonido

Es una pequeña aplicacion en Visual Basic (VB.NET) que permite visualizar imagenes añadiendo sonido a la presentacion asi como otras funcionalidades que pueden resultar interesantes:aumento, desplazamiento, velocidad, etc.

CODIGO:

FORM1

Imports System.IO

Public Class Form1
    Dim FICHERO As String
    Dim CONTADOR As Integer
    Dim SPEED As Integer = 2000
    Dim PRIME As String
    Dim ULTIM As String
    Dim SONIDOS As String
    Dim CANCIONES As Integer = 0
    Dim ARCHIVOS As System.Collections.ObjectModel.ReadOnlyCollection(Of String)

    Private Sub RELOJ_Tick(sender As Object, e As EventArgs) Handles RELOJ.Tick

        Try
            VISOR.Image = System.Drawing.Bitmap.FromFile(ARCHIVOS(CONTADOR))
            Me.Text = ARCHIVOS(CONTADOR)

        Catch ex As Exception
            CONTADOR = 0
            VISOR.Image = System.Drawing.Bitmap.FromFile(ARCHIVOS(CONTADOR))
            Me.Text = ARCHIVOS(CONTADOR)

        End Try
        CONTADOR = CONTADOR + 1
        Label1.Text = "FOTOGRAMA : " & CONTADOR

    End Sub

    Private Sub INICIO_Click(sender As Object, e As EventArgs) Handles INICIO.Click

        CONTADOR = 0
        RELOJ.Enabled = True
        RELOJ.Interval = SPEED


    End Sub
    Private Sub CARPETA_Click(sender As Object, e As EventArgs) Handles CARPETA.Click
        CARPETAS.ShowDialog()
        FICHERO = CARPETAS.SelectedPath
        ARCHIVOS = My.Computer.FileSystem.GetFiles(FICHERO)
    End Sub

    Private Sub PAUSA_Click(sender As Object, e As EventArgs) Handles PAUSA.Click
        RELOJ.Enabled = False
        RELOJ2.Enabled = False
    End Sub

    Private Sub REINICIO_Click(sender As Object, e As EventArgs) Handles REINICIO.Click
        RELOJ.Enabled = True
        RELOJ.Interval = SPEED
    End Sub

    Private Sub RELOJ2_Tick(sender As Object, e As EventArgs) Handles RELOJ2.Tick
        Try
            VISOR.Image = System.Drawing.Bitmap.FromFile(ARCHIVOS(CONTADOR))
            Me.Text = ARCHIVOS(CONTADOR)
        Catch ex As Exception
            CONTADOR = ARCHIVOS.LongCount - 1
            VISOR.Image = System.Drawing.Bitmap.FromFile(ARCHIVOS(CONTADOR))
            Me.Text = ARCHIVOS(CONTADOR)
        End Try
        CONTADOR = CONTADOR - 1
        Label1.Text = "FOTOGRAMA : " & CONTADOR
    End Sub

    Private Sub REVERSE_Click(sender As Object, e As EventArgs) Handles REVERSE.Click
        RELOJ.Enabled = False
        RELOJ2.Enabled = True
        RELOJ2.Interval = SPEED
    End Sub

    Private Sub MAS_Click(sender As Object, e As EventArgs) Handles MAS.Click
        VISOR.Width = VISOR.Width + 200
        VISOR.Height = VISOR.Height + 100
        VISOR.Location = New Point(VISOR.Location.X - 100, VISOR.Location.Y - 50)
    End Sub

    Private Sub MENOS_Click(sender As Object, e As EventArgs) Handles MENOS.Click
        VISOR.Width = VISOR.Width - 200
        VISOR.Height = VISOR.Height - 100
        VISOR.Location = New Point(VISOR.Location.X + 100, VISOR.Location.Y + 50)
    End Sub

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Label1.Text = "FOTOGRAMA :0"

        Label3.Text = "VELOCIDAD: " & SPEED

    End Sub

    Private Sub IZQUIERDA_Click(sender As Object, e As EventArgs) Handles IZQUIERDA.Click
        VISOR.Location = New Point(VISOR.Location.X - 100, VISOR.Location.Y)
    End Sub

    Private Sub DERECHA_Click(sender As Object, e As EventArgs) Handles DERECHA.Click
        VISOR.Location = New Point(VISOR.Location.X + 100, VISOR.Location.Y)
    End Sub

    Private Sub ARRIBA_Click(sender As Object, e As EventArgs) Handles ARRIBA.Click
        VISOR.Location = New Point(VISOR.Location.X, VISOR.Location.Y + 100)

    End Sub

    Private Sub ABAJO_Click(sender As Object, e As EventArgs) Handles ABAJO.Click
        VISOR.Location = New Point(VISOR.Location.X, VISOR.Location.Y - 100)
    End Sub

    Private Sub Button1_Click_2(sender As Object, e As EventArgs) Handles Button1.Click
        SPEED = 20
        RELOJ.Interval = SPEED
        RELOJ2.Interval = SPEED
        Label3.Text = "VELOCIDAD:   " & SPEED
    End Sub

    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        SPEED = 5000
        RELOJ.Interval = SPEED
        RELOJ2.Interval = SPEED
        Label3.Text = "VELOCIDAD:   " & SPEED
    End Sub
    Private Sub RadioButton2_CheckedChanged(sender As Object, e As EventArgs) Handles RadioButton2.CheckedChanged
        VISOR.SizeMode = PictureBoxSizeMode.Zoom
    End Sub

    Private Sub RadioButton1_CheckedChanged(sender As Object, e As EventArgs) Handles RadioButton1.CheckedChanged
        VISOR.SizeMode = PictureBoxSizeMode.StretchImage
    End Sub

    Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
        SPEED = SPEED * 2
        RELOJ.Interval = SPEED
        RELOJ2.Interval = SPEED
        Label3.Text = "VELOCIDAD:   " & SPEED
    End Sub

    Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click
        If SPEED >= 10 Then
            SPEED = SPEED / 2
            RELOJ.Interval = SPEED
            RELOJ2.Interval = SPEED
            Label3.Text = "VELOCIDAD:   " & SPEED
        Else
            MsgBox("NO SE PUEDE REALIZAR LA ACCION")
        End If
    End Sub


    Private Sub SONIDO_Click(sender As Object, e As EventArgs) Handles SONIDO.Click
        If SONIDO.BackColor = Color.Black Then
            SONIDO.BackColor = Color.Red
            MUSICA.ShowDialog()
            SONIDOS = MUSICA.FileName
            My.Computer.Audio.Play(SONIDOS, AudioPlayMode.BackgroundLoop)

        ElseIf SONIDO.BackColor = Color.Red Then
            SONIDO.BackColor = Color.Black
            My.Computer.Audio.Stop()
        End If

    End Sub

    Private Sub FONDO_Click(sender As Object, e As EventArgs) Handles FONDO.Click

            FONDOS.ShowDialog()
        BackgroundImage = System.Drawing.Bitmap.FromFile(FONDOS.FileName)

    End Sub
End Class

02- Pilas y Colas, Stack & Queue, Ejemplo de Aplicacion en Visual Basic (VB.NET)

Se trata de una pequeña aplicacion para tratar de ayudar a entender, de forma muy elemental, los conceptos de Pila y de Cola en programación.

CODIGO:

FORM1

Public Class Form1
    Dim PILA As New Stack()
    Dim COLA As New Queue()
    Dim PILA2 As New Stack()
    '¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡    P I L A S     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    Private Sub BCARGARPILA_Click(sender As Object, e As EventArgs) Handles BCARGARPILA.Click 'BUTTON
        PILA.Push(TINPUT.Text) 'TEXTBOX
        MUESTRAPILA()
        TINPUT.Text = ""
        TINPUT.Focus()
    End Sub

Private Sub BDESCARGARPILA_Click(sender As Object, e As EventArgs) Handles BDESCARGARPILA.Click 'BUTTON

        If PILA.Count > 0 Then
            LOUTPUT.Text = PILA.Pop 'LABEL
        Else
            MsgBox("NO HAY MAS ELEMENTOS EN LA PILA")
        End If

MUESTRAPILA()

End Sub

'¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡ C O L A S !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    Private Sub BCARGARCOLA_Click(sender As Object, e As EventArgs) Handles BCARGARCOLA.Click 'BUTTON
        COLA.Enqueue(TINPUT1.Text) 'TEXTBOX
        MUESTRACOLA()
        TINPUT1.Text = ""
        TINPUT1.Focus()
    End Sub

    Private Sub BDESCARGARCOLA_Click(sender As Object, e As EventArgs) Handles BDESCARGARCOLA.Click 'BUTTON
        If COLA.Count > 0 Then
            LOUTPUT1.Text = COLA.Dequeue 'LABEL

        Else
            MsgBox("NO HAY MAS ELEMENTOS EN LA COLA")
        End If
        MUESTRACOLA()
    End Sub
    Public Sub MUESTRAPILA()
        LRESTOPILA.Text = ""
        For index = 0 To PILA.Count
            LRESTOPILA.Text = LRESTOPILA.Text & PILA(index) & vbCrLf
        Next
    End Sub
    Public Sub MUESTRACOLA()
        LRESTOCOLA.Text = ""
        For index = 0 To COLA.Count
            LRESTOCOLA.Text = LRESTOCOLA.Text & COLA(index) & vbCrLf
        Next
    End Sub

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        APLICACION.Show()
        Hide()
    End Sub
End Class

APLICACION

Public Class APLICACION
Dim PILA1 As New Stack()
Dim PILA2 As New Stack()

    Private Sub TINPUT_TextChanged(sender As Object, e As EventArgs) Handles TINPUT.TextChanged
        PILA1.Push(TINPUT.Text)
        MUESTRAPILA1()
    End Sub
    Public Sub MUESTRAPILA1()
        LPILA1.Text = ""
        For I = 0 To PILA1.Count
            LPILA1.Text = LPILA1.Text & PILA1(I) & vbCrLf
        Next
    End Sub

    Private Sub PDESHACER_Click(sender As Object, e As EventArgs) Handles PDESHACER.Click
        TINPUT.Visible = False
        If PILA1.Count > 0 Then
            LOUTPUT.Text = TINPUT.Text

            LOUTPUT.Text = PILA1.Pop()
            PILA2.Push(LOUTPUT.Text)
            MUESTRAPILA1()
            MUESTRAPILA2()
        Else
            MsgBox("NO HAY MAS ELEMENTOS EN LA PILA1")
        End If
    End Sub
    Public Sub MUESTRAPILA2()
        LPILA2.Text = ""
        For I = 0 To PILA2.Count
            LPILA2.Text = LPILA2.Text & PILA2(I) & vbCrLf
        Next
    End Sub

    Private Sub PREHACER_Click(sender As Object, e As EventArgs) Handles PREHACER.Click
        TINPUT.Visible = False
        If PILA2.Count > 0 Then
            LOUTPUT.Text = TINPUT.Text

            LOUTPUT.Text = PILA2.Pop()
            PILA1.Push(LOUTPUT.Text)
            MUESTRAPILA1()
            MUESTRAPILA2()
        Else
            MsgBox("NO HAY MAS ELEMENTOS EN LA PILA1")
        End If
    End Sub

    Private Sub BCARGARCOLA_Click(sender As Object, e As EventArgs) Handles BCARGARCOLA.Click
        Me.Close()
        Form1.Show()
    End Sub
End Class

Descargar y Guardar Imagenes desde una Pagina Web con Visual Basic (VB.NET)

Se trata de una pequeña aplicacion para descargar y guardar imagenes de una pagina Web. Se pueden descargar de una en una o todas a la vez. La descarga de todas a la vez no sirve para Google Imagenes pero si para Bing Imagenes. La descarga de una y una sirve para todas.

CODIGO:

Public Class Form1
    Dim CONTADOR As Integer = 10000
    Dim IMAGEN As Image
    Dim CARPETA As String
    Dim FECHA As String = DateTime.Now.ToShortDateString().Replace("/", "_") + "_" + DateTime.Now.ToLongTimeString().Replace(":", "_")
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        WebBrowser1.Navigate(TextBox4.Text)

    End Sub

    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        Label1.Text = "GUARDANDO...."
        If FolderBrowserDialog1.SelectedPath = "" Then
            FolderBrowserDialog1.ShowDialog()
        End If

        Dim CLIENTE As New System.Net.WebClient()
        Dim IMAGENES As HtmlElementCollection = Me.WebBrowser1.Document.GetElementsByTagName("img")
        Try
            For i As Integer = 0 To IMAGENES.Count - 1
                CLIENTE.DownloadFile(IMAGENES(i).GetAttribute("src"), FolderBrowserDialog1.SelectedPath & "\" & i.ToString() & ".jpg")
            Next
            Label1.Text = "GUARDADO"
            System.Threading.Thread.Sleep(3000)
        Catch ex As Exception
            MsgBox(ex.Message)
        Finally
            FolderBrowserDialog1.SelectedPath = ""
            Label1.Text = ""
        End Try

    End Sub

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        WebBrowser1.Navigate(TextBox4.Text)
        Label1.Text = ""
    End Sub

    Private Sub WebBrowser1_DocumentCompleted(sender As Object, e As WebBrowserDocumentCompletedEventArgs) Handles WebBrowser1.DocumentCompleted
        TextBox4.Text = WebBrowser1.Url.ToString
    End Sub

    Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
        If Button3.BackColor = Color.Red Then
            Button3.BackColor = Color.Black
            Clipboard.Clear()
            Timer1.Enabled = False
            FolderBrowserDialog2.Dispose()

        Else
            FolderBrowserDialog2.ShowDialog()
            CARPETA = FolderBrowserDialog2.SelectedPath
            Button3.BackColor = Color.Red
            Timer1.Enabled = True
        End If
    End Sub

    Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
        If Clipboard.ContainsImage Then
            IMAGEN = Clipboard.GetImage
            IMAGEN.Save(CARPETA & "\" & FECHA & CONTADOR & ".JPG")
            CONTADOR = CONTADOR + 1
            Clipboard.Clear()
        End If
    End Sub


End Class

Grabadora de Sonidos con Visual Basic (VB.NET)

Se trata de una pequeña aplicacion para grabar los sonidos ambientales.

Codigo:

Imports System.Runtime.InteropServices

Public Class Form1

    Dim ARCHIVO As String

    <DllImport("winmm.dll")> _
    Private Shared Function mciSendString(ByVal command As String, ByVal buffer As String, ByVal bufferSize As Integer, ByVal hwndCallback As IntPtr) As Integer
    End Function

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        If Button1.Text = "GRABAR" Then

            SaveFileDialog1.ShowDialog()
            ARCHIVO = SaveFileDialog1.FileName & ".WAV"
            Button1.Text = "PARAR"
            mciSendString("open new Type waveaudio Alias recsound", "", 0, 0)
            mciSendString("record recsound", "", 0, 0)

        Else
            mciSendString("save recsound " & ARCHIVO, "", 0, 0)
            mciSendString("close recsound ", "", 0, 0)
            Button2.Visible = True
            Button1.Text = "GRABAR"
        End If

    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        My.Computer.Audio.Play(ARCHIVO)
    End Sub


End Class

Guardar y Leer Datos con un Fichero de Texto, Visual Basic (VB.NET)

Se trata de una pequeña aplicacion para tratar el tema de Guardar y Leer con un Fichero de Texto. Si teneis alguna duda dejad un comentario.

Codigo:

FORM1

Imports Microsoft.VisualBasic.FileIO

Public Class Form1
    Dim DATOS As String = Application.StartupPath & "\DATOS.TXT"

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        My.Computer.FileSystem.WriteAllText(DATOS, TextBox1.Text & "#" & TextBox2.Text & "#" & TextBox3.Text & "#", False)
    End Sub

    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        Dim FICHERO_LEER As String = DATOS
        Dim CAMPOS As String()
        Dim DELIMITADOR As String = "#"
        Using ANALIZADOR_SINTACTICO As New TextFieldParser(FICHERO_LEER)
            ANALIZADOR_SINTACTICO.SetDelimiters(DELIMITADOR)
            While Not ANALIZADOR_SINTACTICO.EndOfData

                'LEE LOS CAMPOS DE ESTA LINEA
                CAMPOS = ANALIZADOR_SINTACTICO.ReadFields()
                ' CODIGO PARA QUE HAGA LO QUE QUEREMOS

                TextBox1.Text = CAMPOS(0)

                TextBox2.Text = CAMPOS(1)

                TextBox3.Text = CAMPOS(2)

            End While
        End Using

    End Sub

    Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
        My.Computer.FileSystem.WriteAllText(DATOS, TextBox1.Text & "#" & TextBox2.Text & "#" & TextBox3.Text & "#", False)
    End Sub

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load

        If My.Computer.FileSystem.FileExists(DATOS) Then

            Dim FICHERO_LEER As String = DATOS
            Dim CAMPOS As String()
            Dim DELIMITADOR As String = "#"
            Using ANALIZADOR_SINTACTICO As New TextFieldParser(FICHERO_LEER)
                ANALIZADOR_SINTACTICO.SetDelimiters(DELIMITADOR)
                While Not ANALIZADOR_SINTACTICO.EndOfData

                    'LEE LOS CAMPOS DE ESTA LINEA
                    CAMPOS = ANALIZADOR_SINTACTICO.ReadFields()
                    ' CODIGO PARA QUE HAGA LO QUE QUEREMOS

                    TextBox1.Text = CAMPOS(0)

                    TextBox2.Text = CAMPOS(1)

                    TextBox3.Text = CAMPOS(2)

                End While
            End Using

        End If
    End Sub
End Class

Movimiento del Cursor por Teclado. Sin Raton. Visual Basic (VB.NET). Mouse

Se trata de una pequeña aplicacion para tratar el tema de movimiento del cursor por teclado sin raton. Si teneis alguna duda dejad un comentario.

Codigo:

Imports System.Runtime.InteropServices

Public Class Form1
    <DllImport("user32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)> _
    Public Shared Sub mouse_event(dwFlags As Integer, dx As Integer, dy As Integer, cButtons As Integer, dwExtraInfo As Integer)
    End Sub

    Private Const MOUSEEVENTF_LEFTDOWN As Integer = &H2
    Private Const MOUSEEVENTF_LEFTUP As Integer = &H4
    Private Const MOUSEEVENTF_RIGHTDOWN As Integer = &H8
    Private Const MOUSEEVENTF_RIGHTUP As Integer = &H10

    Dim PUNTOX As Integer
    Dim PUNTOY As Integer

    Dim BANDERA As Boolean = False

    Public Sub CLICKIZDO()
        mouse_event(MOUSEEVENTF_LEFTDOWN, PUNTOX, PUNTOY, 0, 0)
        mouse_event(MOUSEEVENTF_LEFTUP, PUNTOX, PUNTOY, 0, 0)
    End Sub
    Public Sub CLICKDCHO()
        mouse_event(MOUSEEVENTF_RIGHTDOWN, PUNTOX, PUNTOY, 0, 0)
        mouse_event(MOUSEEVENTF_RIGHTUP, PUNTOX, PUNTOY, 0, 0)
    End Sub

    Private Sub MOVERMOUSE()
        Cursor = New Cursor(Cursor.Current.Handle)
        Cursor.Position = New Point(PUNTOX, PUNTOY)
    End Sub

    Protected Overrides Function ProcessCmdKey( _
     ByRef msg As System.Windows.Forms.Message, _
     ByVal keyData As System.Windows.Forms.Keys) As Boolean

        Select Case keyData
            Case Keys.Up
                PUNTOX = Cursor.Position.X
                PUNTOY = Cursor.Position.Y - 5
                MOVERMOUSE()
                Label1.Text = "ARRIBA"
                Label2.Text = "ARRIBA"
                Label3.Text = "ARRIBA"
                Label4.Text = "ARRIBA"
            Case Keys.Down
                PUNTOX = Cursor.Position.X
                PUNTOY = Cursor.Position.Y + 5
                MOVERMOUSE()
                Label1.Text = "ABAJO"
                Label2.Text = "ABAJO"
                Label3.Text = "ABAJO"
                Label4.Text = "ABAJO"

            Case Keys.Left
                PUNTOX = Cursor.Position.X - 5
                PUNTOY = Cursor.Position.Y
                MOVERMOUSE()
                Label1.Text = "IZQUIERDA"
                Label2.Text = "IZQUIERDA"
                Label3.Text = "IZQUIERDA"
                Label4.Text = "IZQUIERDA"

            Case Keys.Right
                PUNTOX = Cursor.Position.X + 5
                PUNTOY = Cursor.Position.Y
                MOVERMOUSE()
                Label1.Text = "DERECHA"
                Label2.Text = "DERECHA"
                Label3.Text = "DERECHA"
                Label4.Text = "DERECHA"



            Case Keys.Enter
                CLICKIZDO()
            Case Keys.Space
                CLICKDCHO()
                Label1.Text = "MOUSE 2"
                Label2.Text = "MOUSE 2"
                Label3.Text = "MOUSE 2"
                Label4.Text = "MOUSE 2"

        End Select

        Return Nothing

    End Function


End Class

Comunicacion entre dos Aplicaciones con Serialport en VB.NET. (VB - VB y VB- PROTEUS)

Se trata de una pequeña aplicacion que permite comunicar dos aplicaciones a traves del serialport. En este video se muestra la comunicacion entre dos aplicaciones iguales en visual basic y la comunicacion entre visual basic y Proteus. Si teneis alguna duda dejad un comentario.

El enlace de donde he obtenido el proyecto en Proteus, es:
http://www.youtube.com/watch?v=jhD069FHYdM

CODIGO:

Public Class Form1

Dim RECIBIDO As String

Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load

For Each PUERTO In My.Computer.Ports.SerialPortNames

ComboBox1.Items.Add(PUERTO)

Next

End Sub

Private Sub ComboBox1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ComboBox1.SelectedIndexChanged

SerialPort1.PortName = ComboBox1.SelectedItem

SerialPort1.Open()

Timer1.Enabled = True

End Sub

Private Sub ButtonENVIAR_Click(sender As Object, e As EventArgs) Handles ButtonENVIAR.Click

SerialPort1.Write(TextBoxENVIAR.Text)

TextBoxENVIAR.Text = ""

End Sub

Private Sub SerialPort1_DataReceived(sender As Object, e As IO.Ports.SerialDataReceivedEventArgs) Handles SerialPort1.DataReceived

RECIBIDO = SerialPort1.ReadExisting

End Sub

Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick

LabelRECIBIR.Text = RECIBIDO

End Sub

End Class

Obtener Imagenes desde un Video en Visual Basic ( VB.NET ) . Video a Imagenes , JPG

Se trata de una pequeña aplicacion para obtener imagenes desde un video. Si teneis alguna duda, dejad un comentario.

CODIGO:

Imports System.Drawing.Imaging

Public Class Form1

Dim CONTADOR As Integer = 1000000

Dim BM As Bitmap

Dim DIBUJO As Graphics

Dim INTERVALO As Integer

Dim BORDESUPERIOR As Integer = 42 ' ANCHURA DEL TITULO DEL FORMULARIO

Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click

'CARGA EL VIDEO

Button3.BackColor = Color.Red

OpenFileDialog1.ShowDialog()
AxWindowsMediaPlayer1.URL = OpenFileDialog1.FileName

AxWindowsMediaPlayer1.stretchToFit = True

End Sub

Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click

'PAUSA EL VIDEO

Button5.BackColor = Color.Red

Button4.BackColor = Color.Black

AxWindowsMediaPlayer1.Ctlcontrols.pause()

End Sub

Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click

'REANUDA EL VIDEO

Button4.BackColor = Color.Red

Button5.BackColor = Color.Black

AxWindowsMediaPlayer1.Ctlcontrols.play()

End Sub

Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

'LEE EL TEXTBOX, CALCULA EL INTERVALO DEL TIMER,PIDE CARPETA DE GUARDADO, ELIMINA EL MARCO DEL MEDIAPLAYER, REANUDA EL VIDEO E INICIA EL GUARDADO

Button1.BackColor = Color.Red

INTERVALO = CInt(1000 / TextBox1.Text)

FolderBrowserDialog1.ShowDialog()

AxWindowsMediaPlayer1.uiMode = "none"

AxWindowsMediaPlayer1.Ctlcontrols.play()
Timer1.Interval = INTERVALO

Timer1.Enabled = True

End Sub

Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick

'INAHBILITA EL BOTON MINIMIZAR PARA EVITAR ERRORES EN LAS IMAGENES,CREA UN BITMAP DEL AREA DEL FORM DONDE ESTA EL MEDIAPLAYER, LO PRESENTA EN EL PICTUREBOX Y GUARDA UNA IMAGEN,

'LE PONE EL NUMERO DEL CONTADOR Y ADELANTA EL CONTADOR UN ENTERO.

Me.MinimizeBox = False

BM = New Bitmap(AxWindowsMediaPlayer1.Bounds.Width, AxWindowsMediaPlayer1.Bounds.Height, PixelFormat.Format24bppRgb)

DIBUJO = Graphics.FromImage(BM)

DIBUJO.CopyFromScreen(AxWindowsMediaPlayer1.Location.X, AxWindowsMediaPlayer1.Location.Y + BORDESUPERIOR, 0, 0, AxWindowsMediaPlayer1.Size, CopyPixelOperation.SourceCopy)

PictureBox1.Image = BM

PictureBox1.Image.Save(FolderBrowserDialog1.SelectedPath & "\" & CONTADOR & ".JPG", Imaging.ImageFormat.Jpeg)

CONTADOR = CONTADOR + 1

End Sub

Private Sub Button6_Click(sender As Object, e As EventArgs)

'CIERRA LA APLICACION

Close()

End Sub

Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click

'PAUSA EL GUARDADO DE IMAGENES

Button2.BackColor = Color.Red

Button6.BackColor = Color.Black

Timer1.Enabled = False

End Sub

Private Sub Button6_Click_1(sender As Object, e As EventArgs) Handles Button6.Click

'REANUDA EL GUARDADO DE IMAGENES

Button6.BackColor = Color.Red

Button2.BackColor = Color.Black

Timer1.Enabled = True

End Sub

End Class

18 comentarios:

Anónimo9 de enero de 2014, 2:51
Hola en el programa de encriptacion de donde sale "procesar" o que sería procesar?
espero tu respuesta saludos
ResponderEliminar
Respuestas
Anónimo18 de enero de 2014, 23:46
Hola como estas, gracias por tu respuesta, luego presté atención y observe donde aparecía la parte de procesar muy bueno. Te hago una pregunta tienes un tutorial donde la aplicación se cierre en una determinada fecha (por ej. un mes) y que para ser reactivada se utilice una contraseña y que dicho proceso se repita la verdad es excelente tu blog, te felicito, saludos
ResponderEliminar
Respuestas
marcos17 de junio de 2014, 19:36
amigo podria hacer un programa que bloquee la pc asi como los del cyber control pero con una contraseña se habilte
ResponderEliminar
Respuestas
Anónimo12 de febrero de 2015, 19:36
hola me llamo mauricio estaba viendo el teclado numérico que creaste y me interesa tener uno como lo puedo hacer desconozco el tema necesito ayuda.
ResponderEliminar
Respuestas
Anónimo12 de febrero de 2015, 20:04
donde descargo el programa full
ResponderEliminar
Respuestas
Anónimo13 de febrero de 2015, 2:32
hola no me entendiste no tengo el programa visual basic full ,al parecer descargue uno pero no venia completo,cuando le doy a ejecutar el teclado numérico me sale un error debido que me sale el archivo no es valido visual studio solution.
ResponderEliminar
Respuestas
Unknown16 de febrero de 2015, 18:37
Hola me salen varios express el que tengo que descargar es de windows,web o desktop, son de 6.5G ? cual es que me sirve ayuda...
ResponderEliminar
Respuestas

Añadir comentario