Menú

Mostrar Mensajes

Esta sección te permite ver todos los mensajes escritos por este usuario. Ten en cuenta que sólo puedes ver los mensajes escritos en zonas a las que tienes acceso en este momento.

Mostrar Mensajes Menú

Mensajes - Eleкtro

#6921
Hace un tiempo estuve indagando acerca de como narices implementar un (decente) algoritmo de ImageMatching, esto significa, identificar la existencia de una imagen en la pantalla, y de paso obtener las coordenadas para futuros usos.

Pues bien, despues de mucho investigar y mucha documentación leida, está claro que un algoritmo casero no puede llegar a compararse en eficacia y rendimiento a un producto (una librería) de renombre que tenga la suficiente experiencia en el ámbito, pues esto no es un simple PixelSearch, es algo mucho más laborioso.

Después de probar en profundidad distintos productos/librerías, encontré Aforge.NET, el cual es muy bueno tanto en su capacidad efectiva como en su velocidad de procesamiento de imagen, aunque no resulta tan rápido como a mi me gustaria y como he visto en algún que otro Software.

Nota: Si alguien conoce alguna librería eficiente y más rápida que Aforge, le agradecería que lo comentase.

Este código necesita la utilización de dicha librería, AForge, y sirve para identificar una imagen en la pantalla y obtener sus coordenadas, algo imprescindible si tienes pensado desarrollar un Bot por reconocimiento de imagen... así que espero que le sirva a alguien de ayuda.

Unos consejos antes de utilizar:
1. Si la imagen es demasiado grande, redimensionala al 40-60% (cuidado, cuando más difuso estén los pixeles puede ser menos efectivo).
2. Si la velocidad no es la esperada, prueba también a convertir la imagen a una escala de grises.

Código (vbnet) [Seleccionar]
    ' Find Image
    ' ( By Elektro )
    '
    ' Usage Examples:
    '
    'Private Sub Test() Handles MyBase.Shown
    '
    '    ' A Desktop Screenshot, in 1920x1080 px. resolution.
    '    Dim DesktopScreenshoot As New Bitmap("C:\Desktop.png")
    '
    '    ' A cutted piece of the screenshot, in 50x50 px. resolution.
    '    Dim PartOfDesktopToFind As New Bitmap("C:\PartOfDesktop.png")
    '
    '    ' Find the part of the image in the desktop, with the specified similarity.
    '    For Each matching As AForge.Imaging.TemplateMatch In
    '        FindImage(BaseImage:=DesktopScreenshoot, ImageToFind:=PartOfDesktopToFind, Similarity:=80.5R) ' 80,5% Similarity.
    '
    '        Dim sb As New System.Text.StringBuilder
    '
    '        sb.AppendFormat("Top-Left Corner Coordinates: {0}", matching.Rectangle.Location.ToString())
    '        sb.AppendLine()
    '        sb.AppendFormat("Similarity Image Percentage: {0}%", (matching.Similarity * 100.0F).ToString("00.00"))
    '
    '        MessageBox.Show(sb.ToString)
    '
    '    Next matching
    '
    'End Sub
    '
    ''' <summary>
    ''' Finds a part of an image inside other image and returns the top-left corner coordinates and it's similarity percent.
    ''' </summary>
    ''' <param name="BaseImage">
    ''' Indicates the base image.
    ''' </param>
    ''' <param name="ImageToFind">
    ''' Indicates the image to find in the base image.
    ''' </param>
    ''' <param name="Similarity">
    ''' Indicates the similarity percentage to compare the images.
    ''' A value of '100' means identical image.
    ''' Note: High percentage values with big images could take several minutes to finish.
    ''' </param>
    ''' <returns>AForge.Imaging.TemplateMatch().</returns>
    Private Function FindImage(ByVal BaseImage As Bitmap,
                               ByVal ImageToFind As Bitmap,
                               ByVal Similarity As Double) As AForge.Imaging.TemplateMatch()

        Dim SingleSimilarity As Single

        ' Translate the readable similarity percent value to Single value.
        Select Case Similarity

            Case Is < 0.1R, Is > 100.0R ' Value is out of range.
                Throw New Exception(String.Format("Similarity value of '{0}' is out of range, range is from '0.1' to '100.0'",
                                                  CStr(Similarity)))

            Case Is = 100.0R ' Identical image comparission.
                SingleSimilarity = 1.0F

            Case Else ' Image comparission with specific similarity.
                SingleSimilarity = Convert.ToSingle(Similarity) / 100.0F

        End Select

        ' Set the similarity threshold to find all matching images with specified similarity.
        Dim tm As New AForge.Imaging.ExhaustiveTemplateMatching(SingleSimilarity)

        ' Return all the found matching images,
        ' it contains the top-left corner coordinates of each one
        ' and matchings are sortered by it's similarity percent.
        Return tm.ProcessImage(BaseImage, ImageToFind)

    End Function
#6922
Hola

Para todos los que estén interesados en iniciarse en los Hooks de bajo nivel (en lo cual yo no soy ningún experto) esto les podría servir, ya que considero haberlo dejado muy bien documentado y se puede aprender algo solo leyendo los comentarios XML.

Simplemente es un Hook que intercepta los eventos del ratón, pudiendo suscribirse a ellos, nada más que eso.

Código (vbnet) [Seleccionar]
' ***********************************************************************
' Author           : Elektro
' Last Modified On : 05-13-2014
' ***********************************************************************
' <copyright file="MouseHook.vb" company="Elektro Studios">
'     Copyright (c) Elektro Studios. All rights reserved.
' </copyright>
' ***********************************************************************

#Region " Instructions "

' Go to page:
' Project > Properties > Debug
'
' And uncheck the option:
' Enable the Visual Studio Hosting Process

#End Region

#Region " Usage Examples "

' ''' <summary>
' ''' A low level mouse hook that captures mouse events.
' ''' </summary>
'Private WithEvents MouseEvents As MouseHook = Nothing

