Click here to Skip to main content
15,893,564 members
Articles / Multimedia / GDI+

ColorBlender - Dynamic Gradient Color Blend Creation Control (VB.NET)

Rate me:
Please Sign up or sign in to vote.
4.90/5 (29 votes)
1 Aug 2012CPOL6 min read 89.5K   4.4K   61  
How to create a ColorBlend and two color blending UserControls to make it easier.
#Region "Imports"

Imports System.Drawing.Drawing2D
Imports System.ComponentModel
Imports System.Windows.Forms.Design
Imports ColorBlender.cBlenderItems

#End Region

<System.Diagnostics.DebuggerStepThrough()>
<ToolboxItem(True), ToolboxBitmap(GetType(gColorBlender), "ColorBlender.ColorBlender.bmp")>
<Designer(GetType(gColorBlenderDesigner))>
<DefaultEvent("BlendChanged")>
Public Class gColorBlender
    Inherits UserControl

#Region "Fields"

    Private ReadOnly StartPointer As cPointer = New cPointer(0, Color.White, 255, False)
    Private ReadOnly EndPointer As cPointer = New cPointer(1, Color.Black, 255, False)
    Private ReadOnly MiddlePointers As New Collection
    Private MouseMoving As Boolean
    Private CurrPointer As Integer = 0
    Private CurrPos As String
    Private rectSample As Rectangle
    Private rectBar As Rectangle
    Private rectLeft As Rectangle
    Private rectRight As Rectangle
    Private ptsLeft As PointF()
    Private ptsRight As PointF()
    Private rectCurrColor As Rectangle
    Private rectSampInvalidate As Rectangle
    Private rectBorderSelect As Rectangle
    Private LoadingColorBlend As Boolean

    Public Event BlendChanged()

#End Region

#Region "New"

    Public Sub New()

        ' This call is required by the Windows Form Designer.
        InitializeComponent()

        ' Add any initialization after the InitializeComponent() call.
        SetStyle(ControlStyles.UserPaint _
            Or ControlStyles.ResizeRedraw _
            Or ControlStyles.OptimizedDoubleBuffer _
            Or ControlStyles.AllPaintingInWmPaint _
            , True)
    End Sub

    Public Sub New(ByVal cBlend As cBlenderItems)

        ' This call is required by the Windows Form Designer.
        InitializeComponent()

        ' Add any initialization after the InitializeComponent() call.
        SetStyle(ControlStyles.UserPaint _
            Or ControlStyles.ResizeRedraw _
            Or ControlStyles.OptimizedDoubleBuffer _
            Or ControlStyles.AllPaintingInWmPaint _
            , True)

        gColorBlend = New cBlenderItems(cBlend.cbColor, cBlend.cbPosition, cBlend.BorderColor,
                                        cBlend.FocalPoints, cBlend.BlendGradientType,
                                        cBlend.BlendGradientMode, cBlend.BlendPathShape)

    End Sub

    ' The editor service displaying this control.
    Private ReadOnly m_EditorService As Windows.Forms.Design.IWindowsFormsEditorService
    Public Sub New(ByVal editor_service As Windows.Forms.Design.IWindowsFormsEditorService, ByVal cBlend As cBlenderItems)

        ' This call is required by the Windows Form Designer.
        InitializeComponent()

        ' Add any initialization after the InitializeComponent() call.
        SetStyle(ControlStyles.UserPaint _
            Or ControlStyles.ResizeRedraw _
            Or ControlStyles.OptimizedDoubleBuffer _
            Or ControlStyles.AllPaintingInWmPaint _
            , True)

        m_EditorService = editor_service

        gColorBlend = New cBlenderItems(cBlend.cbColor, cBlend.cbPosition, cBlend.BorderColor,
                                        cBlend.FocalPoints, cBlend.BlendGradientType,
                                        cBlend.BlendGradientMode, cBlend.BlendPathShape)
    End Sub
#End Region

#Region "Load"

    Private Sub ColorBlender_Load(ByVal sender As Object, ByVal e As EventArgs) Handles Me.Load
        LoadingColorBlend = True
        ColorBox.DrawMode = DrawMode.OwnerDrawFixed
        ColorBox.DropDownStyle = ComboBoxStyle.DropDownList
        AddHandler ColorBox.DrawItem, AddressOf ColorList_DrawItem
        Dim cList As New List(Of Color)
        For Each s As String In [Enum].GetNames(GetType(KnownColor))
            If Not Color.FromName(s).IsSystemColor Then
                cList.Add(Color.FromName(s))
            End If
        Next
        cList.Sort(AddressOf SortColors)
        With ColorBox
            .Items.Clear()
            For Each c As Color In cList
                .Items.Add(c.Name)
            Next
        End With
        ColorBox.SelectedIndex = 1
        LoadingColorBlend = False
        LoadABlend()
        StartPointer.pIsCurr = True
        UpdateRGBs(StartPointer.ARGB, True)
    End Sub
#End Region

