elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Security Series.XSS. [Cross Site Scripting]


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP) (Moderador: kub0x)
| | | |-+  Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: 1 ... 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 [54] 55 56 57 58 Ir Abajo Respuesta Imprimir
Autor Tema: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)  (Leído 480,205 veces)
Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.788



Ver Perfil
Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
« Respuesta #530 en: 9 Mayo 2018, 07:48 am »

Una búsqeuda rápida me ofrece este pdf, que puede servirte... (no lo he descargado).
https://www.vmware.com/support/developer/vix-api/vix170_vmrun_command.pdf

Gracias @NEBIRE, pero te puedes imaginar que yo también estuve buscando y encontré el mismo PDF en Google :P, lamentablemente no me ayudó.

Gracias de nuevo.



TL;DR (Too Long; Didn't Don't Read):

Por cierto, quiero aclarar que no suelo apoyar nunca el hecho de depender en el uso de aplicaciones command-line, considero que el auténtico reto sería crear un wrapper de la librería nativa vix.dll en .NET, pero a ver quien tiene los c@jones de hacerlo... con la inmensa cantidad de miembros y funciones exportadas a implementar que tiene, y teniendo en cuenta que en cada release de VMWare modifican cosas y quedan algunos miembros obsoletos y otros nuevos, o que reemplacen la librería por una nueva donde la anterior queda completamente inservible (como sucedió con vixcom.dll). Sería un trabajo en vano, una absurda pérdida de tiempo.

Nah, mucho más viable, seguro y estable es recurrir al uso del programita/wrapper vmrun.exe, que aunque inevitablemente sea bastante más lento en términos de tiempo de ejecución (puesto que es un executable), al menos su estructura "no cambia" con el tiempo, por que ya se encargan los de VMWare de adaptar el programa para que funcione (obvio) con los nuevos cambios que introduzcan a la librería vix.dll, y nosotros como usuarios o programadores en el peor de los casos solo necesitariamos hacer un par de adaptaciones en la sintaxis de los argumentos a enviar a vmrun.exe y todo listo para funcionar con nuevas releases de VMWare.

Claro que, para los que puedan programar diréctamente en C/C++ ya sería otro cantar... aunque seguiría siendo bastante tedioso usar la librería (no hay más que mirar los samples de código que provee VMWare en el directorios de la API de VIX, 200 lineas de código solo para ejecutar una operación de encendido y/o apagado de la VM), pero bueno, programando en C/C++ supongo que sería más aceptable usar la librería vix.dll en lugar de usar vmrun.exe, supongo.

saludos!


« Última modificación: 9 Mayo 2018, 08:22 am por Eleкtro » En línea

Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.788



Ver Perfil
Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
« Respuesta #531 en: 17 Mayo 2018, 14:23 pm »

Determinar si un tamaño/resolución pertenece a una relación de aspecto específica.

No creo que haya nada que añadir a la descripción. Solo diré que la utilidad que le encuentro a esto personálmente es para realizar con mayor seguridad en operaciones de captura de imagen en ventanas externas (para evitar posibles fallos humanos de especificar una resolución incorrecta).

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Determine whether the source resolution belongs to the specified aspect ratio.
  4. ''' </summary>
  5. ''' ----------------------------------------------------------------------------------------------------
  6. ''' <param name="resolution">
  7. ''' The source resolution.
  8. ''' </param>
  9. '''
  10. ''' <param name="aspectRatio">
  11. ''' The aspect ratio.
  12. ''' </param>
  13. ''' ----------------------------------------------------------------------------------------------------
  14. ''' <returns>
  15. ''' <see langword="True"/> if the source resolution belongs to the specified aspect ratio; otherwise, <see langword="False"/>.
  16. ''' </returns>
  17. ''' ----------------------------------------------------------------------------------------------------
  18. Public Shared Function ResolutionIsOfAspectRatio(ByVal resolution As Size, ByVal aspectRatio As Point) As Boolean
  19.  
  20.    Return (resolution.Width / aspectRatio.X) * aspectRatio.Y = resolution.Height
  21.  
  22. End Function
  23.  

Ejemplo de uso:

Código
  1. Dim resolution As New Size(width:=1920, height:=1080)
  2. Dim aspectRatio As New Point(x:=16, y:=9)
  3.  
  4. Dim result As Boolean = ResolutionIsOfAspectRatio(resolution, aspectRatio)
  5.  
  6. Console.WriteLine(result)



Escalar/Adaptar la posición y tamaño de un Rectangle, según el factor de porcentage resultante entre la diferencia de dos tamaños.

Para que lo entiendan mejor:

Imaginemos que tenemos un Rectangle con posición (X,Y): 100,100 y tamaño (width,height): 100,100, y esos valores han sido especificados así para ser usado sobre una superficie de 800x600. Por ejemplo podemos decir que se trata de un Rectangle que sirve para capturar una porción específica de una ventana que tenga ese tamaño, 800x600.

Pues bien, lo que hace esta función es adaptar la posición y el tamaño de ese Rectangle, a un tamaño/superficie diferente, por ejemplo adaptarlo de 800x600 a 1024x1024.

Espero que se haya entendido bien, de todas formas abajo les dejo un ejemplo de como usarlo...

Código
  1.    Public Module RectangleExtensions
  2.  
  3. #Region " Public Extension Methods "
  4.  
  5.        ''' ----------------------------------------------------------------------------------------------------
  6.        ''' <summary>
  7.        ''' Scale the size and position of the source <see cref="Rectangle"/>
  8.        ''' by the difference of the specified sizes.
  9.        ''' </summary>
  10.        ''' ----------------------------------------------------------------------------------------------------
  11.        ''' <param name="sender">
  12.        ''' The source <see cref="Rectangle"/>.
  13.        ''' </param>
  14.        '''
  15.        ''' <param name="fromSize">
  16.        ''' The source <see cref="Size"/>.
  17.        ''' </param>
  18.        '''
  19.        ''' <param name="toSize">
  20.        ''' The target <see cref="Size"/>.
  21.        ''' </param>
  22.        ''' ----------------------------------------------------------------------------------------------------
  23.        ''' <returns>
  24.        ''' The resulting <see cref="Rectangle"/>.
  25.        ''' </returns>
  26.        ''' ----------------------------------------------------------------------------------------------------
  27.        <DebuggerStepThrough>
  28.        <Extension>
  29.        <EditorBrowsable(EditorBrowsableState.Always)>
  30.        Public Function ScaleBySizeDifference(ByVal sender As Rectangle,
  31.                                              ByVal fromSize As Size,
  32.                                              ByVal toSize As Size) As Rectangle
  33.  
  34.            Dim percentChangeX As Double = (toSize.Width / fromSize.Width)
  35.            Dim percentChangeY As Double = (toSize.Height / fromSize.Height)
  36.  
  37.            Return New Rectangle With {
  38.                    .X = CInt(sender.X * percentChangeX),
  39.                    .Y = CInt(sender.Y * percentChangeY),
  40.                    .Width = CInt(sender.Width * percentChangeX),
  41.                    .Height = CInt(sender.Height * percentChangeY)
  42.                }
  43.  
  44.        End Function
  45.  
  46.        ''' ----------------------------------------------------------------------------------------------------
  47.        ''' <summary>
  48.        ''' Scale the size and position of the source <see cref="RectangleF"/>
  49.        ''' by the difference of the specified sizes.
  50.        ''' </summary>
  51.        ''' ----------------------------------------------------------------------------------------------------
  52.        ''' <param name="sender">
  53.        ''' The source <see cref="RectangleF"/>.
  54.        ''' </param>
  55.        '''
  56.        ''' <param name="fromSize">
  57.        ''' The source <see cref="SizeF"/>.
  58.        ''' </param>
  59.        '''
  60.        ''' <param name="toSize">
  61.        ''' The target <see cref="SizeF"/>.
  62.        ''' </param>
  63.        ''' ----------------------------------------------------------------------------------------------------
  64.        ''' <returns>
  65.        ''' The resulting <see cref="RectangleF"/>.
  66.        ''' </returns>
  67.        ''' ----------------------------------------------------------------------------------------------------
  68.        <DebuggerStepThrough>
  69.        <Extension>
  70.        <EditorBrowsable(EditorBrowsableState.Always)>
  71.        Public Function ScaleBySizeDifference(ByVal sender As RectangleF,
  72.                                              ByVal fromSize As SizeF,
  73.                                              ByVal toSize As SizeF) As RectangleF
  74.  
  75.            Dim percentChangeX As Double = (toSize.Width / fromSize.Width)
  76.            Dim percentChangeY As Double = (toSize.Height / fromSize.Height)
  77.  
  78.            Return New RectangleF With {
  79.                .X = CSng(sender.X * percentChangeX),
  80.                .Y = CSng(sender.Y * percentChangeY),
  81.                .Width = CSng(sender.Width * percentChangeX),
  82.                .Height = CSng(sender.Height * percentChangeY)
  83.            }
  84.  
  85.        End Function
  86.  
  87. #End Region
  88.  
  89.    End Module

Ejemplo de uso:

Código
  1. Dim oldSize As New Size(640, 480)
  2. Dim oldRect As New Rectangle(New Point(100, 100), New Size(639, 479))
  3.  
  4. Dim newSize As New Size(800, 600)
  5. Dim newRect As Rectangle = ScaleBySizeDifference(oldRect, oldSize, newSize)
  6.  
  7. Console.WriteLine(String.Format("oldRect: {0}", oldRect.ToString())) ' {X=100,Y=100,Width=639,Height=479}
  8. Console.WriteLine(String.Format("newRect: {0}", newRect.ToString())) ' {X=125,Y=125,Width=798,Height=598}

Saludos.


« Última modificación: 17 Mayo 2018, 14:28 pm por Eleкtro » En línea

Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.788



Ver Perfil
Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
« Respuesta #532 en: 24 Mayo 2018, 03:48 am »

GENERAR UNA FECHA ALEATORIA, EN UN RANGO ESPECÍFICO.

Sencillos pero prácticos miembros para generar fechas aleatorias. Le encontrarán alguna utilidad.

