Rounding the colors found to the specified palette colors

Question

I find the dominant colors in a picture with the help of the codes below.

> Public Class baskinrenkler
> 
>     Public Items As New Collection
> 
>     Public Sub AddItem(ByVal R As Integer, ByVal G As Integer, ByVal B As Integer, ByVal Count As Single)
>         If (R = 0 And G = 0 And B = 0) Or (R >= 25 And G >= 25 And B >= 25) Then
>             Exit Sub
>         End If
>         For Each i As RGBItem In Items
>             If i.R = R And i.G = G And i.B = B Then
>                 i.Count += Count
>                 Exit Sub
>             End If
>         Next
>         Dim i2 As New RGBItem(R, G, B, Count)
>         Items.Add(i2)
>     End Sub
> 
>     Public Function GetDominantColor(ByVal Image As Bitmap) As Color
>         If Image Is Nothing Then
>             Return Color.White
>         End If
>         For i As Integer = 0 To Image.Width - 1
>             For j As Integer = 0 To Image.Height - 1
>                 Dim c As Color = Image.GetPixel(i, j)
>                 If c.A = 255 Then
>                     AddItem(c.R / 10, c.G / 10, c.B / 10, c.A / 255)
>                 End If
>             Next
>         Next
>         If Items.Count = 0 Then
>             Return Color.White
>         End If
>         Dim Dominant As RGBItem = Items(1)
>         For Each i As RGBItem In Items
>             If i.Count > Dominant.Count Then
>                 Dominant = i
>             End If
>         Next
>         Return Dominant.ReturnColor
>     End Function End Class
> 
> 
> Public Class RGBItem
>     Public R As Integer
>     Public G As Integer
>     Public B As Integer
> 
>     Public Count As Single = 0
> 
>     Public Sub New(ByVal R1 As Integer, ByVal G1 As Integer, ByVal B1 As Integer, ByVal Count1 As Single)
>         R = R1
>         G = G1
>         B = B1
>         Count = Count1
>     End Sub
> 
>     Public Function ReturnColor() As Color
>         Dim R1 As Integer = 10 * R
>         Dim G1 As Integer = 10 * G
>         Dim B1 As Integer = 10 * B
>         If R1 > 255 Then
>             R1 = 255
>         End If
>         If G1 > 255 Then
>             G1 = 255
>         End If
>         If B1 > 255 Then
>             B1 = 255
>         End If
>         Return Color.FromArgb(R1, G1, B1)
>     End Function 
End Class

my first question:

I want to increase the number of dominant colors to 3 as in the link below
https://www.imgonline.com.ua/eng/get-dominant-colors.php

my second question:

I'll create the palette like the one below and round every color I find to the appropriate color in this palette. Like this

https://www.google.com/search?q=dominant+color&rlz=1C1GCEA_enTR804TR804&sxsrf=ALeKk01MmqvPI0eHRVgI5qPRA6MbFnxYrw:1598339294733&tbm=isch&source=iu&ictx=1&fir=lGdBd6WrwgizsM%252CFnH5HyKe40YvtM%252C_&vet=1&usg=AI4_-kR2X6baHXUSptz35ivGDYRdH3MwlA&sa=X&ved=2ahUKEwjtkZLv5bXrAhXGh1wKHWiFBWEQ_h0wAXoECAkQBg#imgrc=lGdBd6WrwgizsM

---

and these codes must be in vb I'm using vs2010.

how can I do that?. Thank you in advance for your help

*

Answer 1

I want to increase the number of dominant colors to 3

Modify the function that searches the list for the max-by-count color to instead be sorted by count, take the first X

This parameterizes the number of colors to take:

Public Function GetDominantColors(ByVal image As Bitmap, Dim numberOfDominants as Int32) As Color()
    If image Is Nothing Then
        Return Color.White
    End If
    For i As Integer = 0 To Image.Width - 1
        For j As Integer = 0 To Image.Height - 1
            Dim c As Color = Image.GetPixel(i, j)
            If c.A = 255 Then
                AddItem(c.R / 10, c.G / 10, c.B / 10, c.A / 255)
            End If
        Next
    Next
    If Items.Count = 0 Then
        Return Color.White
    End If

    Return Items _
      .OrderByDescending(Function(x) x.Count) _ 
      .Select(Function(x) x.ReturnColor) _
      .Take(numberOfDominants) _
      .ToArray()

End Function

Per the comments, change your Items to be a List(Of RGBColor) rather than a Collection

Note that calling GetPixel in each pixel in an image is really slow, because it locks and unlocks for every pixel. You can get better performance by locking larger portions of the image and treating them like an array. See for example https://www.codeproject.com/tips/240973/work-with-bitmaps-faster-in-csharp or Replace Bitmap.GetPixel usage in algorithm for LockBits

---

Couldn't understand your second question; sounds like you want to change colors to be "nearest to a set of colors" - i.e. the sort of operation a paint program would carry out to reduce a 16 million color image to 256 colors. This is not a trivial thing to do in a way that looks right - a good deal of it relates to human psychology of color perception as to whether one color is "close to" another. Perhaps look for something where someone has already invented that wheel, imagemagick might be helpful

Answer 2

There is not necessary you have a lot of code as you can do that only in a function (like code below shows) The idea is to have all pixel/colors in a list then grouping by color having count of matches. Then order this list by count of element to have at the top the most used colors. The second parameter is the number of top colors you want to detect. I hope is what you want.

Public Function GetDominantColors(ByVal Image As Bitmap, topColors As Integer) As List(Of Color)


    If Image Is Nothing Then
        Return New List(Of Color) From {Color.White}
    End If

    Dim listOfColors = New List(Of Color)
    For i As Integer = 0 To Image.Width - 1
        For j As Integer = 0 To Image.Height - 1
            listOfColors.Add(Image.GetPixel(i, j))
        Next
    Next

    Dim mostUsed = From colors In listOfColors
                   Where colors <> Color.Transparent
                   Where colors <> Color.White
                   Where colors <> Color.Black
                   Group By colore = colors Into Group, length = Count
                   Order By length Descending
                   Select colore, length
                   Take topColors



    Dim finalList As List(Of Color) = New List(Of Color)

    For Each currentC In mostUsed
        finalList.Add(currentC.colore)
        Console.WriteLine("color:" & currentC.colore.Name & " matches: " & currentC.length)
    Next

    Return finalList

End Function

Usage:

Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load



    Dim img = Image.FromFile("C:\Users\MyUser\Pictures\test.png")
    Dim mostUsed As List(Of Color) = GetDominantColors(New Bitmap(img), 10)

    For i As Integer = 0 To mostUsed.Count - 1

        Me.Controls.Add(New Label With {
            .TextAlign = ContentAlignment.MiddleCenter,
            .Text = mostUsed(i).Name,
            .BackColor = mostUsed(i),
            .Location = New Point(10, i * 30)
        })
    Next


End Sub

Answer 3