#Region "Properties"

    Private _gColorBlend As cBlenderItems = DefaultColorFillBlend()
    ''' <summary>
    ''' The ColorBlend used to fill the cBlenderItem
    ''' </summary>
    <Description("The ColorBlend used to fill the cBlenderItems"), _
    Category("gColorBlend"), _
    RefreshProperties(RefreshProperties.All), _
    Editor(GetType(BlendTypeEditor), GetType(Drawing.Design.UITypeEditor))> _
    Public Property gColorBlend() As cBlenderItems
        Get
            Return _gColorBlend
        End Get
        Set(ByVal value As cBlenderItems)
            _gColorBlend = value
            LoadABlend()
            Invalidate()

        End Set
    End Property

    Private Sub LoadABlend()

        StartPointer.SetARGB(_gColorBlend.cbColor(0))
        StartPointer.pPos = _gColorBlend.cbPosition(0)
        EndPointer.SetARGB(_gColorBlend.cbColor(_gColorBlend.cbColor.Length - 1))
        EndPointer.pPos = _gColorBlend.cbPosition(_gColorBlend.cbColor.Length - 1)
        MiddlePointers.Clear()
        If _gColorBlend.cbColor.Length > 2 Then
            For i As Integer = 1 To _gColorBlend.cbColor.Length - 2
                MiddlePointers.Add(New cPointer(_gColorBlend.cbPosition(i), _gColorBlend.cbColor(i), False))
            Next
        End If
    End Sub

#Region "gColorBlend DefaultValue Settings"

    'The standard <DefaultValue(XXX)> attribute
    'will not work correctly for custom Types
    'These Methods are needed to set the Default Value Correctly   

    Private Shared Function DefaultColorFillBlend() As cBlenderItems
        Return New cBlenderItems '(New Color() {Color.AliceBlue, Color.RoyalBlue, Color.Navy}, New Single() {0, 0.5, 1})
    End Function

    Public Sub ResetgColorBlend()
        gColorBlend = DefaultColorFillBlend()
    End Sub

    Private Function ShouldSerializegColorBlend() As Boolean
        Return Not (_gColorBlend.Equals(DefaultColorFillBlend))
    End Function

#End Region

    Private _BarHeight As Single = 20
    ''' <summary>
    ''' Height of color blender bar
    ''' </summary>
    ''' <value></value>
    ''' <returns>Single</returns>
    ''' <remarks></remarks>
    <Category("gColorBlender")>
    <Description("Height of color blender bar")>
    <DefaultValue(20)>
    Public Property BarHeight() As Single
        Get
            Return _BarHeight
        End Get
        Set(ByVal value As Single)
            _BarHeight = Math.Max(value, 20)
            panProps.Location = New Point(5, value + 15)
            Height = panProps.Bottom + 3

        End Set
    End Property

    Private _showSample As Boolean = True
    ''' <summary>
    ''' Show or Hide the Sample
    ''' </summary>
    ''' <value></value>
    ''' <returns>Boolean</returns>
    ''' <remarks></remarks>
    <Category("gColorBlender")>
   <Description("Show or Hide the Sample")>
    <DefaultValue(True)>
    Public Property ShowSample As Boolean
        Get
            Return _showSample
        End Get
        Set(ByVal Value As Boolean)
            _showSample = Value
            If Value Then
                Width = panProps.Right + 85
            Else
                Width = panProps.Right + 3
            End If
            Invalidate()
        End Set
    End Property




#End Region

#Region "Public Methods"
    ''' <summary>
    ''' Returns the Center point for the given Rectangle relative to the sample Center point 
    ''' </summary>
    ''' <param name="X"></param>
    ''' <param name="Y"></param>
    ''' <param name="Width"></param>
    ''' <param name="Height"></param>
    ''' <returns>PointF</returns>
    ''' <remarks></remarks>
    Public Function BlendConvertCenterPoint(X As Single, Y As Single, ByVal Width As Single, ByVal Height As Single) As PointF
        Return New PointF(X + (Width * gColorBlend.FocalPoints.CenterPtX),
                          Y + (Height * gColorBlend.FocalPoints.CenterPtY))
    End Function

    ''' <summary>
    ''' Returns the Center point for the given Rectangle relative to the sample Center point 
    ''' </summary>
    ''' <param name="rect"></param>
    ''' <returns>PointF</returns>
    ''' <remarks></remarks>
    Public Function BlendConvertCenterPoint(rect As Rectangle) As PointF
        Return New PointF(rect.X + (rect.Width * gColorBlend.FocalPoints.CenterPtX),
                          rect.Y + (rect.Height * gColorBlend.FocalPoints.CenterPtY))
    End Function

    ''' <summary>
    ''' Returns the Center point for the given Rectangle relative to the sample Center point 
    ''' </summary>
    ''' <param name="Width"></param>
    ''' <param name="Height"></param>
    ''' <returns>PointF</returns>
    ''' <remarks></remarks>
    Public Function BlendConvertCenterPoint(ByVal Width As Single, ByVal Height As Single) As PointF
        Return New PointF((Width * gColorBlend.FocalPoints.CenterPtX),
                          (Height * gColorBlend.FocalPoints.CenterPtY))
    End Function

    ''' <summary>
    ''' Returns the Center point for the given Rectangle relative to the sample Center point 
    ''' </summary>
    ''' <param name="sizef"></param>
    ''' <returns>PointF</returns>
    ''' <remarks></remarks>
    Public Function BlendConvertCenterPoint(ByVal sizef As SizeF) As PointF
        Return New PointF((sizef.Width * gColorBlend.FocalPoints.CenterPtX),
                          (sizef.Height * gColorBlend.FocalPoints.CenterPtY))
    End Function

    ''' <summary>
    ''' Pass on the Drawing.Drawing2D.ColorBlend from the cBlenderItem
    ''' </summary>
    ''' <returns>Drawing.Drawing2D.ColorBlend</returns>
    ''' <remarks></remarks>
    Public Function GetColorBlendForBrush() As ColorBlend
        Return _gColorBlend.GetColorBlendForBrush
    End Function

#End Region