' ''' <summary>
' ''' Handles the 'MouseLeftDown' event of the Mouse Hook.
' ''' </summary>
' ''' <param name="MouseLocation">Indicates the mouse [X,Y] coordinates.</param>
'Private Sub MouseEvents_MouseLeftDown(ByVal MouseLocation As Point) Handles MouseEvents.MouseLeftDown
'
'    Debug.WriteLine(String.Format("Mouse Left Down At: x={0}, y={1}", CStr(MouseLocation.X), CStr(MouseLocation.Y)))
'
'End Sub

' ''' <summary>
' ''' Handles the 'MouseLeftUp' event of the Mouse Hook.
' ''' </summary>
' ''' <param name="MouseLocation">Indicates the mouse [X,Y] coordinates.</param>
'Private Sub MouseEvents_MouseLeftUp(ByVal MouseLocation As Point) Handles MouseEvents.MouseLeftUp
'
'    Debug.WriteLine(String.Format("Mouse Left Up At: x={0}, y={1}", CStr(MouseLocation.X), CStr(MouseLocation.Y)))
'
'End Sub

' ''' <summary>
' ''' Handles the 'MouseMove' event of the Mouse Hook.
' ''' </summary>
' ''' <param name="MouseLocation">Indicates the mouse [X,Y] coordinates.</param>
'Private Sub MouseEvents_MouseMove(ByVal MouseLocation As Point) Handles MouseEvents.MouseMove
'
'    Debug.WriteLine(String.Format("Mouse Moved To: x={0}, y={1}", CStr(MouseLocation.X), CStr(MouseLocation.Y)))
'
'End Sub

' ''' <summary>
' ''' Handles the 'Click' event of the 'ButtonStartHook' control.
' ''' </summary>
'Private Sub ButtonStartHook() Handles ButtonStartHook.Click

'    ' Start the Mouse Hook.
'    MouseEvents = New MouseHook

'End Sub

' ''' <summary>
' ''' Handles the 'Click' event of the 'ButtonStopHook' control.
' ''' </summary>
'Private Sub ButtonStopHook() Handles ButtonStopHook.Click

'    ' Stop the Mouse Hook.
'    MouseEvents = Nothing

'End Sub

#End Region

#Region " Imports "

Imports System.ComponentModel
Imports System.Reflection
Imports System.Runtime.InteropServices

#End Region

#Region " MouseHook "

''' <summary>
''' A low level mouse hook class that captures mouse events.
''' </summary>
Public Class MouseHook

#Region " WinAPI "

#Region " Methods "

   ''' <summary>
   ''' Passes the hook information to the next hook procedure in the current hook chain.
   ''' A hook procedure can call this function either before or after processing the hook information.
   ''' For more info see here:
   ''' http://msdn.microsoft.com/en-us/library/windows/desktop/ms644974%28v=vs.85%29.aspx
   ''' </summary>
   ''' <param name="idHook">
   ''' This parameter is ignored.
   ''' </param>
   ''' <param name="nCode">
   ''' The hook code passed to the current hook procedure.
   ''' The next hook procedure uses this code to determine how to process the hook information.
   ''' </param>
   ''' <param name="wParam">
   ''' The wParam value passed to the current hook procedure.
   ''' The meaning of this parameter depends on the type of hook associated with the current hook chain.
   ''' </param>
   ''' <param name="lParam">
   ''' The lParam value passed to the current hook procedure.
   ''' The meaning of this parameter depends on the type of hook associated with the current hook chain.
   ''' </param>
   ''' <returns>
   ''' This value is returned by the next hook procedure in the chain.
   ''' The current hook procedure must also return this value.
   ''' The meaning of the return value depends on the hook type.
   ''' For more information, see the descriptions of the individual hook procedures.
   ''' </returns>
   <DllImport("user32.dll", CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Auto)>
   Private Shared Function CallNextHookEx(
          ByVal idHook As Integer,
          ByVal nCode As Integer,
          ByVal wParam As Integer,
          ByVal lParam As MSLLHOOKSTRUCT
   ) As Integer
   End Function

   ''' <summary>
   ''' Installs an application-defined hook procedure into a hook chain.
   ''' You would install a hook procedure to monitor the system for certain types of events.
   ''' These events are associated either with a specific thread
   ''' or with all threads in the same desktop as the calling thread.
   ''' For more info see here:
   ''' http://msdn.microsoft.com/en-us/library/windows/desktop/ms644990%28v=vs.85%29.aspx
   ''' </summary>
   ''' <param name="idHook">
   ''' The type of hook procedure to be installed.
   ''' </param>
   ''' <param name="lpfn">
   ''' A pointer to the hook procedure.
   ''' If the dwThreadId parameter is zero or specifies the identifier of a thread created by a different process,
   ''' the lpfn parameter must point to a hook procedure in a DLL.
   ''' Otherwise, lpfn can point to a hook procedure in the code associated with the current process.
   ''' </param>
   ''' <param name="hInstance">
   ''' A handle to the DLL containing the hook procedure pointed to by the lpfn parameter.
   ''' The hMod parameter must be set to NULL if the dwThreadId parameter specifies a thread created by
   ''' the current process and if the hook procedure is within the code associated with the current process.
   ''' </param>
   ''' <param name="threadId">
   ''' The identifier of the thread with which the hook procedure is to be associated.
   ''' For desktop apps, if this parameter is zero, the hook procedure is associated
   ''' with all existing threads running in the same desktop as the calling thread.
   ''' </param>
   ''' <returns>
   ''' If the function succeeds, the return value is the handle to the hook procedure.
   ''' If the function fails, the return value is NULL.
   ''' </returns>
   <DllImport("user32.dll", CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Auto)>
   Private Shared Function SetWindowsHookEx(
          ByVal idHook As HookType,
          ByVal lpfn As MouseProcDelegate,
          ByVal hInstance As IntPtr,
          ByVal threadId As Integer
   ) As Integer
   End Function

   ''' <summary>
   ''' Removes a hook procedure installed in a hook chain by the 'SetWindowsHookEx' function.
   ''' For more info see here:
   ''' http://msdn.microsoft.com/en-us/library/windows/desktop/ms644993%28v=vs.85%29.aspx
   ''' </summary>
   ''' <param name="idHook">
   ''' A handle to the hook to be removed.
   ''' This parameter is a hook handle obtained by a previous call to SetWindowsHookEx.
   ''' </param>
   ''' <returns>
   ''' If the function succeeds, the return value is nonzero.
   ''' If the function fails, the return value is zero.
   ''' </returns>
   <DllImport("user32.dll", CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Auto)>
   Private Shared Function UnhookWindowsHookEx(
          ByVal idHook As Integer
   ) As Boolean
   End Function

