Mensajes

La versión que compartí tenía un error grave con la transparencia.

En el post principal pueden descargar la nueva versión.

• Cambios v1.1:
       - Bug correjido: La imagen no se centra en la pantalla después de redimensionarla.
       - Bug correjido: La transparencia de la aplicación afecta a la imagen mostrada (la imagen pierde ciertos colores).
       - Añadida compatibilidad 100% con imágenes PNG/ICO transparentes y con sombras.
       - Añadido los parámetros "/Ontop" y "/Clickable".
       - Añadido un icono a la aplicación.
       - Pequeñas optimizaciones de código para cargar más rápido.
       - Erratas de texto correjidas en la sección de ayuda de la aplicación.
  
       
• Cosas por hacer:
       Añadir compatibilidad con los efectos FadeIn/FadeOUT para imágenes PNG/ICO.
       Añadir Más efectos especiales.

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

PD: Hay que instanciarlo siempre para handlear el .Currentcolor

Ejemplos de uso:

Código (vbnet) [Seleccionar] Expandir

Public Class Form1

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

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

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

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

End Class

Código (vbnet) [Seleccionar] Expandir

Public Class Colordialog_Realtime
   Inherits ColorDialog

   Public Event CurrentColor(ByVal c As Color)

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

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

   Private EditWindows As List(Of ApiWindow) = Nothing

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

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

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

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

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

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

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

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

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

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

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

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

End Class

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

Class WindowsEnumerator

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

End Class

Reproducir, pausar, detener archivos MP3/WAV/MIDI

Código (vbnet) [Seleccionar] Expandir

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

#Region " PlayFile Class"

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

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

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

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

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

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

               Dim playCommand As String = "play audiofile from 0"

               If _wait = True Then playCommand += " wait"

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

       IsPaused = False

   End Sub

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

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

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

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

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

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

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

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

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

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

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

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

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

           Return Str(buf)
       End Get
   End Property

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

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

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

           _filename = value
       End Set
   End Property
End Class

#End Region




Ejemplos de uso del Windows Media Player control:

Código (vbnet) [Seleccionar] Expandir

#Region " Windows Media Player "

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

#End Region

[MediaInfo Lite]

me mediinfo no tiene ese modo depurar, me decis que programa es ese, mi media info vino con k lite mega pack.

El K-Lite te instala el "MediaInfo Lite", que es una versión gráfica especial del MediaInfo para K-Lite (Una GUI), está muy bien para añadir el programa al menú contextual de Windows para los videos, pero desde luego no es el MediaInfo original.

MediaInfo se suele usar por consola, también tiene sus dll's SDK para programadores (De ahí existe el programa MediaInfo-Lite)
http://mediainfo.sourceforge.net/en/Download

No se a que modo "depurar" te refieres,
Saludos.

Y no te resultaría esto algo más entendible?:

Código (dos) [Seleccionar] Expandir

:home
echo VINE POR ACA PARA DECIRTE QUE SON LAS 12 DE LA NOCHE.
echo+
echo [1] Programar un temporizador de auto-apagado.
echo [2] No hacer nada y seguir en marcha.
echo [6] Cancelar un temporizador de auto-apagado activo. | MORE

Choice /C 126 /M "elige una opcion: "
If %Errorlevel% EQU 1 (Goto :apagar)
If %Errorlevel% EQU 2 (Goto :salir)
If %Errorlevel% EQU 3 (Goto :cancel)

Saludos

[Timer]

Hola,
Todo eso está muy bien, pero... ¿y si comentas en que lenguaje lo estás haciendo?...

Como iniciar un proceso externo: http://msdn.microsoft.com/en-us/library/system.diagnostics.process.start%28v=vs.100%29.aspx

Código [Seleccionar] Expandir

process.start(".\AutoIt3.exe", "Argumentos si quieres")

Para lo del lapsus de tiempo usa un Timer si no tienes la necesidad de mostrar la cuenta regresiva: http://msdn.microsoft.com/en-us/library/system.timers.timer%28v=vs.90%29.aspx

Código [Seleccionar] Expandir

timer1.interval = 5000 ' ms

...De lo contrario usa un TimeSpan junsto a un StopWatch si quieres ir mostrando la cuenta atrás hasta llegar a "00" "00" "00" en los TextBoxes: http://msdn.microsoft.com/en-us/library/system.diagnostics.stopwatch%28v=vs.90%29.aspx   http://msdn.microsoft.com/en-us/library/system.timespan%28v=vs.90%29.aspx