#Region "Mouse Events"

    Private Sub ColorBlender_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Me.MouseDown
        'CurrPointer: 
        '-3 is the BorderColor
        '0 is the StartPointer 
        '-1 is the EndPointer
        '1,2,3,4,... are MiddlePointers 
        If CurrPointer > -3 Then
            If rectLeft.Contains(e.X, e.Y) Then
                'Go to the next Pointer
                If e.Button = Windows.Forms.MouseButtons.Right Then
                    Dim cp As Int32 = CurrPointer
                    If cp <> -1 Then
                        If cp > MiddlePointers.Count - 1 Then
                            cp = -1
                        Else
                            cp += 1
                        End If
                        SelectPointer(cp)
                    End If

                Else
                    'Increment the Position
                    If CurrPointer > 0 Then
                        If Control.ModifierKeys = Keys.Control Then
                            UpdateCurrentPointerPos(MiddlePointers(CurrPointer).pPos + 0.001)
                        Else
                            UpdateCurrentPointerPos(MiddlePointers(CurrPointer).pPos + 0.01)
                        End If
                    End If
                End If
                Return
            ElseIf rectRight.Contains(e.X, e.Y) Then
                'Go to the previous Pointer
                If e.Button = Windows.Forms.MouseButtons.Right Then
                    Dim cp As Int32 = CurrPointer
                    If cp <> 0 Then
                        If cp = -1 Then
                            cp = MiddlePointers.Count
                        Else
                            cp -= 1
                        End If
                        SelectPointer(cp)
                    End If

                Else
                    'Decrement the Position
                    If CurrPointer > 0 Then
                        If Control.ModifierKeys = Keys.Control Then
                            UpdateCurrentPointerPos(MiddlePointers(CurrPointer).pPos - 0.001)
                        Else
                            UpdateCurrentPointerPos(MiddlePointers(CurrPointer).pPos - 0.01)
                        End If
                    End If
                End If
                Return
            End If
        End If

        'Check if the pointer is over the Sample Preview
        If IsMouseOverSample(e.X, e.Y) Then
            If e.Button = Windows.Forms.MouseButtons.Right Then
                ContextMenuStrip1.Show(Me, e.X, e.Y)
                Return
            End If
            If _gColorBlend.BlendGradientType = eBlendGradientType.Path Then
                If e.Button = Windows.Forms.MouseButtons.Left Then
                    If Control.ModifierKeys = Keys.Control Then
                        gColorBlend.FocalPoints.SetFocusScales((e.X - rectSample.X) / (rectSample.Width),
                                                               (e.Y - rectSample.Y) / rectSample.Height)
                    Else
                        gColorBlend.FocalPoints.SetCenterPoint((e.X - rectSample.X) / (rectSample.Width),
                                                               (e.Y - rectSample.Y) / rectSample.Height)
                    End If
                End If
                Invalidate(rectSampInvalidate)
            End If

        ElseIf e.Y < BarHeight + 8 And e.X > rectBar.Left - 5 And e.X < rectBar.Right + 5 Then
            'Check if the cursor is over a MiddlePointer
            'Returns the Pointer index or -4 if not over any MiddlePointer
            Dim mOver As Integer = IsMouseOverPointer(e.X, e.Y)
            If mOver <> -4 Then
                If Not CurrPointer = mOver Then
                    SelectPointer(mOver)
                End If

                If e.Button = Windows.Forms.MouseButtons.Left Then
                    MouseMoving = True
                ElseIf e.Button = Windows.Forms.MouseButtons.Right Then
                    MiddlePointers.Remove(CurrPointer)
                    CurrPos = ""
                End If
            Else
                'Check if the cursor is over a Start or End Pointer
                If IsMouseOverStartPointer(e.X, e.Y) Then
                    SelectPointer(0)
                ElseIf IsMouseOverEndPointer(e.X, e.Y) Then
                    SelectPointer(-1)
                Else
                    'If the cursor is not over a Pointer then Add One
                    If e.Button = Windows.Forms.MouseButtons.Left Then
                        ClearCurrPointer()
                        MiddlePointers.Add(New cPointer(((e.X - rectBar.Left) / (rectBar.Width)),
                            Color.FromArgb(gszRed.Value, gszGreen.Value, gszBlue.Value), gszAlpha.Value, True))
                        SortCollection(MiddlePointers, "pPos", True)
                        CurrPointer = FindCurr()
                        Invalidate()
                        MouseMoving = True
                        CurrPos = CType(MiddlePointers(CurrPointer), cPointer).PosToStrong
                    End If
                End If

            End If
            'Check if the cursor is over the Border Selector
        ElseIf IsMouseOverBorder(e.X, e.Y) Then
            ClearCurrPointer()
            CurrPointer = -3
            UpdateRGBs(gColorBlend.BorderColor, True)
        End If

    End Sub

    Private Sub SelectPointer(ByVal ptr As Int32)

        ClearCurrPointer()
        CurrPointer = ptr

        If ptr = 0 Then
            StartPointer.pIsCurr = True
            UpdateRGBs(StartPointer.ARGB, True)
            CurrPos = StartPointer.PosToStrong
        ElseIf ptr = -1 Then
            EndPointer.pIsCurr = True
            UpdateRGBs(EndPointer.ARGB, True)
            CurrPos = EndPointer.PosToStrong
        Else
            MiddlePointers(CurrPointer).pIsCurr = True
            UpdateRGBs(MiddlePointers(CurrPointer).ARGB, True)
            CurrPos = CType(MiddlePointers(CurrPointer), cPointer).PosToStrong
        End If

    End Sub

    Private Sub ColorBlender_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Me.MouseMove
        If e.Button <> Windows.Forms.MouseButtons.None Then
            If _gColorBlend.BlendGradientType = eBlendGradientType.Path AndAlso IsMouseOverSample(e.X, e.Y) Then
                If e.Button = Windows.Forms.MouseButtons.Left Then
                    If Control.ModifierKeys = Keys.Control Then
                        gColorBlend.FocalPoints.SetFocusScales((e.X - rectSample.X) / (rectSample.Width),
                                                               (e.Y - rectSample.Y) / rectSample.Height)
                    Else
                        gColorBlend.FocalPoints.SetCenterPoint((e.X - rectSample.X) / (rectSample.Width),
                                                               (e.Y - rectSample.Y) / rectSample.Height)
                    End If
                    Invalidate(rectSampInvalidate)
                End If

            Else
                If MouseMoving AndAlso e.Button = Windows.Forms.MouseButtons.Left Then
                    If e.X >= rectBar.Left + 1 And e.X <= (rectBar.Right - 1) Then
                        UpdateCurrentPointerPos((e.X - rectBar.Left) / (rectBar.Width))
                    End If
                End If
            End If
        End If
    End Sub

    Private Sub UpdateCurrentPointerPos(ByVal pos As Single)
        MiddlePointers(CurrPointer).pPos = Math.Round(pos, 3)
        SortCollection(MiddlePointers, "pPos", True)
        CurrPointer = FindCurr()
        CurrPos = CType(MiddlePointers(CurrPointer), cPointer).PosToStrong
        Invalidate()
    End Sub

    Private Sub ColorBlender_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Me.MouseUp
        MouseMoving = False
        If CurrPointer = -3 Then
        Else

            SortCollection(MiddlePointers, "pPos", True)

            CurrPointer = FindCurr()
            gszDimColor.Reset()
            Invalidate()

        End If
    End Sub

    Private Function IsMouseOverSample(ByVal X As Integer, ByVal Y As Integer) As Boolean
        Return rectSample.Contains(X, Y)
    End Function

    Private Function IsMouseOverBorder(ByVal X As Integer, ByVal Y As Integer) As Boolean
        Return rectBorderSelect.Contains(X, Y)
    End Function

    Private Function IsMouseOverStartPointer(ByVal X As Integer, ByVal Y As Integer) As Boolean
        'Convert to Region.
        Using PointerRegion As New Region(BuildPointer(GetpX(0)))
            'Is the point inside the region.
            Return PointerRegion.IsVisible(X, Y)
        End Using
    End Function

    Private Function IsMouseOverEndPointer(ByVal X As Integer, ByVal Y As Integer) As Boolean
        'Convert to Region.
        Using PointerRegion As New Region(BuildPointer(GetpX(1)))
            'Is the point inside the region.
            Return PointerRegion.IsVisible(X, Y)
        End Using
    End Function

    Private Function IsMouseOverPointer(ByVal X As Integer, ByVal Y As Integer) As Integer
        If MiddlePointers IsNot Nothing Then

            For I As Integer = 1 To MiddlePointers.Count
                'Convert to Region.
                Using PointerRegion As New Region(BuildPointer(GetpX(MiddlePointers(I).pPos)))
                    'Is the point inside the region.
                    If PointerRegion.IsVisible(X, Y) Then Return I
                End Using
            Next
            Return -4
        End If
    End Function

    Private Sub ClearCurrPointer()
        For Each ptr As cPointer In MiddlePointers
            ptr.pIsCurr = False
        Next
        StartPointer.pIsCurr = False
        EndPointer.pIsCurr = False
    End Sub

    Private Function FindCurr() As Integer
        For i As Integer = 1 To MiddlePointers.Count
            If MiddlePointers(i).piscurr Then Return i
        Next
        If StartPointer.pIsCurr Then
            Return 0
        Else
            Return -1
        End If
    End Function