#End Region

#Region " Enums "

   ''' <summary>
   ''' Indicates a type of Hook procedure to be installed.
   ''' </summary>
   <Description("Enum used in 'idHook' parameter of 'SetWindowsHookEx' function")>
   Private Enum HookType As Integer

       ' **************************************
       ' This enumeration is partially defined.
       ' **************************************

       ''' <summary>
       ''' Installs a hook procedure that monitors low-level mouse input events.
       ''' For more information, see the LowLevelMouseProc hook procedure.
       ''' </summary>
       WH_MOUSE_LL = 14

   End Enum

#End Region

#Region " Structures "

   ''' <summary>
   ''' Contains information about a low-level mouse input event.
   ''' </summary>
   <Description("Structure used in 'lParam' parameter of 'CallNextHookEx' function")>
   Private Structure MSLLHOOKSTRUCT

       ''' <summary>
       ''' The ptThe x- and y-coordinates of the cursor, in screen coordinates.
       ''' </summary>
       Public pt As Point

       ''' <summary>
       ''' If the message is 'WM_MOUSEWHEEL', the high-order word of this member is the wheel delta.
       ''' The low-order word is reserved.
       ''' A positive value indicates that the wheel was rotated forward, away from the user;
       ''' a negative value indicates that the wheel was rotated backward, toward the user.
       ''' One wheel click is defined as 'WHEEL_DELTA', which is '120'.
       ''' </summary>
       Public mouseData As Integer

       ''' <summary>
       ''' The event-injected flag.
       ''' </summary>
       Public flags As Integer

       ''' <summary>
       ''' The time stamp for this message.
       ''' </summary>
       Public time As Integer

       ''' <summary>
       ''' Additional information associated with the message.
       ''' </summary>
       Public dwExtraInfo As Integer

   End Structure

#End Region

#End Region

#Region " Variables "

   ''' <summary>
   '''
   ''' </summary>
   Private MouseHook As Integer

#End Region

#Region " Delegates "

   ''' <summary>
   ''' Delegate MouseProcDelegate
   ''' </summary>
   ''' <returns>System.Int32.</returns>
   Private Delegate Function MouseProcDelegate(
           ByVal nCode As Integer,
           ByVal wParam As Integer,
           ByRef lParam As MSLLHOOKSTRUCT
   ) As Integer

   ''' <summary>
   ''' </summary>
   Private MouseHookDelegate As MouseProcDelegate

#End Region

#Region " Enums "

   ''' <summary>
   ''' Indicates a Windows Message related to a mouse events.
   ''' For more info see here:
   ''' http://msdn.microsoft.com/en-us/library/windows/desktop/ff468877%28v=vs.85%29.aspx
   ''' </summary>
   Private Enum MouseWindowsMessages As Integer

       ''' <summary>
       ''' Posted to a window when the cursor moves.
       ''' If the mouse is not captured, the message is posted to the window that contains the cursor.
       ''' Otherwise, the message is posted to the window that has captured the mouse
       ''' </summary>
       WM_MOUSEMOVE = &H200

       ''' <summary>
       ''' Posted when the user presses the left mouse button while the cursor is in the client area of a window.
       ''' If the mouse is not captured, the message is posted to the window beneath the cursor.
       ''' Otherwise, the message is posted to the window that has captured the mouse
       ''' </summary>
       WM_LBUTTONDOWN = &H201

       ''' <summary>
       ''' Posted when the user releases the left mouse button while the cursor is in the client area of a window.
       ''' If the mouse is not captured, the message is posted to the window beneath the cursor.
       ''' Otherwise, the message is posted to the window that has captured the mouse
       ''' </summary>
       WM_LBUTTONUP = &H202

       ''' <summary>
       ''' Posted when the user double-clicks the left mouse button while the cursor is in the client area of a window.
       ''' If the mouse is not captured, the message is posted to the window beneath the cursor.
       ''' Otherwise, the message is posted to the window that has captured the mouse
       ''' </summary>
       WM_LBUTTONDBLCLK = &H203

       ''' <summary>
       ''' Posted when the user presses the right mouse button while the cursor is in the client area of a window.
       ''' If the mouse is not captured, the message is posted to the window beneath the cursor.
       ''' Otherwise, the message is posted to the window that has captured the mouse
       ''' </summary>
       WM_RBUTTONDOWN = &H204

       ''' <summary>
       ''' Posted when the user releases the right mouse button while the cursor is in the client area of a window.
       ''' If the mouse is not captured, the message is posted to the window beneath the cursor.
       ''' Otherwise, the message is posted to the window that has captured the mouse
       ''' </summary>
       WM_RBUTTONUP = &H205

       ''' <summary>
       ''' Posted when the user double-clicks the right mouse button while the cursor is in the client area of a window.
       ''' If the mouse is not captured, the message is posted to the window beneath the cursor.
       ''' Otherwise, the message is posted to the window that has captured the mouse
       ''' </summary>
       WM_RBUTTONDBLCLK = &H206

       ''' <summary>
       ''' Posted when the user presses the middle mouse button while the cursor is in the client area of a window.
       ''' If the mouse is not captured, the message is posted to the window beneath the cursor.
       ''' Otherwise, the message is posted to the window that has captured the mouse
       ''' </summary>
       WM_MBUTTONDOWN = &H207

       ''' <summary>
       ''' Posted when the user releases the middle mouse button while the cursor is in the client area of a window.
       ''' If the mouse is not captured, the message is posted to the window beneath the cursor.
       ''' Otherwise, the message is posted to the window that has captured the mouse
       ''' </summary>
       WM_MBUTTONUP = &H208

       ''' <summary>
       ''' Posted when the user double-clicks the middle mouse button while the cursor is in the client area of a window.
       ''' If the mouse is not captured, the message is posted to the window beneath the cursor.
       ''' Otherwise, the message is posted to the window that has captured the mouse
       ''' </summary>
       WM_MBUTTONDBLCLK = &H209

       ''' <summary>
       ''' Sent to the active window when the mouse's horizontal scroll wheel is tilted or rotated.
       ''' The DefWindowProc function propagates the message to the window's parent.
       ''' There should be no internal forwarding of the message,
       ''' since DefWindowProc propagates it up the parent chain until it finds a window that processes it.
       ''' </summary>
       WM_MOUSEWHEEL = &H20A

   End Enum

   ''' <summary>
   ''' Indicates the whell direction of the mouse.
   ''' </summary>
   Public Enum WheelDirection

       ''' <summary>
       ''' The wheel is moved up.
       ''' </summary>
       WheelUp

       ''' <summary>
       ''' The wheel is moved down.
       ''' </summary>
       WheelDown

   End Enum