Código
  1.  
  2.    ''' ----------------------------------------------------------------------------------------------------
  3.    ''' <summary>
  4.    ''' Contains date and time related utilities.
  5.    ''' </summary>
  6.    ''' ----------------------------------------------------------------------------------------------------
  7.    <ImmutableObject(True)>
  8.    Public NotInheritable Class DateTimeUtil
  9.  
  10. #Region " Private Fields "
  11.  
  12.        ''' ----------------------------------------------------------------------------------------------------
  13.        ''' <summary>
  14.        ''' A <see cref="Random"/> instance to generate random secuences of numbers.
  15.        ''' </summary>
  16.        ''' ----------------------------------------------------------------------------------------------------
  17.        Private Shared rng As Random
  18.  
  19. #End Region
  20.  
  21. #Region " Constructors "
  22.  
  23.        ''' ----------------------------------------------------------------------------------------------------
  24.        ''' <summary>
  25.        ''' Prevents a default instance of the <see cref="DateTimeUtil"/> class from being created.
  26.        ''' </summary>
  27.        ''' ----------------------------------------------------------------------------------------------------
  28.        <DebuggerNonUserCode>
  29.        Private Sub New()
  30.        End Sub
  31.  
  32. #End Region
  33.  
  34. #Region " Public Methods "
  35.  
  36.        ''' ----------------------------------------------------------------------------------------------------
  37.        ''' <summary>
  38.        ''' Gets a random <see cref="Date"/> in range between the specified two dates.
  39.        ''' </summary>
  40.        ''' ----------------------------------------------------------------------------------------------------
  41.        ''' <example> This is a code example.
  42.        ''' <code>
  43.        ''' Dim minDate As Date = Date.MinValue
  44.        ''' Dim maxDate As Date = Date.MaxValue
  45.        ''' Dim ramdomDate As Date = GetRandomDateTime(minDate, maxDate)
  46.        '''
  47.        ''' Console.WriteLine(randomDate.ToString())
  48.        ''' </code>
  49.        ''' </example>
  50.        ''' ----------------------------------------------------------------------------------------------------
  51.        ''' <param name="dateMin">
  52.        ''' The minimum <see cref="Date"/>.
  53.        ''' </param>
  54.        '''
  55.        ''' <param name="dateMax">
  56.        ''' The maximum <see cref="Date"/>.
  57.        ''' </param>
  58.        ''' ----------------------------------------------------------------------------------------------------
  59.        ''' <returns>
  60.        ''' The resulting <see cref="Date"/>.
  61.        ''' </returns>
  62.        ''' ----------------------------------------------------------------------------------------------------
  63.        <DebuggerStepThrough>
  64.        Public Shared Function GetRandomDateTime(ByVal dateMin As Date, ByVal dateMax As Date) As Date
  65.  
  66.            If (DateTimeUtil.rng Is Nothing) Then
  67.                DateTimeUtil.rng = New Random(Seed:=Environment.TickCount)
  68.            End If
  69.  
  70.            ' Generate random date with 00:00:00 time.
  71.            Dim daysRange As Integer = dateMax.Subtract(dateMin).Days
  72.            Dim dt As Date = dateMin.AddDays(DateTimeUtil.rng.Next(daysRange))
  73.  
  74.            ' Generate random time.
  75.            Dim hours As Integer = DateTimeUtil.rng.Next(dateMax.TimeOfDay.Hours + 1)
  76.            Dim minutes As Integer = DateTimeUtil.rng.Next(dateMax.TimeOfDay.Minutes + 1)
  77.            Dim seconds As Integer = DateTimeUtil.rng.Next(dateMax.TimeOfDay.Seconds + 1)
  78.            Dim milliseconds As Integer = DateTimeUtil.rng.Next(dateMax.TimeOfDay.Milliseconds + 1)
  79.  
  80.            ' Return the resulting date.
  81.            Return New Date(dt.Year, dt.Month, dt.Day, hours, minutes, seconds, milliseconds, dt.Kind)
  82.  
  83.        End Function
  84.  
  85.        ''' ----------------------------------------------------------------------------------------------------
  86.        ''' <summary>
  87.        ''' Gets a random <see cref="Date"/> in range between <see cref="DateTime.MinValue"/> and the specified date.
  88.        ''' </summary>
  89.        ''' ----------------------------------------------------------------------------------------------------
  90.        ''' <example> This is a code example.
  91.        ''' <code>
  92.        ''' Dim maxDate As Date = Date.MaxValue
  93.        ''' Dim ramdomDate As Date = GetRandomDateTime(maxDate)
  94.        '''
  95.        ''' Console.WriteLine(randomDate.ToString())
  96.        ''' </code>
  97.        ''' </example>
  98.        ''' ----------------------------------------------------------------------------------------------------
  99.        ''' <param name="dateMax">
  100.        ''' The maximum <see cref="Date"/>.
  101.        ''' </param>
  102.        ''' ----------------------------------------------------------------------------------------------------
  103.        ''' <returns>
  104.        ''' The resulting <see cref="Date"/>.
  105.        ''' </returns>
  106.        ''' ----------------------------------------------------------------------------------------------------
  107.        <DebuggerStepThrough>
  108.        Public Shared Function GetRandomDateTime(ByVal dateMax As Date) As Date
  109.            Return DateTimeUtil.GetRandomDateTime(Date.MinValue, dateMax)
  110.        End Function
  111.  
  112.        ''' ----------------------------------------------------------------------------------------------------
  113.        ''' <summary>
  114.        ''' Gets a random <see cref="Date"/> in range between <see cref="DateTime.MinValue"/> and <see cref="DateTime.MaxValue"/>.
  115.        ''' </summary>
  116.        ''' ----------------------------------------------------------------------------------------------------
  117.        ''' <example> This is a code example.
  118.        ''' <code>
  119.        ''' Dim ramdomDate As Date = GetRandomDateTime()
  120.        '''
  121.        ''' Console.WriteLine(randomDate.ToString())
  122.        ''' </code>
  123.        ''' </example>
  124.        ''' ----------------------------------------------------------------------------------------------------
  125.        ''' <returns>
  126.        ''' The resulting <see cref="Date"/>.
  127.        ''' </returns>
  128.        ''' ----------------------------------------------------------------------------------------------------
  129.        <DebuggerStepThrough>
  130.        Public Shared Function GetRandomDateTime() As Date
  131.            Return DateTimeUtil.GetRandomDateTime(Date.MinValue, Date.MaxValue)
  132.        End Function
  133.  
  134. #End Region
  135.  
  136.    End Class
En línea

**Aincrad**


Desconectado Desconectado

Mensajes: 668



Ver Perfil WWW
Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
« Respuesta #533 en: 24 Junio 2018, 05:03 am »

mi código no es como el de todo los gurus de aquí , pero lo publico para el que le sirva.

Bueno el siguiente código hará que puedan mostrar un formulario en la esquina de la pantalla , como si fuera una notificación.



[EDITADO] (Se ha corregido el error que daba y ahora son menos lineas de código)  ;D

Código
  1. 'Para usarlo
  2. 'FormNotificacion(NOMBRE DE SU FORMULARIO a mostrar)
  3.  
  4.   Private Sub FormNotificacion(ByVal formulario As Object)
  5.        Dim fh As Form = TryCast(formulario, Form)
  6.        fh.ShowInTaskbar = False
  7.        fh.Show()
  8.        fh.Location = New Point(CInt((Screen.PrimaryScreen.WorkingArea.Width / 1) - (formulario.Width / 1)), CInt((Screen.PrimaryScreen.WorkingArea.Height / 1) - (formulario.Height / 1)))
  9.    End Sub


« Última modificación: 3 Julio 2018, 22:16 pm por **Aincrad** » En línea



Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.788



Ver Perfil
Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
« Respuesta #534 en: 29 Agosto 2018, 03:14 am »

¿Cómo silenciar el volumen de un proceso externo y/o cambiar su nivel de volumen?.

El siguiente código contiene varias definiciones nativas de la API de WASAPI, y una clase por nombre "AudioUtil" la cual contiene varios métodos estáticos que sirven como wrappers de esta API para lograr nuestro objetivo de forma sencilla y reutilizable.

Simplemente copiar y pegar directamente todo este bloque de código en una nueva clase:

Código
  1. #Region " Option Statements "
  2.  
  3. Option Strict On
  4. Option Explicit On
  5. Option Infer Off
  6.  
  7. #End Region
  8.  
  9. #Region " Imports "
  10.  
  11. Imports System.ComponentModel
  12. Imports System.Globalization
  13. Imports System.Runtime.InteropServices
  14.  
  15. Imports ElektroKit.Interop.Win32
  16.  
  17. #End Region
  18.  
  19. #Region " Interoperability "
  20.  
  21. Namespace ElektroKit.Interop
  22.  
  23. #Region " Win32 API "
  24.  
  25.    Namespace Win32
  26.  
  27. #Region " EDataFlow "
  28.  
  29.        ''' <summary>
  30.        ''' Defines constants that indicate the direction in which audio data flows between an audio endpoint device and an application.
  31.        ''' </summary>
  32.        ''' <remarks>
  33.        ''' <see href="https://docs.microsoft.com/en-us/windows/desktop/api/mmdeviceapi/ne-mmdeviceapi-__midl___midl_itf_mmdeviceapi_0000_0000_0001"/>
  34.        ''' </remarks>
  35.        Public Enum EDataFlow As Integer
  36.            Render
  37.            Capture
  38.            All
  39.            EDataFlow_enum_count
  40.        End Enum
  41.  
  42. #End Region
  43.  
  44. #Region " ERole "
  45.  
  46.        ''' <summary>
  47.        ''' Defines constants that indicate the role that the system has assigned to an audio endpoint device.
  48.        ''' </summary>
  49.        ''' <remarks>
  50.        ''' <see href="https://docs.microsoft.com/en-us/windows/desktop/api/mmdeviceapi/ne-mmdeviceapi-__midl___midl_itf_mmdeviceapi_0000_0000_0002"/>
  51.        ''' </remarks>
  52.        Public Enum ERole As Integer
  53.            Console
  54.            Multimedia
  55.            Communications
  56.            ERole_enum_count
  57.        End Enum
  58.  
  59. #End Region
  60.  
  61. #Region " MMDeviceEnumerator "
  62.  
  63.        ''' <summary>
  64.        ''' <c>CLSID_MMDeviceEnumerator</c>.
  65.        ''' </summary>
  66.        <ComImport>
  67.        <Guid("BCDE0395-E52F-467C-8E3D-C4579291692E")>
  68.        Public Class MMDeviceEnumerator
  69.        End Class
  70.  
  71. #End Region
  72.  
  73. #Region " IMMDeviceEnumerator "
  74.  
  75.        ''' <summary>
  76.        ''' Provides methods for enumerating multimedia device resources.
  77.        ''' <para></para>
  78.        ''' In the current implementation of the MMDevice API,
  79.        ''' the only device resources that this interface can enumerate are audio endpoint devices.
  80.        ''' <para></para>
  81.        ''' A client obtains a reference to an <see cref="IMMDeviceEnumerator"/> interface by calling the CoCreateInstance.
  82.        ''' <para></para>
  83.        ''' The device resources enumerated by the methods in the IMMDeviceEnumerator interface are represented as
  84.        ''' collections of objects with <see cref="IMMDevice"/> interfaces.
  85.        ''' <para></para>
  86.        ''' A collection has an IMMDeviceCollection interface.
  87.        ''' The IMMDeviceEnumerator.EnumAudioEndpoints method creates a device collection.
  88.        ''' </summary>
  89.        ''' <remarks>
  90.        ''' <see href="https://docs.microsoft.com/en-us/windows/desktop/api/mmdeviceapi/nn-mmdeviceapi-immdeviceenumerator"/>
  91.        ''' </remarks>
  92.        <ComImport>
  93.        <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
  94.        <Guid("A95664D2-9614-4F35-A746-DE8DB63617E6")>
  95.        Public Interface IMMDeviceEnumerator
  96.  
  97.            <EditorBrowsable(EditorBrowsableState.Never)>
  98.            <PreserveSig>
  99.            Function NotImplemented1() As Integer
  100.  
  101.            <PreserveSig>
  102.            Function GetDefaultAudioEndpoint(<[In]> <MarshalAs(UnmanagedType.I4)> ByVal dataFlow As EDataFlow,
  103.                                             <[In]> <MarshalAs(UnmanagedType.I4)> ByVal role As ERole,
  104.                                             <Out> <MarshalAs(UnmanagedType.Interface)> ByRef refDevice As IMMDevice) As Integer
  105.  
  106.            <EditorBrowsable(EditorBrowsableState.Never)>
  107.            Function NotImplemented2() As Integer
  108.  
  109.            <EditorBrowsable(EditorBrowsableState.Never)>
  110.            Function NotImplemented3() As Integer
  111.  
  112.            <EditorBrowsable(EditorBrowsableState.Never)>
  113.            Function NotImplemented4() As Integer
  114.  
  115.        End Interface
  116.  
  117. #End Region
  118.  
  119. #Region " IMMDevice "
  120.  
  121.        ''' <summary>
  122.        ''' Provides methods for enumerating multimedia device resources.
  123.        ''' <para></para>
  124.        ''' In the current implementation of the MMDevice API,
  125.        ''' the only device resources that this interface can enumerate are audio endpoint devices.
  126.        ''' <para></para>
  127.        ''' A client obtains a reference to an <see cref="IMMDeviceEnumerator"/> interface by calling the CoCreateInstance.
  128.        ''' <para></para>
  129.        ''' The device resources enumerated by the methods in the IMMDeviceEnumerator interface are represented as
  130.        ''' collections of objects with <see cref="IMMDevice"/> interfaces.
  131.        ''' <para></para>
  132.        ''' A collection has an IMMDeviceCollection interface.
  133.        ''' The IMMDeviceEnumerator.EnumAudioEndpoints method creates a device collection.
  134.        ''' </summary>
  135.        ''' <remarks>
  136.        ''' <see href="https://docs.microsoft.com/en-us/windows/desktop/api/mmdeviceapi/nn-mmdeviceapi-immdevice"/>
  137.        ''' </remarks>
  138.        <ComImport>
  139.        <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
  140.        <Guid("D666063F-1587-4E43-81F1-B948E807363F")>
  141.        Public Interface IMMDevice
  142.  
  143.            <PreserveSig>
  144.            Function Activate(ByRef ref¡d As Guid, ByVal clsCtx As Integer, ByVal activationParams As IntPtr,
  145.                              <MarshalAs(UnmanagedType.IUnknown)> ByRef refInterface As Object) As Integer
  146.  
  147.            <EditorBrowsable(EditorBrowsableState.Never)>
  148.            <PreserveSig>
  149.            Function NotImplemented1() As Integer
  150.  
  151.            <EditorBrowsable(EditorBrowsableState.Never)>
  152.            <PreserveSig>
  153.            Function NotImplemented2() As Integer
  154.  
  155.            <EditorBrowsable(EditorBrowsableState.Never)>
  156.            <PreserveSig>
  157.            Function NotImplemented3() As Integer
  158.  
  159.        End Interface
  160.  
  161. #End Region
  162.  
  163. #Region " IAudioSessionControl "
  164.  
  165.        ''' <summary>
  166.        ''' Enables a client to configure the control parameters for an audio session and to monitor events in the session.
  167.        ''' </summary>
  168.        ''' <remarks>
  169.        ''' <see href="https://docs.microsoft.com/en-us/windows/desktop/api/audiopolicy/nn-audiopolicy-iaudiosessioncontrol"/>
  170.        ''' </remarks>
  171.        <ComImport>
  172.        <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
  173.        <Guid("F4B1A599-7266-4319-A8CA-E70ACB11E8CD")>
  174.        Public Interface IAudioSessionControl
  175.  
  176.            <EditorBrowsable(EditorBrowsableState.Never)>
  177.            <PreserveSig>
  178.            Function NotImplemented1() As Integer
  179.  
  180.            <PreserveSig>
  181.            Function GetDisplayName(<Out> <MarshalAs(UnmanagedType.LPWStr)> ByRef refDisplayName As String) As Integer
  182.  
  183.            <EditorBrowsable(EditorBrowsableState.Never)>
  184.            <PreserveSig>
  185.            Function NotImplemented2() As Integer
  186.  
  187.            <EditorBrowsable(EditorBrowsableState.Never)>
  188.            <PreserveSig>
  189.            Function NotImplemented3() As Integer
  190.  
  191.            <EditorBrowsable(EditorBrowsableState.Never)>
  192.            <PreserveSig>
  193.            Function NotImplemented4() As Integer
  194.  
  195.            <EditorBrowsable(EditorBrowsableState.Never)>
  196.            <PreserveSig>
  197.            Function NotImplemented5() As Integer
  198.  
  199.            <EditorBrowsable(EditorBrowsableState.Never)>
  200.            <PreserveSig>
  201.            Function NotImplemented6() As Integer
  202.  
  203.            <EditorBrowsable(EditorBrowsableState.Never)>
  204.            <PreserveSig>
  205.            Function NotImplemented7() As Integer
  206.  
  207.            <EditorBrowsable(EditorBrowsableState.Never)>
  208.            <PreserveSig>
  209.            Function NotImplemented8() As Integer
  210.  
  211.        End Interface
  212.  
  213. #End Region
  214.  
  215. #Region " IAudioSessionControl2 "
  216.  
  217.        ''' <summary>
  218.        ''' Enables a client to configure the control parameters for an audio session and to monitor events in the session.
  219.        ''' <para></para>
  220.        ''' The IAudioClient.Initialize method initializes a stream object and assigns the stream to an audio session.
  221.        ''' </summary>
  222.        ''' <remarks>
  223.        ''' <see href="https://docs.microsoft.com/en-us/windows/desktop/api/audiopolicy/nn-audiopolicy-iaudiosessioncontrol"/>
  224.        ''' </remarks>
  225.        <ComImport>
  226.        <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
  227.        <Guid("BFB7FF88-7239-4FC9-8FA2-07C950BE9C6D")>
  228.        Public Interface IAudioSessionControl2
  229.  
  230.            <EditorBrowsable(EditorBrowsableState.Never)>
  231.            <PreserveSig>
  232.            Function NotImplemented1() As Integer
  233.  
  234.            <PreserveSig>
  235.            Function GetDisplayName(<Out> <MarshalAs(UnmanagedType.LPWStr)> ByRef refDisplayName As String) As Integer
  236.  
  237.            <EditorBrowsable(EditorBrowsableState.Never)>
  238.            <PreserveSig>
  239.            Function NotImplemented2() As Integer
  240.  
  241.            <EditorBrowsable(EditorBrowsableState.Never)>
  242.            <PreserveSig>
  243.            Function NotImplemented3() As Integer
  244.  
  245.            <EditorBrowsable(EditorBrowsableState.Never)>
  246.            <PreserveSig>
  247.            Function NotImplemented4() As Integer
  248.  
  249.            <EditorBrowsable(EditorBrowsableState.Never)>
  250.            <PreserveSig>
  251.            Function NotImplemented5() As Integer
  252.  
  253.            <EditorBrowsable(EditorBrowsableState.Never)>
  254.            <PreserveSig>
  255.            Function NotImplemented6() As Integer
  256.  
  257.            <EditorBrowsable(EditorBrowsableState.Never)>
  258.            <PreserveSig>
  259.            Function NotImplemented7() As Integer
  260.  
  261.            <EditorBrowsable(EditorBrowsableState.Never)>
  262.            <PreserveSig>
  263.            Function NotImplemented8() As Integer
  264.  
  265.            <EditorBrowsable(EditorBrowsableState.Never)>
  266.            <PreserveSig>
  267.            Function NotImplemented9() As Integer
  268.  
  269.            <EditorBrowsable(EditorBrowsableState.Never)>
  270.            <PreserveSig>
  271.            Function NotImplemented10() As Integer
  272.  
  273.            <PreserveSig>
  274.            Function GetProcessId(<Out> ByRef refValue As UInteger) As Integer
  275.  
  276.            <EditorBrowsable(EditorBrowsableState.Never)>
  277.            <PreserveSig>
  278.            Function NotImplemented11() As Integer
  279.  
  280.            <EditorBrowsable(EditorBrowsableState.Never)>
  281.            <PreserveSig>
  282.            Function NotImplemented12() As Integer
  283.  
  284.        End Interface
  285.  
  286. #End Region
  287.  
  288. #Region " IAudioSessionEnumerator "
  289.  
  290.        ''' <summary>
  291.        ''' Enumerates audio sessions on an audio device.
  292.        ''' </summary>
  293.        ''' <remarks>
  294.        ''' <see href="https://docs.microsoft.com/en-us/windows/desktop/api/audiopolicy/nn-audiopolicy-iaudiosessionenumerator"/>
  295.        ''' </remarks>
  296.        <ComImport>
  297.        <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
  298.        <Guid("E2F5BB11-0570-40CA-ACDD-3AA01277DEE8")>
  299.        Public Interface IAudioSessionEnumerator
  300.  
  301.            <PreserveSig>
  302.            Function GetCount(ByRef refSessionCount As Integer) As Integer
  303.  
  304.            <PreserveSig>
  305.            Function GetSession(ByVal sessionCount As Integer, ByRef refSession As IAudioSessionControl) As Integer
  306.  
  307.        End Interface
  308.  
  309. #End Region
  310.  
  311. #Region " IAudioSessionManager2 "
  312.  
  313.        ''' <summary>
  314.        ''' Enables an application to manage submixes for the audio device.
  315.        ''' </summary>
  316.        ''' <remarks>
  317.        ''' <see href="https://docs.microsoft.com/en-us/windows/desktop/api/audiopolicy/nn-audiopolicy-iaudiosessionmanager2"/>
  318.        ''' </remarks>
  319.        <ComImport>
  320.        <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
  321.        <Guid("77AA99A0-1BD6-484F-8BC7-2C654C9A9B6F")>
  322.        Public Interface IAudioSessionManager2
  323.  
  324.            <EditorBrowsable(EditorBrowsableState.Never)>
  325.            <PreserveSig>
  326.            Function NotImplemented1() As Integer
  327.  
  328.            <EditorBrowsable(EditorBrowsableState.Never)>
  329.            <PreserveSig>
  330.            Function NotImplemented2() As Integer
  331.  
  332.            <PreserveSig>
  333.            Function GetSessionEnumerator(<Out> <MarshalAs(UnmanagedType.Interface)> ByRef refSessionEnum As IAudioSessionEnumerator) As Integer
  334.  
  335.            <EditorBrowsable(EditorBrowsableState.Never)>
  336.            <PreserveSig>
  337.            Function NotImplemented3() As Integer
  338.  
  339.            <EditorBrowsable(EditorBrowsableState.Never)>
  340.            <PreserveSig>
  341.            Function NotImplemented4() As Integer
  342.  
  343.            <EditorBrowsable(EditorBrowsableState.Never)>
  344.            <PreserveSig>
  345.            Function NotImplemented5() As Integer
  346.  
  347.            <EditorBrowsable(EditorBrowsableState.Never)>
  348.            <PreserveSig>
  349.            Function NotImplemented6() As Integer
  350.  
  351.        End Interface
  352.  
  353. #End Region
  354.  
  355. #Region " ISimpleAudioVolume "
  356.  
  357.        ''' <summary>
  358.        ''' Enables a client to control the master volume level of an audio session.
  359.        ''' </summary>
  360.        ''' <remarks>
  361.        ''' <see href="https://docs.microsoft.com/en-us/windows/desktop/api/audioclient/nn-audioclient-isimpleaudiovolume"/>
  362.        ''' </remarks>
  363.        <ComImport>
  364.        <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
  365.        <Guid("87CE5498-68D6-44E5-9215-6DA47EF883D8")>
  366.        Public Interface ISimpleAudioVolume
  367.  
  368.            <PreserveSig>
  369.            Function SetMasterVolume(<[In]> <MarshalAs(UnmanagedType.R4)> ByVal levelNormalization As Single,
  370.                                 <[In]> <MarshalAs(UnmanagedType.LPStruct)> ByVal eventContext As Guid) As Integer
  371.  
  372.            <PreserveSig>
  373.            Function GetMasterVolume(<Out> <MarshalAs(UnmanagedType.R4)> ByRef refLevelNormalization As Single) As Integer
  374.  
  375.            <PreserveSig>
  376.            Function SetMute(<[In]> <MarshalAs(UnmanagedType.Bool)> ByVal isMuted As Boolean,
  377.                         <[In]> <MarshalAs(UnmanagedType.LPStruct)> ByVal eventContext As Guid) As Integer
  378.  
  379.            <PreserveSig>
  380.            Function GetMute(<Out> <MarshalAs(UnmanagedType.Bool)> ByRef refIsMuted As Boolean) As Integer
  381.  
  382.        End Interface
  383.  
  384. #End Region
  385.  
  386.    End Namespace
  387.  
  388. #End Region
  389.  
  390. #Region " Inter-process Communication "
  391.  
  392.    Namespace IPC
  393.  
  394.        ''' ----------------------------------------------------------------------------------------------------
  395.        ''' <summary>
  396.        ''' Contains audio related utilities to apply on external processes.
  397.        ''' </summary>
  398.        ''' ----------------------------------------------------------------------------------------------------
  399.        Public NotInheritable Class AudioUtil
  400.  
  401. #Region " Constructors "
  402.  
  403.            ''' ----------------------------------------------------------------------------------------------------
  404.            ''' <summary>
  405.            ''' Prevents a default instance of the <see cref="AudioUtil"/> class from being created.
  406.            ''' </summary>
  407.            ''' ----------------------------------------------------------------------------------------------------
  408.            <DebuggerNonUserCode>
  409.            Private Sub New()
  410.            End Sub
  411.  
  412. #End Region
  413.  
  414. #Region " Public Methods "
  415.  
  416.            ''' ----------------------------------------------------------------------------------------------------
  417.            ''' <summary>
  418.            ''' Mute the audio volume of the specified process.
  419.            ''' </summary>
  420.            ''' ----------------------------------------------------------------------------------------------------
  421.            ''' <param name="pr">
  422.            ''' The <see cref="Process"/>.
  423.            ''' </param>
  424.            ''' ----------------------------------------------------------------------------------------------------
  425.            Public Shared Sub MuteApplication(ByVal pr As Process)
  426.  
  427.                Dim volume As ISimpleAudioVolume = AudioUtil.GetVolumeObject(pr)
  428.                If (volume IsNot Nothing) Then
  429.                    Dim guid As Guid = Guid.Empty
  430.                    volume.SetMute(True, guid)
  431.                End If
  432.  
  433.            End Sub
  434.  
  435.            ''' ----------------------------------------------------------------------------------------------------
  436.            ''' <summary>
  437.            ''' Unmute the audio volume of the specified process.
  438.            ''' </summary>
  439.            ''' ----------------------------------------------------------------------------------------------------
  440.            ''' <param name="pr">
  441.            ''' The <see cref="Process"/>.
  442.            ''' </param>
  443.            ''' ----------------------------------------------------------------------------------------------------
  444.            Public Shared Sub UnmuteApplication(ByVal pr As Process)
  445.  
  446.                Dim volume As ISimpleAudioVolume = AudioUtil.GetVolumeObject(pr)
  447.                If (volume IsNot Nothing) Then
  448.                    Dim guid As Guid = Guid.Empty
  449.                    volume.SetMute(False, guid)
  450.                End If
  451.  
  452.            End Sub
  453.  
  454.            ''' ----------------------------------------------------------------------------------------------------
  455.            ''' <summary>
  456.            ''' Gets a value that determine whether the audio volume of the specified application is muted.
  457.            ''' </summary>
  458.            ''' ----------------------------------------------------------------------------------------------------
  459.            ''' <param name="pr">
  460.            ''' The <see cref="Process"/>.
  461.            ''' </param>
  462.            ''' ----------------------------------------------------------------------------------------------------
  463.            ''' <returns>
  464.            ''' Returns <see langword="True"/> if the application is muted, <see langword="False"/> otherwise.
  465.            ''' </returns>
  466.            ''' ----------------------------------------------------------------------------------------------------
  467.            Public Shared Function IsApplicationMuted(ByVal pr As Process) As Boolean
  468.  
  469.                Dim volume As ISimpleAudioVolume = AudioUtil.GetVolumeObject(pr)
  470.                If (volume IsNot Nothing) Then
  471.                    Dim isMuted As Boolean
  472.                    volume.GetMute(isMuted)
  473.                    Return isMuted
  474.                End If
  475.  
  476.                Return False
  477.  
  478.            End Function
  479.  
  480.            ''' ----------------------------------------------------------------------------------------------------
  481.            ''' <summary>
  482.            ''' Gets the audio volume level of the specified process.
  483.            ''' </summary>
  484.            ''' ----------------------------------------------------------------------------------------------------
  485.            ''' <param name="pr">
  486.            ''' The <see cref="Process"/>.
  487.            ''' </param>
  488.            ''' ----------------------------------------------------------------------------------------------------
  489.            ''' <returns>
  490.            ''' The audio volume, expressed in the range between 0 and 100.
  491.            ''' </returns>
  492.            ''' ----------------------------------------------------------------------------------------------------
  493.            <DebuggerStepThrough>
  494.            Public Shared Function GetApplicationVolume(ByVal pr As Process) As Integer
  495.  
  496.                Dim volume As ISimpleAudioVolume = AudioUtil.GetVolumeObject(pr)
  497.                If (volume IsNot Nothing) Then
  498.                    Dim levelNormalization As Single = Nothing
  499.                    volume.GetMasterVolume(levelNormalization)
  500.                    Return CInt(levelNormalization * 100)
  501.                End If
  502.  
  503.                Return 100
  504.  
  505.            End Function
  506.  
  507.            ''' ----------------------------------------------------------------------------------------------------
  508.            ''' <summary>
  509.            ''' Sets the audio volume level for the specified process.
  510.            ''' </summary>
  511.            ''' ----------------------------------------------------------------------------------------------------
  512.            ''' <param name="pr">
  513.            ''' The <see cref="Process"/>.
  514.            ''' </param>
  515.            '''
  516.            ''' <param name="volumeLevel">
  517.            ''' The new volume level, expressed in the range between 0 and 100.
  518.            ''' </param>
  519.            ''' ----------------------------------------------------------------------------------------------------
  520.            <DebuggerStepThrough>
  521.            Public Shared Sub SetApplicationVolume(ByVal pr As Process, ByVal volumeLevel As Integer)
  522.  
  523.                If (volumeLevel < 0) OrElse (volumeLevel > 100) Then
  524.                    Throw New ArgumentOutOfRangeException(paramName:=NameOf(volumeLevel),
  525.                                                      actualValue:=volumeLevel,
  526.                                                      message:=String.Format(CultureInfo.CurrentCulture,
  527.                                                               "A value of '{0}' is not valid for '{1}'. '{1}' must be between 0 and 100.",
  528.                                                               volumeLevel, NameOf(volumeLevel)))
  529.                End If
  530.  
  531.                Dim volume As ISimpleAudioVolume = AudioUtil.GetVolumeObject(pr)
  532.                If (volume IsNot Nothing) Then
  533.                    Dim guid As Guid = Guid.Empty
  534.                    volume.SetMasterVolume((volumeLevel / 100.0F), guid)
  535.                End If
  536.  
  537.            End Sub
  538.  
  539. #End Region
  540.  
  541. #Region " Private Methods "
  542.  
  543.            ''' ----------------------------------------------------------------------------------------------------
  544.            ''' <summary>
  545.            ''' Enumerate all the <see cref="IAudioSessionControl2"/> of the default (<see cref="IMMDevice"/>) audio device.
  546.            ''' </summary>
  547.            ''' ----------------------------------------------------------------------------------------------------
  548.            ''' <remarks>
  549.            ''' Credits to @Simon Mourier: <see href="https://stackoverflow.com/a/14322736/1248295"/>
  550.            ''' </remarks>
  551.            ''' ----------------------------------------------------------------------------------------------------
  552.            ''' <returns>
  553.            ''' The resulting <see cref="IEnumerable(Of IAudioSessionControl2)"/>.
  554.            ''' </returns>
  555.            ''' ----------------------------------------------------------------------------------------------------
  556.            <DebuggerStepperBoundary>
  557.            Private Shared Iterator Function EnumerateAudioSessionControls() As IEnumerable(Of IAudioSessionControl2)
  558.  
  559.                ' Get the (1st render + multimedia) aodio device.
  560.                Dim deviceEnumerator As IMMDeviceEnumerator = DirectCast(New MMDeviceEnumerator(), IMMDeviceEnumerator)
  561.                Dim device As IMMDevice = Nothing
  562.                deviceEnumerator.GetDefaultAudioEndpoint(EDataFlow.Render, ERole.Multimedia, device)
  563.  
  564.                ' Activate the session manager.
  565.                Dim IID_IAudioSessionManager2 As Guid = GetType(IAudioSessionManager2).GUID
  566.                Dim obj As Object = Nothing
  567.                device.Activate(IID_IAudioSessionManager2, 0, IntPtr.Zero, obj)
  568.                Dim manager As IAudioSessionManager2 = DirectCast(obj, IAudioSessionManager2)
  569.  
  570.                ' Enumerate sessions for on this device.
  571.                Dim sessionEnumerator As IAudioSessionEnumerator = Nothing
  572.                manager.GetSessionEnumerator(sessionEnumerator)
  573.                Dim sessionCount As Integer
  574.                sessionEnumerator.GetCount(sessionCount)
  575.  
  576.                For i As Integer = 0 To (sessionCount - 1)
  577.                    Dim ctl As IAudioSessionControl = Nothing
  578.                    Dim ctl2 As IAudioSessionControl2
  579.                    sessionEnumerator.GetSession(i, ctl)
  580.                    ctl2 = DirectCast(ctl, IAudioSessionControl2)
  581.                    Yield ctl2
  582.                    Marshal.ReleaseComObject(ctl2)
  583.                    Marshal.ReleaseComObject(ctl)
  584.                Next i
  585.  
  586.                Marshal.ReleaseComObject(sessionEnumerator)
  587.                Marshal.ReleaseComObject(manager)
  588.                Marshal.ReleaseComObject(device)
  589.                Marshal.ReleaseComObject(deviceEnumerator)
  590.            End Function
  591.  
  592.            ''' ----------------------------------------------------------------------------------------------------
  593.            ''' <summary>
  594.            ''' Searchs and returns the corresponding <see cref="ISimpleAudioVolume"/> for the specified <see cref="Process"/>.
  595.            ''' </summary>
  596.            ''' ----------------------------------------------------------------------------------------------------
  597.            ''' <remarks>
  598.            ''' Credits to @Simon Mourier: <see href="https://stackoverflow.com/a/14322736/1248295"/>
  599.            ''' </remarks>
  600.            ''' ----------------------------------------------------------------------------------------------------
  601.            ''' <param name="pr">
  602.            ''' The <see cref="Process"/>.
  603.            ''' </param>
  604.            ''' ----------------------------------------------------------------------------------------------------
  605.            ''' <returns>
  606.            ''' The resulting <see cref="ISimpleAudioVolume"/>,
  607.            ''' or <see langword="Nothing"/> if a <see cref="ISimpleAudioVolume"/> is not found for the specified process.
  608.            ''' </returns>
  609.            ''' ----------------------------------------------------------------------------------------------------
  610.            <DebuggerStepperBoundary>
  611.            Private Shared Function GetVolumeObject(ByVal pr As Process) As ISimpleAudioVolume
  612.  
  613.                For Each ctl As IAudioSessionControl2 In AudioUtil.EnumerateAudioSessionControls()
  614.                    Dim pId As UInteger
  615.                    ctl.GetProcessId(pId)
  616.  
  617.                    If (pId = pr.Id) Then
  618.                        Return DirectCast(ctl, ISimpleAudioVolume)
  619.                    End If
  620.                Next ctl
  621.  
  622.                Return Nothing
  623.  
  624.            End Function
  625.  
  626. #End Region
  627.  
  628.        End Class
  629.  
  630.    End Namespace
  631.  
  632. #End Region
  633.  
  634. End Namespace
  635.  
  636. #End Region