#End Region

#Region "Drawing"

    Private Sub DrawPointer(ByRef g As Graphics, ByVal bColor As Color, ByVal pt As Single, ByVal IsCurr As Boolean)

        Using cpbr As Brush = New SolidBrush(bColor),
            pn As New Pen(Color.LightGray, 2),
            gp As GraphicsPath = BuildPointer(GetpX(pt))
            g.FillPath(cpbr, gp)
            g.DrawPath(pn, gp)
            pn.Width = 1
            pn.Color = Color.Black
            g.DrawPath(pn, gp)
            If IsCurr Then
                Using pnCurr As New Pen(Brushes.Red, 1)
                    g.DrawLines(pnCurr, New PointF() {
                                New PointF(gp.GetBounds.Left - 1, gp.GetBounds.Bottom),
                                New PointF(gp.GetBounds.Left - 1, gp.GetBounds.Bottom + 3),
                                New PointF(gp.GetBounds.Right + 1, gp.GetBounds.Bottom + 3),
                                New PointF(gp.GetBounds.Right + 1, gp.GetBounds.Bottom)
                                })
                End Using
            End If
        End Using
    End Sub

    Private Function GetpX(ByVal pos As Single)
        Return ((rectBar.Width) * pos) + rectBar.Left
    End Function

    Private Function BuildPointer(ByVal cPX As Single) As GraphicsPath
        cPX -= 5
        Dim gp As New GraphicsPath
        gp.AddLine(cPX + 5, BarHeight - 3, cPX + 10, BarHeight)
        gp.AddLine(cPX + 10, BarHeight, cPX + 10, BarHeight + 7)
        gp.AddLine(cPX + 10, BarHeight + 7, cPX, BarHeight + 7)
        gp.AddLine(cPX, BarHeight + 7, cPX, BarHeight)
        gp.CloseFigure()
        Return gp
        gp.Dispose()

    End Function

    Public Function LinearBrush(ByVal BaseRect As Rectangle, ByVal Mode As LinearGradientMode) As LinearGradientBrush
        BaseRect.Inflate(1, 1)
        Dim br = New LinearGradientBrush(BaseRect,
                                        Color.AliceBlue,
                                        Color.Blue, Mode) With {.InterpolationColors = GetColorBlendForBrush()}

        Return br
    End Function

    Public Function PathBrush(ByVal BaseRect As Rectangle) As PathGradientBrush
        BaseRect.Inflate(1, 1)
        Dim gp As GraphicsPath = GetShapePath(BaseRect)
        Dim br As PathGradientBrush = New PathGradientBrush(gp) With
                                      {.InterpolationColors = GetColorBlendForBrush(),
                                       .CenterPoint = BlendConvertCenterPoint(BaseRect),
                                       .FocusScales = gColorBlend.FocalPoints.FocusScales
                                      }
        gp.Dispose()
        Return br
    End Function

    Public Function GetShapePath(ByVal rect As Rectangle) As GraphicsPath
        Dim gp As GraphicsPath = New GraphicsPath
        Select Case _gColorBlend.BlendPathShape

            Case eBlendPathShape.Ellipse
                gp.AddEllipse(rect)

            Case eBlendPathShape.Triangle
                Dim pts() As Point = New Point() { _
                    New Point(rect.X + (rect.Width / 2), rect.Y), _
                    New Point(rect.X + rect.Width, rect.Y + rect.Height), _
                    New Point(rect.X, rect.Y + rect.Height)}
                gp.AddPolygon(pts)

            Case eBlendPathShape.Polygon
                Dim pts() As Point = New Point() { _
                    New Point(rect.X + (rect.Width / 2), rect.Y), _
                    New Point(rect.X + rect.Width / 1.5, rect.Y + rect.Height / 4), _
                    New Point(rect.X + rect.Width, rect.Y + rect.Height / 3), _
                    New Point(rect.X + rect.Width / 1.5, rect.Y + rect.Height / 2), _
                    New Point(rect.X + rect.Width / 1.1, rect.Y + rect.Height / 1.1), _
                    New Point(rect.X + rect.Width / 2, rect.Y + rect.Height / 1.2), _
                    New Point(rect.X + rect.Width / 2.5, rect.Y + rect.Height), _
                    New Point(rect.X, rect.Y + rect.Height / 1.5), _
                    New Point(rect.X + rect.Width / 8, rect.Y + rect.Height / 2), _
                    New Point(rect.X + rect.Width / 10, rect.Y + rect.Height / 5) _
                    }
                gp.AddPolygon(pts)

            Case eBlendPathShape.Rectangle
                gp.AddRectangle(rect)

        End Select

        Return gp

    End Function

    Private Sub BuildABlend()
        Dim lColors As New List(Of Color)
        lColors.Add(StartPointer.ARGB)
        If MiddlePointers IsNot Nothing Then
            For Each ptr As cPointer In MiddlePointers
                lColors.Add(ptr.ARGB)
            Next
        End If
        lColors.Add(EndPointer.ARGB)
        gColorBlend.cbColor = lColors.ToArray
        lColors = Nothing

        Dim lPos As New List(Of Single)
        lPos.Add(StartPointer.pPos)
        If MiddlePointers IsNot Nothing Then
            For Each ptr As cPointer In MiddlePointers
                lPos.Add(ptr.pPos)
            Next
        End If
        lPos.Add(EndPointer.pPos)
        gColorBlend.cbPosition = lPos.ToArray
        lPos = Nothing
        RaiseEvent BlendChanged()
    End Sub

    Private Sub UpdatePointerColor()
        Dim CurrColor As Color = Color.FromArgb(gszAlpha.Value, gszRed.Value, gszGreen.Value, gszBlue.Value).GetColorBest
        If CurrPointer = -3 Then
            gColorBlend.BorderColor = Color.FromArgb(gszAlpha.Value, CurrColor)
        Else
            If StartPointer.pIsCurr Then
                StartPointer.pColor = CurrColor
                StartPointer.pAlpha = gszAlpha.Value
            ElseIf EndPointer.pIsCurr Then
                EndPointer.pColor = CurrColor
                EndPointer.pAlpha = gszAlpha.Value
            Else
                Dim curr As Integer = FindCurr()
                If curr > 0 Then
                    MiddlePointers(curr).pColor = CurrColor
                    MiddlePointers(curr).pAlpha = gszAlpha.Value
                End If
            End If
        End If

        If Not Dimming Then
            gszDimColor.Tag = New cPointer(CurrPointer, CurrColor, gszAlpha.Value, True)
            gszDimColor.Reset()
        End If
        txbCurrColor.Text = CurrColor.Name
        LoadingColorBlend = True
        ColorBox.Text = CurrColor.GetColorNearestName()
        LoadingColorBlend = False
        Invalidate()

    End Sub

