[VB.net]替 Color 型別擴充增加 FromHsl() 方法來處理介面色彩

2011-08-05

4791
0
VB.net
2011-08-07

動機及需求：

把色彩數據化的方法和標準有很多種，我們都知道 RGB 的色彩概念，通常簡單的指定一種顏色時用 RGB 會是個不錯的選擇。
另外還有用色相、飽和度、亮度來描述色彩的 HSL 和 HSV（也叫做HSB）表示法，在建立漸層圖、製作介面風格、或為了調和同一色系的視覺效果時，HSL 提供了更佳的解決方案。
HSL和 HSV 的概念可參考（http://zh.wikipedia.org/wiki/HSL）
Visual Studio 的 Color 型別有 A、R、G、B 四個屬性可提取 Color 的 RGB 成份，也有 FromArgb(a,r,g,b) 方法可組成一個色彩。
在 HSL 方面雖然也有 GetHue()、GetSaturation()、GetBrightness() 可提取 HSB ，却沒有 FromHsl(h,s,l) 方法，而且傳回的數值也有不同於一般的地方。
1. 它們的型別是 Single 不是整數。
2. S 和 B 傳回值在 0–1 之間，要適當的放大才好利用（通常是以 240 為滿刻度值）。
3. H 傳回值在 0–360 之間，若要和 ColorDialog 相容以 240 為滿刻度的話就要乘以 (2/3) 。
4. 下圖可參考對照：
接下來我們將為 System.Drawing.Color 增加幾個方法來處理 HSL 相關的操作：
1. 仿原來的 Color.A()、Color.R()、Color.G()、Color.B()、Color.FromArgb() 方法及命名的模樣。
2. 增加 Color.H()、Color.S()、Color.L()、Color.FromHsl() 方法。
3. 再多做一個產生漸層色塊的 CreateLinearImage() 方法可傳回 Color 值為基礎色的漸層色塊，型別為 Image。
4. 下面是完成後的擷圖：

表單 Code 如下，可以看出新方法的使用非常方便。


Public Class Form1
    '---選取色彩---
    Private Sub B1() Handles Button1.Click
        With ColorDialog1
            .ShowDialog()
            Label1.BackColor = .Color
            With .Color
                Label2.Text = " 紅綠藍(RGB) = " & .R & "," & .G & "," & .B
                Label3.Text = ".net 的(HSL) = " & .GetHue & "," & .GetSaturation & "," & .GetBrightness
                Label4.Text = " 擴充的(HSL) = " & .H & "," & .S & "," & .L
            End With
        End With
    End Sub
    '---為表單配上漸層底圖---
    Private Sub B2() Handles Button2.Click
        Me.BackgroundImage = Label1.BackColor.CreateLinearImage(64, 64, 120, 315)
        Me.BackgroundImageLayout = ImageLayout.Stretch
    End Sub
End Class

方法及實現：

VB.net 2008 開始加入了擴充方法（Extension Method），它不需寫衍生類別就可以直接使用擴充方法，並且支援 IntelliSence 自動提示功能。
參考 MSDN 介紹 http://msdn.microsoft.com/zh-tw/library/bb514025.aspx
深入了解 HSL 的演算法並且用 VB.net 測試及實踐：

→
建立模組的方法及流程請直接參看前面 MSDN 的說明，這裡就不再說了。

以下是模組的 Code，裡面還是寫了 RGB2HSL() 的函式，是為了讓用 VB6 or VBA 的朋友也能參考它演算法。


Imports System.Runtime.CompilerServices
Imports System.Drawing.Drawing2D
Module ExtensionColor
#Region "公開的方法"
    <Extension()> _
    Public Function H(ByVal c As Color) As Integer
        Return c.GetHue * 2 / 3
        'Return Color2HSL(c).H     '---也可直接用這個--
    End Function
    <Extension()> _
    Function S(ByVal c As Color) As Integer
        Return c.GetSaturation * 240
        'Return Color2HSL(c).S    '---也可直接用這個---
    End Function
    <Extension()> _
    Function L(ByVal c As Color) As Integer
        Return c.GetBrightness * 240
        'Return Color2HSL(c).L    '---也可直接用這個---
    End Function
    <Extension()> _
    Function FromHSL(ByVal c As Color, ByVal h As Byte, ByVal s As Byte, ByVal l As Byte) As Color
        Return HSL2Color(h, s, l)
    End Function
    <Extension()> _
    Function WebColorValue(ByVal c As Color) As String
        Return "#" & Hex(c.R * 256 ^ 2 + c.G * 256 + c.B).PadLeft(6, "0")
    End Function
    <Extension()> _
    Function CreateLinearImage(ByVal c As System.Drawing.Color, ByVal 寬 As Integer, ByVal 高 As Integer, ByVal 濃度 As Integer, ByVal 方向 As Integer) As Image
        Dim c0 As Color = HSL2Color(c.H, 濃度, 40)
        Dim c1 As Color = HSL2Color(c.H, 濃度, 180)
        Return 新建漸層色塊(寬, 高, c0, c1, 方向)
    End Function
