modhsl.bas

防Listview控件源码

Attribute VB_Name = "modHSL"
'****************************************************************************
'人人为我，我为人人
'枕善居汉化收藏整理
'发布日期：2007/05/08
'描    述：另类自定义listview控件源码(支持真彩色图标)
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
'
'感谢您使用本站源码，如果方便的话请给于本站一点支持，谢谢。
'
'本站物品:
'700MB容量的VB.NET源码光盘(38元包快递)
'支持支付宝交易:http://auction1.taobao.com/auction/0/item_detail-0db1-a8aba972995270433643e99d2e4ac592.jhtml
'也可以银行汇款：http://www.mndsoft.com/sale/yh.png
'
'USB电脑遥控器 源码光盘
'支持支付宝交易:http://auction1.taobao.com/auction/0/item_detail-0db1-dd4a9c3f6a5785231091b01d54af01fd.jhtml
'也可以银行汇款：http://www.mndsoft.com/sale/yh.png
'
'如果您给于本站一点支持，本站将更好的利用自身优势为您寻找您需要的代码!
Option Explicit

'Author: Andrew Gray
'Date: 9/10/2001 8:18:23 PM
'Link: http://abstractvb.com/code.asp?F=50&P=1&A=926

Public Type HSL
    Hue                 As Integer
    Saturation          As Integer
    Luminance           As Integer
End Type

Public Type RGB
    Red                 As Integer
    Green               As Integer
    Blue                As Integer
End Type

Private Const HueMAX    As Long = 239
Private Const SatMAX    As Long = 240
Private Const LumMAX    As Long = 240

Private Const C_2_DIV_3 As Double = (2 / 3)
Private Const C_1_DIV_3 As Double = (1 / 3)

Public Function HSLtoRGB(ByVal Hue As Integer, _
                         ByVal Saturation As Integer, _
                         ByVal Luminance As Integer) As Long

    Dim RetVal      As RGB
    Dim pHue        As Double
    Dim pSat        As Double
    Dim pLum        As Double
    Dim pRed        As Double
    Dim pGreen      As Double
    Dim pBlue       As Double
    Dim temp1       As Double
    Dim temp2       As Double
    Dim temp3(2)    As Double
    Dim N           As Long
   
    pHue = Hue / HueMAX
    pSat = Saturation / SatMAX
    pLum = Luminance / LumMAX

    If pSat = 0 Then
        pRed = pLum
        pGreen = pLum
        pBlue = pLum
    Else
        If pLum < 0.5 Then
            temp2 = pLum * (1 + pSat)
        Else
            temp2 = pLum + pSat - pLum * pSat
        End If
        temp1 = 2 * pLum - temp2
   
        temp3(0) = pHue + C_1_DIV_3
        temp3(1) = pHue
        temp3(2) = pHue - C_1_DIV_3
      
        For N = 0 To 2
            If temp3(N) < 0# Then
                temp3(N) = temp3(N) + 1#
            ElseIf temp3(N) > 1# Then
                temp3(N) = temp3(N) - 1#
            End If
            
            If 6# * temp3(N) < 1# Then
                temp3(N) = temp1 + (temp2 - temp1) * 6# * temp3(N)
            Else
                If 2# * temp3(N) < 1# Then
                    temp3(N) = temp2
                Else
                    If 3# * temp3(N) < 2# Then
                        temp3(N) = temp1 + (temp2 - temp1) * (C_2_DIV_3 - temp3(N)) * 6#
                    Else
                        temp3(N) = temp1
                    End If
                End If
            End If
        Next N

        pRed = temp3(0)
        pGreen = temp3(1)
        pBlue = temp3(2)
    End If

    With RetVal
        .Red = Int(pRed * 255#)
        .Green = Int(pGreen * 255#)
        .Blue = Int(pBlue * 255#)
        
        If .Red < 0 Then .Red = 0
        If .Green < 0 Then .Green = 0
        If .Blue < 0 Then .Blue = 0
        
        HSLtoRGB = RGB(.Red, .Green, .Blue)
    End With
End Function