#End Region

#Region "Painting"

    Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
        MyBase.OnPaint(e)
        'Go through each Pointer in the collection to get the current Color and Position arrays
        BuildABlend()

        'Create a canvas to paint on the same size as the control
        Dim bitmapBuffer As Bitmap = New Bitmap(ClientSize.Width, ClientSize.Height)
        Dim g As Graphics = Graphics.FromImage(bitmapBuffer)
        g.Clear(BackColor)
        g.SmoothingMode = SmoothingMode.AntiAlias
        g.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAliasGridFit

        ' Paint the ColorBlender Bar with the Linear Brush
        Dim br As Brush = LinearBrush(rectBar, LinearGradientMode.Horizontal)
        g.FillRectangle(br, rectBar)


        ' Paint the Current Color and Position
        br = New HatchBrush(HatchStyle.LargeCheckerBoard, Color.White, Color.Silver)
        g.FillRectangle(br, rectCurrColor)
        g.FillRectangle(New SolidBrush(Color.FromArgb(gszAlpha.Value, _
                                           gszRed.Value, _
                                           gszGreen.Value, _
                                           gszBlue.Value)), rectCurrColor)
        g.DrawRectangle(Pens.Black, rectCurrColor)
        If CurrPointer > -3 Then
            TextRenderer.DrawText(g,
                CurrPos,
                New Font("Arial", 8, FontStyle.Bold),
                New Rectangle(rectCurrColor.Left - 3, rectCurrColor.Bottom + 1, 50, 30),
                Color.Black, BackColor, TextFormatFlags.Left)

            g.FillRectangles(Brushes.White, New Rectangle() {rectLeft, rectRight})
            g.FillPolygon(Brushes.MediumBlue, ptsLeft)
            g.FillPolygon(Brushes.MediumBlue, ptsRight)
            g.DrawRectangles(Pens.Black, New Rectangle() {rectLeft, rectRight})
        End If

        'Draw all the pointers in their Color at their Position along the Bar
        Using pn As New Pen(Color.Gray, 1) With {.DashStyle = DashStyle.Dash}
            g.DrawLine(pn, rectBar.Left, BarHeight + 7, rectBar.Right, BarHeight + 7)

            pn.Color = Color.Black
            pn.DashStyle = DashStyle.Solid

            DrawPointer(g, StartPointer.ARGB, 0, StartPointer.pIsCurr)
            DrawPointer(g, EndPointer.ARGB, 1, EndPointer.pIsCurr)

            If MiddlePointers IsNot Nothing Then
                For I As Integer = 1 To MiddlePointers.Count
                    DrawPointer(g, MiddlePointers(I).ARGB, _
                    MiddlePointers(I).pPos, I = CurrPointer)
                Next
            End If

        End Using

        If _showSample Then
            'Draw Border
            Dim rectHatch As Rectangle = rectBorderSelect
            rectHatch.Inflate(-1, -1)
            g.FillRectangle(br, rectHatch)
            g.FillRectangle(New SolidBrush(gColorBlend.BorderColor), rectBorderSelect)
            If CurrPointer = -3 Then
                Using pn As New Pen(Brushes.Red, 1)
                    g.DrawLines(pn, New Point() {
                            New Point(rectBorderSelect.Left - 2, rectBorderSelect.Top + 4),
                            New Point(rectBorderSelect.Left - 2, rectBorderSelect.Top - 2),
                            New Point(rectBorderSelect.Right + 2, rectBorderSelect.Top - 2),
                            New Point(rectBorderSelect.Right + 2, rectBorderSelect.Top + 4)
                                            })
                End Using
            End If

            ' Paint the ColorBlender Sample with the chosen Shape and BrushType
            Using gp As New GraphicsPath, gph As New GraphicsPath

                rectHatch = rectSample
                rectHatch.Inflate(-1, -1)
                If _gColorBlend.BlendGradientType = eBlendGradientType.Linear Then
                    gph.AddRectangle(rectHatch)
                    g.FillPath(br, gph)
                    gp.AddRectangle(rectSample)
                    br = LinearBrush(rectSample, _gColorBlend.BlendGradientMode)
                Else
                    gph.AddPath(GetShapePath(rectHatch), False)
                    g.FillPath(br, gph)
                    gp.AddPath(GetShapePath(rectSample), False)
                    br = PathBrush(rectSample)
                    TextRenderer.DrawText(g, String.Format(
                         "cp: {1:0.00}, {2:0.00}{0}fs: {3:0.00}, {4:0.00}",
                         vbNewLine,
                         gColorBlend.FocalPoints.CenterPtX,
                         gColorBlend.FocalPoints.CenterPtY,
                         gColorBlend.FocalPoints.FocusPtX,
                         gColorBlend.FocalPoints.FocusPtY),
                        New Font("Arial", 8, FontStyle.Regular),
                        New Rectangle(rectSample.Left - 2, rectSample.Bottom + 1, rectSample.Width + 2, 30),
                        Color.Black, BackColor, TextFormatFlags.HorizontalCenter)
                End If

                g.FillPath(br, gp)
                Using pn As New Pen(gColorBlend.BorderColor, 2)
                    g.DrawPath(pn, gp)
                End Using

            End Using
        End If

        'Draw the entire image to the control in one shot to eliminate flicker
        e.Graphics.DrawImage(bitmapBuffer.Clone, 0, 0)

        bitmapBuffer.Dispose()
        br.Dispose()
        g.Dispose()

    End Sub


