对性能要求高。
结果一般准确就好。
------解决方案--------------------
仅供参考(尽管是VB)
- VB code
Private Function Minimum(ParamArray Vals()) Dim n As Integer, MinVal On Error Resume Next MinVal = Vals(0) For n = 1 To UBound(Vals) If Vals(n) < MinVal Then MinVal = Vals(n) Next n Minimum = MinVal End Function Private Function Maximum(ParamArray Vals()) Dim n As Integer, MaxVal On Error Resume Next MaxVal = Vals(0) For n = 1 To UBound(Vals) If Vals(n) > MaxVal Then MaxVal = Vals(n) Next n Maximum = MaxVal End Function Private Sub c2hsb(ByVal clr As Long) Dim MyR As Single, MyG As Single, MyB As Single Dim Max As Single, Min As Single Dim MyS As Single Dim Delta As Single, MyVal As Single Dim cc As String * 6 Dim r1, g1, b1 As Byte On Error Resume Next cc = Right("000000" + Hex$(clr), 6) b1 = Val("&H" + Left(cc, 2)) g1 = Val("&H" + Mid(cc, 3, 2)) r1 = Val("&H" + Right(cc, 2)) MyR = r1 / 255: MyG = g1 / 255: MyB = b1 / 255 Max = Maximum(MyR, MyG, MyB) Min = Minimum(MyR, MyG, MyB) hsbB = Int(Max * 100) If Max <> 0 Then MyS = (Max - Min) / Max * 100 Else MyS = 0 End If hsbS = MyS If hsbS = 0 Then hsbH = 0 Else Delta = Max - Min Select Case Max Case MyR MyVal = (MyG - MyB) / Delta Case MyG MyVal = 2 + (MyB - MyR) / Delta Case MyB MyVal = 4 + (MyR - MyG) / Delta End Select MyVal = MyVal * 60 If MyVal < 0 Then MyVal = MyVal + 360 hsbH = MyVal End If ' Debug.Print "hsb="; hsbH; " "; hsbS; " "; hsbB End Sub Private Function ColorDistance(ByVal c1 As Long, ByVal c2 As Long) As Long Dim cd As Long Dim h1, s1, b1, h2, s2, b2 As Single On Error Resume Next If c1 = -1 Or c2 = -1 Then ColorDistance = 1000000 Exit Function End If c2hsb (c1) h1 = hsbH / 360 s1 = hsbS b1 = hsbB c2hsb (c2) h2 = hsbH / 360 s2 = hsbS b2 = hsbB cd = Abs(h1 - h2) cd = cd + Abs(s1 - s2) cd = cd + Abs(b1 - b2) ColorDistance = cd End Function