I wrote this VBA program during lockdown 2020, 5th November to 2nd December
The standard equation of a circle is (x-h)^2+(y-k)^2=r^2, where (h,k) is the center.
for example h = 25 k = 25 r = 20 from quadratic x^2 + y^2 = r^2
Sub doit()
sbAllWhiteAYL606
Call fnRainbow117(600, 660, 500)
Range("A1").Select
End Sub
Function fnRainbow117(h, k, r)
' RGB rainbow
' red 255, 0, 0
' orange 255, 127, 0
' yellow 255, 255, 0
' green 0, 255, 0
' blue 0, 0, 255
' indigo 75, 0, 130
' violet 148, 0, 211
'
' red
red = 255
green = 0
blue = 0
' red 255, 0, 0
' orange 255, 127, 0
' yellow 255, 255, 0
For c = 1 To 21
For x = 1 To r 'Step 10
y = (VBA.Sqr((r * r) + 1 - (x * x)))
xh = x + h
yk = y + k
Cells(xh - (2 * x), yk).Select
Call fn1rgb(red, green, blue)
Cells(xh - (2 * x), yk - (2 * y)).Select
Call fn1rgb(red, green, blue)
Next x
r = r - 1
green = green + 12
Next c
'
' yellow
red = 255
green = 255
blue = 0
' yellow 255, 255, 0
' green 0, 255, 0
For c = 1 To 10
For x = 1 To r 'Step 10
y = (VBA.Sqr((r * r) + 1 - (x * x)))
xh = x + h
yk = y + k
Cells(xh - (2 * x), yk).Select
Call fn1rgb(red, green, blue)
Cells(xh - (2 * x), yk - (2 * y)).Select
Call fn1rgb(red, green, blue)
Next x
r = r - 1
red = red - 25
Next c
'
' green
red = 0
green = 255
blue = 0
' green 0, 255, 0
' blue 0, 0, 255
For c = 1 To 10
For x = 1 To r 'Step 10
y = (VBA.Sqr((r * r) + 1 - (x * x)))
xh = x + h
yk = y + k
Cells(xh - (2 * x), yk).Select
Call fn1rgb(red, green, blue)
Cells(xh - (2 * x), yk - (2 * y)).Select
Call fn1rgb(red, green, blue)
Next x
r = r - 1
green = green - 25
blue = blue + 25
Next c
'
' blue
red = 0
green = 0
blue = 255
' blue 0, 0, 255
' indigo 75, 0, 130
For c = 1 To 10
For x = 1 To r 'Step 10
y = (VBA.Sqr((r * r) + 1 - (x * x)))
xh = x + h
yk = y + k
Cells(xh - (2 * x), yk).Select
Call fn1rgb(red, green, blue)
Cells(xh - (2 * x), yk - (2 * y)).Select
Call fn1rgb(red, green, blue)
Next x
r = r - 1
red = red + 7
blue = blue - 12
Next c
'
' indigo
red = 75
green = 0
blue = 130
' indigo 75, 0, 130
' violet 148, 0, 211
For c = 1 To 10
For x = 1 To r 'Step 10
y = (VBA.Sqr((r * r) + 1 - (x * x)))
xh = x + h
yk = y + k
Cells(xh - (2 * x), yk).Select
Call fn1rgb(red, green, blue)
Cells(xh - (2 * x), yk - (2 * y)).Select
Call fn1rgb(red, green, blue)
Next x
r = r - 1
red = red + 7
blue = blue + 8
Next c
fnRainbow117_Exit:
Range("A1").Select
End Function
Sub sb1rgb(r, g, b)
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = RGB(r, g, b)
.TintAndShade = 0
.PatternTintAndShade = 0
End With
DoEvents
End Sub
Sub sbAllWhiteAYL606()
Range("A1:AYL606").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
DoEvents
Range("A1").Select
End Sub
Sub sbNoHeadings()
ActiveWindow.DisplayHeadings = False
Application.DisplayFormulaBar = False
End Sub
Sub sb100x100()
Cells.Select
Selection.RowHeight = 0.75
Selection.ColumnWidth = 0.083
Range("A1").Select
End Sub
|