#End Region

#Region " Events "

   ''' <summary>
   ''' Occurs when the mouse moves.
   ''' </summary>
   Public Event MouseMove(ByVal MouseLocation As Point)

   ''' <summary>
   ''' Occurs when the mouse left button is pressed.
   ''' </summary>
   Public Event MouseLeftDown(ByVal MouseLocation As Point)

   ''' <summary>
   ''' Occurs when the mouse left button is released.
   ''' </summary>
   Public Event MouseLeftUp(ByVal MouseLocation As Point)

   ''' <summary>
   ''' Occurs when the mouse left button is double-clicked.
   ''' </summary>
   Public Event MouseLeftDoubleClick(ByVal MouseLocation As Point)

   ''' <summary>
   ''' Occurs when the mouse right button is pressed.
   ''' </summary>
   Public Event MouseRightDown(ByVal MouseLocation As Point)

   ''' <summary>
   ''' Occurs when the mouse right button is released.
   ''' </summary>
   Public Event MouseRightUp(ByVal MouseLocation As Point)

   ''' <summary>
   ''' Occurs when the mouse right button is double-clicked.
   ''' </summary>
   Public Event MouseRightDoubleClick(ByVal MouseLocation As Point)

   ''' <summary>
   ''' Occurs when the mouse middle button is pressed.
   ''' </summary>
   Public Event MouseMiddleDown(ByVal MouseLocation As Point)

   ''' <summary>
   ''' Occurs when the mouse middle button is released.
   ''' </summary>
   Public Event MouseMiddleUp(ByVal MouseLocation As Point)

   ''' <summary>
   ''' Occurs when the mouse middle button is double-clicked.
   ''' </summary>
   Public Event MouseMiddleDoubleClick(ByVal MouseLocation As Point)

   ''' <summary>
   ''' Occurs when [mouse move].
   ''' </summary>
   Public Event MouseWheel(ByVal MouseLocation As Point,
                           ByVal WheelDirection As WheelDirection)

#End Region

#Region " Constructors "

   ''' <summary>
   ''' Initializes a new instance of this class.
   ''' </summary>
   Public Sub New()

       MouseHookDelegate = New MouseProcDelegate(AddressOf MouseProc)

       MouseHook = SetWindowsHookEx(HookType.WH_MOUSE_LL,
                                    MouseHookDelegate,
                                    Marshal.GetHINSTANCE(Assembly.GetExecutingAssembly.GetModules()(0)).ToInt32, 0)
   End Sub

#End Region

#Region " Protected Methods "

   ''' <summary>
   ''' Allows an object to try to free resources
   ''' and perform other cleanup operations before it is reclaimed by garbage collection.
   ''' </summary>
   Protected Overrides Sub Finalize()

       UnhookWindowsHookEx(MouseHook)
       MyBase.Finalize()

   End Sub

#End Region

#Region " Private Methods "

   ''' <summary>
   ''' Processes the mouse windows messages and raises it's corresponding events.
   ''' </summary>
   ''' <returns>System.Int32.</returns>
   Private Function MouseProc(ByVal nCode As Integer,
                              ByVal wParam As Integer,
                              ByRef lParam As MSLLHOOKSTRUCT
   ) As Integer

       If nCode = 0 Then

           Select Case wParam

               Case MouseWindowsMessages.WM_MOUSEMOVE
                   RaiseEvent MouseMove(lParam.pt)

               Case MouseWindowsMessages.WM_LBUTTONDOWN
                   RaiseEvent MouseLeftDown(lParam.pt)

               Case MouseWindowsMessages.WM_LBUTTONUP
                   RaiseEvent MouseLeftUp(lParam.pt)

               Case MouseWindowsMessages.WM_LBUTTONDBLCLK
                   RaiseEvent MouseLeftDoubleClick(lParam.pt)

               Case MouseWindowsMessages.WM_RBUTTONDOWN
                   RaiseEvent MouseRightDown(lParam.pt)

               Case MouseWindowsMessages.WM_RBUTTONUP
                   RaiseEvent MouseRightUp(lParam.pt)

               Case MouseWindowsMessages.WM_RBUTTONDBLCLK
                   RaiseEvent MouseRightDoubleClick(lParam.pt)

               Case MouseWindowsMessages.WM_MBUTTONDOWN
                   RaiseEvent MouseMiddleDown(lParam.pt)

               Case MouseWindowsMessages.WM_MBUTTONUP
                   RaiseEvent MouseMiddleUp(lParam.pt)

               Case MouseWindowsMessages.WM_MBUTTONDBLCLK
                   RaiseEvent MouseMiddleDoubleClick(lParam.pt)

               Case MouseWindowsMessages.WM_MOUSEWHEEL
                   Dim wDirection As WheelDirection
                   If lParam.mouseData < 0 Then
                       wDirection = WheelDirection.WheelDown
                   Else
                       wDirection = WheelDirection.WheelUp
                   End If
                   RaiseEvent MouseWheel(lParam.pt, wDirection)

           End Select

       End If

       Return CallNextHookEx(MouseHook, nCode, wParam, lParam)

   End Function

#End Region

End Class

#End Region
#6923
Hola

Desarrollé este Snippet para que dibuja una forma cuadrada/rectangular sobre la pantalla para seleccionar un área de la imagen en movimiento, y devuelve los datos de la estructura del rectángulo seleccionado para, posteriormente, poder capturar esa región de la imagen.