#End Region

#Region "Resize"
    Private Sub ColorBlender_Resize(ByVal sender As Object, ByVal e As EventArgs) Handles Me.Resize
        ResizeMe()
    End Sub

    Private Sub ResizeMe()
        rectSample = New Rectangle(panProps.Right + 4, BarHeight + 30, 74, 74)
        rectBar = New Rectangle(40, 0, Width - 50, BarHeight)
        rectCurrColor = New Rectangle(5, (BarHeight / 2) - 9, 18, 18)
        rectLeft = New Rectangle(rectCurrColor.Right,
                                   rectCurrColor.Top,
                                   10,
                                   rectCurrColor.Height \ 2)

        rectRight = New Rectangle(rectCurrColor.Right,
                                    rectCurrColor.Top + rectCurrColor.Height \ 2,
                                    10,
                                    rectCurrColor.Height \ 2)

        rectBorderSelect = New Rectangle(rectSample.Right - rectSample.Width / 4,
                                           rectSample.Top - 10,
                                           rectSample.Width / 4 - 1,
                                           10)

        rectSampInvalidate = New Rectangle(rectSample.Left - 1,
                                           rectBorderSelect.Top,
                                           rectSample.Right + 1,
                                           rectSample.Bottom + 4)

        ptsLeft = New PointF() {New PointF(rectRight.Right - 3, rectRight.Top + 2),
                                New PointF(rectRight.Left + 2, rectRight.Top + rectRight.Height / 2),
                                New PointF(rectRight.Right - 3, rectRight.Bottom - 2)}

        ptsRight = New PointF() {New PointF(rectLeft.Left + 3, rectLeft.Top + 2),
                                 New PointF(rectLeft.Right - 2, rectLeft.Top + rectLeft.Height / 2),
                                 New PointF(rectLeft.Left + 3, rectLeft.Bottom - 2)}
    End Sub
#End Region