Ejemplos de uso:

Código
  1. Imports ElektroKit.Interop.IPC
  2. Imports System.Linq

Código
  1. ' Get the process we want to modify.
  2. ' Note the process must have an audio mixer available to be able mute it and/or to modify its volume level.
  3. ' In other words, the process must have an audio signal enabled, like for example a videogame or a music player, or any other process with an audio output.
  4. Dim pr As Process = Process.GetProcessesByName("process name").SingleOrDefault()

Código
  1. ' ----------------------- '
  2. ' GET OR SET VOLUME LEVEL '
  3. ' ----------------------- '
  4.  
  5. Dim volumeLevel As Integer ' resulting value of this variable will be in range of 0% to 100%.
  6.  
  7. ' Get current process volume level.
  8. volumeLevel = AudioUtil.GetApplicationVolume(pr)
  9. Console.WriteLine(String.Format("Current volume level: {0}%", volumeLevel))
  10.  
  11. ' Set process volume level to a new value.
  12. AudioUtil.SetApplicationVolume(pr, 50) ' 50%
  13. volumeLevel = AudioUtil.GetApplicationVolume(pr)
  14. Console.WriteLine(String.Format("New volume level: {0}%", volumeLevel))

Código
  1. ' ------------------------ '
  2. ' MUTE OR UNMUTE A PROCESS '
  3. ' ------------------------ '
  4.  
  5. Dim isMuted As Boolean
  6.  
  7. ' Mute the aplication.
  8. AudioUtil.MuteApplication(pr)
  9. isMuted = AudioUtil.IsApplicationMuted(pr)
  10. Console.WriteLine(String.Format("Is appliaction properly muted: {0}", isMuted))
  11.  
  12. ' Mute the aplication.
  13. AudioUtil.UnmuteApplication(pr)
  14. isMuted = AudioUtil.IsApplicationMuted(pr)
  15. Console.WriteLine(String.Format("Is appliaction properly unmuted?: {0}", Not isMuted))