Public Class baskinrenkler

    Public Items As New Collection

    Public Sub AddItem(ByVal R As Integer, ByVal G As Integer, ByVal B As Integer, ByVal Count As Single)
        If (R = 0 And G = 0 And B = 0) Or (R >= 25 And G >= 25 And B >= 25) Then
            Exit Sub
        End If
        For Each i As RGBItem In Items
            If i.R = R And i.G = G And i.B = B Then
                i.Count += Count
                Exit Sub
            End If
        Next
        Dim i2 As New RGBItem(R, G, B, Count)
        Items.Add(i2)
    End Sub

    Public Function GetDominantColors(ByVal Image As Bitmap, ByVal topColors As Integer) As List(Of Color)


        If Image Is Nothing Then
            Return New List(Of Color) From {Color.White}
        End If

        Dim listOfColors = New List(Of Color)
        For i As Integer = 0 To Image.Width - 1
            For j As Integer = 0 To Image.Height - 1
                listOfColors.Add(renkgamut(FindNearestColor(renkgamut, Image.GetPixel(i, j))))
            Next
        Next

        Dim mostUsed = From colors In listOfColors
                       Where colors <> Color.Transparent
                       Where colors <> Color.White
                       Where colors <> Color.Black
                       Group By colore = colors Into Group, length = Count()
                       Order By length Descending
                       Select colore, length
                       Take topColors



        Dim finalList As List(Of Color) = New List(Of Color)

        For Each currentC In mostUsed
            finalList.Add(currentC.colore)
            Console.WriteLine("color:" & currentC.colore.Name & " matches: " & currentC.length)
        Next

        Return finalList

    End Function

    Public renkgamut As Color() = _
                 {
ColorTranslator.FromHtml("#050000"), ColorTranslator.FromHtml("#EC407A"), ColorTranslator.FromHtml("#4A148C"), ColorTranslator.FromHtml("#303F9F"), ColorTranslator.FromHtml("#2196F3"), ColorTranslator.FromHtml("#18FFFF"), ColorTranslator.FromHtml("#43A047"), ColorTranslator.FromHtml("#FFEB3B"), ColorTranslator.FromHtml("#FB8C00"), ColorTranslator.FromHtml("#EFEBE9"), ColorTranslator.FromHtml("#6D4C41"), ColorTranslator.FromHtml("#BDBDBD"), ColorTranslator.FromHtml("#000000"), ColorTranslator.FromHtml("#1A237E"), ColorTranslator.FromHtml("#FFFFFF")
                 }




    Public Function FindNearestColor(ByVal map As Color(), ByVal current As Color) As Integer
        Dim shortestDistance As Integer
        Dim index As Integer
        index = -1
        shortestDistance = Integer.MaxValue

        For i As Integer = 0 To map.Length - 1
            Dim match As Color
            Dim distance As Integer
            match = map(i)
            distance = GetDistance(current, match)

            If distance < shortestDistance Then
                index = i
                shortestDistance = distance
            End If
        Next

        Return index
    End Function

    Public Shared Function GetDistance(ByVal current As Color, ByVal match As Color) As Integer

        Dim redDifference As Integer
        Dim greenDifference As Integer
        Dim blueDifference As Integer
        Dim alphaDifference As Integer
        alphaDifference = CInt(current.A) - CInt(match.A)
        redDifference = CInt(current.R) - CInt(match.R)
        greenDifference = CInt(current.G) - CInt(match.G)
        blueDifference = CInt(current.B) - CInt(match.B)
        Return alphaDifference * alphaDifference + redDifference * redDifference + greenDifference * greenDifference + blueDifference * blueDifference
    End Function

    Function collectionToArray(ByVal c As Collection) As Object()
        Dim a() As Object : ReDim a(0 To c.Count - 1)
        Dim i As Integer
        For i = 1 To c.Count
            a(i - 1) = c.Item(i)
        Next
        collectionToArray = a
    End Function
End Class


Public Class RGBItem
    Public R As Integer
    Public G As Integer
    Public B As Integer

    Public Count As Single = 0

    Public Sub New(ByVal R1 As Integer, ByVal G1 As Integer, ByVal B1 As Integer, ByVal Count1 As Single)
        R = R1
        G = G1
        B = B1
        Count = Count1
    End Sub

    Public Function ReturnColor() As Color
        Dim R1 As Integer = 10 * R
        Dim G1 As Integer = 10 * G
        Dim B1 As Integer = 10 * B
        If R1 > 255 Then
            R1 = 255
        End If
        If G1 > 255 Then
            G1 = 255
        End If
        If B1 > 255 Then
            B1 = 255
        End If
        Return Color.FromArgb(R1, G1, B1)
    End Function




End Class