#Region "SortCollection"
    'Thanks to Greg Givler for this routine
    Private Shared Sub SortCollection(ByVal col As Collection, _
    ByVal psSortPropertyName As String, ByVal pbAscending As Boolean, _
    Optional ByVal psKeyPropertyName As String = "")

        Dim obj As Object
        Dim i As Integer
        Dim j As Integer
        Dim iMinMaxIndex As Integer
        Dim vMinMax As Object
        Dim vValue As Object
        Dim bSortCondition As Boolean
        Dim bUseKey As Boolean
        Dim sKey As String

        bUseKey = (psKeyPropertyName <> "")

        For i = 1 To col.Count - 1
            obj = col(i)
            vMinMax = CallByName(obj, psSortPropertyName, vbGet)
            iMinMaxIndex = i

            For j = i + 1 To col.Count
                obj = col(j)
                vValue = CallByName(obj, _
                    psSortPropertyName, vbGet)

                If (pbAscending) Then
                    bSortCondition = (vValue < vMinMax)
                Else
                    bSortCondition = (vValue > vMinMax)
                End If

                If (bSortCondition) Then
                    vMinMax = vValue
                    iMinMaxIndex = j
                End If

                obj = Nothing
            Next j

            If (iMinMaxIndex <> i) Then
                obj = col(iMinMaxIndex)

                col.Remove(iMinMaxIndex)
                If (bUseKey) Then
                    sKey = CStr(CallByName(obj, _
                       psKeyPropertyName, vbGet))
                    col.Add(obj, sKey, i)
                Else
                    col.Add(obj, , i)
                End If

                obj = Nothing
            End If

            obj = Nothing
        Next i

    End Sub

#End Region

#Region "Color Swatches"

    Private Sub Panel7_Click(ByVal sender As Object, ByVal e As EventArgs) _
        Handles Panel22.Click, Panel7.Click, Panel8.Click, Panel9.Click, Panel10.Click,
        Panel11.Click, Panel12.Click, Panel13.Click, Panel20.Click, Panel19.Click,
        Panel14.Click, Panel15.Click, Panel16.Click, Panel17.Click, Panel21.Click,
        Panel18.Click, Panel28.Click, Panel27.Click, Panel26.Click, Panel25.Click,
        Panel24.Click, Panel23.Click, Panel6.Click, Panel29.Click

        UpdateRGBs(sender.BackColor)
        Invalidate()
    End Sub

    Private CurrSwatch As Panel
    Private Sub Panel10_MouseEnter(ByVal sender As Object, ByVal e As EventArgs) _
        Handles Panel22.MouseEnter, Panel7.MouseEnter, Panel8.MouseEnter, Panel9.MouseEnter,
        Panel10.MouseEnter, Panel11.MouseEnter, Panel12.MouseEnter, Panel13.MouseEnter,
        Panel20.MouseEnter, Panel19.MouseEnter, Panel14.MouseEnter, Panel15.MouseEnter,
        Panel16.MouseEnter, Panel17.MouseEnter, Panel21.MouseEnter, Panel18.MouseEnter,
        Panel28.MouseEnter, Panel27.MouseEnter, Panel26.MouseEnter, Panel25.MouseEnter,
        Panel24.MouseEnter, Panel23.MouseEnter, Panel6.MouseEnter, Panel29.MouseEnter

        If Not IsNothing(CurrSwatch) Then CurrSwatch.BorderStyle = Windows.Forms.BorderStyle.Fixed3D
        CurrSwatch = sender
        CurrSwatch.BorderStyle = Windows.Forms.BorderStyle.FixedSingle
    End Sub

    Private Sub Panel1_MouseLeave(ByVal sender As Object, ByVal e As EventArgs) Handles Panel1.MouseLeave
        If Not IsNothing(CurrSwatch) Then CurrSwatch.BorderStyle = Windows.Forms.BorderStyle.Fixed3D
    End Sub
#End Region

#Region "ColorBox"

    Private Sub ColorBox_SelectedIndexChanged(ByVal sender As Object, ByVal e As EventArgs) Handles ColorBox.SelectedIndexChanged
        If Not LoadingColorBlend Then

            UpdateRGBs(Color.FromName(ColorBox.Text))
            Invalidate()

        End If
    End Sub

    Private Sub ColorList_DrawItem(ByVal sender As Object, _
        ByVal e As DrawItemEventArgs)
        If Not LoadingColorBlend Then

            ' If the item is the edit box item, then draw the rectangle white
            ' If the item is the selected item, then draw the rectangle blue
            ' Otherwise, draw the rectangle filled in beige
            If (e.State And DrawItemState.ComboBoxEdit) = DrawItemState.ComboBoxEdit Then
                e.Graphics.FillRectangle(Brushes.White, e.Bounds)
            ElseIf (e.State And DrawItemState.Selected) = DrawItemState.Selected Then
                e.Graphics.FillRectangle(Brushes.CornflowerBlue, e.Bounds)
            Else
                e.Graphics.FillRectangle(Brushes.Beige, e.Bounds)
            End If

            ' Cast the sender object  to ComboBox type.
            Dim TheBox As ComboBox = CType(sender, ComboBox)
            Dim itemString As String = CType(TheBox.Items(e.Index), String)
            Dim myBrush As New SolidBrush(Color.FromName(itemString))

            'Draw a Color Swatch
            e.Graphics.FillRectangle(myBrush, e.Bounds.X + 3, e.Bounds.Y + 3, 20, e.Bounds.Height - 5)
            e.Graphics.DrawRectangle(Pens.Black, e.Bounds.X + 3, e.Bounds.Y + 3, 20, e.Bounds.Height - 5)

            ' Draw the text in the item.
            e.Graphics.DrawString(itemString, ColorBox.Font, _
                Brushes.Black, e.Bounds.X + 25, e.Bounds.Y + 1)

            ' Draw the focus rectangle around the selected item.
            e.DrawFocusRectangle()
            myBrush.Dispose()

        End If

    End Sub