Eso es todo.
En línea

z3nth10n


Desconectado Desconectado

Mensajes: 1.583


"Jack of all trades, master of none." - Zenthion


Ver Perfil WWW
Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
« Respuesta #535 en: 18 Octubre 2018, 09:28 am »

Como rellenar un array siguiendo el algoritmo Flood Fill usando HashSet

https://es.wikipedia.org/wiki/Algoritmo_de_relleno_por_difusi%C3%B3n

Código
  1. Imports System.Collections.Generic
  2. Imports System.Linq
  3. Imports System.Runtime.CompilerServices
  4. Imports System.Runtime.InteropServices
  5.  
  6. Module F
  7.    <Extension()>
  8.    Sub FloodFill(Of T)(ByVal source As T(), ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer, ByVal target As T, ByVal replacement As T)
  9.        Dim i As Integer = 0
  10.        FloodFill(source, x, y, width, height, target, replacement, i)
  11.    End Sub
  12.  
  13.    <Extension()>
  14.    Sub FloodFill(Of T)(ByVal source As T(), ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer, ByVal target As T, ByVal replacement As T, <Out> ByRef i As Integer)
  15.        i = 0
  16.        Dim queue As HashSet(Of Integer) = New HashSet(Of Integer)()
  17.        queue.Add(Pn(x, y, width))
  18.  
  19.        While queue.Count > 0
  20.            Dim _i As Integer = queue.First(), _x As Integer = _i Mod width, _y As Integer = _i / width
  21.            queue.Remove(_i)
  22.            If source(_i).Equals(target) Then source(_i) = replacement
  23.  
  24.            For offsetX As Integer = -1 To 2 - 1
  25.  
  26.                For offsetY As Integer = -1 To 2 - 1
  27.                    If offsetX = 0 AndAlso offsetY = 0 OrElse offsetX = offsetY OrElse offsetX = -offsetY OrElse -offsetX = offsetY Then Continue For
  28.                    Dim targetIndex As Integer = Pn(_x + offsetX, _y + offsetY, width)
  29.                    Dim _tx As Integer = targetIndex Mod width, _ty As Integer = targetIndex / width
  30.                    If _tx < 0 OrElse _ty < 0 OrElse _tx >= width OrElse _ty >= height Then Continue For
  31.  
  32.                    If Not queue.Contains(targetIndex) AndAlso source(targetIndex).Equals(target) Then
  33.                        queue.Add(targetIndex)
  34.                        i += 1
  35.                    End If
  36.                Next
  37.            Next
  38.        End While
  39.    End Sub
  40.  
  41.    Function Pn(ByVal x As Integer, ByVal y As Integer, ByVal w As Integer) As Integer
  42.        Return x + (y * w)
  43.    End Function
  44. End Module