Código (vbnet) [Seleccionar] Expandir

#Region " Time Remaining "

   ' [ Time Remaining ]
   '
   ' // By Elektro H@cker
   '
   ' Examples :
   ' CountDown_Start()

   Dim TotalTime As Long = 10000 ' ms
   Dim Time_Elapsed_Watch As New Stopwatch
   Dim Time_Remaining_Span As New TimeSpan()
   Dim WithEvents CountDown_Timer As New Timer

   Private Sub CountDown_Start()
       Time_Remaining_Span = TimeSpan.FromMilliseconds(TotalTime + 1000)
       Time_Elapsed_Watch.Start()
       CountDown_Timer.Start()
   End Sub

   Private Sub CountDown_Timer_Tick(sender As Object, e As EventArgs) Handles CountDown_Timer.Tick
       Dim TimeRemaining As TimeSpan = Time_Remaining_Span - Time_Elapsed_Watch.Elapsed

       Label1.Text = "Elapsed : " & _
                    String.Format("{0:00}:{1:00}:{2:00}", _
                    Time_Elapsed_Watch.Elapsed.Hours, _
                    Time_Elapsed_Watch.Elapsed.Minutes, _
                    Time_Elapsed_Watch.Elapsed.Seconds)

       Label2.Text = "TimeLeft: " & _
                     String.Format("{0:00}:{1:00}:{2:00}", _
                     CLng(Math.Floor(TimeRemaining.TotalHours)) Mod 999999999999999999, _
                     CLng(Math.Floor(TimeRemaining.TotalMinutes)) Mod 60, _
                     CLng(Math.Floor(TimeRemaining.TotalSeconds)) Mod 60)

       If TimeRemaining.TotalSeconds <= 0 OrElse Time_Elapsed_Watch.ElapsedMilliseconds > TotalTime Then
           Time_Elapsed_Watch.Reset()
           CountDown_Timer.Stop()
       End If

   End Sub

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

#End Region

EDITO: Como reproducir un archivo que no séa WAV:

Código (vbnet) [Seleccionar] Expandir

    On Error GoTo ErrMsg
    AxMMControl1.Wait = True
    AxMMControl1.FileName = OpenFileDialog1.FileName
    AxMMControl1.Command = "Open"
    AxMMControl1.Command = "Play"
    Exit Sub
    ErrMsg:
    MsgBox(Err.Description)
    End Sub

O usando APIs: http://stackoverflow.com/questions/10244068/playing-a-wav-mp3-file-at-the-start-of-a-vb2010-windows-form


PD: Acerca de la interfaz yo modificaría "Ejecutar sonido" por "Reproducir sonido" y "Ejecutar programa" por "Iniciar proceso".

Saludos.

Redimensionar una imágen:

Código (vbnet) [Seleccionar] Expandir

#Region " Resize Image "

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

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

#End Region





Redimensionar una imágen a escala:

Código (vbnet) [Seleccionar] Expandir

#Region " Scale Image "

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

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

#End Region

@usherfiles

Para hacer un código más o menos legible (no para los demás, sinó especiálmente para ti), te recomiendo que la redirección la escribas al final del comando, no en medio,
y que agrupes las aplicaciones que vas a matar, que uses la indentación y los saltos de líena, en fín no arrejuntar todo el código línea por línea, la lectura de esos códigos es dificil cuando se trata de códigos muy largos.

Sobre el resto, puedes usar FOR para simplificar las cosas.

No cuesta nada hacer las cosas de forma ordenada:

Código original:

Código (DOS) [Seleccionar] Expandir

@ECHO OFF
start /wait taskkill>nul /IM explorer.exe /F
start /wait taskkill>nul /IM Teamviewer.exe /F
start /wait taskkill>nul /IM Teamviewer_Service.exe /F
start /wait taskkill>nul /IM tv_w32.exe /F
msg * Por favor espere un momento, Estamos tratando de conectarlo al servidor (esto puede tardar HASTA 2 minutos)
msg * Y no se preocupe ,el contador del ciber empieza luego de la comprobacion
Set verify=0
:verify
timeout>nul 3
set /a verify=%verify% + 1
IF %verify%==50 goto :verify65
IF EXIST "\\SERVERG4\Documentos c\Comprobador\Verificador.txt" goto :INICIO
IF NOT EXIST "\\SERVERG4\Documentos c\Comprobador\Verificador.txt" goto :verify
:VERIFY65
shutdown -r -f -t 4 -c "Disculpe, durante 2 minutos no se ha podido conectar con el servidor, Esta pc se reiniciará, si esto pasa mas de 2 veces, hable con el cajero de turno"
:INICIO
xcopy "\\SERVERG4\Documentos c\Comprobador de red\UPDATER.bat" C:\Windows\System32 /y
cls
START /W UPDATER.bat
START 3.vbs
exit

