我在Excel VBA中尝试制作基于HSL的色轮,使用小单元格作为“像素”,效果不错,所以我想分享一下。
![Click image to enlarge](https://istack.dev59.com/4F6tD.gif)
这展示了如何在编程中转换
HSL和RGB,以及如何以编程方式在任何网格上绘制线条/圆形,甚至是电子表格单元格。
代码已经准备就绪,可以直接运行:
Option Explicit
Const colorSheetName = "COLORS"
Const pi = 3.14159265358979
Const squareSize = 3.75
Const cDiameter = 80#
Const numAngles = 360#
Sub CalculateColorWheel()
Dim ws As Worksheet, radsPerAngle As Double, radius As Long, xStop As Double, _
yStop As Double, z As Integer, xyLength As Double, lineDot As Long, _
lineLength As Long, h As Byte, s As Byte, v As Byte, r As Byte, g As Byte, b As Byte
Set ws = ThisWorkbook.Sheets.Add
On Error Resume Next
Application.DisplayAlerts = False
ThisWorkbook.Sheets(colorSheetName).Delete
Application.DisplayAlerts = True
On Error GoTo 0
With ws
.Name = colorSheetName
.Rows.RowHeight = squareSize
.Columns.ColumnWidth=widthToColumnWidth(squareSize)
ActiveWindow.DisplayGridlines = False
ActiveWindow.DisplayHeadings = False
radius = cDiameter / 2
lineLength = radius * 1.5
radsPerAngle = (360 / numAngles) * pi / 180
Debug.Print "Grid size=" & .[a1].Height & "×" & .[a1].Width _
& ", Diameter:" & cDiameter _
& ", Area=" & Round(pi * radius ^ 2, 0) _
& ", Circumference=" & Round(2 * pi * radius, 0) _
& ", Radians per Angle=" & Round(radsPerAngle, 3) _
& " × " & numAngles & " angles"
For z = 0 To numAngles - 1
For lineDot = 1 To lineLength
xyLength = radius * (lineDot / lineLength)
xStop = Int(Cos(radsPerAngle * z) * xyLength) + radius + 2
yStop = Int(Sin(radsPerAngle * z) * xyLength) + radius + 2
If .Cells(yStop, xStop).Interior.Pattern=xlNone Then
h = ((z + 1) / numAngles) * 255
s = (lineDot / lineLength) * 255
v = 255
HSVtoRGB h, s, v, r, g, b
.Cells(yStop, xStop).Interior.Color=rgb(r,g,b)
dots = dots + 1
End If
Next lineDot
Application.StatusBar = Format(z / (numAngles - 1), "0%")
DoEvents
Next z
End With
Beep
Application.StatusBar = "Finished drawing color circle (" & dots & " colors)"
End Sub
Public Function widthToColumnWidth(pts As Double) As Double
Select Case pts
Case Is <= 0: widthToColumnWidth = 0
Case Is <= 12: widthToColumnWidth = pts / 12
Case Else: widthToColumnWidth = 1 + (pts - 12) / (75 / 11)
End Select
End Function
Public Sub HSVtoRGB(h As Byte, s As Byte, v As Byte, r As Byte, g As Byte, b As Byte)
Dim minV As Byte, maxV As Byte, Chroma As Byte, tempH As Double
If v = 0 Then
r = 0: g = 0: b = 0
Else
If s = 0 Then
r = v: g = v: b = v:
Else
maxV = v: Chroma = s / 255 * maxV: minV = maxV - Chroma
Select Case h
Case Is >= 170: tempH = (h - 170) / 43: g = 0
If tempH < 1 Then
b = maxV: r = maxV * tempH
Else: r = maxV: b = maxV * (2 - tempH): End If
Case Is >= 85: tempH = (h - 85) / 43: r = 0
If tempH < 1 Then
g = maxV: b = maxV * tempH
Else: b = maxV: g = maxV * (2 - tempH): End If
Case Else: tempH = h / 43: b = 0
If tempH < 1 Then
r = maxV: g = maxV * tempH
Else: g = maxV: r = maxV * (2 - tempH): End If
End Select
r = r / maxV * (maxV - minV) + minV
g = g / maxV * (maxV - minV) + minV
b = b / maxV * (maxV - minV) + minV
End If
End If
End Sub
如何在Excel中运行此代码:将上面的代码复制并粘贴到普通模块中。(选择代码,按Ctrl+C进行复制,然后在Excel中,按住Alt并按F11+I+M,然后按Ctrl+V进行粘贴,最后按F5运行。)
更多信息:
color(angle) = HSV(angle, 1, 1)
吗? - Andreas Rejbrand