Hay 2 formas (que yo sepa al menos) de llevar esto a cabo, una es "congelando" la imagen, y la otra es en tiempo real, yo opté por la segunda opción, a pesar de ser mucho más complicada es lo que se adaptaba a mis necesidades.

Espero que puedan sacar algo de provecho en este código.

Código (vbnet) [Seleccionar]
' ***********************************************************************
' Author           : Elektro
' Last Modified On : 06-03-2014
' ***********************************************************************
' <copyright file="RegionSelector.vb" company="Elektro Studios">
'     Copyright (c) Elektro Studios. All rights reserved.
' </copyright>
' ***********************************************************************

#Region " Usage Examples "

'Public Class Form1

'    Dim SelectedRegion As Rectangle = Rectangle.Empty
'    Dim RegionSelectorIsWorking As Boolean = False

'    Private Sub Button_Click() Handles Button1.Click
'        GetScreenRegion()
'    End Sub

'    Public Sub GetScreenRegion()

'        Dim Callback As RegionSelector.RegionSelectedDelegate

'        Dim Selector As New RegionSelector(BorderColor:=Color.YellowGreen,
'                                           BorderSize:=3,
'                                           backgroundcolor:=Color.YellowGreen,
'                                           BackgroundOpacity:=0.06R)

'        Select Case RegionSelectorIsWorking

'            Case True ' Only one selection at once!
'                Exit Sub

'            Case Else
'                RegionSelectorIsWorking = True
'                Callback = New RegionSelector.RegionSelectedDelegate(AddressOf SelectionFinished)

'                With Selector
'                    .Callback = Callback
'                    .Show()
'                End With

'        End Select

'        ' Don't do any stuff here... do it in Rectangle Drawn...

'    End Sub

'    Private Sub SelectionFinished(ByVal Region As Rectangle)

'        RegionSelectorIsWorking = False ' Allow draw again.
'        Me.SelectedRegion = Region

'        Dim sb As New System.Text.StringBuilder
'        With sb
'            .AppendLine("Selected Area")
'            .AppendLine()
'            .AppendLine("· Size")
'            .AppendLine(String.Format("Width: {0}", CStr(SelectedRegion.Width)))
'            .AppendLine(String.Format("Height: {0}", CStr(SelectedRegion.Height)))
'            .AppendLine()
'            .AppendLine("· Coordinates")
'            .AppendLine(String.Format("Top: {0}", CStr(SelectedRegion.Top)))
'            .AppendLine(String.Format("Left: {0}", CStr(SelectedRegion.Left)))
'            .AppendLine(String.Format("Right: {0}", CStr(SelectedRegion.Right)))
'            .AppendLine(String.Format("Bottom: {0}", CStr(SelectedRegion.Bottom)))
'            .AppendLine()
'        End With

'        MessageBox.Show(sb.ToString)

'    End Sub

'End Class

#End Region

''' <summary>
''' Selects a region on the Screen.
''' </summary>
Public NotInheritable Class RegionSelector : Inherits Form

#Region " Delegates "

   ''' <summary>
   ''' Delegate RegionSelectedDelegate.
   ''' </summary>
   ''' <param name="Region">The region.</param>
   Public Delegate Sub RegionSelectedDelegate(ByVal Region As Rectangle)

#End Region

#Region " Properties "

   ''' <summary>
   ''' Callback to be invoked when drawing is done...
   ''' </summary>
   ''' <value>Delegate of Region Selected</value>
   Public Property Callback As RegionSelectedDelegate = Nothing

   ''' <summary>
   ''' Gets or sets the border size of the region selector.
   ''' </summary>
   ''' <value>The size of the border.</value>
   Public Property BorderSize As Integer = 2

   ''' <summary>
   ''' Gets or sets the border color of the region selector.
   ''' </summary>
   ''' <value>The color of the border.</value>
   Public Property BorderColor As Color = Color.Red

   ''' <summary>
   ''' Gets or sets the background color of the region selector.
   ''' </summary>
   ''' <value>The color of the border.</value>
   Public Property BackgroundColor As Color = Color.RoyalBlue

   ''' <summary>
   ''' Gets or sets the background opacity of the region selector.
   ''' </summary>
   ''' <value>The color of the border.</value>
   Public Property BackgroundOpacity As Double = 0.08R

   ''' <summary>
   ''' Gets the rectangle that contains the selected region.
   ''' </summary>
   Public ReadOnly Property SelectedRegion As Rectangle
       Get
           Return Me.DrawRect
       End Get
   End Property

#End Region

#Region " Objects "

   ''' <summary>
   ''' Indicates the initial location when the mouse left button is clicked.
   ''' </summary>
   Private InitialLocation As Point = Point.Empty

   ''' <summary>
   ''' The rectangle where to draw the region.
   ''' </summary>
   Public DrawRect As Rectangle = Rectangle.Empty

   ''' <summary>
   ''' The Graphics object to draw on the screen.
   ''' </summary>
   Private ScreenGraphic As Graphics = Graphics.FromHwnd(IntPtr.Zero)

   ''' <summary>
   ''' Indicates the Rectangle Size.
   ''' </summary>
   Dim DrawSize As Size

   ''' <summary>
   ''' Indicates the draw form.
   ''' </summary>
   Dim DrawForm As Form

   ''' <summary>
   ''' Indicates whether the RegionSelector is busy drawing the rectangle.
   ''' </summary>
   Public IsDrawing As Boolean = False

#End Region

#Region " Constructors "

   ''' <summary>
   ''' Initializes a new instance of the <see cref="RegionSelector"/> class.
   ''' </summary>
   Public Sub New()
   End Sub

   ''' <summary>
   ''' Initializes a new instance of the <see cref="RegionSelector" /> class.
   ''' </summary>
   ''' <param name="BorderColor">Indicates the border color of the region selector.</param>
   ''' <param name="BorderSize">Indicates the border size of the region selector.</param>
   ''' <param name="BackgroundColor">Indicates the background color of the region selector.</param>
   ''' <param name="BackgroundOpacity">Indicates the background opacity size of the region selector.</param>
   Public Sub New(Optional ByVal BorderColor As Color = Nothing,
                  Optional ByVal BorderSize As Integer = 2,
                  Optional ByVal BackgroundColor As Color = Nothing,
                  Optional ByVal BackgroundOpacity As Double = 0.1R)

       If BorderColor = Nothing _
       OrElse BorderColor = Color.Transparent Then
           BorderColor = Color.Red
       End If

       If BackgroundColor = Nothing _
       OrElse BackgroundColor = Color.Transparent Then
           BackgroundColor = Color.Black
       End If

       Me.BorderSize = BorderSize
       Me.BorderColor = BorderColor
       Me.BackgroundOpacity = BackgroundOpacity
       Me.BackgroundColor = BackgroundColor

   End Sub

