Autor
|
Tema: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets) (Leído 526,929 veces)
|
Eleкtro
Ex-Staff
Desconectado
Mensajes: 9.866
|
Gracias @NEBIRE, pero te puedes imaginar que yo también estuve buscando y encontré el mismo PDF en Google , 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
Mensajes: 9.866
|
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). ''' ---------------------------------------------------------------------------------------------------- ''' <summary> ''' Determine whether the source resolution belongs to the specified aspect ratio. ''' </summary> ''' ---------------------------------------------------------------------------------------------------- ''' <param name="resolution"> ''' The source resolution. ''' </param> ''' ''' <param name="aspectRatio"> ''' The aspect ratio. ''' </param> ''' ---------------------------------------------------------------------------------------------------- ''' <returns> ''' <see langword="True"/> if the source resolution belongs to the specified aspect ratio; otherwise, <see langword="False"/>. ''' </returns> ''' ---------------------------------------------------------------------------------------------------- Public Shared Function ResolutionIsOfAspectRatio(ByVal resolution As Size, ByVal aspectRatio As Point) As Boolean Return (resolution.Width / aspectRatio.X) * aspectRatio.Y = resolution.Height End Function
Ejemplo de uso: Dim resolution As New Size(width:=1920, height:=1080) Dim aspectRatio As New Point(x:=16, y:=9) Dim result As Boolean = ResolutionIsOfAspectRatio(resolution, aspectRatio) 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... Public Module RectangleExtensions #Region " Public Extension Methods " ''' ---------------------------------------------------------------------------------------------------- ''' <summary> ''' Scale the size and position of the source <see cref="Rectangle"/> ''' by the difference of the specified sizes. ''' </summary> ''' ---------------------------------------------------------------------------------------------------- ''' <param name="sender"> ''' The source <see cref="Rectangle"/>. ''' </param> ''' ''' <param name="fromSize"> ''' The source <see cref="Size"/>. ''' </param> ''' ''' <param name="toSize"> ''' The target <see cref="Size"/>. ''' </param> ''' ---------------------------------------------------------------------------------------------------- ''' <returns> ''' The resulting <see cref="Rectangle"/>. ''' </returns> ''' ---------------------------------------------------------------------------------------------------- <DebuggerStepThrough> <Extension> <EditorBrowsable(EditorBrowsableState.Always)> Public Function ScaleBySizeDifference(ByVal sender As Rectangle, ByVal fromSize As Size, ByVal toSize As Size) As Rectangle Dim percentChangeX As Double = (toSize.Width / fromSize.Width) Dim percentChangeY As Double = (toSize.Height / fromSize.Height) Return New Rectangle With { .X = CInt(sender.X * percentChangeX), .Y = CInt(sender.Y * percentChangeY), .Width = CInt(sender.Width * percentChangeX), .Height = CInt(sender.Height * percentChangeY) } End Function ''' ---------------------------------------------------------------------------------------------------- ''' <summary> ''' Scale the size and position of the source <see cref="RectangleF"/> ''' by the difference of the specified sizes. ''' </summary> ''' ---------------------------------------------------------------------------------------------------- ''' <param name="sender"> ''' The source <see cref="RectangleF"/>. ''' </param> ''' ''' <param name="fromSize"> ''' The source <see cref="SizeF"/>. ''' </param> ''' ''' <param name="toSize"> ''' The target <see cref="SizeF"/>. ''' </param> ''' ---------------------------------------------------------------------------------------------------- ''' <returns> ''' The resulting <see cref="RectangleF"/>. ''' </returns> ''' ---------------------------------------------------------------------------------------------------- <DebuggerStepThrough> <Extension> <EditorBrowsable(EditorBrowsableState.Always)> Public Function ScaleBySizeDifference(ByVal sender As RectangleF, ByVal fromSize As SizeF, ByVal toSize As SizeF) As RectangleF Dim percentChangeX As Double = (toSize.Width / fromSize.Width) Dim percentChangeY As Double = (toSize.Height / fromSize.Height) Return New RectangleF With { .X = CSng(sender.X * percentChangeX), .Y = CSng(sender.Y * percentChangeY), .Width = CSng(sender.Width * percentChangeX), .Height = CSng(sender.Height * percentChangeY) } End Function #End Region End Module
Ejemplo de uso: Dim oldSize As New Size(640, 480) Dim oldRect As New Rectangle(New Point(100, 100), New Size(639, 479)) Dim newSize As New Size(800, 600) Dim newRect As Rectangle = ScaleBySizeDifference(oldRect, oldSize, newSize) Console.WriteLine(String.Format("oldRect: {0}", oldRect.ToString())) ' {X=100,Y=100,Width=639,Height=479} 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
Mensajes: 9.866
|
GENERAR UNA FECHA ALEATORIA, EN UN RANGO ESPECÍFICO.Sencillos pero prácticos miembros para generar fechas aleatorias. Le encontrarán alguna utilidad. ''' ---------------------------------------------------------------------------------------------------- ''' <summary> ''' Contains date and time related utilities. ''' </summary> ''' ---------------------------------------------------------------------------------------------------- <ImmutableObject(True)> Public NotInheritable Class DateTimeUtil #Region " Private Fields " ''' ---------------------------------------------------------------------------------------------------- ''' <summary> ''' A <see cref="Random"/> instance to generate random secuences of numbers. ''' </summary> ''' ---------------------------------------------------------------------------------------------------- Private Shared rng As Random #End Region #Region " Constructors " ''' ---------------------------------------------------------------------------------------------------- ''' <summary> ''' Prevents a default instance of the <see cref="DateTimeUtil"/> class from being created. ''' </summary> ''' ---------------------------------------------------------------------------------------------------- <DebuggerNonUserCode> Private Sub New() End Sub #End Region #Region " Public Methods " ''' ---------------------------------------------------------------------------------------------------- ''' <summary> ''' Gets a random <see cref="Date"/> in range between the specified two dates. ''' </summary> ''' ---------------------------------------------------------------------------------------------------- ''' <example> This is a code example. ''' <code> ''' Dim minDate As Date = Date.MinValue ''' Dim maxDate As Date = Date.MaxValue ''' Dim ramdomDate As Date = GetRandomDateTime(minDate, maxDate) ''' ''' Console.WriteLine(randomDate.ToString()) ''' </code> ''' </example> ''' ---------------------------------------------------------------------------------------------------- ''' <param name="dateMin"> ''' The minimum <see cref="Date"/>. ''' </param> ''' ''' <param name="dateMax"> ''' The maximum <see cref="Date"/>. ''' </param> ''' ---------------------------------------------------------------------------------------------------- ''' <returns> ''' The resulting <see cref="Date"/>. ''' </returns> ''' ---------------------------------------------------------------------------------------------------- <DebuggerStepThrough> Public Shared Function GetRandomDateTime(ByVal dateMin As Date, ByVal dateMax As Date) As Date If (DateTimeUtil.rng Is Nothing) Then DateTimeUtil.rng = New Random(Seed:=Environment.TickCount) End If ' Generate random date with 00:00:00 time. Dim daysRange As Integer = dateMax.Subtract(dateMin).Days Dim dt As Date = dateMin.AddDays(DateTimeUtil.rng.Next(daysRange)) ' Generate random time. Dim hours As Integer = DateTimeUtil.rng.Next(dateMax.TimeOfDay.Hours + 1) Dim minutes As Integer = DateTimeUtil.rng.Next(dateMax.TimeOfDay.Minutes + 1) Dim seconds As Integer = DateTimeUtil.rng.Next(dateMax.TimeOfDay.Seconds + 1) Dim milliseconds As Integer = DateTimeUtil.rng.Next(dateMax.TimeOfDay.Milliseconds + 1) ' Return the resulting date. Return New Date(dt.Year, dt.Month, dt.Day, hours, minutes, seconds, milliseconds, dt.Kind) End Function ''' ---------------------------------------------------------------------------------------------------- ''' <summary> ''' Gets a random <see cref="Date"/> in range between <see cref="DateTime.MinValue"/> and the specified date. ''' </summary> ''' ---------------------------------------------------------------------------------------------------- ''' <example> This is a code example. ''' <code> ''' Dim maxDate As Date = Date.MaxValue ''' Dim ramdomDate As Date = GetRandomDateTime(maxDate) ''' ''' Console.WriteLine(randomDate.ToString()) ''' </code> ''' </example> ''' ---------------------------------------------------------------------------------------------------- ''' <param name="dateMax"> ''' The maximum <see cref="Date"/>. ''' </param> ''' ---------------------------------------------------------------------------------------------------- ''' <returns> ''' The resulting <see cref="Date"/>. ''' </returns> ''' ---------------------------------------------------------------------------------------------------- <DebuggerStepThrough> Public Shared Function GetRandomDateTime(ByVal dateMax As Date) As Date Return DateTimeUtil.GetRandomDateTime(Date.MinValue, dateMax) End Function ''' ---------------------------------------------------------------------------------------------------- ''' <summary> ''' Gets a random <see cref="Date"/> in range between <see cref="DateTime.MinValue"/> and <see cref="DateTime.MaxValue"/>. ''' </summary> ''' ---------------------------------------------------------------------------------------------------- ''' <example> This is a code example. ''' <code> ''' Dim ramdomDate As Date = GetRandomDateTime() ''' ''' Console.WriteLine(randomDate.ToString()) ''' </code> ''' </example> ''' ---------------------------------------------------------------------------------------------------- ''' <returns> ''' The resulting <see cref="Date"/>. ''' </returns> ''' ---------------------------------------------------------------------------------------------------- <DebuggerStepThrough> Public Shared Function GetRandomDateTime() As Date Return DateTimeUtil.GetRandomDateTime(Date.MinValue, Date.MaxValue) End Function #End Region End Class
|
|
|
En línea
|
|
|
|
**Aincrad**
|
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) 'Para usarlo 'FormNotificacion(NOMBRE DE SU FORMULARIO a mostrar) Private Sub FormNotificacion(ByVal formulario As Object) Dim fh As Form = TryCast(formulario, Form) fh.ShowInTaskbar = False fh.Show() fh.Location = New Point(CInt((Screen.PrimaryScreen.WorkingArea.Width / 1) - (formulario.Width / 1)), CInt((Screen.PrimaryScreen.WorkingArea.Height / 1) - (formulario.Height / 1))) End Sub
|
|
« Última modificación: 3 Julio 2018, 22:16 pm por **Aincrad** »
|
En línea
|
|
|
|
Eleкtro
Ex-Staff
Desconectado
Mensajes: 9.866
|
¿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: #Region " Option Statements " Option Strict On Option Explicit On Option Infer Off #End Region #Region " Imports " Imports System.ComponentModel Imports System.Globalization Imports System.Runtime.InteropServices Imports ElektroKit.Interop.Win32 #End Region #Region " Interoperability " Namespace ElektroKit.Interop #Region " Win32 API " Namespace Win32 #Region " EDataFlow " ''' <summary> ''' Defines constants that indicate the direction in which audio data flows between an audio endpoint device and an application. ''' </summary> ''' <remarks> ''' <see href="https://docs.microsoft.com/en-us/windows/desktop/api/mmdeviceapi/ne-mmdeviceapi-__midl___midl_itf_mmdeviceapi_0000_0000_0001"/> ''' </remarks> Public Enum EDataFlow As Integer Render Capture All EDataFlow_enum_count End Enum #End Region #Region " ERole " ''' <summary> ''' Defines constants that indicate the role that the system has assigned to an audio endpoint device. ''' </summary> ''' <remarks> ''' <see href="https://docs.microsoft.com/en-us/windows/desktop/api/mmdeviceapi/ne-mmdeviceapi-__midl___midl_itf_mmdeviceapi_0000_0000_0002"/> ''' </remarks> Public Enum ERole As Integer Console Multimedia Communications ERole_enum_count End Enum #End Region #Region " MMDeviceEnumerator " ''' <summary> ''' <c>CLSID_MMDeviceEnumerator</c>. ''' </summary> <ComImport> <Guid("BCDE0395-E52F-467C-8E3D-C4579291692E")> Public Class MMDeviceEnumerator End Class #End Region #Region " IMMDeviceEnumerator " ''' <summary> ''' Provides methods for enumerating multimedia device resources. ''' <para></para> ''' In the current implementation of the MMDevice API, ''' the only device resources that this interface can enumerate are audio endpoint devices. ''' <para></para> ''' A client obtains a reference to an <see cref="IMMDeviceEnumerator"/> interface by calling the CoCreateInstance. ''' <para></para> ''' The device resources enumerated by the methods in the IMMDeviceEnumerator interface are represented as ''' collections of objects with <see cref="IMMDevice"/> interfaces. ''' <para></para> ''' A collection has an IMMDeviceCollection interface. ''' The IMMDeviceEnumerator.EnumAudioEndpoints method creates a device collection. ''' </summary> ''' <remarks> ''' <see href="https://docs.microsoft.com/en-us/windows/desktop/api/mmdeviceapi/nn-mmdeviceapi-immdeviceenumerator"/> ''' </remarks> <ComImport> <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> <Guid("A95664D2-9614-4F35-A746-DE8DB63617E6")> Public Interface IMMDeviceEnumerator <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented1() As Integer <PreserveSig> Function GetDefaultAudioEndpoint(<[In]> <MarshalAs(UnmanagedType.I4)> ByVal dataFlow As EDataFlow, <[In]> <MarshalAs(UnmanagedType.I4)> ByVal role As ERole, <Out> <MarshalAs(UnmanagedType.Interface)> ByRef refDevice As IMMDevice) As Integer <EditorBrowsable(EditorBrowsableState.Never)> Function NotImplemented2() As Integer <EditorBrowsable(EditorBrowsableState.Never)> Function NotImplemented3() As Integer <EditorBrowsable(EditorBrowsableState.Never)> Function NotImplemented4() As Integer End Interface #End Region #Region " IMMDevice " ''' <summary> ''' Provides methods for enumerating multimedia device resources. ''' <para></para> ''' In the current implementation of the MMDevice API, ''' the only device resources that this interface can enumerate are audio endpoint devices. ''' <para></para> ''' A client obtains a reference to an <see cref="IMMDeviceEnumerator"/> interface by calling the CoCreateInstance. ''' <para></para> ''' The device resources enumerated by the methods in the IMMDeviceEnumerator interface are represented as ''' collections of objects with <see cref="IMMDevice"/> interfaces. ''' <para></para> ''' A collection has an IMMDeviceCollection interface. ''' The IMMDeviceEnumerator.EnumAudioEndpoints method creates a device collection. ''' </summary> ''' <remarks> ''' <see href="https://docs.microsoft.com/en-us/windows/desktop/api/mmdeviceapi/nn-mmdeviceapi-immdevice"/> ''' </remarks> <ComImport> <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> <Guid("D666063F-1587-4E43-81F1-B948E807363F")> Public Interface IMMDevice <PreserveSig> Function Activate(ByRef ref¡d As Guid, ByVal clsCtx As Integer, ByVal activationParams As IntPtr, <MarshalAs(UnmanagedType.IUnknown)> ByRef refInterface As Object) As Integer <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented1() As Integer <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented2() As Integer <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented3() As Integer End Interface #End Region #Region " IAudioSessionControl " ''' <summary> ''' Enables a client to configure the control parameters for an audio session and to monitor events in the session. ''' </summary> ''' <remarks> ''' <see href="https://docs.microsoft.com/en-us/windows/desktop/api/audiopolicy/nn-audiopolicy-iaudiosessioncontrol"/> ''' </remarks> <ComImport> <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> <Guid("F4B1A599-7266-4319-A8CA-E70ACB11E8CD")> Public Interface IAudioSessionControl <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented1() As Integer <PreserveSig> Function GetDisplayName(<Out> <MarshalAs(UnmanagedType.LPWStr)> ByRef refDisplayName As String) As Integer <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented2() As Integer <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented3() As Integer <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented4() As Integer <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented5() As Integer <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented6() As Integer <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented7() As Integer <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented8() As Integer End Interface #End Region #Region " IAudioSessionControl2 " ''' <summary> ''' Enables a client to configure the control parameters for an audio session and to monitor events in the session. ''' <para></para> ''' The IAudioClient.Initialize method initializes a stream object and assigns the stream to an audio session. ''' </summary> ''' <remarks> ''' <see href="https://docs.microsoft.com/en-us/windows/desktop/api/audiopolicy/nn-audiopolicy-iaudiosessioncontrol"/> ''' </remarks> <ComImport> <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> <Guid("BFB7FF88-7239-4FC9-8FA2-07C950BE9C6D")> Public Interface IAudioSessionControl2 <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented1() As Integer <PreserveSig> Function GetDisplayName(<Out> <MarshalAs(UnmanagedType.LPWStr)> ByRef refDisplayName As String) As Integer <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented2() As Integer <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented3() As Integer <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented4() As Integer <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented5() As Integer <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented6() As Integer <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented7() As Integer <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented8() As Integer <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented9() As Integer <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented10() As Integer <PreserveSig> Function GetProcessId(<Out> ByRef refValue As UInteger) As Integer <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented11() As Integer <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented12() As Integer End Interface #End Region #Region " IAudioSessionEnumerator " ''' <summary> ''' Enumerates audio sessions on an audio device. ''' </summary> ''' <remarks> ''' <see href="https://docs.microsoft.com/en-us/windows/desktop/api/audiopolicy/nn-audiopolicy-iaudiosessionenumerator"/> ''' </remarks> <ComImport> <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> <Guid("E2F5BB11-0570-40CA-ACDD-3AA01277DEE8")> Public Interface IAudioSessionEnumerator <PreserveSig> Function GetCount(ByRef refSessionCount As Integer) As Integer <PreserveSig> Function GetSession(ByVal sessionCount As Integer, ByRef refSession As IAudioSessionControl) As Integer End Interface #End Region #Region " IAudioSessionManager2 " ''' <summary> ''' Enables an application to manage submixes for the audio device. ''' </summary> ''' <remarks> ''' <see href="https://docs.microsoft.com/en-us/windows/desktop/api/audiopolicy/nn-audiopolicy-iaudiosessionmanager2"/> ''' </remarks> <ComImport> <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> <Guid("77AA99A0-1BD6-484F-8BC7-2C654C9A9B6F")> Public Interface IAudioSessionManager2 <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented1() As Integer <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented2() As Integer <PreserveSig> Function GetSessionEnumerator(<Out> <MarshalAs(UnmanagedType.Interface)> ByRef refSessionEnum As IAudioSessionEnumerator) As Integer <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented3() As Integer <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented4() As Integer <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented5() As Integer <EditorBrowsable(EditorBrowsableState.Never)> <PreserveSig> Function NotImplemented6() As Integer End Interface #End Region #Region " ISimpleAudioVolume " ''' <summary> ''' Enables a client to control the master volume level of an audio session. ''' </summary> ''' <remarks> ''' <see href="https://docs.microsoft.com/en-us/windows/desktop/api/audioclient/nn-audioclient-isimpleaudiovolume"/> ''' </remarks> <ComImport> <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> <Guid("87CE5498-68D6-44E5-9215-6DA47EF883D8")> Public Interface ISimpleAudioVolume <PreserveSig> Function SetMasterVolume(<[In]> <MarshalAs(UnmanagedType.R4)> ByVal levelNormalization As Single, <[In]> <MarshalAs(UnmanagedType.LPStruct)> ByVal eventContext As Guid) As Integer <PreserveSig> Function GetMasterVolume(<Out> <MarshalAs(UnmanagedType.R4)> ByRef refLevelNormalization As Single) As Integer <PreserveSig> Function SetMute(<[In]> <MarshalAs(UnmanagedType.Bool)> ByVal isMuted As Boolean, <[In]> <MarshalAs(UnmanagedType.LPStruct)> ByVal eventContext As Guid) As Integer <PreserveSig> Function GetMute(<Out> <MarshalAs(UnmanagedType.Bool)> ByRef refIsMuted As Boolean) As Integer End Interface #End Region End Namespace #End Region #Region " Inter-process Communication " Namespace IPC ''' ---------------------------------------------------------------------------------------------------- ''' <summary> ''' Contains audio related utilities to apply on external processes. ''' </summary> ''' ---------------------------------------------------------------------------------------------------- Public NotInheritable Class AudioUtil #Region " Constructors " ''' ---------------------------------------------------------------------------------------------------- ''' <summary> ''' Prevents a default instance of the <see cref="AudioUtil"/> class from being created. ''' </summary> ''' ---------------------------------------------------------------------------------------------------- <DebuggerNonUserCode> Private Sub New() End Sub #End Region #Region " Public Methods " ''' ---------------------------------------------------------------------------------------------------- ''' <summary> ''' Mute the audio volume of the specified process. ''' </summary> ''' ---------------------------------------------------------------------------------------------------- ''' <param name="pr"> ''' The <see cref="Process"/>. ''' </param> ''' ---------------------------------------------------------------------------------------------------- Public Shared Sub MuteApplication(ByVal pr As Process) Dim volume As ISimpleAudioVolume = AudioUtil.GetVolumeObject(pr) If (volume IsNot Nothing) Then Dim guid As Guid = Guid.Empty volume.SetMute(True, guid) End If End Sub ''' ---------------------------------------------------------------------------------------------------- ''' <summary> ''' Unmute the audio volume of the specified process. ''' </summary> ''' ---------------------------------------------------------------------------------------------------- ''' <param name="pr"> ''' The <see cref="Process"/>. ''' </param> ''' ---------------------------------------------------------------------------------------------------- Public Shared Sub UnmuteApplication(ByVal pr As Process) Dim volume As ISimpleAudioVolume = AudioUtil.GetVolumeObject(pr) If (volume IsNot Nothing) Then Dim guid As Guid = Guid.Empty volume.SetMute(False, guid) End If End Sub ''' ---------------------------------------------------------------------------------------------------- ''' <summary> ''' Gets a value that determine whether the audio volume of the specified application is muted. ''' </summary> ''' ---------------------------------------------------------------------------------------------------- ''' <param name="pr"> ''' The <see cref="Process"/>. ''' </param> ''' ---------------------------------------------------------------------------------------------------- ''' <returns> ''' Returns <see langword="True"/> if the application is muted, <see langword="False"/> otherwise. ''' </returns> ''' ---------------------------------------------------------------------------------------------------- Public Shared Function IsApplicationMuted(ByVal pr As Process) As Boolean Dim volume As ISimpleAudioVolume = AudioUtil.GetVolumeObject(pr) If (volume IsNot Nothing) Then Dim isMuted As Boolean volume.GetMute(isMuted) Return isMuted End If Return False End Function ''' ---------------------------------------------------------------------------------------------------- ''' <summary> ''' Gets the audio volume level of the specified process. ''' </summary> ''' ---------------------------------------------------------------------------------------------------- ''' <param name="pr"> ''' The <see cref="Process"/>. ''' </param> ''' ---------------------------------------------------------------------------------------------------- ''' <returns> ''' The audio volume, expressed in the range between 0 and 100. ''' </returns> ''' ---------------------------------------------------------------------------------------------------- <DebuggerStepThrough> Public Shared Function GetApplicationVolume(ByVal pr As Process) As Integer Dim volume As ISimpleAudioVolume = AudioUtil.GetVolumeObject(pr) If (volume IsNot Nothing) Then Dim levelNormalization As Single = Nothing volume.GetMasterVolume(levelNormalization) Return CInt(levelNormalization * 100) End If Return 100 End Function ''' ---------------------------------------------------------------------------------------------------- ''' <summary> ''' Sets the audio volume level for the specified process. ''' </summary> ''' ---------------------------------------------------------------------------------------------------- ''' <param name="pr"> ''' The <see cref="Process"/>. ''' </param> ''' ''' <param name="volumeLevel"> ''' The new volume level, expressed in the range between 0 and 100. ''' </param> ''' ---------------------------------------------------------------------------------------------------- <DebuggerStepThrough> Public Shared Sub SetApplicationVolume(ByVal pr As Process, ByVal volumeLevel As Integer) If (volumeLevel < 0) OrElse (volumeLevel > 100) Then Throw New ArgumentOutOfRangeException(paramName:=NameOf(volumeLevel), actualValue:=volumeLevel, message:=String.Format(CultureInfo.CurrentCulture, "A value of '{0}' is not valid for '{1}'. '{1}' must be between 0 and 100.", volumeLevel, NameOf(volumeLevel))) End If Dim volume As ISimpleAudioVolume = AudioUtil.GetVolumeObject(pr) If (volume IsNot Nothing) Then Dim guid As Guid = Guid.Empty volume.SetMasterVolume((volumeLevel / 100.0F), guid) End If End Sub #End Region #Region " Private Methods " ''' ---------------------------------------------------------------------------------------------------- ''' <summary> ''' Enumerate all the <see cref="IAudioSessionControl2"/> of the default (<see cref="IMMDevice"/>) audio device. ''' </summary> ''' ---------------------------------------------------------------------------------------------------- ''' <remarks> ''' Credits to @Simon Mourier: <see href="https://stackoverflow.com/a/14322736/1248295"/> ''' </remarks> ''' ---------------------------------------------------------------------------------------------------- ''' <returns> ''' The resulting <see cref="IEnumerable(Of IAudioSessionControl2)"/>. ''' </returns> ''' ---------------------------------------------------------------------------------------------------- <DebuggerStepperBoundary> Private Shared Iterator Function EnumerateAudioSessionControls() As IEnumerable(Of IAudioSessionControl2) ' Get the (1st render + multimedia) aodio device. Dim deviceEnumerator As IMMDeviceEnumerator = DirectCast(New MMDeviceEnumerator(), IMMDeviceEnumerator) Dim device As IMMDevice = Nothing deviceEnumerator.GetDefaultAudioEndpoint(EDataFlow.Render, ERole.Multimedia, device) ' Activate the session manager. Dim IID_IAudioSessionManager2 As Guid = GetType(IAudioSessionManager2).GUID Dim obj As Object = Nothing device.Activate(IID_IAudioSessionManager2, 0, IntPtr.Zero, obj) Dim manager As IAudioSessionManager2 = DirectCast(obj, IAudioSessionManager2) ' Enumerate sessions for on this device. Dim sessionEnumerator As IAudioSessionEnumerator = Nothing manager.GetSessionEnumerator(sessionEnumerator) Dim sessionCount As Integer sessionEnumerator.GetCount(sessionCount) For i As Integer = 0 To (sessionCount - 1) Dim ctl As IAudioSessionControl = Nothing Dim ctl2 As IAudioSessionControl2 sessionEnumerator.GetSession(i, ctl) ctl2 = DirectCast(ctl, IAudioSessionControl2) Yield ctl2 Marshal.ReleaseComObject(ctl2) Marshal.ReleaseComObject(ctl) Next i Marshal.ReleaseComObject(sessionEnumerator) Marshal.ReleaseComObject(manager) Marshal.ReleaseComObject(device) Marshal.ReleaseComObject(deviceEnumerator) End Function ''' ---------------------------------------------------------------------------------------------------- ''' <summary> ''' Searchs and returns the corresponding <see cref="ISimpleAudioVolume"/> for the specified <see cref="Process"/>. ''' </summary> ''' ---------------------------------------------------------------------------------------------------- ''' <remarks> ''' Credits to @Simon Mourier: <see href="https://stackoverflow.com/a/14322736/1248295"/> ''' </remarks> ''' ---------------------------------------------------------------------------------------------------- ''' <param name="pr"> ''' The <see cref="Process"/>. ''' </param> ''' ---------------------------------------------------------------------------------------------------- ''' <returns> ''' The resulting <see cref="ISimpleAudioVolume"/>, ''' or <see langword="Nothing"/> if a <see cref="ISimpleAudioVolume"/> is not found for the specified process. ''' </returns> ''' ---------------------------------------------------------------------------------------------------- <DebuggerStepperBoundary> Private Shared Function GetVolumeObject(ByVal pr As Process) As ISimpleAudioVolume For Each ctl As IAudioSessionControl2 In AudioUtil.EnumerateAudioSessionControls() Dim pId As UInteger ctl.GetProcessId(pId) If (pId = pr.Id) Then Return DirectCast(ctl, ISimpleAudioVolume) End If Next ctl Return Nothing End Function #End Region End Class End Namespace #End Region End Namespace #End Region
Ejemplos de uso: Imports ElektroKit.Interop.IPC Imports System.Linq
' Get the process we want to modify. ' Note the process must have an audio mixer available to be able mute it and/or to modify its volume level. ' 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. Dim pr As Process = Process.GetProcessesByName("process name").SingleOrDefault()
' ----------------------- ' ' GET OR SET VOLUME LEVEL ' ' ----------------------- ' Dim volumeLevel As Integer ' resulting value of this variable will be in range of 0% to 100%. ' Get current process volume level. volumeLevel = AudioUtil.GetApplicationVolume(pr) Console.WriteLine(String.Format("Current volume level: {0}%", volumeLevel)) ' Set process volume level to a new value. AudioUtil.SetApplicationVolume(pr, 50) ' 50% volumeLevel = AudioUtil.GetApplicationVolume(pr) Console.WriteLine(String.Format("New volume level: {0}%", volumeLevel))
' ------------------------ ' ' MUTE OR UNMUTE A PROCESS ' ' ------------------------ ' Dim isMuted As Boolean ' Mute the aplication. AudioUtil.MuteApplication(pr) isMuted = AudioUtil.IsApplicationMuted(pr) Console.WriteLine(String.Format("Is appliaction properly muted: {0}", isMuted)) ' Mute the aplication. AudioUtil.UnmuteApplication(pr) isMuted = AudioUtil.IsApplicationMuted(pr) Console.WriteLine(String.Format("Is appliaction properly unmuted?: {0}", Not isMuted))
Eso es todo.
|
|
|
En línea
|
|
|
|
z3nth10n
Desconectado
Mensajes: 1.583
"Jack of all trades, master of none." - Zenthion
|
Como rellenar un array siguiendo el algoritmo Flood Fill usando HashSethttps://es.wikipedia.org/wiki/Algoritmo_de_relleno_por_difusi%C3%B3nImports System.Collections.Generic Imports System.Linq Imports System.Runtime.CompilerServices Imports System.Runtime.InteropServices Module F <Extension()> 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) Dim i As Integer = 0 FloodFill(source, x, y, width, height, target, replacement, i) End Sub <Extension()> 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) i = 0 Dim queue As HashSet(Of Integer) = New HashSet(Of Integer)() queue.Add(Pn(x, y, width)) While queue.Count > 0 Dim _i As Integer = queue.First(), _x As Integer = _i Mod width, _y As Integer = _i / width queue.Remove(_i) If source(_i).Equals(target) Then source(_i) = replacement For offsetX As Integer = -1 To 2 - 1 For offsetY As Integer = -1 To 2 - 1 If offsetX = 0 AndAlso offsetY = 0 OrElse offsetX = offsetY OrElse offsetX = -offsetY OrElse -offsetX = offsetY Then Continue For Dim targetIndex As Integer = Pn(_x + offsetX, _y + offsetY, width) Dim _tx As Integer = targetIndex Mod width, _ty As Integer = targetIndex / width If _tx < 0 OrElse _ty < 0 OrElse _tx >= width OrElse _ty >= height Then Continue For If Not queue.Contains(targetIndex) AndAlso source(targetIndex).Equals(target) Then queue.Add(targetIndex) i += 1 End If Next Next End While End Sub Function Pn(ByVal x As Integer, ByVal y As Integer, ByVal w As Integer) As Integer Return x + (y * w) End Function End Module
using System.Collections.Generic; using System.Linq; public static class F { /// <summary> /// Floods the fill. /// </summary> /// <typeparam name="T"></typeparam> /// <param name="source">The source.</param> /// <param name="x">The x.</param> /// <param name="y">The y.</param> /// <param name="width">The width.</param> /// <param name="height">The height.</param> /// <param name="target">The target to replace.</param> /// <param name="replacement">The replacement.</param> public static void FloodFill<T>(this T[] source, int x, int y, int width, int height, T target, T replacement) { int i = 0; FloodFill(source, x, y, width, height, target, replacement, out i); } /// <summary> /// Floods the array following Flood Fill algorithm /// </summary> /// <typeparam name="T"></typeparam> /// <param name="source">The source.</param> /// <param name="x">The x.</param> /// <param name="y">The y.</param> /// <param name="width">The width.</param> /// <param name="height">The height.</param> /// <param name="target">The target to replace.</param> /// <param name="replacement">The replacement.</param> /// <param name="i">The iterations made (if you want to debug).</param> public static void FloodFill<T>(this T[] source, int x, int y, int width, int height, T target, T replacement, out int i) { i = 0; // Queue of pixels to process. :silbar: HashSet <int> queue = new HashSet <int>(); queue.Add(Pn(x, y, width)); while (queue.Count > 0) { int _i = queue.First(), _x = _i % width, _y = _i / width; queue.Remove(_i); if (source[_i].Equals(target)) source[_i] = replacement; for (int offsetX = -1; offsetX < 2; offsetX++) for (int offsetY = -1; offsetY < 2; offsetY++) { // do not check origin or diagonal neighbours if (offsetX == 0 && offsetY == 0 || offsetX == offsetY || offsetX == -offsetY || -offsetX == offsetY) continue; int targetIndex = Pn(_x + offsetX, _y + offsetY, width); int _tx = targetIndex % width, _ty = targetIndex / width; // skip out of bounds point if (_tx < 0 || _ty < 0 || _tx >= width || _ty >= height) continue; if (!queue.Contains(targetIndex) && source[targetIndex].Equals(target)) { queue.Add(targetIndex); ++i; } } } } public static int Pn(int x, int y, int w) { return x + (y * w); } }
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/ZacRiBUn saludo.
|
|
« Última modificación: 18 Octubre 2018, 20:30 pm por z3nth10n »
|
En línea
|
⏩ Interesados hablad por Discord.
|
|
|
z3nth10n
Desconectado
Mensajes: 1.583
"Jack of all trades, master of none." - Zenthion
|
Leer los pixeles de una imagen y contarlos siguiendo un diccionario estático de coloresBá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.csNota: 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:Imports System Imports System.Net Imports System.Drawing Imports System.Drawing.Imaging Imports System.Runtime.InteropServices Imports System.IO Imports System.Collections.Generic Imports System.Linq Imports Color = zenthion.Color Imports System.Diagnostics Imports System.Reflection Public Enum GroundType Building Asphalt LightPavement Pavement Grass DryGrass Sand Dirt Mud Water Rails Tunnel BadCodingDark BadCodingLight BuildingLight End Enum Public Enum OrderingType ByColor [ByVal] ByName End Enum Public Class Program Public Shared colorToCompare As Color = Color.white Public Shared orderingType As OrderingType = OrderingType.ByVal Public Shared isDarkened As Boolean = False, isPosterized As Boolean = False, isOrdered As Boolean = True, saveTexture As Boolean = False Private Shared ReadOnly Property SavingPath() As String Get Return Path.Combine(Path.GetDirectoryName(System.Reflection.Assembly.GetExecutingAssembly().Location), "texture.png") End Get End Property Public Shared Sub Main() Dim imageBytes() As Byte = Nothing ' OriginalTexture: http://i.imgur.com/g9fRYbm.png ' TextureColor: https://image.ibb.co/dP3Nvf/texture-Color.png Dim url As String = "https://image.ibb.co/dP3Nvf/texture-Color.png" Using webClient = New WebClient() imageBytes = webClient.DownloadData(url) End Using Dim sw As Stopwatch = Stopwatch.StartNew() isDarkened = url = "https://image.ibb.co/dP3Nvf/texture-Color.png" Dim colors As IEnumerable(Of Color) = Nothing Dim bitmap As Bitmap = Nothing Dim dict = GetColorCount(bitmap, imageBytes, (If(isDarkened, F.DarkenedMapColors, F.mapColors)).Values.AsEnumerable(), colors, isPosterized) Console.WriteLine(DebugDict(dict)) Console.WriteLine("Num of colors: {0}", dict.Keys.Count) If saveTexture Then colors.ToArray().SaveBitmap(7000, 5000, SavingPath) End If bitmap.Dispose() sw.Stop() Console.WriteLine("Ellapsed: {0} s", (sw.ElapsedMilliseconds / 1000F).ToString("F2")) Console.Read() End Sub Private Shared Function DebugDict (ByVal dict As Dictionary(Of Color, Integer)) As String 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)))}) Dim num1 = num If isOrdered Then 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))) End If Dim num2 = num1.Select(Function(x) String.Format("[{2}] {0}: {1}", x.Name, x.Val.ToString("N0"), x.Similarity.ToString("F2"))) Return String.Join(Environment.NewLine, num2) End Function 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) Using stream As Stream = New MemoryStream(arr) image = CType(System.Drawing.Image.FromStream(stream), Bitmap) End Using 'Color[] imageColors = image.ToColor() '.ToArray(); 'Parallel.ForEach(Partitioner.Create(imageColors, true).GetOrderableDynamicPartitions(), colorItem => For Each colorItem As Color In imageColors ' .Value Dim thresholedColor As Color = If((Not isPosterized), colorItem.GetSimilarColor(colors), colorItem) '.RoundColorOff(65); If Not count.ContainsKey(thresholedColor) Then count.Add(thresholedColor, 1) Else count(thresholedColor) += 1 End If Next colorItem Dim posterizedColors As Dictionary(Of Color, Integer) = If(isPosterized, New Dictionary(Of Color, Integer)(), count ) If isPosterized Then For Each kv In count Dim pColor As Color = kv.Key.Posterize(16) If Not posterizedColors.ContainsKey(pColor) Then posterizedColors.Add(pColor, kv.Value) Else posterizedColors(pColor) += kv.Value End If Next kv End If Return posterizedColors End Function End Class Public Module F Public mapColors As New Dictionary(Of GroundType, Color )() From { { GroundType.Building, Color.white }, { GroundType.Asphalt, Color.black }, { GroundType.LightPavement, New Color(206, 207, 206, 255) }, { GroundType.Pavement, New Color(156, 154, 156, 255) }, { GroundType.Grass, New Color(57, 107, 41, 255) }, { GroundType.DryGrass, New Color(123, 148, 57, 255) }, { GroundType.Sand, New Color(231, 190, 107, 255) }, { GroundType.Dirt, New Color(156, 134, 115, 255) }, { GroundType.Mud, New Color(123, 101, 90, 255) }, { GroundType.Water, New Color(115, 138, 173, 255) }, { GroundType.Rails, New Color(74, 4, 0, 255) }, { GroundType.Tunnel, New Color(107, 105, 99, 255) }, { GroundType.BadCodingDark, New Color(127, 0, 0, 255) }, { GroundType.BadCodingLight, New Color(255, 127, 127, 255) } } Private _darkened As Dictionary(Of GroundType, Color ) Public ReadOnly Property DarkenedMapColors () As Dictionary(Of GroundType, Color ) Get If _darkened Is Nothing Then _darkened = GetDarkenedMapColors() End If Return _darkened End Get End Property Private BmpStride As Integer = 0 Private Function GetDarkenedMapColors () As Dictionary(Of GroundType, Color ) ' We will take the last 2 elements Dim last2 = mapColors.Skip(mapColors.Count - 2) Dim exceptLast2 = mapColors.Take(mapColors.Count - 2) Dim dict As New Dictionary(Of GroundType, Color )() dict.AddRange(exceptLast2.Select(Function(x) New KeyValuePair(Of GroundType, Color)(x.Key, x.Value.Lerp(Color.black,.5F)))) dict.Add(GroundType.BuildingLight, Color.white) dict.AddRange(last2) Return dict End Function <System.Runtime.CompilerServices.Extension> _ Public Sub AddRange (Of TKey, TValue )(ByVal dic As Dictionary(Of TKey, TValue ), ByVal dicToAdd As IEnumerable (Of KeyValuePair (Of TKey, TValue ))) dicToAdd.ForEach(Sub(x) dic.Add(x.Key, x.Value)) End Sub <System.Runtime.CompilerServices.Extension> _ Public Sub ForEach(Of T)(ByVal source As IEnumerable(Of T), ByVal action As Action(Of T)) For Each item In source action(item) Next item End Sub '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: <System.Runtime.CompilerServices.Extension> _ Public Function Posterize(ByVal color_Renamed As Color, ByVal level As Byte) As Color Dim r As Byte = 0, g As Byte = 0, b As Byte = 0 Dim value As Double = color_Renamed.r \ 255.0 value *= level - 1 value = Math.Round(value) value /= level - 1 r = CByte(value * 255) value = color_Renamed.g \ 255.0 value *= level - 1 value = Math.Round(value) value /= level - 1 g = CByte(value * 255) value = color_Renamed.b \ 255.0 value *= level - 1 value = Math.Round(value) value /= level - 1 b = CByte(value * 255) Return New Color(r, g, b, 255) End Function <System.Runtime.CompilerServices.Extension> _ Public Function GetGroundType(ByVal c As Color, ByVal isPosterized As Boolean) As String Dim mapToUse = If(Program.isDarkened, DarkenedMapColors, mapColors) Dim kvColor As KeyValuePair(Of GroundType, Color) = mapToUse.FirstOrDefault(Function(x)If(isPosterized, x.Value.ColorSimilaryPerc(c) >.9F, x.Value = c)) If Not kvColor.Equals(Nothing) Then Return kvColor.Key.ToString() Else Return c.ToString() End If End Function <System.Runtime.CompilerServices.Extension> _ Public Function GetSimilarColor(ByVal c1 As Color, ByVal cs As IEnumerable(Of Color)) As Color Return cs.OrderBy(Function(x) x.ColorThreshold(c1)).FirstOrDefault() End Function <System.Runtime.CompilerServices.Extension> _ Public Function ColorThreshold(ByVal c1 As Color, ByVal c2 As Color) As Integer Return (Math.Abs(c1.r - c2.r) + Math.Abs(c1.g - c2.g) + Math.Abs(c1.b - c2.b)) End Function <System.Runtime.CompilerServices.Extension> _ Public Function ColorSimilaryPerc(ByVal a As Color, ByVal b As Color) As Single Return 1F - (a.ColorThreshold(b) / (256F * 3)) End Function <System.Runtime.CompilerServices.Extension> _ Public Function RoundColorOff(ByVal c As Color, Optional ByVal roundTo As Byte = 5) As Color Return New Color(c.r.RoundOff(roundTo), c.g.RoundOff(roundTo), c.b.RoundOff(roundTo), 255) End Function <System.Runtime.CompilerServices.Extension> _ Public Function RoundOff(ByVal i As Byte, Optional ByVal roundTo As Byte = 5) As Byte Return CByte(CByte(Math.Ceiling(i / CDbl(roundTo))) * roundTo) End Function <System.Runtime.CompilerServices.Extension> _ Public Iterator Function ToColor(ByVal bmp As Bitmap) As IEnumerable(Of Color) Dim rect As New Rectangle(0, 0, bmp.Width, bmp.Height) Dim bmpData As BitmapData = bmp.LockBits(rect, System.Drawing.Imaging.ImageLockMode.ReadWrite, bmp.PixelFormat) Dim ptr As IntPtr = bmpData.Scan0 Dim bytes As Integer = bmpData.Stride * bmp.Height Dim rgbValues(bytes - 1) As Byte ' Copy the RGB values into the array. Marshal.Copy(ptr, rgbValues, 0, bytes) BmpStride = bmpData.Stride For column As Integer = 0 To bmpData.Height - 1 For row As Integer = 0 To bmpData.Width - 1 ' Little endian Dim b As Byte = CByte(rgbValues((column * BmpStride) + (row * 4))) Dim g As Byte = CByte(rgbValues((column * BmpStride) + (row * 4) + 1)) Dim r As Byte = CByte(rgbValues((column * BmpStride) + (row * 4) + 2)) Yield New Color(r, g, b, 255) Next row Next column ' Unlock the bits. bmp.UnlockBits(bmpData) End Function <System.Runtime.CompilerServices.Extension> _ Public Sub SaveBitmap(ByVal bmp() As Color, ByVal width As Integer, ByVal height As Integer, ByVal path As String) Dim stride As Integer = BmpStride Dim rgbValues((BmpStride * height) - 1) As Byte For column As Integer = 0 To height - 1 For row As Integer = 0 To width - 1 Dim i As Integer = Pn(row, column, width) ' Little endian rgbValues((column * BmpStride) + (row * 4)) = bmp(i).b rgbValues((column * BmpStride) + (row * 4) + 1) = bmp(i).g rgbValues((column * BmpStride) + (row * 4) + 2) = bmp(i).r rgbValues((column * BmpStride) + (row * 4) + 3) = bmp(i).a Next row Next column Using image As New Bitmap(width, height, width * 4, PixelFormat.Format32bppArgb, Marshal.UnsafeAddrOfPinnedArrayElement(rgbValues, 0)) image.Save(path) End Using End Sub Public Function Pn(ByVal x As Integer, ByVal y As Integer, ByVal w As Integer) As Integer Return x + (y * w) End Function End Module Public Module Mathf <System.Runtime.CompilerServices.Extension> _ Public Function Clamp(Of T As IComparable(Of T))(ByVal val As T, ByVal min As T, ByVal max As T) As T If val.CompareTo(min) < 0 Then Return min ElseIf val.CompareTo(max) > 0 Then Return max Else Return val End If End Function ' Interpolates between /a/ and /b/ by /t/. /t/ is clamped between 0 and 1. Public Function Lerp(ByVal a As Single, ByVal b As Single, ByVal t As Single) As Single Return a + (b - a) * Clamp01(t) End Function ' Clamps value between 0 and 1 and returns value Public Function Clamp01(ByVal value As Single) As Single If value < 0F Then Return 0F ElseIf value > 1F Then Return 1F Else Return value End If End Function End Module Namespace zenthion ''' <summary> ''' Struct Color ''' </summary> ''' <seealso cref="System.ICloneable" /> <Serializable> Public Structure Color Implements ICloneable ''' <summary> ''' Clones this instance. ''' </summary> ''' <returns>System.Object.</returns> Public Function Clone() As Object Implements ICloneable.Clone Return MemberwiseClone() End Function ''' <summary> ''' The r ''' </summary> Public r, g, b, a As Byte ''' <summary> ''' Gets the white. ''' </summary> ''' <value>The white.</value> Public Shared ReadOnly Property white() As Color Get Return New Color(255, 255, 255) End Get End Property ''' <summary> ''' Gets the red. ''' </summary> ''' <value>The red.</value> Public Shared ReadOnly Property red() As Color Get Return New Color(255, 0, 0) End Get End Property ''' <summary> ''' Gets the green. ''' </summary> ''' <value>The green.</value> Public Shared ReadOnly Property green() As Color Get Return New Color(0, 255, 0) End Get End Property ''' <summary> ''' Gets the blue. ''' </summary> ''' <value>The blue.</value> Public Shared ReadOnly Property blue() As Color Get Return New Color(0, 0, 255) End Get End Property ''' <summary> ''' Gets the yellow. ''' </summary> ''' <value>The yellow.</value> Public Shared ReadOnly Property yellow() As Color Get Return New Color(255, 255, 0) End Get End Property ''' <summary> ''' Gets the gray. ''' </summary> ''' <value>The gray.</value> Public Shared ReadOnly Property gray() As Color Get Return New Color(128, 128, 128) End Get End Property ''' <summary> ''' Gets the black. ''' </summary> ''' <value>The black.</value> Public Shared ReadOnly Property black() As Color Get Return New Color(0, 0, 0) End Get End Property ''' <summary> ''' Gets the transparent. ''' </summary> ''' <value>The transparent.</value> Public Shared ReadOnly Property transparent() As Color Get Return New Color(0, 0, 0, 0) End Get End Property ''' <summary> ''' Initializes a new instance of the <see cref="Color"/> struct. ''' </summary> ''' <param name="r">The r.</param> ''' <param name="g">The g.</param> ''' <param name="b">The b.</param> Public Sub New(ByVal r As Byte, ByVal g As Byte, ByVal b As Byte) Me.r = r Me.g = g Me.b = b a = Byte.MaxValue End Sub ''' <summary> ''' Initializes a new instance of the <see cref="Color"/> struct. ''' </summary> ''' <param name="r">The r.</param> ''' <param name="g">The g.</param> ''' <param name="b">The b.</param> ''' <param name="a">a.</param> Public Sub New(ByVal r As Byte, ByVal g As Byte, ByVal b As Byte, ByVal a As Byte) Me.r = r Me.g = g Me.b = b Me.a = a End Sub ''' <summary> ''' Implements the ==. ''' </summary> ''' <param name="c1">The c1.</param> ''' <param name="c2">The c2.</param> ''' <returns>The result of the operator.</returns> Public Shared Operator =(ByVal c1 As Color, ByVal c2 As Color) As Boolean Return c1.r = c2.r AndAlso c1.g = c2.g AndAlso c1.b = c2.b AndAlso c1.a = c2.a End Operator ''' <summary> ''' Implements the !=. ''' </summary> ''' <param name="c1">The c1.</param> ''' <param name="c2">The c2.</param> ''' <returns>The result of the operator.</returns> Public Shared Operator <>(ByVal c1 As Color, ByVal c2 As Color) As Boolean Return Not(c1.r = c2.r AndAlso c1.g = c2.g AndAlso c1.b = c2.b AndAlso c1.a = c2.a) End Operator ''' <summary> ''' Returns a hash code for this instance. ''' </summary> ''' <returns>A hash code for this instance, suitable for use in hashing algorithms and data structures like a hash table.</returns> Public Overrides Function GetHashCode() As Integer Return GetHashCode() End Function ''' <summary> ''' Determines whether the specified <see cref="System.Object" /> is equal to this instance. ''' </summary> ''' <param name="obj">The <see cref="System.Object" /> to compare with this instance.</param> ''' <returns><c>true</c> if the specified <see cref="System.Object" /> is equal to this instance; otherwise, <c>false</c>.</returns> Public Overrides Function Equals(ByVal obj As Object) As Boolean Dim c As Color = DirectCast(obj, Color) Return r = c.r AndAlso g = c.g AndAlso b = c.b End Function ''' <summary> ''' Implements the -. ''' </summary> ''' <param name="c1">The c1.</param> ''' <param name="c2">The c2.</param> ''' <returns>The result of the operator.</returns> Public Shared Operator -(ByVal c1 As Color, ByVal c2 As Color) As Color 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))) End Operator ''' <summary> ''' Implements the +. ''' </summary> ''' <param name="c1">The c1.</param> ''' <param name="c2">The c2.</param> ''' <returns>The result of the operator.</returns> Public Shared Operator +(ByVal c1 As Color, ByVal c2 As Color) As Color 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))) End Operator ''' <summary> ''' Lerps the specified c2. ''' </summary> ''' <param name="c2">The c2.</param> ''' <param name="t">The t.</param> ''' <returns>Color.</returns> Public Function Lerp(ByVal c2 As Color, ByVal t As Single) As Color Return New Color(CByte(Mathf.Lerp(r, c2.r, t)), CByte(Mathf.Lerp(g, c2.g, t)), CByte(Mathf.Lerp(b, c2.b, t))) End Function ''' <summary> ''' Inverts this instance. ''' </summary> ''' <returns>Color.</returns> Public Function Invert() As Color 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))) End Function ''' <summary> ''' Returns a <see cref="System.String" /> that represents this instance. ''' </summary> ''' <returns>A <see cref="System.String" /> that represents this instance.</returns> Public Overrides Function ToString() As String If Me = white Then Return "white" ElseIf Me = transparent Then Return "transparent" ElseIf Me = red Then Return "red" ElseIf Me = blue Then Return "blue" ElseIf Me = black Then Return "black" ElseIf Me = green Then Return "green" ElseIf Me = yellow Then Return "yellow" Else Return String.Format("({0}, {1}, {2}, {3})", r, g, b, a) End If End Function ''' <summary> ''' Fills the specified x. ''' </summary> ''' <param name="x">The x.</param> ''' <param name="y">The y.</param> ''' <returns>Color[].</returns> Public Shared Iterator Function Fill(ByVal x As Integer, ByVal y As Integer) As IEnumerable(Of Color) For i As Integer = 0 To (x * y) - 1 Yield black Next i End Function End Structure End Namespace
Nota: A pesar de haber sido convertido con un conversor se ha comprobado en: https://dotnetfiddle.net/1vbkgGNota2: 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: 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.
|
|
« Última modificación: 18 Octubre 2018, 19:57 pm por z3nth10n »
|
En línea
|
⏩ Interesados hablad por Discord.
|
|
|
Serapis
|
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... // 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) // 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)... // 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... 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
Mensajes: 1.583
"Jack of all trades, master of none." - Zenthion
|
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
Mensajes: 9.866
|
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.
<System.Runtime.CompilerServices.Extension> _ Public Iterator Function ToColor(ByVal bmp As Bitmap) As IEnumerable(Of Color) Dim rect As New Rectangle(0, 0, bmp.Width, bmp.Height) Dim bmpData As BitmapData = bmp.LockBits(rect, System.Drawing.Imaging.ImageLockMode.ReadWrite, bmp.PixelFormat) Dim ptr As IntPtr = bmpData.Scan0 Dim bytes As Integer = bmpData.Stride * bmp.Height Dim rgbValues(bytes - 1) As Byte ' Copy the RGB values into the array. Marshal.Copy(ptr, rgbValues, 0, bytes) BmpStride = bmpData.Stride For column As Integer = 0 To bmpData.Height - 1 For row As Integer = 0 To bmpData.Width - 1 ' Little endian Dim b As Byte = CByte(rgbValues((column * BmpStride) + (row * 4))) Dim g As Byte = CByte(rgbValues((column * BmpStride) + (row * 4) + 1)) Dim r As Byte = CByte(rgbValues((column * BmpStride) + (row * 4) + 2)) Yield New Color(r, g, b, 255) Next row Next column ' Unlock the bits. bmp.UnlockBits(bmpData) End Function <System.Runtime.CompilerServices.Extension> _ Public Sub SaveBitmap(ByVal bmp() As Color, ByVal width As Integer, ByVal height As Integer, ByVal path As String) Dim stride As Integer = BmpStride Dim rgbValues((BmpStride * height) - 1) As Byte For column As Integer = 0 To height - 1 For row As Integer = 0 To width - 1 Dim i As Integer = Pn(row, column, width) ' Little endian rgbValues((column * BmpStride) + (row * 4)) = bmp(i).b rgbValues((column * BmpStride) + (row * 4) + 1) = bmp(i).g rgbValues((column * BmpStride) + (row * 4) + 2) = bmp(i).r rgbValues((column * BmpStride) + (row * 4) + 3) = bmp(i).a Next row Next column Using image As New Bitmap(width, height, width * 4, PixelFormat.Format32bppArgb, Marshal.UnsafeAddrOfPinnedArrayElement(rgbValues, 0)) image.Save(path) End Using End Sub Public Function Pn(ByVal x As Integer, ByVal y As Integer, ByVal w As Integer) As Integer Return x + (y * w) End Function End Module
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... 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: 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: Public Iterator Function GetColors(ByVal bmp As Bitmap) As IEnumerable(Of Color) ' Lock the bitmap bits. Dim pixelFormat As PixelFormat = PixelFormat.Format32bppArgb Dim bytesPerPixel As Integer = 4 ' PixelFormat.Format32bppArgb Dim rect As New Rectangle(Point.Empty, bmp.Size) Dim bmpData As BitmapData = bmp.LockBits(rect, ImageLockMode.ReadOnly, pixelFormat) ' Get the address of the first row. Dim address As IntPtr = bmpData.Scan0 ' Hold the raw bytes of the bitmap. Dim numBytes As Integer = (Math.Abs(bmpData.Stride) * rect.Height) Dim rawImageData As Byte() = New Byte(numBytes - 1) {} Marshal.Copy(address, rawImageData, 0, numBytes) ' Unlock the bitmap bits. bmp.UnlockBits(bmpData) ' Iterate the pixels. For i As Integer = 0 To (rawImageData.Length - bytesPerPixel) Step bytesPerPixel Yield Color.FromArgb(alpha:=rawImageData(i + 3), red:=rawImageData(i + 2), green:=rawImageData(i + 1), blue:=rawImageData(i)) Next i 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
|
|
|
|
|
Mensajes similares |
|
Asunto |
Iniciado por |
Respuestas |
Vistas |
Último mensaje |
|
|
Librería de Snippets en C/C++
« 1 2 3 4 »
Programación C/C++
|
z3nth10n
|
31
|
25,808
|
2 Agosto 2013, 17:13 pm
por 0xDani
|
|
|
[APORTE] [VBS] Snippets para manipular reglas de bloqueo del firewall de Windows
Scripting
|
Eleкtro
|
1
|
4,067
|
3 Febrero 2014, 20:19 pm
por Eleкtro
|
|
|
Librería de Snippets para Delphi
« 1 2 »
Programación General
|
crack81
|
15
|
21,044
|
25 Marzo 2016, 18:39 pm
por crack81
|
|
|
Una organización en Github para subir, proyectos, snippets y otros?
Sugerencias y dudas sobre el Foro
|
z3nth10n
|
0
|
3,065
|
21 Febrero 2017, 10:47 am
por z3nth10n
|
|
|
índice de la Librería de Snippets para VB.NET !!
.NET (C#, VB.NET, ASP)
|
Eleкtro
|
7
|
6,506
|
4 Julio 2018, 21:35 pm
por Eleкtro
|
|