The color wheel main program has a loop that is controlled by the number of colors or number of segments to be drawn. The key question now is really the point of the whole program, what is the scheme for mixing colors? Our first test subroutine uses a random number generator. This shows the loop in simple form. Each time through the loop a random number between 0 and 255 is generated for each of the RGB values. The wheel can be any size, even hundreds of segments, and it can cover any angle of revolution. This is not the standard color wheel which has definite rules for placing colors.
Sub testwheel1() Call connect_acad Dim i As Integer Dim numcolors As Integer Dim angl_rev As Double Dim r1 As Double, r2 As Double Dim a1 As Double, a2 As Double, a_inc As Double Dim i_r As Integer, i_g As Integer, i_b As Integer 'parameters to be input from a user form numcolors = 18 angl_rev = 360 a1 = 0 'start angle r1 = 6 'interior radius r2 = 12 'outside radius a_inc = angl_rev / numcolors a2 = a1 + a_inc For i = 1 To numcolors 'random number generators for RGB values i_r = Int((255 - 0 + 1) * Rnd + 0) i_g = Int((255 - 0 + 1) * Rnd + 0) i_b = Int((255 - 0 + 1) * Rnd + 0) THIS IS ANNOYING AS CRAP WHAT THE WORDPRESS EDITOR DOES TO QUOTED STRINGS IN THE CODE Debug.Print i & ", " & i_r & ", " & i_g & ", " & i_b Call makeslice(r1, r2, a1, a2, i_r, i_g, i_b) a1 = a1 + a_inc a2 = a1 + a_inc Next i Update End Sub
The standard color wheel has a definite pattern. The 3 primary colors are evenly spaced around the wheel at 120 degrees. Midway between them is a pure blend where each of the primary colors is mixed full strength.
The most common wheel has 12 colors, but any number can be used, the wheel keeps the same colors in the same locations, there are just more transition colors between them.
No matter how many colors are used, an array can be used to hold the RGB values. There is an array for each of the RGB components. They have the same data in the same order, but each array is shifted one third the length of the array from the previous array. The data “shift” is the number of colors divided by 3.
here is the final test version of the standard color wheel
Sub test_stdwheel_1() Call connect_acad Dim i As Integer Dim numcolors As Integer Dim angl_rev As Double Dim r1 As Double, r2 As Double Dim a1 As Double, a2 As Double, a_inc As Double Dim i_r As Integer, i_g As Integer, i_b As Integer Dim shift As Integer 'parameters to be input from a user form numcolors = 512 angl_rev = 360 a1 = 0 'start angle r1 = 0.1 'interior radius r2 = 14 'outside radius a_inc = angl_rev / numcolors a2 = a1 + a_inc shift = numcolors / 3 'preparation of the RGB value arrays Dim data_array() As Integer Dim red_array() As Integer Dim green_array() As Integer Dim blue_array() As Integer ReDim red_array(1 To numcolors) ReDim green_array(1 To numcolors) ReDim blue_array(1 To numcolors) 'data_array is the generic pattern created for a specific numcolor Call make_data_array(data_array, numcolors) 'red and data_array are the same For i = 1 To numcolors red_array(i) = data_array(i) Next i Call copyshiftarray(red_array, green_array, shift) Call copyshiftarray(green_array, blue_array, shift) For i = 1 To numcolors Call makeslice(r1, r2, a1, a2, red_array(i), green_array(i), blue_array(i)) a1 = a1 + a_inc a2 = a1 + a_inc Next i Update End Sub
Make_data_array takes the empty array as an argument, and the number of colors, divides up the array into 4 sections, and fills the data. It uses a subroutine retndx to figure the exact values for the ascending and descending sections.
Sub make_data_array(ByRef data_array() As Integer, clrs As Integer) Dim i As Integer, ndx As Integer, n As Integer Dim A As Integer, B As Integer Dim c As Integer, d As Integer Dim e As Integer, f As Integer Dim g As Integer, h As Integer n = clrs / 6 ReDim data_array(1 To clrs) A = 1 B = clrs / 3 + 1 c = B + 1 d = c + clrs / 6 - 2 e = d + 1 f = e + clrs / 3 g = f + 1 h = clrs For i = A To B data_array(i) = 255 Debug.Print 255 Next For i = c To d 'ndx = retndx_desc(0, 255, n, i - c + 1) ndx = retndx(255, 0, n, i - c + 1) data_array(i) = ndx Debug.Print ndx Next For i = e To f data_array(i) = 0 Debug.Print 0 Next For i = g To h ndx = retndx(0, 255, n, i - g + 1) data_array(i) = ndx Debug.Print ndx Next End Sub
Function retndx(A As Integer, B As Integer, n As Integer, ndx As Integer) As Integer 'n is number of spaces to divide the span AB 'ndx is the index of the value to be returned Dim dbl_n As Double dbl_n = (B - A) / n retndx = A + (ndx * dbl_n) End Function
Copyshiftarray takes one array as template and one array as product to be a copy but have the data shifted one third of the way around the wheel. It was made with a small sample on graph paper simply numbering boxes, for instance if the data in the first array is 1,2,3,4,5,6,7,8,9,10,11,12 and the shift is 4, the data in the second array is 5,6,7,8,9,10,11,12,1,2,3,4. The shift is calculated from numcolors/3.
Sub copyshiftarray(ByRef array1() As Integer, ByRef array2() As Integer, shift As Integer) 'not a general sub but one specific to application 'use with array sizes evenly divisible by 3 'use with one based index Dim i As Integer, j As Integer Dim index As Integer Dim arraysize As Integer arraysize = UBound(array1) For i = 1 To arraysize If i + shift &amp;amp;lt;= arraysize Then array2(i) = array1(i + shift) Else index = i + shift - arraysize array2(i) = array1(index) End If Next i End Sub