#End Region

#Region " Event Handlers "

   ''' <summary>
   ''' Handles the Load event of the RegionSelector.
   ''' </summary>
   ''' <param name="sender">The source of the event.</param>
   ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
   Private Sub RegionSelector_Load(ByVal sender As Object, ByVal e As EventArgs) Handles Me.Load

       Me.SuspendLayout()

       Me.AutoScaleMode = AutoScaleMode.None
       Me.BackColor = Me.BackgroundColor
       Me.BackgroundImageLayout = ImageLayout.None
       Me.CausesValidation = False
       Me.ClientSize = New Size(0, 0)
       Me.ControlBox = False
       Me.Cursor = Cursors.Cross
       Me.DoubleBuffered = True
       Me.FormBorderStyle = FormBorderStyle.None
       Me.MaximizeBox = False
       Me.MinimizeBox = False
       Me.Name = "RegionSelector"
       Me.Opacity = Me.BackgroundOpacity
       Me.ShowIcon = False
       Me.ShowInTaskbar = False
       Me.SizeGripStyle = SizeGripStyle.Hide
       Me.StartPosition = FormStartPosition.CenterScreen
       Me.TopMost = False
       Me.WindowState = FormWindowState.Maximized

       Me.ResumeLayout(False)

       Me.DrawForm = New DrawingRegionClass(Me)
       With DrawForm
           .AutoScaleMode = AutoScaleMode.None
           .BackColor = Color.Tomato
           .BackgroundImageLayout = ImageLayout.None
           .ControlBox = False
           .FormBorderStyle = FormBorderStyle.None
           .MaximizeBox = False
           .MinimizeBox = False
           .ShowIcon = False
           .ShowInTaskbar = False
           .SizeGripStyle = SizeGripStyle.Hide
           .StartPosition = FormStartPosition.CenterScreen
           .TopLevel = True
           .TopMost = True
           .TransparencyKey = Color.Tomato
           .WindowState = FormWindowState.Maximized
       End With

       Me.AddOwnedForm(Me.DrawForm)
       Me.DrawForm.Show()

   End Sub

   ''' <summary>
   ''' Raises the <see cref="E:System.Windows.Forms.Control.MouseDown" /> event.
   ''' </summary>
   ''' <param name="e">A <see cref="T:System.Windows.Forms.MouseEventArgs" /> that contains the event data.</param>
   Protected Overrides Sub OnMouseDown(ByVal e As MouseEventArgs)

       If e.Button = MouseButtons.Left Then
           Me.InitialLocation = e.Location
           Me.IsDrawing = True
       End If

   End Sub

   ''' <summary>
   ''' Raises the <see cref="E:System.Windows.Forms.Control.MouseUp" /> event.
   ''' </summary>
   ''' <param name="e">A <see cref="T:System.Windows.Forms.MouseEventArgs" /> that contains the event data.</param>
   Protected Overrides Sub OnMouseUp(ByVal e As MouseEventArgs)

       Me.IsDrawing = False
       Callback.Invoke(SelectedRegion)
       Me.Close() ' Must be called last.

   End Sub

   ''' <summary>
   ''' Raises the <see cref="E:System.Windows.Forms.Control.MouseMove" /> event.
   ''' </summary>
   ''' <param name="e">A <see cref="T:System.Windows.Forms.MouseEventArgs" /> that contains the event data.</param>
   Protected Overrides Sub OnMouseMove(ByVal e As MouseEventArgs)

       If Me.IsDrawing Then

           Me.DrawSize = New Size(e.X - Me.InitialLocation.X, e.Y - Me.InitialLocation.Y)
           Me.DrawRect = New Rectangle(Me.InitialLocation, Me.DrawSize)

           If Me.DrawRect.Height < 0 Then
               Me.DrawRect.Height = Math.Abs(Me.DrawRect.Height)
               Me.DrawRect.Y -= Me.DrawRect.Height
           End If

           If Me.DrawRect.Width < 0 Then
               Me.DrawRect.Width = Math.Abs(Me.DrawRect.Width)
               Me.DrawRect.X -= Me.DrawRect.Width
           End If

           Me.DrawForm.Invalidate()

       End If

   End Sub

#End Region

End Class