#End Region
#Region "內部程序"
    Friend Structure sHSL
        Dim H As Integer
        Dim S As Integer
        Dim L As Integer
    End Structure
    Friend Structure sRGB
        Dim R As Integer
        Dim G As Integer
        Dim B As Integer
    End Structure
    Private Function Color2HSL(ByVal c As Color) As sHSL
        Return RGB2HSL(c.R, c.G, c.B)
    End Function
    Private Function HSL2Color(ByVal h As Integer, ByVal s As Integer, ByVal l As Integer) As Color
        Return Color.FromArgb(HSL2RGB(h, s, l).R, HSL2RGB(h, s, l).G, HSL2RGB(h, s, l).B)
    End Function
    Private Function RGB2HSL(ByVal r As Integer, ByVal g As Integer, ByVal b As Integer) As sHSL
        Dim vR = (r / 255), vG = (g / 255), vB = (b / 255)
        Dim vMax = 最大值(vR, vG, vB)
        Dim vMin = 最小值(vR, vG, vB)
        Dim 和 = vMax + vMin
        Dim 差 = vMax - vMin
        Dim vH, vS, vL As Double
        vL = 和 / 2
        Select Case True
            Case vL = 0 OrElse vMax = vMin : vS = 0 : vH = 0
            Case Else
                If vL <= 0.5 Then vS = 差 / 和 Else vS = 差 / (2 - 和)
                Dim sd As Double = 差 * 6
                Select Case vMax
                    Case Is = vR : vH = IIf(vG >= vB, 0, 1) + (vG - vB) / sd
                    Case Is = vG : vH = (1 / 3) + (vB - vR) / sd
                    Case Is = vB : vH = (2 / 3) + (vR - vG) / sd
                End Select
        End Select
        RGB2HSL.H = vH * 240
        RGB2HSL.S = vS * 240
        RGB2HSL.L = vL * 240
    End Function
    Friend Function HSL2RGB(ByVal H As Integer, ByVal s As Integer, ByVal L As Integer) As sRGB
        Dim vR, vG, vB, p, q As Double
        Dim vH = H / 240, vS = s / 240, vL = L / 240
        Select Case vS
            Case Is = 0 : vR = vL * 255 : vG = vL * 255 : vB = vL * 255
            Case Else
                q = IIf(vL < 0.5, vL * (1 + vS), vL + vS - (vS * vL))
                p = 2 * vL - q
                vR = H2RGB(p, q, vH + (1 / 3)) * 255
                vG = H2RGB(p, q, vH) * 255
                vB = H2RGB(p, q, vH - (1 / 3)) * 255
        End Select
        HSL2RGB.R = vR
        HSL2RGB.G = vG
        HSL2RGB.B = vB
    End Function
    Private Function H2RGB(ByVal p As Single, ByVal q As Single, ByVal h As Single) As Single
        If h < 0 Then h = h + 1
        If h > 1 Then h = h - 1
        Select Case h
            Case Is < (1 / 6) : Return p + (q - p) * 6 * h
            Case (1 / 6) To (1 / 2) : Return q
            Case (1 / 2) To (2 / 3) : Return p + (q - p) * ((2 / 3) - h) * 6
            Case Else : Return p
        End Select
    End Function
    Function 新建漸層色塊 _
          (ByVal w As Integer, ByVal h As Integer, ByVal 暗色 As Color, ByVal 亮色 As Color, ByVal 方向 As Integer) As Image
        Dim bmp As Bitmap = New System.Drawing.Bitmap(w, h)
        Dim g As Graphics = Graphics.FromImage(bmp)
        Dim rect0 As New Rectangle(0, 0, bmp.Size.Width, bmp.Size.Height)
        Dim 漸層色 As LinearGradientBrush = New LinearGradientBrush(rect0, 亮色, 暗色, 方向)
        g.FillRectangle(漸層色, rect0)
        Return bmp
    End Function
    Private Function 最大值(ByVal r, ByVal g, ByVal b)
        Return IIf(r > g, IIf(g > b, r, IIf(r > b, r, b)), IIf(g > b, g, b))
    End Function
    Private Function 最小值(ByVal r, ByVal g, ByVal b)
        Return IIf(r < g, IIf(g < b, r, IIf(r < b, r, b)), IIf(g < b, g, b))
    End Function
#End Region
End Module

下載 VB.net 專案原始碼：擴充方法.rar

ku3

VB.net

回首頁