Código editado:

Código (dos) [Seleccionar] Expandir


@ECHO OFF

:: Set Apps
Set "Applications=Explorer.exe;Teamviewer.exe;Teamviewer_Service.exe;tv_w32.exe"

:: Close Apps
For %%# in (%Applications%) Do (start /w taskkill /IM "%%#" /F >nul)

:: Show Info
msg * Por favor espere un momento, Estamos tratando de conectarlo al servidor (esto puede tardar HASTA 2 minutos).
msg * Y no se preocupe, el contador del ciber empieza luego de la comprobacion.

:: Verify connectivity
For /L %%# in (1,1,50) Do (
Timeout 3 >nul
IF EXIST "\\SERVERG4\Documentos c\Comprobador\Verificador.txt" (Goto :INICIO)
)
Shutdown -r -f -t 4 -c "Disculpe, durante 2 minutos no se ha podido conectar con el servidor, Esta pc se reiniciará, si esto pasa mas de 2 veces, hable con el cajero de turno."
Exit

:INICIO
xcopy "\\SERVERG4\Documentos c\Comprobador de red\UPDATER.bat" "%WINDIR%\System32\" /y
cls
START /W "" "UPDATER.bat"
START /B "" "3.vbs"
Exit

Saludos.

Devuelve una lista con todos los valores de una enumeración

Código (vbnet) [Seleccionar] Expandir

   #Region " Get Enum Values "
   
      ' [ Get Enum Values Function ]
      '
      ' // By Elektro H@cker
      '
      ' Examples :
      ' For Each value In Get_Enum_Values(Of KnownColor)() : MsgBox(value) : Next
   
   Private Function Get_Enum_Values(Of T)() As List(Of String)
       Dim ValueList As New List(Of String)
       For Each value In System.[Enum].GetValues(GetType(T)) : ValueList.Add(value.ToString) : Next
       Return ValueList
   End Function
   
   #End Region





Como hacer un Loop sobre todos los colores conocidos:

Código (vbnet) [Seleccionar] Expandir

       For Each col In System.[Enum].GetValues(GetType(KnownColor))
           Dim mycolor As Color = Color.FromKnownColor(col)
           MsgBox(mycolor.ToString)
            MsgBox(mycolor.R)
            MsgBox(mycolor.G)
            MsgBox(mycolor.B)
       Next

Comprobar si una imagen contiene cierto color.

Esta función me ha costado la vida conseguirla, ya la pueden guardar bien xD...

Código (vbnet) [Seleccionar] Expandir

  Private Function Image_Has_Color(ByVal image As Image, ByVal color As Color) As Boolean

       Using Bitmap_Image = New Bitmap(image.Width, image.Height, System.Drawing.Imaging.PixelFormat.Format32bppArgb)

           Graphics.FromImage(Bitmap_Image).DrawImage(image, 0, 0)

           Dim Bitmap_Data = Bitmap_Image.LockBits(New Rectangle(0, 0, Bitmap_Image.Width, Bitmap_Image.Height), System.Drawing.Imaging.ImageLockMode.[ReadOnly], Bitmap_Image.PixelFormat)
           Dim Bitmap_Pointer As IntPtr = Bitmap_Data.Scan0

           Dim Pixel_Color As Int32
           Dim Result As Boolean = False

           For i = 0 To Bitmap_Data.Height * Bitmap_Data.Width - 1

               Pixel_Color = System.Runtime.InteropServices.Marshal.ReadInt32(Bitmap_Pointer, i * 4)

               If (Pixel_Color And &HFF000000) <> 0 AndAlso (Pixel_Color And &HFFFFFF) = (color.ToArgb() And &HFFFFFF) Then
                   Result = True
                   Exit For
               End If

           Next

           Bitmap_Image.UnlockBits(Bitmap_Data)
           Return Result

       End Using

   End Function

Ejemplo:

Código (vbnet) [Seleccionar] Expandir


   Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
       MsgBox(Image_Has_Color(System.Drawing.Image.FromFile("C:\imagen.jpg"), Color.FromArgb(240, 240, 240)))
   End Sub