GTA-CountColors to VB.NET | C# Online Compiler

GTA-CountColors to VB.NET by z3nth10n

'INSTANT VB NOTE: This code snippet uses implicit typing. You will need to set 'Option Infer On' in the VB file or set 'Option Infer' at the project level.

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)
		Dim count As New 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

​x
 
'INSTANT VB NOTE: This code snippet uses implicit typing. You will need to set 'Option Infer On' in the VB file or set 'Option Infer' at the project level.
​
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)
        Dim count As New 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

View IL Code