#End Region

#Region "Context Menu Brush"

    Private Sub LinearHorizontalToolStripMenuItem_Click(ByVal sender As Object, ByVal e As EventArgs) Handles _
        LinearHorizontalToolStripMenuItem.Click, _
        LinearVerticalToolStripMenuItem.Click, _
        LinearDiagonalForwardToolStripMenuItem.Click, _
        LinearDiagonalBackwardsToolStripMenuItem.Click, _
        PathRectangleToolStripMenuItem.Click, _
        PathEllipseToolStripMenuItem.Click, _
        PathTriangleToolStripMenuItem.Click, _
        PathPolygonToolStripMenuItem.Click

        Dim item As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem)
        LinearHorizontalToolStripMenuItem.Checked = (item.Name = "LinearHorizontalToolStripMenuItem")
        LinearVerticalToolStripMenuItem.Checked = (item.Name = "LinearVerticalToolStripMenuItem")
        LinearDiagonalForwardToolStripMenuItem.Checked = (item.Name = "LinearDiagonalForwardToolStripMenuItem")
        LinearDiagonalBackwardsToolStripMenuItem.Checked = (item.Name = "LinearDiagonalBackwardsToolStripMenuItem")
        PathRectangleToolStripMenuItem.Checked = (item.Name = "PathRectangleToolStripMenuItem")
        PathEllipseToolStripMenuItem.Checked = (item.Name = "PathEllipseToolStripMenuItem")
        PathTriangleToolStripMenuItem.Checked = (item.Name = "PathTriangleToolStripMenuItem")
        PathPolygonToolStripMenuItem.Checked = (item.Name = "PathPolygonToolStripMenuItem")

        Select Case item.Name

            Case "LinearHorizontalToolStripMenuItem", _
                "LinearVerticalToolStripMenuItem", _
                "LinearDiagonalForwardToolStripMenuItem", _
                "LinearDiagonalBackwardsToolStripMenuItem"

                _gColorBlend.BlendGradientType = eBlendGradientType.Linear
                _gColorBlend.BlendGradientMode = [Enum].Parse(GetType(LinearGradientMode), item.Tag.ToString)

            Case "PathRectangleToolStripMenuItem", _
                "PathEllipseToolStripMenuItem", _
                "PathTriangleToolStripMenuItem", _
                "PathPolygonToolStripMenuItem"

                _gColorBlend.BlendGradientType = eBlendGradientType.Path
                _gColorBlend.BlendPathShape = [Enum].Parse(GetType(eBlendPathShape), item.Tag.ToString)

        End Select

        Invalidate(rectSampInvalidate)

    End Sub
#End Region

#Region "Color Dimmer"

    Private Dimming As Boolean

    Private Sub gszDimColor_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) Handles gszDimColor.MouseDown
        Dimming = True
    End Sub

    Private Sub gszDimColor_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs) Handles gszDimColor.MouseUp
        Dimming = False
    End Sub

    Private Sub gszDimColor_ValueChanged(ByVal sender As Object, ByVal Value As Int32, ByVal ValueAdj As Single) Handles gszDimColor.ValueChanged
        Dim colorsamp As Color = CType(gszDimColor.Tag, cPointer).ARGB
        UpdateRGBs(DimTheColor(colorsamp, Value))
    End Sub
#End Region

#Region "Alpha Value"

    Private Sub gszAlpha_ValueChanged(ByVal sender As Object, ByVal Value As Int32, ByVal ValueAdj As Single) Handles gszAlpha.ValueChanged
        UpdatePointerColor()
    End Sub
#End Region

#Region "RGB Values"

    Private Sub gszRed_ValueChanged(ByVal sender As Object, ByVal Value As Int32, ByVal ValueAdj As Single) Handles gszRed.ValueChanged, gszGreen.ValueChanged, gszBlue.ValueChanged
        UpdatePointerColor()
    End Sub

    Private Sub UpdateRGBs(ByVal c As Color, Optional ByVal includeAlpha As Boolean = False)
        If includeAlpha Then
            gszAlpha.Value = c.A
            gszAlpha.ResetValue = c.A
        End If

        If c = Color.Transparent Or c.Name = "ffffff" Then
            gszAlpha.Value = 0
            gszAlpha.ResetValue = 0
        ElseIf gszAlpha.Value = 0 Then
            gszAlpha.Value = 255
            gszAlpha.ResetValue = 255
        End If

        gszRed.Value = c.R
        gszGreen.Value = c.G
        gszBlue.Value = c.B
        gszRed.ResetValue = c.R
        gszGreen.ResetValue = c.G
        gszBlue.ResetValue = c.B

        UpdatePointerColor()
    End Sub

#End Region

End Class

#Region "gColorBlenderDesigner"

Public Class gColorBlenderDesigner

    Inherits ControlDesigner

    Public Overrides ReadOnly Property SelectionRules() As SelectionRules
        Get
            Return Windows.Forms.Design.SelectionRules.Visible _
                   Or Windows.Forms.Design.SelectionRules.Moveable Or Windows.Forms.Design.SelectionRules.Moveable
        End Get
    End Property
End Class
#End Region

By viewing downloads associated with this article you agree to the Terms of Service and the article's licence.

If a file you wish to view isn't highlighted, and is a text file (not binary), please let us know and we'll add colourisation support for it.

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)


Written By
Software Developer
United States United States
I first got hooked on programing with the TI994A. After it finally lost all support I reluctantly moved to the Apple IIe. Thank You BeagleBros for getting me through. I wrote programs for my Scuba buisness during this time. Currently I am a Database manager and software developer. I started with VBA and VB6 and now having fun with VB.NET/WPF/C#...

Comments and Discussions