Imports System.Buffers
Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.Drawing.Imaging
Imports System.IO
Imports System.Runtime.CompilerServices
Imports System.Runtime.InteropServices
Public Module BitmapExtensions
''' <summary>
''' Precomputed look-up table that maps each sRGB encoded byte value [0, 255]
''' to its corresponding linear-light (physical) value in the range [0.0, 1.0].
''' </summary>
'''
''' <remarks>
''' Used by function: <see cref="BitmapExtensions.ComputeAverageLightness(Bitmap, Byte)"/>
''' to convert sRGB pixel values to linear light for accurate luminance calculations.
''' </remarks>
Private LinearSrgbLut As IReadOnlyList(Of Double)
''' <summary>
''' Computes the average CIE L* lightness of the specified <see cref="Bitmap"/>.
''' <para></para>
''' The bitmap must use <see cref="PixelFormat.Format32bppArgb"/> layout;
''' any other format will raise a <see cref="NotSupportedException"/>.
''' <para></para>
''' For arbitrary bitmaps, prefer <see cref="ImageExtensions.ComputeAverageLightness"/> function,
''' which handles proper <see cref="Bitmap"/> format conversion automatically.
''' </summary>
'''
''' <param name="bitmap">
''' Source bitmap in <see cref="PixelFormat.Format32bppArgb"/> format.
''' </param>
'''
''' <param name="alphaThreshold">
''' Optional alpha threshold below which a pixel is considered fully transparent and excluded from the lightness average.
''' <para></para>
''' Range: 0–255. A value of 0 includes all pixels; 255 includes only fully opaque pixels.
''' <para></para>
''' Default value is 8.
''' </param>
'''
''' <returns>
''' Average CIE L* value in the range [0.0, 100.0], or 0.0 if all pixels are below the alpha threshold.
''' </returns>
<Extension>
Public Function ComputeAverageLightness(sourceBitmap As Bitmap, Optional alphaThreshold As Byte = 8) As Double
#If NETCOREAPP Then
ArgumentNullException.ThrowIfNull(sourceBitmap)
#Else
If bitmap Is Nothing Then
Throw New ArgumentNullException(NameOf(bitmap))
End If
#End If
If sourceBitmap.PixelFormat <> PixelFormat.Format32bppArgb Then
Throw New NotSupportedException(
$"Expected PixelFormat {NameOf(PixelFormat.Format32bppArgb)}, got {sourceBitmap.PixelFormat}.")
End If
' ITU-R BT.709 standard coefficients for relative luminance (Y)
' These weights reflect human visual sensitivity to RGB channels.
Const LumaR As Double = 0.2126R
Const LumaG As Double = 0.7152R
Const LumaB As Double = 0.0722R
' CIE L* (Lightness) formula constants
' Used to transform relative luminance (Y) into perceptual lightness (L*).
Const LStarScale As Double = 116.0R
Const LStarOffset As Double = 16.0R
If BitmapExtensions.LinearSrgbLut Is Nothing Then
BitmapExtensions.LinearSrgbLut = UtilColor.BuildLinearSRGBLookupTable()
End If
Dim rect As New Rectangle(0, 0, sourceBitmap.Width, sourceBitmap.Height)
Dim bmpData As BitmapData = sourceBitmap.LockBits(rect, ImageLockMode.ReadOnly, PixelFormat.Format32bppArgb)
Dim pixels As Byte() = Nothing
Try
Dim stride As Integer = bmpData.Stride
If stride <= 0 Then
Throw New NotSupportedException("Negative or zero stride is not supported.")
End If
Dim bufferSize As Integer = stride * sourceBitmap.Height
pixels = ArrayPool(Of Byte).Shared.Rent(bufferSize)
Marshal.Copy(bmpData.Scan0, pixels, 0, bufferSize)
Dim totalL As Double = 0.0R
Dim pixelCount As Long = 0L
Dim y As Integer
For y = 0 To sourceBitmap.Height - 1
Dim rowOffset As Integer = y * stride
Dim x As Integer
For x = 0 To sourceBitmap.Width - 1
Dim idx As Integer = rowOffset + (x * 4)
' Format32bppArgb byte layout: B=idx+0, G=idx+1, R=idx+2, A=idx+3
Dim alpha As Byte = pixels(idx + 3)
If alpha <= alphaThreshold Then
Continue For
End If
Dim r As Byte = pixels(idx + 2)
Dim g As Byte = pixels(idx + 1)
Dim b As Byte = pixels(idx)
' Step 1: Calculate CIE Relative Luminance (Y) using the LUT
' This represents the physical light intensity.
Dim relY As Double =
(BitmapExtensions.LinearSrgbLut(r) * LumaR) +
(BitmapExtensions.LinearSrgbLut(g) * LumaG) +
(BitmapExtensions.LinearSrgbLut(b) * LumaB)
' Step 2: Calculate Perceptual Lightness (L*)
' This transforms physical light into human perceived brightness [0-100].
' Note: ComputeLabF FUNCTION applies the cube root or linear slope per CIE specs.
totalL += (LStarScale * UtilColor.ComputeLabF(relY)) - LStarOffset
pixelCount += 1L
Next
Next
Return If(pixelCount = 0L, 0.0R, totalL / pixelCount)
Finally
sourceBitmap.UnlockBits(bmpData)
If pixels IsNot Nothing Then
ArrayPool(Of Byte).Shared.Return(pixels, clearArray:=False)
End If
End Try
End Function
End Module
Public Module ImageExtensions
''' <summary>
''' Computes the average CIE L* lightness of the specified <see cref="Image"/>.
''' </summary>
'''
''' <param name="bitmap">
''' Source bitmap in <see cref="PixelFormat.Format32bppArgb"/> format.
''' </param>
'''
''' <param name="alphaThreshold">
''' Optional alpha threshold below which a pixel is considered fully transparent and excluded from the lightness average.
''' <para></para>
''' Range: 0–255. A value of 0 includes all pixels; 255 includes only fully opaque pixels.
''' <para></para>
''' Default value is 8.
''' </param>
'''
''' <returns>
''' Average CIE L* value in the range [0.0, 100.0], or 0.0 if all pixels are below the alpha threshold.
''' </returns>
<Extension>
Public Function ComputeAverageLightness(sourceImage As Image, Optional alphaThreshold As Byte = 8) As Double
#If NETCOREAPP Then
ArgumentNullException.ThrowIfNull(sourceImage)
#Else
If sourceImage Is Nothing Then
Throw New ArgumentNullException(NameOf(sourceImage))
End If
#End If
Dim bmp As Bitmap = TryCast(sourceImage, Bitmap)
Dim mustDispose As Boolean = False
If bmp Is Nothing OrElse bmp.PixelFormat <> PixelFormat.Format32bppArgb Then
bmp = New Bitmap(sourceImage.Width, sourceImage.Height, PixelFormat.Format32bppArgb)
Using gfx As Graphics = Graphics.FromImage(bmp)
gfx.CompositingMode = CompositingMode.SourceCopy
gfx.InterpolationMode = InterpolationMode.NearestNeighbor
gfx.PixelOffsetMode = PixelOffsetMode.HighSpeed
gfx.CompositingQuality = CompositingQuality.HighSpeed
gfx.DrawImage(sourceImage, 0, 0, sourceImage.Width, sourceImage.Height)
End Using
mustDispose = True
End If
Try
Return BitmapExtensions.ComputeAverageLightness(bmp, alphaThreshold)
Finally
If mustDispose Then
bmp.Dispose()
End If
End Try
End Function
End Module
Public Class UtilImage
''' <summary>
''' Computes the average CIE L* lightness of the specified image file.
''' </summary>
'''
''' <example> This is a code example.
''' <code language="VB">
''' Dim imageFile As String = "C:\Wallpaper.jpg"
''' Dim avgLightness As Double = UtilImage.ComputeAverageLightness(imageFile)
'''
''' Console.WriteLine($"Image File: {Path.GetFileName(imageFile)}")
''' Console.WriteLine($"Average Lightness (CIE L*): {(avgLightness / 100.0R):P2}")
''' </code>
''' </example>
'''
''' <param name="filePath">
''' Full path to the source image file.
''' </param>
'''
''' <param name="alphaThreshold">
''' Optional alpha threshold below which a pixel is considered fully transparent and excluded from the lightness average.
''' <para></para>
''' Range: 0–255. A value of 0 includes all pixels; 255 includes only fully opaque pixels.
''' <para></para>
''' Default value is 8.
''' </param>
'''
''' <returns>
''' Average CIE L* value in the range [0.0, 100.0], or 0.0 if all pixels are below the alpha threshold.
''' </returns>
Public Shared Function ComputeAverageLightness(filePath As String, Optional alphaThreshold As Byte = 8) As Double
Using sourceStream As New FileStream(filePath, IO.FileMode.Open, IO.FileAccess.Read, IO.FileShare.Read)
Using sourceImage As Image = Image.FromStream(sourceStream, useEmbeddedColorManagement:=False, validateImageData:=True)
Return ImageExtensions.ComputeAverageLightness(sourceImage, alphaThreshold)
End Using
End Using
End Function
End Class
Public Class UtilColor
''' <summary>
''' Applies the CIE XYZn to L*a*b* (CIELAB) transfer function (also known as the f-function)
''' used in the conversion from relative luminance (<c>Y</c>) to perceptual lightness (<c>L*</c>).
''' </summary>
'''
''' <example> This example shows how to calculate the Perceptual Lightness (<c>L*</c>) of a 18% "Middle Gray" value:
''' <code language="VB">
''' Dim relativeY As Double = 0.18R ' 18% reflectance
''' Dim fValue As Double = ComputeLabF(relativeY)
'''
''' ' Formula for L* (Lightness): 116 * f(Y) - 16
''' Dim lightness As Double = (116.0R * fValue) - 16.0R
'''
''' Console.WriteLine($"Relative Luminance (Y): {relativeY}")
''' Console.WriteLine($"Perceptual Lightness (L*): {lightness:F2}")
''' </code>
''' </example>
'''
''' <param name="value">
''' The relative luminance (<c>Y</c>) or color component, expected in the normalized range <c>[0.0, 1.0]</c>.
''' </param>
'''
''' <returns>
''' The transformed value <c>f(Y)</c> to be used in <c>L*</c>, <c>a*</c>, or <c>b*</c> calculations.
''' </returns>
'''
''' <remarks>
''' This function is part of the CIE L*a*b* (CIELAB) color space definition.
''' It models how humans perceive brightness differences.
''' <para></para>
'''
''' The constants used by this function are defined by the CIE (International Commission on Illumination):
''' <para></para>
''' - <b>Epsilon (ε)</b>: The transition point between linear and non-linear behavior, calculated as <c>(6/29)^3 ≈ 0.008856</c>.
''' <para></para>
''' - <b>Kappa (κ)</b>: The slope of the linear segment near black, calculated as <c>(29/3)^3 ≈ 903.3</c>.
''' <para></para>
'''
''' For more technical details, see:
''' <para></para>
''' <see href="https://en.wikipedia.org/wiki/CIELAB_color_space#Forward_transformation"/>
''' <para></para>
''' <see href="https://en.wikipedia.org/wiki/Relative_luminance"/>
''' </remarks>
<DebuggerStepThrough>
Public Shared Function ComputeLabF(value As Double) As Double
Const Epsilon As Double = 0.008856R
Const Kappa As Double = 903.3R
' CIE L* (L-Star / Lightness) formula constants
Const LStarScale As Double = 116.0R
Const LStarOffset As Double = 16.0R
' If the value is above Epsilon, we use the power function (cube root).
' If the value is below Epsilon, we use a linear slope (Kappa) to avoid
' infinite gradients at the zero point, and handle image noise better.
Return If(value > Epsilon,
Math.Pow(value, 1.0R / 3.0R),
(Kappa * value + LStarOffset) / LStarScale)
End Function
''' <summary>
''' Precomputes a look-up table (LUT) containing the linearized sRGB values [0.0, 1.0] for each possible 8-bit channel value [0, 255].
''' </summary>
'''
''' <example>
''' This example demonstrates how to use the look-up table (LUT) to linearize a standard 8-bit RGB channel value:
''' <code language="VB">
''' Dim lut As IReadOnlyList(Of Double) = BuildLinearSRGBLookupTable()
'''
''' ' Get the linear intensity of a middle-gray byte (127)
''' Dim grayByte As Integer = 127
''' Dim linearLight As Double = lut(grayByte)
'''
''' ' Output the result (approx. 0.21 or 21% light intensity)
''' Console.WriteLine($"Byte Value: {grayByte}")
''' Console.WriteLine($"Linear Light Intensity: {linearLight:P2}")
''' </code>
''' </example>
'''
''' <returns>
''' A readon-only list of 256 <see cref="Double"/> values representing normalized linear light intensities in the range [0.0, 1.0].
''' </returns>
'''
''' <remarks>
''' Standard digital images (sRGB) are gamma-corrected to optimize bit depth for human perception.
''' Before performing any physical light calculations (like luminosity), we must "undo" this correction.
''' This process is known as <b>Gamma Expansion</b>.
''' <para></para>
''' For more technical details, see: <see href="https://en.wikipedia.org/wiki/SRGB#The_forward_transformation_(gamma_compression)"/>
''' </remarks>
<DebuggerStepThrough>
Public Shared Function BuildLinearSRGBLookupTable() As IReadOnlyList(Of Double)
' sRGB Standard Constants
' The exponent used for the power-law (gamma) section.
' While often simplified to 2.2, the official sRGB standard uses 2.4.
Const GammaExponent As Double = 2.4R
' The threshold that separates the linear slope from the curve.
Const GammaThreshold As Double = 0.04045R
' The divisor used for the linear segment near black.
Const LinearSlope As Double = 12.92R
' The offset (magic number) used to align the linear and curve segments.
Const Offset As Double = 0.055R
Dim lut As Double() = New Double(255) {}
For i As Integer = 0 To 255
' Normalize the 8-bit integer [0, 255] to a double [0.0, 1.0]
Dim v As Double = i / 255.0R
' The "Piecewise" function:
' If the value is very dark (below threshold), use a simple linear division;
' Otherwise, use the exponential formula (Gamma Expansion).
lut(i) = If(v <= GammaThreshold,
v / LinearSlope,
Math.Pow((v + Offset) / (1.0R + Offset), GammaExponent))
Next
Return Array.AsReadOnly(lut)
End Function
End Class
Autor
En línea