''' <summary>
''' Class DrawingRegionClass. This class cannot be inherited.
''' </summary>
Friend NotInheritable Class DrawingRegionClass : Inherits Form

   Private DrawParent As RegionSelector

   Public Sub New(ByVal Parent As Form)

       Me.DrawParent = Parent

   End Sub

   Protected Overrides Sub OnPaintBackground(ByVal e As PaintEventArgs)

       Dim Bg As Bitmap
       Dim Canvas As Graphics

       If Me.DrawParent.IsDrawing Then

           Bg = New Bitmap(Width, Height)
           Canvas = Graphics.FromImage(Bg)
           Canvas.Clear(Color.Tomato)

           Using pen As New Pen(Me.DrawParent.BorderColor, Me.DrawParent.BorderSize)
               Canvas.DrawRectangle(pen, Me.DrawParent.DrawRect)
           End Using

           Canvas.Dispose()
           e.Graphics.DrawImage(Bg, 0, 0, Width, Height)
           Bg.Dispose()

       Else
           MyBase.OnPaintBackground(e)
       End If

   End Sub

End Class



Complemento adicional:

Código (vbnet) [Seleccionar]
    ' Take Region ScreenShot
    ' ( By Elektro )
    '
    ' Usage Examples :
    '
    ' Dim RegionScreenShot As Bitmap = TakeRegionScreenShot(New Point(0, 0), New Size(256, 256))
    ' Dim RegionScreenShot As Bitmap = TakeRegionScreenShot(New Rectangle With {.Location = Point.Empty, .Size = New Size(256, 256)})
    ' PictureBox1.BackgroundImage = RegionScreenShot
    ' RegionScreenShot.Save("C:\RegionScreenShot.png", Imaging.ImageFormat.Png)
    '
    ''' <summary>
    ''' Takes an image screenshot of an specific screen region.
    ''' </summary>
    ''' <param name="Coordinates">
    ''' The X-coordinate is the point at the upper-left corner of the region.
    ''' The Y-coordinate is the point at the upper-left corner of the region.
    ''' </param>
    ''' <param name="Size">Indicates the size of the area to be transferred.</param>
    ''' <param name="PixelFormat">Indicates the Bitmap pixel format.</param>
    ''' <returns>Bitmap.</returns>
    Private Function TakeRegionScreenShot(ByVal Coordinates As Point,
                                          ByVal [Size] As Size,
                                          Optional ByVal [PixelFormat] As Imaging.PixelFormat =
                                                                          Imaging.PixelFormat.Format24bppRgb) As Bitmap

        Using ScreenImage As New Bitmap([Size].Width, [Size].Height, [PixelFormat])

            Using ScreenGraphics As Graphics = Graphics.FromImage(ScreenImage)

                ScreenGraphics.CopyFromScreen(Coordinates, Point.Empty, ScreenImage.Size)

            End Using ' ScreenGraphics

            Return CType(ScreenImage.Clone, Bitmap)

        End Using ' ScreenImage

    End Function

    ''' <summary>
    ''' Takes an image screenshot of an specific screen region.
    ''' </summary>
    ''' <param name="Region">Indicates a Rectangle structure that contains the region coordinates and the size.</param>
    ''' <param name="PixelFormat">Indicates the Bitmap pixel format.</param>
    ''' <returns>Bitmap.</returns>
    Private Function TakeRegionScreenShot(ByVal [Region] As Rectangle,
                                          Optional ByVal [PixelFormat] As Imaging.PixelFormat =
                                                                          Imaging.PixelFormat.Format24bppRgb) As Bitmap

        Return TakeRegionScreenShot([Region].Location, [Region].Size, [PixelFormat])

    End Function
#6924
Bueno pues empecé haciendo un código muy sencillo (quiero decir, muy pequeño) y acabé expandiendo su funcionalidad...

Se trata de una función que cuenta los caracteres de agrupación dentro de un String, comprueba si hay agrupaciones abiertas o vacias, y la cantidad de agrupaciones abiertas y cerradas hay, y obtiene sus índices de posición en el string, la función devuelve todos estos datos gracias a una Class personalizado para la ocasión.

No es gran cosa, simplemente quise compartirlo.

Espero que a alguien le ayude.

Código (vbnet) [Seleccionar]
   ' Count Agrupations In String
   ' // By Elektro
   '
   ' Example Usages :
   '
   'Private Sub Test()
   '
   '    Dim InputStrings As String() =
   '        {
   '            "(This) is (good)",
   '            "This (is (good))",
   '            "This is good",
   '            "This is (bad))",
   '            "This is (bad",
   '            "This is bad)",
   '            "This is bad)("
   '        }
   '
   '    Dim AgrupationChars As New Tuple(Of Char, Char)("(", ")")
   '
   '    For Each InputString As String In InputStrings
   '
   '        Dim Info As AgrupationCharsInfo = Me.CountAgrupationsInString(AgrupationChars, InputString)
   '
   '        Dim sb As New System.Text.StringBuilder
   '
   '        With sb
   '
   '            .AppendLine(String.Format("Input String: {0}", Info.InputString))
   '            .AppendLine(String.Format("Agrupation Characters: {0}{1}", Info.AgrupationChars.Item1,
   '                                                                       Info.AgrupationChars.Item2))
   '
   '            .AppendLine()
   '            .AppendLine(String.Format("String has closed agrupations?: {0}", Info.StringHasClosedAgrupations))
   '            .AppendLine(String.Format("String has opened agrupations?: {0}", Info.StringHasOpenedAgrupations))
   '
   '            .AppendLine()
   '            .AppendLine(String.Format("Closed Agrupations Count: {0}", Info.CountClosedAgrupations))
   '            .AppendLine(String.Format("Opened Agrupations Count: {0}", Info.CountOpenedAgrupations))
   '
   '            .AppendLine()
   '            .AppendLine("Closed Agrupations Indexes:")
   '            For Each Item As Tuple(Of Integer, Integer) In Info.ClosedAgrupationsIndex
   '                .AppendLine(String.Format("Start: {0}, End: {1}",
   '                                          CStr(Item.Item1), CStr(Item.Item2)))
   '            Next Item
   '
   '            .AppendLine()
   '            .AppendLine(String.Format("Opened Agrupations Indexes: {0}",
   '                                      String.Join(", ", Info.OpenedAgrupationsIndex)))
   '
   '        End With '/ sb
   '
   '        MessageBox.Show(sb.ToString, "Agrupations Information",
   '                        MessageBoxButtons.OK, MessageBoxIcon.Information)
   '
   '    Next InputString
   '
   'End Sub

   ''' <summary>
   ''' Retrieves info about the closed and opened agrupation characters inside a String.
   ''' </summary>
   ''' <param name="AgrupationChars">Indicates the characters to determine agrupations.</param>
   ''' <param name="InputString">Indicates the string where to count the agrupations.</param>
   ''' <returns>AgrupationCharsInfo.</returns>
   ''' <exception cref="System.Exception">'InputString' parameter cannot be an empty String..</exception>
   Public Function CountAgrupationsInString(ByVal AgrupationChars As Tuple(Of Char, Char),
                                            ByVal InputString As String) As AgrupationCharsInfo

       If String.IsNullOrEmpty(InputString) OrElse String.IsNullOrWhiteSpace(InputString) Then
           Throw New Exception("'InputString' parameter cannot be an empty String.")
       End If

       Dim CharStack As New Stack(Of Integer)
       Dim Result As New AgrupationCharsInfo

       With Result

           .InputString = InputString
           .AgrupationChars = New Tuple(Of Char, Char)(AgrupationChars.Item1, AgrupationChars.Item2)

           For i As Integer = 0 To InputString.Length - 1

               Select Case InputString(i)

                   Case .AgrupationChars.Item1
                       CharStack.Push(i)
                       .OpenedAgrupationsIndex.Add(i)
                       .CountOpenedAgrupations += 1

                   Case .AgrupationChars.Item2
                       Select Case CharStack.Count

                           Case Is = 0
                               .CountOpenedAgrupations += 1
                               .OpenedAgrupationsIndex.Add(i)

                           Case Else
                               .CountClosedAgrupations += 1
                               .CountOpenedAgrupations -= 1
                               .ClosedAgrupationsIndex.Add(Tuple.Create(Of Integer, Integer)(CharStack.Pop, i))
                               .OpenedAgrupationsIndex.RemoveAt(.OpenedAgrupationsIndex.Count - 1)

                       End Select '/ CharStack.Count

               End Select '/ InputString(i)

           Next i

           .StringHasClosedAgrupations = .CountClosedAgrupations <> 0
           .StringHasOpenedAgrupations = .CountOpenedAgrupations <> 0

       End With '/ Result

       Return Result

   End Function

   ''' <summary>
   ''' Stores info about closed and opened agrupations of chars in a String.
   ''' </summary>
   Public NotInheritable Class AgrupationCharsInfo

       ''' <summary>
       ''' Indicates the input string.
       ''' </summary>
       ''' <value>The input string.</value>
       Public Property InputString As String = String.Empty

       ''' <summary>
       ''' Indicates the agrupation characters.
       ''' </summary>
       ''' <value>The agrupation characters.</value>
       Public Property AgrupationChars As Tuple(Of Char, Char) = Nothing

       ''' <summary>
       ''' Determines whether the input string contains closed agrupation.
       ''' </summary>
       Public Property StringHasClosedAgrupations As Boolean = False

       ''' <summary>
       ''' Determines whether the input string contains opened agrupations.
       ''' </summary>
       Public Property StringHasOpenedAgrupations As Boolean = False

       ''' <summary>
       ''' Indicates the total amount of closed agrupations.
       ''' </summary>
       ''' <value>The closed agrupations count.</value>
       Public Property CountClosedAgrupations As Integer = 0

       ''' <summary>
       ''' Indicates the total amount of opened agrupations.
       ''' </summary>
       ''' <value>The opened agrupations count.</value>
       Public Property CountOpenedAgrupations As Integer = 0

       ''' <summary>
       ''' Indicates the closed agrupations index positions in the string.
       ''' </summary>
       ''' <value>The closed agrupations index positions.</value>
       Public Property ClosedAgrupationsIndex As New List(Of Tuple(Of Integer, Integer))

       ''' <summary>
       ''' Indicates the opened agrupations index positions in the string.
       ''' </summary>
       ''' <value>The opened agrupations index positions.</value>
       Public Property OpenedAgrupationsIndex As New List(Of Integer)

   End Class '/ AgrupationCharsInfo
#6925
Pues no pides ni nada, @Jeny, has ido a elegir el lenguaje más simple para una tarea que requiere el manejo de la WinAPI.

Si tienes conocimientos de VB/VB.NET no te debería resultar muy compleja la tarea (lo único con algo de dificultad sería documentarse en MSDN sobre el manejo de las funciones, y las constantes que sean necesarias utilizar), un ejemplo que puede servir: http://www.codeguru.com/vb/gen/vb_general/miscellaneous/article.php/c15757/The-TaskBar-and-VBNET.htm

Saludos.
#6926
Scripting / Re: Ayuda Código CMD- USB Stealer
28 Junio 2014, 07:32 AM
Podrías sacar algunas ideas productivas de aquí:



[BATCH] [APORTE] USB MON (Roba USB)

PD: Pero opino lo mismo que ya te comentaron, deberías utilizar un lenguaje de verdad.

Saludos
#6927
Scripting / Re: ayuda con archivos bat
28 Junio 2014, 07:16 AM
Una aplicación GUI también puede terminar su ejecución enviando, de manera intencionada, un código de salida a la consola, y en ese caso se podrá leer ese código de retorno desde la CMD.

De todas formas yo intuyo que el proceso que quieres ejecutas es CLI, así que esto te servirá (en ese caso):

Código (dos) [Seleccionar]
Start /W "" "a.exe"
If %ErrorLevel% Neq 0 (
   :: Error detectado, abrir la imagen del error aquí.
)


Saludos
#6928
vale, y yo no entendia tu último comentario donde insinuabas que me burlaba de los nuevos y que estaba mintiendo sobre la existencia de dicha función, no sabía si también era sarcasmo... pero ahora al haber explicado el malentendido creo que entiendo porque lo dijiste.

PD: Le puse la "s" sin querer (costumbre) xD.

Aquí no ha pasado nada,
Saludos.
#6929
Cita de: El Benjo en 28 Junio 2014, 06:45 AMen qué parte dice que la función "mouse_event()" de la API de Windows se ha quedado obsoleta.

-> mouse_event function (Windows) - MSDN - Microsoft

CitarNote: This function has been superseded.
Use SendInput instead
.

Por si no ha quedado claro lo que pone en Inglés, una traducción:
CitarNota: Esta función se ha sustituido.
Utilice SendInput en su lugar
.

En ningún momento he dicho más haya de la realidad, no he dicho que no sea compatible, ni nada, el sarcasmo sobra...

Saludos.
#6930
Cita de: nolasco281 en  7 Mayo 2014, 21:46 PMPd: por lo que entiendo dice que tengo que convertir un double o string si no me equivoco pero no se como hacerlo.

No exactamente, el mensaje de error te indica que es imposible tratar un valor de tipo Double como si fuera de tipo String, y la solución sería realizar la conversión a String, pero en mi opinión no es un buen enfoque.

¿Si estás tratando valores numéricos, porque intentas almacenarlos como tipo String?, ¿y si estás usando valores de tipo Double, porque intentas tratarlos como Decimales (CDec)?

Quédate con un datatype (Double o Decimal) e intenta no realizar conversiones innecesarias.

Prueba así:
Código (vbnet) [Seleccionar]
Dim Valores As Double() =
   (From Valor As Double In listaelementos.Items Order By Valor Ascending).ToArray


Saludos.