Código
  1. using System.Collections.Generic;
  2. using System.Linq;
  3.  
  4. public static class F
  5. {
  6.    /// <summary>
  7.           /// Floods the fill.
  8.           /// </summary>
  9.           /// <typeparam name="T"></typeparam>
  10.           /// <param name="source">The source.</param>
  11.           /// <param name="x">The x.</param>
  12.           /// <param name="y">The y.</param>
  13.           /// <param name="width">The width.</param>
  14.           /// <param name="height">The height.</param>
  15.           /// <param name="target">The target to replace.</param>
  16.           /// <param name="replacement">The replacement.</param>
  17.    public static void FloodFill<T>(this T[] source, int x, int y, int width, int height, T target, T replacement)
  18.    {
  19.        int i = 0;
  20.  
  21.        FloodFill(source, x, y, width, height, target, replacement, out i);
  22.    }
  23.  
  24.    /// <summary>
  25.           /// Floods the array following Flood Fill algorithm
  26.           /// </summary>
  27.           /// <typeparam name="T"></typeparam>
  28.           /// <param name="source">The source.</param>
  29.           /// <param name="x">The x.</param>
  30.           /// <param name="y">The y.</param>
  31.           /// <param name="width">The width.</param>
  32.           /// <param name="height">The height.</param>
  33.           /// <param name="target">The target to replace.</param>
  34.           /// <param name="replacement">The replacement.</param>
  35.           /// <param name="i">The iterations made (if you want to debug).</param>
  36.    public static void FloodFill<T>(this T[] source, int x, int y, int width, int height, T target, T replacement, out int i)
  37.    {
  38.        i = 0;
  39.  
  40.        // Queue of pixels to process. :silbar:
  41.        HashSet<int> queue = new HashSet<int>();
  42.  
  43.        queue.Add(Pn(x, y, width));
  44.  
  45.        while (queue.Count > 0)
  46.        {
  47.            int _i = queue.First(),
  48.              _x = _i % width,
  49.              _y = _i / width;
  50.  
  51.            queue.Remove(_i);
  52.  
  53.            if (source[_i].Equals(target))
  54.                source[_i] = replacement;
  55.  
  56.            for (int offsetX = -1; offsetX < 2; offsetX++)
  57.                for (int offsetY = -1; offsetY < 2; offsetY++)
  58.                {
  59.                    // do not check origin or diagonal neighbours
  60.                    if (offsetX == 0 && offsetY == 0 || offsetX == offsetY || offsetX == -offsetY || -offsetX == offsetY)
  61.                        continue;
  62.  
  63.                    int targetIndex = Pn(_x + offsetX, _y + offsetY, width);
  64.                    int _tx = targetIndex % width,
  65.                      _ty = targetIndex / width;
  66.  
  67.                    // skip out of bounds point
  68.                    if (_tx < 0 || _ty < 0 || _tx >= width || _ty >= height)
  69.                        continue;
  70.  
  71.                    if (!queue.Contains(targetIndex) && source[targetIndex].Equals(target))
  72.                    {
  73.                        queue.Add(targetIndex);
  74.                        ++i;
  75.                    }
  76.                }
  77.        }
  78.    }
  79.  
  80.    public static int Pn(int x, int y, int w)
  81.    {
  82.        return x + (y * w);
  83.    }
  84. }

EDIT: Añadidos using + función PN + codigo en VB.NET que para eso son los snippets de VB

Prueba de concepto: https://dotnetfiddle.net/ZacRiB

Un saludo.
« Última modificación: 18 Octubre 2018, 20:30 pm por z3nth10n » En línea


Interesados hablad por Discord.
z3nth10n


Desconectado Desconectado

Mensajes: 1.583


"Jack of all trades, master of none." - Zenthion


Ver Perfil WWW
Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
« Respuesta #536 en: 18 Octubre 2018, 19:51 pm »

Leer los pixeles de una imagen y contarlos siguiendo un diccionario estático de colores

Básicamente, la funcionalidad que tiene esto, es definir un diccionario estático de colores (con una enumeración donde se especifiquen los apartados que hay (si fuese necesario)), se itera todo pixel a pixel, y cada color se compara con la muestra sacando el porcentaje de similitud, si la similitud es del 90% o mayor se da por hecho que ese color pertenece a x enumeración del diccionario.

Para más INRI, le he añadido la utilidad de que se pueda leer desde Internet, lo que cambia si queremos leerlo desde el disco es que tenemos que llamar únicamente a System.IO.File.ReadAllBytes.

Aquí el codigo: https://github.com/z3nth10n/GTA-ColorCount/blob/master/CountColors/Program.cs

Nota: Tiene una versión compilada (para el que lo quiera probar).
Nota2: No está optimizado (memory leak & no se ha mirado si se puede optimizar desde el punto de vista de procesamiento de cpu), asi que, si se elige guardar puede llegar a ocupar 1GB en memoria (la imagen tiene 7000x5000, en bruto son unos 140MB (7000x5000x4 (ARGB)) en memoria.)

Codigo en VB.NET:

Código
  1. Imports System
  2. Imports System.Net
  3. Imports System.Drawing
  4. Imports System.Drawing.Imaging
  5. Imports System.Runtime.InteropServices
  6. Imports System.IO
  7. Imports System.Collections.Generic
  8. Imports System.Linq
  9. Imports Color = zenthion.Color
  10. Imports System.Diagnostics
  11. Imports System.Reflection
  12.  
  13. Public Enum GroundType
  14. Building
  15. Asphalt
  16. LightPavement
  17. Pavement
  18. Grass
  19. DryGrass
  20. Sand
  21. Dirt
  22. Mud
  23. Water
  24. Rails
  25. Tunnel
  26. BadCodingDark
  27. BadCodingLight
  28. BuildingLight
  29. End Enum
  30.  
  31. Public Enum OrderingType
  32. ByColor
  33. [ByVal]
  34. ByName
  35. End Enum
  36.  
  37. Public Class Program
  38. Public Shared colorToCompare As Color = Color.white
  39. Public Shared orderingType As OrderingType = OrderingType.ByVal
  40. Public Shared isDarkened As Boolean = False, isPosterized As Boolean = False, isOrdered As Boolean = True, saveTexture As Boolean = False
  41.  
  42. Private Shared ReadOnly Property SavingPath() As String
  43. Get
  44. Return Path.Combine(Path.GetDirectoryName(System.Reflection.Assembly.GetExecutingAssembly().Location), "texture.png")
  45. End Get
  46. End Property
  47.  
  48. Public Shared Sub Main()
  49. Dim imageBytes() As Byte = Nothing
  50.  
  51. ' OriginalTexture: http://i.imgur.com/g9fRYbm.png
  52. ' TextureColor: https://image.ibb.co/dP3Nvf/texture-Color.png
  53.  
  54. Dim url As String = "https://image.ibb.co/dP3Nvf/texture-Color.png"
  55.  
  56. Using webClient = New WebClient()
  57. imageBytes = webClient.DownloadData(url)
  58. End Using
  59.  
  60. Dim sw As Stopwatch = Stopwatch.StartNew()
  61.  
  62. isDarkened = url = "https://image.ibb.co/dP3Nvf/texture-Color.png"
  63.  
  64.  
  65. Dim colors As IEnumerable(Of Color) = Nothing
  66.  
  67. Dim bitmap As Bitmap = Nothing
  68. Dim dict = GetColorCount(bitmap, imageBytes, (If(isDarkened, F.DarkenedMapColors, F.mapColors)).Values.AsEnumerable(), colors, isPosterized)
  69.  
  70. Console.WriteLine(DebugDict(dict))
  71. Console.WriteLine("Num of colors: {0}", dict.Keys.Count)
  72.  
  73. If saveTexture Then
  74. colors.ToArray().SaveBitmap(7000, 5000, SavingPath)
  75. End If
  76.  
  77. bitmap.Dispose()
  78. sw.Stop()
  79.  
  80. Console.WriteLine("Ellapsed: {0} s", (sw.ElapsedMilliseconds / 1000F).ToString("F2"))
  81.  
  82. Console.Read()
  83. End Sub
  84.  
  85. Private Shared Function DebugDict(ByVal dict As Dictionary(Of Color, Integer)) As String
  86. Dim num = dict.Select(Function(x) New With {Key .Name = x.Key.GetGroundType(isPosterized), Key .Similarity = x.Key.ColorSimilaryPerc(colorToCompare), Key .Val = x.Value, Key .ColR = x.Key.r, Key .ColG = x.Key.g, Key .ColB = x.Key.b}).GroupBy(Function(x) x.Name).Select(Function(x) New With {Key .Name = x.Key, Key .Similarity = x.Average(Function(y) y.Similarity), Key .Val = x.Sum(Function(y) y.Val), Key .Col = New Color(CByte(x.Average(Function(y) y.ColR)), CByte(x.Average(Function(y) y.ColG)), CByte(x.Average(Function(y) y.ColB)))})
  87.  
  88. Dim num1 = num
  89.  
  90. If isOrdered Then
  91. num1 = If(orderingType = OrderingType.ByName, num.OrderBy(Function(x) x.Name), num.OrderByDescending(Function(x)If(orderingType = OrderingType.ByColor, x.Col.ColorSimilaryPerc(colorToCompare), x.Val)))
  92. End If
  93.  
  94. Dim num2 = num1.Select(Function(x) String.Format("[{2}] {0}: {1}", x.Name, x.Val.ToString("N0"), x.Similarity.ToString("F2")))
  95.  
  96. Return String.Join(Environment.NewLine, num2)
  97. End Function
  98.  
  99. Public Shared Function GetColorCount(ByRef image As Bitmap, ByVal arr() As Byte, ByVal colors As IEnumerable(Of Color), <System.Runtime.InteropServices.Out()> ByRef imageColors As IEnumerable(Of Color), Optional ByVal isPosterized As Boolean = False) As Dictionary(Of Color, Integer)
  100. Dim count As New Dictionary(Of Color, Integer)()
  101.  
  102. Using stream As Stream = New MemoryStream(arr)
  103. image = CType(System.Drawing.Image.FromStream(stream), Bitmap)
  104. End Using
  105.  
  106. 'Color[]
  107. imageColors = image.ToColor() '.ToArray();
  108.  
  109. 'Parallel.ForEach(Partitioner.Create(imageColors, true).GetOrderableDynamicPartitions(), colorItem =>
  110. For Each colorItem As Color In imageColors
  111. ' .Value
  112. Dim thresholedColor As Color = If((Not isPosterized), colorItem.GetSimilarColor(colors), colorItem) '.RoundColorOff(65);
  113.  
  114. If Not count.ContainsKey(thresholedColor) Then
  115. count.Add(thresholedColor, 1)
  116. Else
  117. count(thresholedColor) += 1
  118. End If
  119. Next colorItem
  120.  
  121. Dim posterizedColors As Dictionary(Of Color, Integer) = If(isPosterized, New Dictionary(Of Color, Integer)(), count)
  122.  
  123. If isPosterized Then
  124. For Each kv In count
  125. Dim pColor As Color = kv.Key.Posterize(16)
  126.  
  127. If Not posterizedColors.ContainsKey(pColor) Then
  128. posterizedColors.Add(pColor, kv.Value)
  129. Else
  130. posterizedColors(pColor) += kv.Value
  131. End If
  132. Next kv
  133. End If
  134.  
  135. Return posterizedColors
  136. End Function
  137. End Class
  138.  
  139. Public Module F
  140. Public mapColors As New Dictionary(Of GroundType, Color)() From {
  141. { GroundType.Building, Color.white },
  142. { GroundType.Asphalt, Color.black },
  143. { GroundType.LightPavement, New Color(206, 207, 206, 255) },
  144. { GroundType.Pavement, New Color(156, 154, 156, 255) },
  145. { GroundType.Grass, New Color(57, 107, 41, 255) },
  146. { GroundType.DryGrass, New Color(123, 148, 57, 255) },
  147. { GroundType.Sand, New Color(231, 190, 107, 255) },
  148. { GroundType.Dirt, New Color(156, 134, 115, 255) },
  149. { GroundType.Mud, New Color(123, 101, 90, 255) },
  150. { GroundType.Water, New Color(115, 138, 173, 255) },
  151. { GroundType.Rails, New Color(74, 4, 0, 255) },
  152. { GroundType.Tunnel, New Color(107, 105, 99, 255) },
  153. { GroundType.BadCodingDark, New Color(127, 0, 0, 255) },
  154. { GroundType.BadCodingLight, New Color(255, 127, 127, 255) }
  155. }
  156.  
  157. Private _darkened As Dictionary(Of GroundType, Color)
  158.  
  159. Public ReadOnly Property DarkenedMapColors() As Dictionary(Of GroundType, Color)
  160. Get
  161. If _darkened Is Nothing Then
  162. _darkened = GetDarkenedMapColors()
  163. End If
  164.  
  165. Return _darkened
  166. End Get
  167. End Property
  168.  
  169. Private BmpStride As Integer = 0
  170.  
  171. Private Function GetDarkenedMapColors() As Dictionary(Of GroundType, Color)
  172. ' We will take the last 2 elements
  173.  
  174. Dim last2 = mapColors.Skip(mapColors.Count - 2)
  175.  
  176. Dim exceptLast2 = mapColors.Take(mapColors.Count - 2)
  177.  
  178. Dim dict As New Dictionary(Of GroundType, Color)()
  179.  
  180. dict.AddRange(exceptLast2.Select(Function(x) New KeyValuePair(Of GroundType, Color)(x.Key, x.Value.Lerp(Color.black,.5F))))
  181.  
  182. dict.Add(GroundType.BuildingLight, Color.white)
  183.  
  184. dict.AddRange(last2)
  185.  
  186. Return dict
  187. End Function
  188.  
  189. <System.Runtime.CompilerServices.Extension> _
  190. Public Sub AddRange(Of TKey, TValue)(ByVal dic As Dictionary(Of TKey, TValue), ByVal dicToAdd As IEnumerable(Of KeyValuePair(Of TKey, TValue)))
  191. dicToAdd.ForEach(Sub(x) dic.Add(x.Key, x.Value))
  192. End Sub
  193.  
  194. <System.Runtime.CompilerServices.Extension> _
  195. Public Sub ForEach(Of T)(ByVal source As IEnumerable(Of T), ByVal action As Action(Of T))
  196. For Each item In source
  197. action(item)
  198. Next item
  199. End Sub
  200.  
  201. 'INSTANT VB NOTE: The parameter color was renamed since it may cause conflicts with calls to static members of the user-defined type with this name:
  202. <System.Runtime.CompilerServices.Extension> _
  203. Public Function Posterize(ByVal color_Renamed As Color, ByVal level As Byte) As Color
  204. Dim r As Byte = 0, g As Byte = 0, b As Byte = 0
  205.  
  206. Dim value As Double = color_Renamed.r \ 255.0
  207. value *= level - 1
  208. value = Math.Round(value)
  209. value /= level - 1
  210.  
  211. r = CByte(value * 255)
  212. value = color_Renamed.g \ 255.0
  213. value *= level - 1
  214. value = Math.Round(value)
  215. value /= level - 1
  216.  
  217. g = CByte(value * 255)
  218. value = color_Renamed.b \ 255.0
  219. value *= level - 1
  220. value = Math.Round(value)
  221. value /= level - 1
  222.  
  223. b = CByte(value * 255)
  224.  
  225. Return New Color(r, g, b, 255)
  226. End Function
  227.  
  228. <System.Runtime.CompilerServices.Extension> _
  229. Public Function GetGroundType(ByVal c As Color, ByVal isPosterized As Boolean) As String
  230. Dim mapToUse = If(Program.isDarkened, DarkenedMapColors, mapColors)
  231. Dim kvColor As KeyValuePair(Of GroundType, Color) = mapToUse.FirstOrDefault(Function(x)If(isPosterized, x.Value.ColorSimilaryPerc(c) >.9F, x.Value = c))
  232.  
  233. If Not kvColor.Equals(Nothing) Then
  234. Return kvColor.Key.ToString()
  235. Else
  236. Return c.ToString()
  237. End If
  238. End Function
  239.  
  240. <System.Runtime.CompilerServices.Extension> _
  241. Public Function GetSimilarColor(ByVal c1 As Color, ByVal cs As IEnumerable(Of Color)) As Color
  242. Return cs.OrderBy(Function(x) x.ColorThreshold(c1)).FirstOrDefault()
  243. End Function
  244.  
  245. <System.Runtime.CompilerServices.Extension> _
  246. Public Function ColorThreshold(ByVal c1 As Color, ByVal c2 As Color) As Integer
  247. Return (Math.Abs(c1.r - c2.r) + Math.Abs(c1.g - c2.g) + Math.Abs(c1.b - c2.b))
  248. End Function
  249.  
  250. <System.Runtime.CompilerServices.Extension> _
  251. Public Function ColorSimilaryPerc(ByVal a As Color, ByVal b As Color) As Single
  252. Return 1F - (a.ColorThreshold(b) / (256F * 3))
  253. End Function
  254.  
  255. <System.Runtime.CompilerServices.Extension> _
  256. Public Function RoundColorOff(ByVal c As Color, Optional ByVal roundTo As Byte = 5) As Color
  257. Return New Color(c.r.RoundOff(roundTo), c.g.RoundOff(roundTo), c.b.RoundOff(roundTo), 255)
  258. End Function
  259.  
  260. <System.Runtime.CompilerServices.Extension> _
  261. Public Function RoundOff(ByVal i As Byte, Optional ByVal roundTo As Byte = 5) As Byte
  262. Return CByte(CByte(Math.Ceiling(i / CDbl(roundTo))) * roundTo)
  263. End Function
  264.  
  265. <System.Runtime.CompilerServices.Extension> _
  266. Public Iterator Function ToColor(ByVal bmp As Bitmap) As IEnumerable(Of Color)
  267. Dim rect As New Rectangle(0, 0, bmp.Width, bmp.Height)
  268. Dim bmpData As BitmapData = bmp.LockBits(rect, System.Drawing.Imaging.ImageLockMode.ReadWrite, bmp.PixelFormat)
  269.  
  270. Dim ptr As IntPtr = bmpData.Scan0
  271.  
  272. Dim bytes As Integer = bmpData.Stride * bmp.Height
  273. Dim rgbValues(bytes - 1) As Byte
  274.  
  275. ' Copy the RGB values into the array.
  276. Marshal.Copy(ptr, rgbValues, 0, bytes)
  277.  
  278. BmpStride = bmpData.Stride
  279.  
  280. For column As Integer = 0 To bmpData.Height - 1
  281. For row As Integer = 0 To bmpData.Width - 1
  282. ' Little endian
  283. Dim b As Byte = CByte(rgbValues((column * BmpStride) + (row * 4)))
  284. Dim g As Byte = CByte(rgbValues((column * BmpStride) + (row * 4) + 1))
  285. Dim r As Byte = CByte(rgbValues((column * BmpStride) + (row * 4) + 2))
  286.  
  287. Yield New Color(r, g, b, 255)
  288. Next row
  289. Next column
  290.  
  291. ' Unlock the bits.
  292. bmp.UnlockBits(bmpData)
  293. End Function
  294.  
  295. <System.Runtime.CompilerServices.Extension> _
  296. Public Sub SaveBitmap(ByVal bmp() As Color, ByVal width As Integer, ByVal height As Integer, ByVal path As String)
  297. Dim stride As Integer = BmpStride
  298. Dim rgbValues((BmpStride * height) - 1) As Byte
  299.  
  300. For column As Integer = 0 To height - 1
  301. For row As Integer = 0 To width - 1
  302. Dim i As Integer = Pn(row, column, width)
  303.  
  304. ' Little endian
  305. rgbValues((column * BmpStride) + (row * 4)) = bmp(i).b
  306. rgbValues((column * BmpStride) + (row * 4) + 1) = bmp(i).g
  307. rgbValues((column * BmpStride) + (row * 4) + 2) = bmp(i).r
  308. rgbValues((column * BmpStride) + (row * 4) + 3) = bmp(i).a
  309. Next row
  310. Next column
  311.  
  312. Using image As New Bitmap(width, height, width * 4, PixelFormat.Format32bppArgb, Marshal.UnsafeAddrOfPinnedArrayElement(rgbValues, 0))
  313. image.Save(path)
  314. End Using
  315. End Sub
  316.  
  317. Public Function Pn(ByVal x As Integer, ByVal y As Integer, ByVal w As Integer) As Integer
  318. Return x + (y * w)
  319. End Function
  320. End Module
  321.  
  322. Public Module Mathf
  323. <System.Runtime.CompilerServices.Extension> _
  324. Public Function Clamp(Of T As IComparable(Of T))(ByVal val As T, ByVal min As T, ByVal max As T) As T
  325. If val.CompareTo(min) < 0 Then
  326. Return min
  327. ElseIf val.CompareTo(max) > 0 Then
  328. Return max
  329. Else
  330. Return val
  331. End If
  332. End Function
  333.  
  334. ' Interpolates between /a/ and /b/ by /t/. /t/ is clamped between 0 and 1.
  335. Public Function Lerp(ByVal a As Single, ByVal b As Single, ByVal t As Single) As Single
  336. Return a + (b - a) * Clamp01(t)
  337. End Function
  338.  
  339. ' Clamps value between 0 and 1 and returns value
  340. Public Function Clamp01(ByVal value As Single) As Single
  341. If value < 0F Then
  342. Return 0F
  343. ElseIf value > 1F Then
  344. Return 1F
  345. Else
  346. Return value
  347. End If
  348. End Function
  349. End Module
  350.  
  351. Namespace zenthion
  352. ''' <summary>
  353. ''' Struct Color
  354. ''' </summary>
  355. ''' <seealso cref="System.ICloneable" />
  356. <Serializable>
  357. Public Structure Color
  358. Implements ICloneable
  359.  
  360. ''' <summary>
  361. ''' Clones this instance.
  362. ''' </summary>
  363. ''' <returns>System.Object.</returns>
  364. Public Function Clone() As Object Implements ICloneable.Clone
  365. Return MemberwiseClone()
  366. End Function
  367.  
  368. ''' <summary>
  369. ''' The r
  370. ''' </summary>
  371. Public r, g, b, a As Byte
  372.  
  373. ''' <summary>
  374. ''' Gets the white.
  375. ''' </summary>
  376. ''' <value>The white.</value>
  377. Public Shared ReadOnly Property white() As Color
  378. Get
  379. Return New Color(255, 255, 255)
  380. End Get
  381. End Property
  382.  
  383. ''' <summary>
  384. ''' Gets the red.
  385. ''' </summary>
  386. ''' <value>The red.</value>
  387. Public Shared ReadOnly Property red() As Color
  388. Get
  389. Return New Color(255, 0, 0)
  390. End Get
  391. End Property
  392.  
  393. ''' <summary>
  394. ''' Gets the green.
  395. ''' </summary>
  396. ''' <value>The green.</value>
  397. Public Shared ReadOnly Property green() As Color
  398. Get
  399. Return New Color(0, 255, 0)
  400. End Get
  401. End Property
  402.  
  403. ''' <summary>
  404. ''' Gets the blue.
  405. ''' </summary>
  406. ''' <value>The blue.</value>
  407. Public Shared ReadOnly Property blue() As Color
  408. Get
  409. Return New Color(0, 0, 255)
  410. End Get
  411. End Property
  412.  
  413. ''' <summary>
  414. ''' Gets the yellow.
  415. ''' </summary>
  416. ''' <value>The yellow.</value>
  417. Public Shared ReadOnly Property yellow() As Color
  418. Get
  419. Return New Color(255, 255, 0)
  420. End Get
  421. End Property
  422.  
  423. ''' <summary>
  424. ''' Gets the gray.
  425. ''' </summary>
  426. ''' <value>The gray.</value>
  427. Public Shared ReadOnly Property gray() As Color
  428. Get
  429. Return New Color(128, 128, 128)
  430. End Get
  431. End Property
  432.  
  433. ''' <summary>
  434. ''' Gets the black.
  435. ''' </summary>
  436. ''' <value>The black.</value>
  437. Public Shared ReadOnly Property black() As Color
  438. Get
  439. Return New Color(0, 0, 0)
  440. End Get
  441. End Property
  442.  
  443. ''' <summary>
  444. ''' Gets the transparent.
  445. ''' </summary>
  446. ''' <value>The transparent.</value>
  447. Public Shared ReadOnly Property transparent() As Color
  448. Get
  449. Return New Color(0, 0, 0, 0)
  450. End Get
  451. End Property
  452.  
  453. ''' <summary>
  454. ''' Initializes a new instance of the <see cref="Color"/> struct.
  455. ''' </summary>
  456. ''' <param name="r">The r.</param>
  457. ''' <param name="g">The g.</param>
  458. ''' <param name="b">The b.</param>
  459. Public Sub New(ByVal r As Byte, ByVal g As Byte, ByVal b As Byte)
  460. Me.r = r
  461. Me.g = g
  462. Me.b = b
  463. a = Byte.MaxValue
  464. End Sub
  465.  
  466. ''' <summary>
  467. ''' Initializes a new instance of the <see cref="Color"/> struct.
  468. ''' </summary>
  469. ''' <param name="r">The r.</param>
  470. ''' <param name="g">The g.</param>
  471. ''' <param name="b">The b.</param>
  472. ''' <param name="a">a.</param>
  473. Public Sub New(ByVal r As Byte, ByVal g As Byte, ByVal b As Byte, ByVal a As Byte)
  474. Me.r = r
  475. Me.g = g
  476. Me.b = b
  477. Me.a = a
  478. End Sub
  479.  
  480. ''' <summary>
  481. ''' Implements the ==.
  482. ''' </summary>
  483. ''' <param name="c1">The c1.</param>
  484. ''' <param name="c2">The c2.</param>
  485. ''' <returns>The result of the operator.</returns>
  486. Public Shared Operator =(ByVal c1 As Color, ByVal c2 As Color) As Boolean
  487. Return c1.r = c2.r AndAlso c1.g = c2.g AndAlso c1.b = c2.b AndAlso c1.a = c2.a
  488. End Operator
  489.  
  490. ''' <summary>
  491. ''' Implements the !=.
  492. ''' </summary>
  493. ''' <param name="c1">The c1.</param>
  494. ''' <param name="c2">The c2.</param>
  495. ''' <returns>The result of the operator.</returns>
  496. Public Shared Operator <>(ByVal c1 As Color, ByVal c2 As Color) As Boolean
  497. Return Not(c1.r = c2.r AndAlso c1.g = c2.g AndAlso c1.b = c2.b AndAlso c1.a = c2.a)
  498. End Operator
  499.  
  500. ''' <summary>
  501. ''' Returns a hash code for this instance.
  502. ''' </summary>
  503. ''' <returns>A hash code for this instance, suitable for use in hashing algorithms and data structures like a hash table.</returns>
  504. Public Overrides Function GetHashCode() As Integer
  505. Return GetHashCode()
  506. End Function
  507.  
  508. ''' <summary>
  509. ''' Determines whether the specified <see cref="System.Object" /> is equal to this instance.
  510. ''' </summary>
  511. ''' <param name="obj">The <see cref="System.Object" /> to compare with this instance.</param>
  512. ''' <returns><c>true</c> if the specified <see cref="System.Object" /> is equal to this instance; otherwise, <c>false</c>.</returns>
  513. Public Overrides Function Equals(ByVal obj As Object) As Boolean
  514. Dim c As Color = DirectCast(obj, Color)
  515. Return r = c.r AndAlso g = c.g AndAlso b = c.b
  516. End Function
  517.  
  518. ''' <summary>
  519. ''' Implements the -.
  520. ''' </summary>
  521. ''' <param name="c1">The c1.</param>
  522. ''' <param name="c2">The c2.</param>
  523. ''' <returns>The result of the operator.</returns>
  524. Public Shared Operator -(ByVal c1 As Color, ByVal c2 As Color) As Color
  525. Return New Color(CByte(Mathf.Clamp(c1.r - c2.r, 0, 255)), CByte(Mathf.Clamp(c2.g - c2.g, 0, 255)), CByte(Mathf.Clamp(c2.b - c2.b, 0, 255)))
  526. End Operator
  527.  
  528. ''' <summary>
  529. ''' Implements the +.
  530. ''' </summary>
  531. ''' <param name="c1">The c1.</param>
  532. ''' <param name="c2">The c2.</param>
  533. ''' <returns>The result of the operator.</returns>
  534. Public Shared Operator +(ByVal c1 As Color, ByVal c2 As Color) As Color
  535. Return New Color(CByte(Mathf.Clamp(c1.r + c2.r, 0, 255)), CByte(Mathf.Clamp(c2.g + c2.g, 0, 255)), CByte(Mathf.Clamp(c2.b + c2.b, 0, 255)))
  536. End Operator
  537.  
  538. ''' <summary>
  539. ''' Lerps the specified c2.
  540. ''' </summary>
  541. ''' <param name="c2">The c2.</param>
  542. ''' <param name="t">The t.</param>
  543. ''' <returns>Color.</returns>
  544. Public Function Lerp(ByVal c2 As Color, ByVal t As Single) As Color
  545. Return New Color(CByte(Mathf.Lerp(r, c2.r, t)), CByte(Mathf.Lerp(g, c2.g, t)), CByte(Mathf.Lerp(b, c2.b, t)))
  546. End Function
  547.  
  548. ''' <summary>
  549. ''' Inverts this instance.
  550. ''' </summary>
  551. ''' <returns>Color.</returns>
  552. Public Function Invert() As Color
  553. Return New Color(CByte(Mathf.Clamp(Byte.MaxValue - r, 0, 255)), CByte(Mathf.Clamp(Byte.MaxValue - g, 0, 255)), CByte(Mathf.Clamp(Byte.MaxValue - b, 0, 255)))
  554. End Function
  555.  
  556. ''' <summary>
  557. ''' Returns a <see cref="System.String" /> that represents this instance.
  558. ''' </summary>
  559. ''' <returns>A <see cref="System.String" /> that represents this instance.</returns>
  560. Public Overrides Function ToString() As String
  561. If Me = white Then
  562. Return "white"
  563. ElseIf Me = transparent Then
  564. Return "transparent"
  565. ElseIf Me = red Then
  566. Return "red"
  567. ElseIf Me = blue Then
  568. Return "blue"
  569. ElseIf Me = black Then
  570. Return "black"
  571. ElseIf Me = green Then
  572. Return "green"
  573. ElseIf Me = yellow Then
  574. Return "yellow"
  575. Else
  576. Return String.Format("({0}, {1}, {2}, {3})", r, g, b, a)
  577. End If
  578. End Function
  579.  
  580. ''' <summary>
  581. ''' Fills the specified x.
  582. ''' </summary>
  583. ''' <param name="x">The x.</param>
  584. ''' <param name="y">The y.</param>
  585. ''' <returns>Color[].</returns>
  586. Public Shared Iterator Function Fill(ByVal x As Integer, ByVal y As Integer) As IEnumerable(Of Color)
  587. For i As Integer = 0 To (x * y) - 1
  588. Yield black
  589. Next i
  590. End Function
  591. End Structure
  592. End Namespace

Nota: A pesar de haber sido convertido con un conversor se ha comprobado en: https://dotnetfiddle.net/1vbkgG
Nota2: La idea era que se ejecutase de forma online y si le poneis una imagen más pequeña deberia sacar los pixeles, pero como digo no se puede, por tema de web clouds y recursos compartidos.
Nota3: Le he metido esta imagen (https://vignette.wikia.nocookie.net/gta-myths/images/8/80/Gtasa-blank.png/revision/latest?cb=20161204212845) pero me da un error que ahora mismo no me puedo parar a comprobar:

Citar
Run-time exception (line -1): Arithmetic operation resulted in an overflow.

Stack Trace:

[System.OverflowException: Arithmetic operation resulted in an overflow.]
   at F.ColorThreshold(Color c1, Color c2)
   at F._Closure$__3._Lambda$__15(Color x)
   at System.Linq.EnumerableSorter`2.ComputeKeys(TElement[] elements, Int32 count)
   at System.Linq.EnumerableSorter`1.Sort(TElement[] elements, Int32 count)
   at System.Linq.OrderedEnumerable`1.<GetEnumerator>d__1.MoveNext()
   at System.Linq.Enumerable.FirstOrDefault[TSource](IEnumerable`1 source)
   at F.GetSimilarColor(Color c1, IEnumerable`1 cs)
   at Program.GetColorCount(Bitmap& image, Byte[] arr, IEnumerable`1 colors, IEnumerable`1& imageColors, Boolean isPosterized)
   at Program.Main()

Y creo que eso es todo.

Un saludo.

PD: La razón de que el código esté mitad comentado y mitad sin comentar es porque la parte de la clase Color es una implementación propia de la clase Color que hice hace tiempo y la introducí en mi Lerp2API.
PD2: Este código (el del ColorThreshold y lo de GetSimilarity, todo lo demás lo he escrito esta mañana y tarde) realmente lo estaba usando en mi proyecto de San Andreas Unity (de los últimos commits que hice antes de irme de este y empezar uno nuevo a solas).
PD3: Todo esto es parte de un proceso de depuración un tanto largo que me ha servido para constrastar de donde me venían unos valores. Para ser más concretos, tengo un algoritmo que saca los contornos de los edificios que he estado optimizando (el cual empecé en 2016, y después de un año he retomado), y bueno, yo esperaba que me devolviese unos 2600 edificios, pero se me han devuelto unos 1027k  y hay unos 1029k pixeles en la última imagen que he puesto (lo podéis comprobar vosotros mismos), así que ya se por donde seguir. Espero que vosotros también hagáis lo mismo con lo que escribo. ;) :P
« Última modificación: 18 Octubre 2018, 19:57 pm por z3nth10n » En línea


Interesados hablad por Discord.
Serapis
Colaborador
***
Desconectado Desconectado

Mensajes: 3.348


Ver Perfil
Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
« Respuesta #537 en: 19 Octubre 2018, 03:32 am »

mmm... no estoy seguro de haberte entendido, del todo... luego copio el código y mañana trato de ejecutarlo y ya veré... pero de entrada me parece que intentas contar colores?. o intentas contar áreas que tienen un color (esto último luego de abrir el fichero 'texture-Color.png".


Así que ateniéndome solo a tus comentarios.
Con el algoritmo counting-sort, puedes tener la cantidad de colores únicos que contienen una imagen... necesitas un array de 17Mb.
Después puedes clasificarlos. Si solo aparecen por ejemplo 1millón de colores distintos, solo tienes que reclasificar 1 millons (hacer tu comparación de similaridad, en vez de hacerlo con toda los 7.000x5.000 = 35millones)... counting sort, es el algoritmo más rápido de ordenamiento para números enteros, además tampoco es exactamente dicho algorimo, sino una simplificación pués nos basta saber la existencia de cada único elemento (sin duplicados)

Así que si precisas una clasificación basada en el parecido, es más práctico (que lo que has hecho) aplicar una función que derive los colores que tu dés por sentado que pertenecen a una categoría al color que representa esa categoría... (quiero decir, es más práctico si no te basta con saber qué colores aparecen, si no que además debas hacer algo con ellos después en la imagen). Así al final toda la imagen tendría solo tantos colores como categorías tengas. Por supuesto debe quedar claro previamente que pasa con los colores que pudieran correponder por igual a más de una categoría (el gris puede llevarse a la categoría de negro, lo mismo que a la del blanco, pués equidista de ambos). Es decir, un color no debe estar en mas de una categoría...

Aquí las funciones que harían todo lo antedicho...
Código:
// la función recibe el array de píxeles (4bytes por píxel) y devuelve la cantidad de únicos por referencia y el array de colores únicos.
// es una simplificación de counting-sort (ya que no requerimos ordenarlos, sólo conocer los únicos).
array entero = funcion GetColoresUnicos(in array entero pixeles(), out entero Cantidad)
    array de entero ColoresUnicos(0 a 1677725) //255 para señalar que existe y 0 para no.
    entero k

    bucle para k desde 0 hasta pixeles.length -1
          ColoresUnicos(pixeles(k)) = 255 // por si se quiere hace rpasar por bleao en alguna operación posterior.
    siguiente 
   
    devolver ColoresUnicos 
fin funcion
Listo ya tienes un array donde el índice es el propio color del píxel, y si el valor contenido es 1, dicho color (el valor del índice) existe en la imagen, si vale 0, no.
por ejemplo sea: ColoresUnicos(10145634) que vale 255, ese color (el 10145634, en Hex:9ACF62), existe en la imagen.

Ahora clasificas estos colores únicos según tu criterio de similaridad... y será enormemente más rápido que todo ese código que tienes...
Veamos por ejemplo que tienes 25 categorías... asignas un color a ellos... y pongamos que descansan en un array ColCategorias(0 a 24)
Código:
// Ahora el array de colores únicos se truncará para que cada color existente (valor 255),
//    pase a tener el color de la categoría a la que pertenece
funcion ReclasificarColores(in-out array entero colUnicos() )
    entero k, byte x

    bucle para k desde 0 hasta 16777215
        Si colUnicos(k) > 0)  // es decir si existe en la imagen
            // esta función debe devolver un valor en el rango 0-24, que es el índice de un color de la categoría...           
            x = Similaridad(colUnicos(k))
            colUnicos(k) = colCategoria(x)
            // o bien devolver directamente el color y se asigna entonces a
            // colUnicos(k) = Similaridad(colUnicos(k))
        fin si
     fin bucle
fin funcion


Ahora que ya están todos los colores (únicos) existentes en la imagen, modificado al color de cuya categoría es reepresentativo.... solo resta aplicarlo a la imagen (si fuera el caso)...
Código:
// Cambia cada color d ela imagen, por el que corresponde a su categoría.
funcion SegmentarImagenEnColores(in array entero pixeles(), in array entero colUnicos() )
    entero k

    bucle para k desde 0 hasta pixeles.lenght -1
        pixeles(k) = colUnicos(pixeles(k))
    siguiente
fin funcion


Y fin... vuelves a depositar el array de píxeles en la imagen (si no interceptaste directamente su puntero en memoria), y refrescas la imagen. Ya la tienes segmentada en tus 25 colores (de ejemplo).
Aparte de las 3 funciones dadas en pseudocódigo, te falta solo incorporar la función de similaridad, la cual dependerá de ciertos parámetros, que deenden de lo que uno aya a hacer... y que queda a tu esfuerzo, aunque creo haber visto que en el código pudieras tenerla ya implementada.
Y queda evidentemente la parte del código que carga la imagen y toma su array de píxeles y al final la devuelve (y si procede la guarda a disco)...

aquí lo que sería la función general...
Código:
funcion SegemtarImagenEnCategorias(string Ruta)
   entero cantidadColUnicos
   array entero pixeles()
   array entero colUnicos()
   array entero colCategoria()
   bitmap Imagen

   imagen = ReadImagen(ruta)
   pixeles = GetPixeles(Imagen))
   cantidadColUnicos = GetColoresUnicos(pixeles, colUnicos)
   imprimir cantidadColUnicos // solo por cuirosidad, aunque puede usarse para determinar cuando terminar en un bucle
   // se supone que estos colores ya está definidos de antemano, pueden tomarse desde
   //    fichero, desde recursos, insertos en el código como constantes, etc...
   colCategoria= RadFromFile(Ruta)
   ReclasificarColores(colUnicos)
   SegmentarImagenEnColores(pixeles, colUnicos)
   SetPixeles(Imagen, pixeles)
   WriteImagen(ruta, imagen)
fin funcion

<hr>
Otra opción es simplemente aplicar funciones de segmentación, por ejemplo una convolución con un kernel como el siguiente (-1,1,-1, 1,0,1, -1,1,-1) genera la imagen que pongo justo bajo estas líneas...


O una función de 'relieve' donde realza el contraste cuando encuentra un cambio brusco de luminancia, y apaga-diluye el resto... la siguiente imagen corresponde a ese caso.


Ambas partiendo de la siguiente imagen (se hecha en falta spoilers en el foro). Claro que al hablar de edificios, pensaba que eran en 3 dimensiones, vamos como una ciudad, sin embargo, luego de ver la imagen png, veo que es más una imágen aérea de edificios, lo que sin duda arrojaría un mejor resultado que una en 3d, como esta de la que he partido...




Mañana con más tiempo le hecho un ojo al código...
En línea

z3nth10n


Desconectado Desconectado

Mensajes: 1.583


"Jack of all trades, master of none." - Zenthion


Ver Perfil WWW
Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
« Respuesta #538 en: 19 Octubre 2018, 08:50 am »

Te cuento de forma rápida lo que pretendo.

En el mapa hay x cantidad de colores predefinidos, tantos como enumeraciones tengas.

En este caso: Building, Asphalt, LightPavement, Pavement, Grass, DryGrass, Sand, Dirt, Mud, Water, Rails, Tunnel, BadCodingDark, BadCodingLight, BuildingLight, son 15.

Lo que pasa con esa imagen es hay micro variaciones de color. Quizás hay 100 tonos distintos de Grass con variaciones de pares en la escala RGB (es decir, nunca te vas a encontrar tonos que tengan un (0, 241, 0, 255), para el caso de un verde), y quizás con un rango total de ±10. Es decir, 5 posibilidades entre los 3 componentes: 5^3=125 tonos de verde.

Estos tonos son inperceptibles al ojo humano. Quizás se hizo por algun motivo (ya le metere saturación para ver si sigue algún patrón o algo. Estos de Rockstar te meten easter eggs hasta en los mapas).

Entonces lo que hago primero es iterar todos los colores. Mientras itero, voy comparando pixel a pixel, con los colores definidos en el diccionario, pero no los comparo literalmente (==), si no que saco un porcentaje de similitud. Y estás microvariaciones, como digo, como máximo su diferencia puede ser de ±10.

El porcentaje (con el mayor offset posible) sera en este caso: (255, 255, 255, 255) --> (245, 245, 245, 255) = 0.9609375 = 96,1% (un 3,9% de diferencia), vamos bien, ya que yo comparo con hasta un 10%, es decir una variación de ±25, es decir 25/2=12,5^3=1953 posibilidades, imagina.

Teniendo ese porcentaje, pues ya al debugear lo unico que hago es agrupar todos los colores (antes lo que hacia era posterizarlos, pero no me moló la idea, por eso hay un método de posterización) y sumar sus respectivas agrupaciones, pasamos de +1600 colores a unos 15 o menos (algunos no los detecta bien, otros directamente, no están presentes).

Un saludo.
En línea


Interesados hablad por Discord.
Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.788



Ver Perfil
Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
« Respuesta #539 en: 22 Noviembre 2018, 19:54 pm »

Nota3: Le he metido esta imagen (https://vignette.wikia.nocookie.net/gta-myths/images/8/80/Gtasa-blank.png/revision/latest?cb=20161204212845) pero me da un error que ahora mismo no me puedo parar a comprobar:

Si tu mismo te das cuenta de que el propósito principal del código que tienes está incompleto, puesto que NO funciona correctamente con según que imágenes (más abajo te explico el fallo), ¿entonces por que lo compartes?. Algo incompleto o no del todo funcional sencillamente no sirve para reutilizarlo, es que no sirve.



Citar
Código
  1. <System.Runtime.CompilerServices.Extension> _
  2. Public Iterator Function ToColor(ByVal bmp As Bitmap) As IEnumerable(Of Color)
  3. Dim rect As New Rectangle(0, 0, bmp.Width, bmp.Height)
  4. Dim bmpData As BitmapData = bmp.LockBits(rect, System.Drawing.Imaging.ImageLockMode.ReadWrite, bmp.PixelFormat)
  5.  
  6. Dim ptr As IntPtr = bmpData.Scan0
  7.  
  8. Dim bytes As Integer = bmpData.Stride * bmp.Height
  9. Dim rgbValues(bytes - 1) As Byte
  10.  
  11. ' Copy the RGB values into the array.
  12. Marshal.Copy(ptr, rgbValues, 0, bytes)
  13.  
  14. BmpStride = bmpData.Stride
  15.  
  16. For column As Integer = 0 To bmpData.Height - 1
  17. For row As Integer = 0 To bmpData.Width - 1
  18. ' Little endian
  19. Dim b As Byte = CByte(rgbValues((column * BmpStride) + (row * 4)))
  20. Dim g As Byte = CByte(rgbValues((column * BmpStride) + (row * 4) + 1))
  21. Dim r As Byte = CByte(rgbValues((column * BmpStride) + (row * 4) + 2))
  22.  
  23. Yield New Color(r, g, b, 255)
  24. Next row
  25. Next column
  26.  
  27. ' Unlock the bits.
  28. bmp.UnlockBits(bmpData)
  29. End Function
  30.  
  31. <System.Runtime.CompilerServices.Extension> _
  32. Public Sub SaveBitmap(ByVal bmp() As Color, ByVal width As Integer, ByVal height As Integer, ByVal path As String)
  33. Dim stride As Integer = BmpStride
  34. Dim rgbValues((BmpStride * height) - 1) As Byte
  35.  
  36. For column As Integer = 0 To height - 1
  37. For row As Integer = 0 To width - 1
  38. Dim i As Integer = Pn(row, column, width)
  39.  
  40. ' Little endian
  41. rgbValues((column * BmpStride) + (row * 4)) = bmp(i).b
  42. rgbValues((column * BmpStride) + (row * 4) + 1) = bmp(i).g
  43. rgbValues((column * BmpStride) + (row * 4) + 2) = bmp(i).r
  44. rgbValues((column * BmpStride) + (row * 4) + 3) = bmp(i).a
  45. Next row
  46. Next column
  47.  
  48. Using image As New Bitmap(width, height, width * 4, PixelFormat.Format32bppArgb, Marshal.UnsafeAddrOfPinnedArrayElement(rgbValues, 0))
  49. image.Save(path)
  50. End Using
  51. End Sub
  52.  
  53. Public Function Pn(ByVal x As Integer, ByVal y As Integer, ByVal w As Integer) As Integer
  54. Return x + (y * w)
  55. End Function
  56. End Module
  57.  

Primero de todo quiero comentar que eso no deberían ser extensiones de método puesto que estás usando objetos que no están declarados dentro del bloque de la extensión de método (BmpStride y rgbValues). No es código reutilizable tal y como está ahora mismo.

Bueno, vayamos al grano. Es lógico que el algoritmo te tire errores con la imagen del hipervínculo que has mencionado, puesto que tu algoritmo está hardcodeado para parsear imágenes de 32 BPP (4 bytes por pixel) en ese búcle que haces ahí, sin embargo, tu estás intentando tratar imágenes con otro formato de píxeles, 24 BPP en este caso (3 bytes por pixel), por lo tanto tu búcle generará una excepción del tipo IndexOutOfRangeException.

El error principal lo cometes aquí, al pasarle el argumento bmp.PixelFormat, el cual puede ser cualquier formato de píxeles dependiendo de la imagen original...
Citar
Código
  1. Dim bmpData As BitmapData = bmp.LockBits(rect, System.Drawing.Imaging.ImageLockMode.ReadWrite, bmp.PixelFormat)

En su lugar, debes convertir la imagen a 32 BPP simplemente pasándole el argumento PixelFormat.Format32bppArgb a la función LockBits:
Código
  1. Dim bmpData As BitmapData = bmp.LockBits(rect, ImageLockMode.ReadOnly, PixelFormat.Format32bppArgb)

...o en su defecto, adaptar tu búcle para todos los tipos de formato de píxeles posibles.



Te muestro un ejemplo:

Código
  1. Public Iterator Function GetColors(ByVal bmp As Bitmap) As IEnumerable(Of Color)
  2.  
  3.    ' Lock the bitmap bits.
  4.    Dim pixelFormat As PixelFormat = PixelFormat.Format32bppArgb
  5.    Dim bytesPerPixel As Integer = 4 ' PixelFormat.Format32bppArgb
  6.    Dim rect As New Rectangle(Point.Empty, bmp.Size)
  7.    Dim bmpData As BitmapData = bmp.LockBits(rect, ImageLockMode.ReadOnly, pixelFormat)
  8.  
  9.    ' Get the address of the first row.
  10.    Dim address As IntPtr = bmpData.Scan0
  11.  
  12.    ' Hold the raw bytes of the bitmap.
  13.    Dim numBytes As Integer = (Math.Abs(bmpData.Stride) * rect.Height)
  14.    Dim rawImageData As Byte() = New Byte(numBytes - 1) {}
  15.    Marshal.Copy(address, rawImageData, 0, numBytes)
  16.  
  17.    ' Unlock the bitmap bits.
  18.    bmp.UnlockBits(bmpData)
  19.  
  20.    ' Iterate the pixels.
  21.    For i As Integer = 0 To (rawImageData.Length - bytesPerPixel) Step bytesPerPixel
  22.  
  23.        Yield Color.FromArgb(alpha:=rawImageData(i + 3),
  24.                             red:=rawImageData(i + 2),
  25.                             green:=rawImageData(i + 1),
  26.                             blue:=rawImageData(i))
  27.  
  28.    Next i
  29.  
  30. End Function

En el otro método "SaveBitmap" deberías aplicar el mismo principio, ya que también asumes que es una imagen de 32 BPP.

Saludos
« Última modificación: 22 Noviembre 2018, 20:09 pm por Eleкtro (sin pilas) » En línea

Páginas: 1 ... 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 [54] 55 56 57 58 Ir Arriba Respuesta Imprimir 

Ir a:  

WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines