关于颜色的经典VBA自定义函数【CAD-vba】-欢乐小爪
Access软件网QQ交流学习群(群号码198465573),欢迎您的加入!
首页 >技术文章> Access数据库-模块/函数/VBA


关于颜色的经典VBA自定义函数【CAD-vba】

发表时间:2012/5/30 9:17:50 评论(0) 浏览(13647)  评论 | 加入收藏 | 复制
   
摘 要:关于颜色的经典VBA自定义函数【CAD-vba】
正 文:

Public Function ACI2RGB(ByVal intACI As Integer) As Long
Dim col As New AcadAcCmColor
col.ColorIndex = intACI
ACI2RGB = RGB(col.Red, col.Green, col.Blue)
End Function

cad索引颜色值换算成vba颜色值

Public Function RGB2ACI(ByVal lngRGB As Long) As Integer
Dim col As New AcadAcCmColor
Dim r As Byte, g As Byte, b As Byte
'split color into rgb components
r = (lngRGB Mod 256 ^ 2) Mod 256
g = (lngRGB Mod 256 ^ 2) \ 256
b = lngRGB \ 256 ^ 2
col.SetRGB r, g, b
RGB2ACI = col.ColorIndex
End Function

得到3色的值

Function GetRGB(ACI As Integer, Red As Integer, _
Green As Integer, Blue As Integer) As Long

Dim nbr As Double
nbr = Right(ACI, 1) / 2

Dim bolAdd As Boolean, intBase As Integer
Select Case ACI
Case Is < 1
MsgBox "Invalid ACI number (0-255 valid)."
Exit Function
Case Is < 10: GoTo SkipCalc
Case Is < 60: bolAdd = True: intBase = 1
Case Is < 90: bolAdd = False: intBase = 6
Case Is < 140: bolAdd = True: intBase = 9
Case Is < 170: bolAdd = False: intBase = 14
Case Is < 220: bolAdd = True: intBase = 17
Case Is < 250: bolAdd = False: intBase = 22
Case Is < 256: GoTo SkipCalc
Case Else
MsgBox "Invalid ACI number (0-255 valid)."
Exit Function
End Select

Dim dblStart As Double
If bolAdd Then
dblStart = IIf(nbr = Int(nbr), 0, 0.5)
Else
dblStart = IIf(nbr = Int(nbr), 0.75, 0.875)
End If

Dim intSign As Integer, dblFactor As Double
intSign = IIf(bolAdd, 1, -1)
dblFactor = IIf(nbr = Int(nbr), 0.25, 0.125)

Dim dblA As Double, dblB As Double, dblC As Double
dblA = Choose(Fix(nbr) + 1, 1, 0.65, 0.5, 0.3, 0.15)
dblB = (dblStart + intSign * _
(Left(ACI, Len(CStr(ACI)) - 1) - intBase) * dblFactor) * dblA
dblC = ((2 * nbr) Mod 2) * 0.5 * dblA

SkipCalc:
Select Case ACI
Case 1: Red = 255: Green = 0: Blue = 0
Case 2: Red = 255: Green = 255: Blue = 0
Case 3: Red = 0: Green = 255: Blue = 0
Case 4: Red = 0: Green = 255: Blue = 255
Case 5: Red = 0: Green = 0: Blue = 255
Case 6: Red = 255: Green = 0: Blue = 255
Case 7, 8, 9
Red = 0: Green = 0: Blue = 0
Case Is < 60
Red = 255 * dblA: Green = 255 * dblB: Blue = 255 * dblC
Case Is < 90
Red = 255 * dblB: Green = 255 * dblA: Blue = 255 * dblC
Case Is < 140
Red = 255 * dblC: Green = 255 * dblA: Blue = 255 * dblB
Case Is < 170
Red = 255 * dblC: Green = 255 * dblB: Blue = 255 * dblA
Case Is < 220
Red = 255 * dblB: Green = 255 * dblC: Blue = 255 * dblA
Case Is < 250
Red = 255 * dblA: Green = 255 * dblC: Blue = 255 * dblB
Case Is < 256
Red = 255 * Choose(nbr * 2 + 1, 0.33, 0.464, _
0.598, 0.732, 0.866, 1)
Green = Red: Blue = Red
End Select

GetRGB = RGB(Red, Green, Blue)
End Function


Access软件网交流QQ群(群号:198465573)
 
 相关文章
【Access自定义函数】当前月第一个工作日的示例,当前月最后一个...  【红尘如烟  2013/1/19】
【Access自定义函数】字符串中数字相关的几个自定义函数  【网行者  2013/2/6】
【Access自定义函数】不规则提取日期数据的示例  【红尘如烟  2013/2/13】
【Access自定义函数】测算星座,根据日期算出星座,十二星座查询...  【麥田  2013/4/6】
常见问答
技术分类
相关资源
文章搜索
关于作者

欢乐小爪

文章分类

文章存档

友情链接