dcsimg
Page 2 of 2 FirstFirst 12
Results 41 to 62 of 62

Thread: [RESOLVED] How to draw a color wheel (color picker)?

  1. #41
    Hyperactive Member
    Join Date
    Sep 2010
    Location
    Italy
    Posts
    468

    Re: How to draw a color wheel (color picker)?

    @dreammanor

    If you want to do it using vbRichClient I think this could be a good starting point:
    http://www.vbforums.com/showthread.p...vbRichClient5)

    This is my modified version of cwColorChooser class
    Code:
    Option Explicit    'a circular ColorChooser (implemented as an RC5 cwWidget-Class)
    
    Event ColorChanged()
    
    Const RingSurfaceSize& = 384, RingWidth& = 42    '<- that's the consts for the OneTime-Surface-construction
    
    Private xCenter As Single, yCenter As Single, RingRadius As Single
    Private RingSrf As cCairoSurface
    Private CurRingIdx As Long, ColorLut(0 To 1440 - 1) As Long
    Private CurLUM As Single
    
    Private WithEvents W As cWidgetBase
    
    Private RR#, GG#, BB#
    
    Private Sub Class_Initialize()
        Set W = Cairo.WidgetBase
        W.BackColor = vbWhite
        W.ImplementsWheelMessages = True
        Set RingSrf = CreateRingSpectrumSurface(RingSurfaceSize, RingWidth)
    End Sub
    
    Public Property Get Widget() As cWidgetBase
        Set Widget = W
    End Property
    Public Property Get Widgets() As cWidgets
        Set Widgets = W.Widgets
    End Property
    
    Public Property Get Color() As Long
        'Color = ColorLut(CurRingIdx)
        Color = RGB(RR * 255, GG * 255, BB * 255)
    End Property
    
    Private Sub W_MouseWheel(ByVal MouseKeys As Long, ByVal Rotation As Long, ByVal LineOffset As Long, ByVal xAbs As Single, ByVal yAbs As Single)
        CurRingIdx = (CurRingIdx + UBound(ColorLut) + 1 + LineOffset * 8) Mod UBound(ColorLut) + 1
        
            W.Refresh: RaiseEvent ColorChanged
    End Sub
    
    Private Sub W_Resize()
        xCenter = W.ScaleWidth / 2: yCenter = W.ScaleHeight / 2
        RingRadius = W.ScaleWidth * 0.4
        W.Refresh
    End Sub
    
    Private Sub W_MouseMove(Button As Integer, Shift As Integer, ByVal X As Single, ByVal Y As Single)
        If Button <> 1 Then Exit Sub
        CurRingIdx = (Cairo.CalcArc(yCenter - Y, xCenter - X) * 720 / Cairo.PI + 1080) Mod 1440
        CurLUM = Sqr((xCenter - X) * (xCenter - X) + (yCenter - Y) * (yCenter - Y))
        CurLUM = CurLUM / RingRadius
        If CurLUM > 1 Then CurLUM = 1
        
        W.Refresh: RaiseEvent ColorChanged
    End Sub
    
    Private Sub W_Paint(CC As cCairoContext, ByVal xAbs As Single, ByVal yAbs As Single, ByVal dx_Aligned As Single, ByVal dy_Aligned As Single, UserObj As Object)
        DrawBorderAndBackGround CC, dx_Aligned, dy_Aligned
    
        CC.Arc xCenter, yCenter, 0.4 * RingRadius    'the centered Circle-Fill with the current color
        'CC.SetSourceColor ColorLut(CurRingIdx)
        CC.ColorSplit ColorLut(CurRingIdx), RR, GG, BB
    
        RR = RR + (CurLUM * 2 - 1)
        GG = GG + (CurLUM * 2 - 1)
        BB = BB + (CurLUM * 2 - 1)
        If RR > 1 Then RR = 1
        If GG > 1 Then GG = 1
        If BB > 1 Then BB = 1
        If RR < 0 Then RR = 0
        If GG < 0 Then GG = 0
        If BB < 0 Then BB = 0
        
        CC.SetSourceRGB RR, GG, BB
        CC.Fill True
    
    
        CC.SetLineWidth 2.8
        CC.SetSourceColor vbBlack, 0.25
        CC.Stroke True    'intermediate stroke (the path is still there)
    
        CC.SetLineWidth 1.25
        CC.SetSourceColor vbWhite, 0.7
        CC.Stroke    'final stroke
    
    
        CC.Save
        CC.TranslateDrawings xCenter + 0.5, yCenter + 0.5
        CC.SetSourceColor ColorLut(CurRingIdx)
    
        'the RingSurface
        CC.RenderSurfaceContent RingSrf, -RingRadius, -RingRadius, 2 * RingRadius, 2 * RingRadius
    
        'the small triangle (+ the line leading to it)
        CC.SetLineWidth 0.4
        CC.RotateDrawingsDeg CurRingIdx / 4
        CC.MoveTo 0, 0
        CC.LineTo 0, -RingRadius - 0.75
        CC.RelLineTo -8, -8
        CC.RelLineTo 16, 0
        CC.RelLineTo -8, 8
        CC.Fill True
        CC.Stroke
    
        'the small black/white "inner-circle"
        Dim ScaledRW#: ScaledRW = RingWidth * RingRadius / (RingSurfaceSize - RingWidth - 6)
        'CC.Arc 0, -RingRadius + ScaledRW, ScaledRW * 0.6
        
        CC.Arc 0, -ScaledRW * 0.6 * 2 - CurLUM * (RingRadius - (ScaledRW * 0.6 * 2)) + ScaledRW, ScaledRW * 0.6
        
        CC.SetLineWidth 3
        CC.SetSourceColor vbBlack, 0.55
        CC.Stroke True    'intermediate stroke (the path is still there)
    
        CC.SetLineWidth 1.25
        CC.SetSourceColor vbWhite, 0.7
        CC.Stroke    'final stroke
        CC.Restore
    End Sub
    
    Private Sub DrawBorderAndBackGround(CC As cCairoContext, dx, dy)
        CC.SetLineWidth 1, True
        CC.Rectangle 0, 0, dx, dy, True
        CC.SetSourceColor W.BackColor, W.Alpha
        CC.Fill True
        CC.SetSourceColor W.BorderColor, W.Alpha
        CC.Stroke
    End Sub
    
    Private Function CreateRingSpectrumSurface(Size, RingWidth) As cCairoSurface
        Dim i&, Lst As cArrayList, LUTSrf As cCairoSurface, LUT() As Byte
        Set LUTSrf = Cairo.CreateSurface(1440, 1)    'a long, but only one Pixel high "Stripe-Surface" (1/4 of a degree -> 360*4=1440)
        With Cairo.CreateLinearPattern(0, 0, LUTSrf.Width - 1, 0)
            Set Lst = New_c.ArrayList(vbLong, vbRed, vbYellow, vbGreen, vbCyan, vbBlue, vbMagenta, vbRed)
            For i = 0 To Lst.Count - 1
                .AddColorStop i / 6, Lst(i)
            Next i
            LUTSrf.CreateContext.Paint 1, .This
        End With
    
        Set CreateRingSpectrumSurface = Cairo.CreateSurface(Size, Size)
        With CreateRingSpectrumSurface.CreateContext
            .SetLineCap CAIRO_LINE_CAP_ROUND
            .SetLineWidth (Size - RingWidth - 3.5) * 2 * Cairo.PI / LUTSrf.Width
            .TranslateDrawings Size \ 2, Size \ 2
            LUTSrf.BindToArray LUT
            For i = 0 To 1440 - 1
                ColorLut(i) = RGB(LUT(i * 4 + 2, 0), LUT(i * 4 + 1, 0), LUT(i * 4, 0))
                .SetSourceColor ColorLut(i)
                .MoveTo 0, -(Size / 2 - RingWidth - 3.5)
                .RelLineTo 0, -RingWidth
                .Stroke
                .RotateDrawingsDeg 0.25    'rotate by one quarter of a degree (360 / (1440 steps in the LUT))
            Next i
            LUTSrf.ReleaseArray LUT
        End With
    End Function

  2. #42
    Frenzied Member wqweto's Avatar
    Join Date
    May 2011
    Posts
    1,613

    Re: How to draw a color wheel (color picker)?

    Here is a real-time PhotoShop like color-picker in VB6 that I made as a by-product of another PSC submission.

    http://www.planet-source-code.com/vb...xtCodeId=36529

    It's like PhotoShop from 17 years ago though but I still like it better than modern wheels for actually selecting a color.



    cheers,
    </wqw>

  3. #43
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    5,842

    Re: How to draw a color wheel (color picker)?

    Quote Originally Posted by wqweto View Post
    Here is a real-time PhotoShop like color-picker in VB6 that I made as a by-product of another PSC submission.

    http://www.planet-source-code.com/vb...xtCodeId=36529

    It's like PhotoShop from 17 years ago though but I still like it better than modern wheels for actually selecting a color.

    cheers,
    </wqw>
    That's an interesting approach. It puts Saturation and Value on the large palette, and pulls Hue off as the third dimension. I suppose, in theory, any of the three could be pulled off as the third dimension.

    And yeah, truth be told, I like the rectangle for two dimension. That way, you don't have to make any decisions about what to do with the areas outside of the circle (in the corners).
    Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

  4. #44

    Thread Starter
    Frenzied Member
    Join Date
    Sep 2012
    Posts
    1,693

    Re: How to draw a color wheel (color picker)?

    Quote Originally Posted by Elroy View Post
    Ok, here's my first pass at a true HSV scheme with a color-wheel.



    And a little demo project is attached.

    I still think it would be nice if the Hue-Saturation picture was change according to the light-dark value. And also, we could change the light-dark (value) slider to reflect the chosen hue and saturation. But that would take a bit more work, and I've got other things going on here, so we'll see.
    Great ! Your demo is very close to my original idea. Thank you very much, Elroy.

    Quote Originally Posted by Eduardo- View Post
    I don't think that would make any difference.
    Hi, Eduardo-, I tested SetPixel, if I use SetPixel, Color-Wheel does have white spots, I don't know why.

    wqweto uses a cMemDC in his Color Picker, which may improve the rendering speed of your Color-Wheel.

    In addition, Tanner introduced a faster method than SetPixel: SetBitmapBits and DIB:
    http://www.tannerhelland.com/41/vb-g...programming-2/
    http://www.tannerhelland.com/42/vb-g...programming-3/

  5. #45

    Thread Starter
    Frenzied Member
    Join Date
    Sep 2012
    Posts
    1,693

    Re: How to draw a color wheel (color picker)?

    Quote Originally Posted by reexre View Post
    @dreammanor

    If you want to do it using vbRichClient I think this could be a good starting point:
    http://www.vbforums.com/showthread.p...vbRichClient5)

    This is my modified version of cwColorChooser class
    Code:
    Option Explicit    'a circular ColorChooser (implemented as an RC5 cwWidget-Class)
    
    Event ColorChanged()
    
    Const RingSurfaceSize& = 384, RingWidth& = 42    '<- that's the consts for the OneTime-Surface-construction
    
    Private xCenter As Single, yCenter As Single, RingRadius As Single
    Private RingSrf As cCairoSurface
    Private CurRingIdx As Long, ColorLut(0 To 1440 - 1) As Long
    Private CurLUM As Single
    
    Private WithEvents W As cWidgetBase
    
    Private RR#, GG#, BB#
    
    Private Sub Class_Initialize()
        Set W = Cairo.WidgetBase
        W.BackColor = vbWhite
        W.ImplementsWheelMessages = True
        Set RingSrf = CreateRingSpectrumSurface(RingSurfaceSize, RingWidth)
    End Sub
    
    Public Property Get Widget() As cWidgetBase
        Set Widget = W
    End Property
    Public Property Get Widgets() As cWidgets
        Set Widgets = W.Widgets
    End Property
    
    Public Property Get Color() As Long
        'Color = ColorLut(CurRingIdx)
        Color = RGB(RR * 255, GG * 255, BB * 255)
    End Property
    
    Private Sub W_MouseWheel(ByVal MouseKeys As Long, ByVal Rotation As Long, ByVal LineOffset As Long, ByVal xAbs As Single, ByVal yAbs As Single)
        CurRingIdx = (CurRingIdx + UBound(ColorLut) + 1 + LineOffset * 8) Mod UBound(ColorLut) + 1
        
            W.Refresh: RaiseEvent ColorChanged
    End Sub
    
    Private Sub W_Resize()
        xCenter = W.ScaleWidth / 2: yCenter = W.ScaleHeight / 2
        RingRadius = W.ScaleWidth * 0.4
        W.Refresh
    End Sub
    
    Private Sub W_MouseMove(Button As Integer, Shift As Integer, ByVal X As Single, ByVal Y As Single)
        If Button <> 1 Then Exit Sub
        CurRingIdx = (Cairo.CalcArc(yCenter - Y, xCenter - X) * 720 / Cairo.PI + 1080) Mod 1440
        CurLUM = Sqr((xCenter - X) * (xCenter - X) + (yCenter - Y) * (yCenter - Y))
        CurLUM = CurLUM / RingRadius
        If CurLUM > 1 Then CurLUM = 1
        
        W.Refresh: RaiseEvent ColorChanged
    End Sub
    
    Private Sub W_Paint(CC As cCairoContext, ByVal xAbs As Single, ByVal yAbs As Single, ByVal dx_Aligned As Single, ByVal dy_Aligned As Single, UserObj As Object)
        DrawBorderAndBackGround CC, dx_Aligned, dy_Aligned
    
        CC.Arc xCenter, yCenter, 0.4 * RingRadius    'the centered Circle-Fill with the current color
        'CC.SetSourceColor ColorLut(CurRingIdx)
        CC.ColorSplit ColorLut(CurRingIdx), RR, GG, BB
    
        RR = RR + (CurLUM * 2 - 1)
        GG = GG + (CurLUM * 2 - 1)
        BB = BB + (CurLUM * 2 - 1)
        If RR > 1 Then RR = 1
        If GG > 1 Then GG = 1
        If BB > 1 Then BB = 1
        If RR < 0 Then RR = 0
        If GG < 0 Then GG = 0
        If BB < 0 Then BB = 0
        
        CC.SetSourceRGB RR, GG, BB
        CC.Fill True
    
    
        CC.SetLineWidth 2.8
        CC.SetSourceColor vbBlack, 0.25
        CC.Stroke True    'intermediate stroke (the path is still there)
    
        CC.SetLineWidth 1.25
        CC.SetSourceColor vbWhite, 0.7
        CC.Stroke    'final stroke
    
    
        CC.Save
        CC.TranslateDrawings xCenter + 0.5, yCenter + 0.5
        CC.SetSourceColor ColorLut(CurRingIdx)
    
        'the RingSurface
        CC.RenderSurfaceContent RingSrf, -RingRadius, -RingRadius, 2 * RingRadius, 2 * RingRadius
    
        'the small triangle (+ the line leading to it)
        CC.SetLineWidth 0.4
        CC.RotateDrawingsDeg CurRingIdx / 4
        CC.MoveTo 0, 0
        CC.LineTo 0, -RingRadius - 0.75
        CC.RelLineTo -8, -8
        CC.RelLineTo 16, 0
        CC.RelLineTo -8, 8
        CC.Fill True
        CC.Stroke
    
        'the small black/white "inner-circle"
        Dim ScaledRW#: ScaledRW = RingWidth * RingRadius / (RingSurfaceSize - RingWidth - 6)
        'CC.Arc 0, -RingRadius + ScaledRW, ScaledRW * 0.6
        
        CC.Arc 0, -ScaledRW * 0.6 * 2 - CurLUM * (RingRadius - (ScaledRW * 0.6 * 2)) + ScaledRW, ScaledRW * 0.6
        
        CC.SetLineWidth 3
        CC.SetSourceColor vbBlack, 0.55
        CC.Stroke True    'intermediate stroke (the path is still there)
    
        CC.SetLineWidth 1.25
        CC.SetSourceColor vbWhite, 0.7
        CC.Stroke    'final stroke
        CC.Restore
    End Sub
    
    Private Sub DrawBorderAndBackGround(CC As cCairoContext, dx, dy)
        CC.SetLineWidth 1, True
        CC.Rectangle 0, 0, dx, dy, True
        CC.SetSourceColor W.BackColor, W.Alpha
        CC.Fill True
        CC.SetSourceColor W.BorderColor, W.Alpha
        CC.Stroke
    End Sub
    
    Private Function CreateRingSpectrumSurface(Size, RingWidth) As cCairoSurface
        Dim i&, Lst As cArrayList, LUTSrf As cCairoSurface, LUT() As Byte
        Set LUTSrf = Cairo.CreateSurface(1440, 1)    'a long, but only one Pixel high "Stripe-Surface" (1/4 of a degree -> 360*4=1440)
        With Cairo.CreateLinearPattern(0, 0, LUTSrf.Width - 1, 0)
            Set Lst = New_c.ArrayList(vbLong, vbRed, vbYellow, vbGreen, vbCyan, vbBlue, vbMagenta, vbRed)
            For i = 0 To Lst.Count - 1
                .AddColorStop i / 6, Lst(i)
            Next i
            LUTSrf.CreateContext.Paint 1, .This
        End With
    
        Set CreateRingSpectrumSurface = Cairo.CreateSurface(Size, Size)
        With CreateRingSpectrumSurface.CreateContext
            .SetLineCap CAIRO_LINE_CAP_ROUND
            .SetLineWidth (Size - RingWidth - 3.5) * 2 * Cairo.PI / LUTSrf.Width
            .TranslateDrawings Size \ 2, Size \ 2
            LUTSrf.BindToArray LUT
            For i = 0 To 1440 - 1
                ColorLut(i) = RGB(LUT(i * 4 + 2, 0), LUT(i * 4 + 1, 0), LUT(i * 4, 0))
                .SetSourceColor ColorLut(i)
                .MoveTo 0, -(Size / 2 - RingWidth - 3.5)
                .RelLineTo 0, -RingWidth
                .Stroke
                .RotateDrawingsDeg 0.25    'rotate by one quarter of a degree (360 / (1440 steps in the LUT))
            Next i
            LUTSrf.ReleaseArray LUT
        End With
    End Function
    Hi reexre, thank you for your reply. Cairo can always achieve very cool effects. But I don't know why, I can't understand Cairo. I've already studied the code of you, Olaf and ColinE66, but I still can't draw a smooth Color Wheel with Cairo, which makes me very depressed.

    Drawing algorithms always make me a headache.
    Last edited by dreammanor; Nov 9th, 2019 at 11:16 AM.

  6. #46
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    5,842

    Re: How to draw a color wheel (color picker)?

    Quote Originally Posted by dreammanor View Post
    Hi, Eduardo-, I tested SetPixel, if I use SetPixel, Color-Wheel does have white spots, I don't know why.
    I didn't look at Eduardo's code. But, when you fill in stuff like that, it's always better to do the calculations backwards: Have the loops address the pixels, and then calculate the color for that pixel (as opposed to having the loop run through the colors). Done backwards, you're guaranteed that each pixel is filled with a color (even if some close pixels are the same color).

    The same logic holds when you're manually rotating an image by a non-90 degree multiple.
    Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

  7. #47

    Thread Starter
    Frenzied Member
    Join Date
    Sep 2012
    Posts
    1,693

    Re: How to draw a color wheel (color picker)?

    Quote Originally Posted by wqweto View Post
    Here is a real-time PhotoShop like color-picker in VB6 that I made as a by-product of another PSC submission.

    http://www.planet-source-code.com/vb...xtCodeId=36529

    It's like PhotoShop from 17 years ago though but I still like it better than modern wheels for actually selecting a color.



    cheers,
    </wqw>
    Wonderful! Your color picker seems to be the best solution. I originally wanted to use Cairo to rewrite your Color Picker, but my Cairo skills are so weak that I can't get the job done.

    I'd like to use your Color Picker directly, but I need to add a more modern UI to your Color Picker. Your Color Picker uses the UC ctxUpDown, which is great, but it renders the old VB6 style under Win10. I'd like to know if the DrawFrameControl API can implement the Win10-style UpDown control? Thanks!
    Last edited by dreammanor; Nov 9th, 2019 at 12:58 PM.

  8. #48

    Thread Starter
    Frenzied Member
    Join Date
    Sep 2012
    Posts
    1,693

    Re: How to draw a color wheel (color picker)?

    Quote Originally Posted by Elroy View Post
    I didn't look at Eduardo's code. But, when you fill in stuff like that, it's always better to do the calculations backwards: Have the loops address the pixels, and then calculate the color for that pixel (as opposed to having the loop run through the colors). Done backwards, you're guaranteed that each pixel is filled with a color (even if some close pixels are the same color).

    The same logic holds when you're manually rotating an image by a non-90 degree multiple.
    Eduardo used several different DrawWidths (1, 3, 4, 6) when drawing Color-Wheel. But I have tested that if setting DrawWidth to 3, the same effect can be achieved.

  9. #49
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,435

    Re: How to draw a color wheel (color picker)?

    Quote Originally Posted by dreammanor View Post
    ... I don't know why, I can't understand Cairo. I've already studied the code of you, Olaf and ColinE66, but I still can't draw a smooth Color Wheel with Cairo, which makes me very depressed.

    Drawing algorithms always make me a headache.
    Well, drawing a "conical gradient" is not really the easiest of tasks (no matter what drawing-lib you use).

    But FWIW (to show, how to "really only draw" this stuff with cairo), I've made a simplified example
    (which is not embedded into Widget-Control-Code, which has to ensure a lot more than "just the drawing").

    Here we go (Code to paste into an empty Form):
    Code:
    Option Explicit
    
    Private Sub Form_Load()
    Dim ColorStops 'define the Colors the "Conical-Gradient will span and interpolate-between"
        ColorStops = Array(vbRed, vbYellow, vbGreen, vbCyan, vbBlue, vbMagenta, vbRed)
     
        Set Picture = CreateRingSrf(200, 50, 100, ColorStops).Picture
    End Sub
    
    Function CreateRingSrf(Size, RadiusInner, RadiusOuter, ColorStops) As cCairoSurface
    Dim Steps As Long, Pat As cCairoPattern, i As Long
        Steps = 2 * Cairo.PI * RadiusOuter 'calculate the amount of pixel-steps on the outer radius (2*PI*r)
        
        'create a linear (horizontal) gradient-pattern that matches the amount of "unrolled outer-ring-pixel-steps"
        Set Pat = Cairo.CreateLinearPattern(0, 0, Steps, 0)
        For i = 0 To UBound(ColorStops) 'now add the Color-Stops for this gradient-pattern (to interpolate between)
          Pat.AddColorStop i / UBound(ColorStops), ColorStops(i)
        Next
        
        Set CreateRingSrf = Cairo.CreateSurface(Size, Size) 'create the return-value of this function
        
        With CreateRingSrf.CreateContext 'now we can enter drawing-mode on the Srf-Context
          .SetLineCap CAIRO_LINE_CAP_ROUND 'for softer "overlapped-blending" at the line-"corner"-endpoints
          .SetLineWidth 1.8 'oversize the drawn lines for a little bit of overlap (0.9px to the left and right)
    
          .TranslateDrawings Size / 2, Size / 2 'shift the Contexts Coord-Sys into the center of the Srf
    
          For i = 1 To Steps 'now we "walk the outer ring" (rotating a little bit after each step)
            .MoveTo 0, RadiusOuter - .GetLineWidth
            .LineTo 0, RadiusInner + .GetLineWidth
            
            .Stroke 0, Pat '<- Stroke the line with the current Gradient-Pattern-Color (at the current Pattern-Coord-Pos)
            
            'this prepares the two Coord-Systems for the next round of our loop...
            .RotateDrawingsDeg 360 / Steps 'increase the rotation-angle on the Context-CoordSys for our next line-drawing
             Set Pat.Matrix = Pat.Matrix.TranslateCoords(1, 0) 'shift the CoordSys in the Linear-PatternObj one step to the right
          Next
        End With
    End Function
    Here's hope, that the extensive comments help understanding this stuff a bit more.

    On cairographics.org - as well as on other cairo-related websites - you'll find a lot of tutorials and "best-practice"-hints, how to achieve certain effects with that library...

    Without (at least a rough) understanding what a Cairo-Pattern is (and does) - and without understanding how the so called "transforms" work (all those "translates, scales, rotates" which can be applied to "coordsys-matrices" on a cairo-surface-context, but also within a used cairo-patterns independently of the context this pattern is used on), one cannot write really efficient "cairo-code" for the more challenging scenarios.

    Though I'm absolutely convinced, that - if the community would invest only "half the amount of time" into "learning the cairo-lib" (instead of investing that time into GDI/GDIPlus), a whole lot of "graphics-threads" in this forum would be much shorter.

    Well, I'm here - so just ask questions about the cairo-code-snippets I'm posting, when you "got lost" on a certain line of cairo-drawing-code.

    Olaf

  10. #50
    Frenzied Member
    Join Date
    Feb 2017
    Posts
    1,932

    Re: How to draw a color wheel (color picker)?

    Quote Originally Posted by Elroy View Post
    it's always better to do the calculations backwards
    Following this idea I was able to make a better wheel that the one done with the other approach.
    I posted it in the codebank.
    Last edited by Eduardo-; Nov 11th, 2019 at 02:14 AM.

  11. #51
    Frenzied Member
    Join Date
    Dec 2008
    Posts
    1,242

    Re: How to draw a color wheel (color picker)?

    Quote Originally Posted by wqweto View Post
    Here is a real-time PhotoShop like color-picker in VB6 that I made as a by-product of another PSC submission.
    http://www.planet-source-code.com/vb...xtCodeId=36529
    It's like PhotoShop from 17 years ago though but I still like it better than modern wheels for actually selecting a color.
    cheers,
    </wqw>
    That got voted 5 out of 5 by 260 members
    Must be close to a record in PSC ?
    Rob

  12. #52

    Thread Starter
    Frenzied Member
    Join Date
    Sep 2012
    Posts
    1,693

    Re: How to draw a color wheel (color picker)?

    Quote Originally Posted by Eduardo- View Post
    Following this idea I was able to make a better wheel that the one done with the other approach.
    I posted it in the codebank.
    Great! Thank you very much.

    Quote Originally Posted by Bobbles View Post
    That got voted 5 out of 5 by 260 members
    Must be close to a record in PSC ?
    Rob
    Yes, I noticed that code a long time ago, but I didn't know it was wqweto's. This code is great, unfortunately, people just only saw its OutlookBar, but ignored the same excellent ColorPicker. Now is the time for it to get applause.
    Last edited by dreammanor; Nov 11th, 2019 at 07:40 AM.

  13. #53

    Thread Starter
    Frenzied Member
    Join Date
    Sep 2012
    Posts
    1,693

    Re: How to draw a color wheel (color picker)?

    Quote Originally Posted by Schmidt View Post
    Well, drawing a "conical gradient" is not really the easiest of tasks (no matter what drawing-lib you use).

    But FWIW (to show, how to "really only draw" this stuff with cairo), I've made a simplified example
    (which is not embedded into Widget-Control-Code, which has to ensure a lot more than "just the drawing").

    Here we go (Code to paste into an empty Form):
    Code:
    Option Explicit
    
    Private Sub Form_Load()
    Dim ColorStops 'define the Colors the "Conical-Gradient will span and interpolate-between"
        ColorStops = Array(vbRed, vbYellow, vbGreen, vbCyan, vbBlue, vbMagenta, vbRed)
     
        Set Picture = CreateRingSrf(200, 50, 100, ColorStops).Picture
    End Sub
    
    Function CreateRingSrf(Size, RadiusInner, RadiusOuter, ColorStops) As cCairoSurface
    Dim Steps As Long, Pat As cCairoPattern, i As Long
        Steps = 2 * Cairo.PI * RadiusOuter 'calculate the amount of pixel-steps on the outer radius (2*PI*r)
        
        'create a linear (horizontal) gradient-pattern that matches the amount of "unrolled outer-ring-pixel-steps"
        Set Pat = Cairo.CreateLinearPattern(0, 0, Steps, 0)
        For i = 0 To UBound(ColorStops) 'now add the Color-Stops for this gradient-pattern (to interpolate between)
          Pat.AddColorStop i / UBound(ColorStops), ColorStops(i)
        Next
        
        Set CreateRingSrf = Cairo.CreateSurface(Size, Size) 'create the return-value of this function
        
        With CreateRingSrf.CreateContext 'now we can enter drawing-mode on the Srf-Context
          .SetLineCap CAIRO_LINE_CAP_ROUND 'for softer "overlapped-blending" at the line-"corner"-endpoints
          .SetLineWidth 1.8 'oversize the drawn lines for a little bit of overlap (0.9px to the left and right)
    
          .TranslateDrawings Size / 2, Size / 2 'shift the Contexts Coord-Sys into the center of the Srf
    
          For i = 1 To Steps 'now we "walk the outer ring" (rotating a little bit after each step)
            .MoveTo 0, RadiusOuter - .GetLineWidth
            .LineTo 0, RadiusInner + .GetLineWidth
            
            .Stroke 0, Pat '<- Stroke the line with the current Gradient-Pattern-Color (at the current Pattern-Coord-Pos)
            
            'this prepares the two Coord-Systems for the next round of our loop...
            .RotateDrawingsDeg 360 / Steps 'increase the rotation-angle on the Context-CoordSys for our next line-drawing
             Set Pat.Matrix = Pat.Matrix.TranslateCoords(1, 0) 'shift the CoordSys in the Linear-PatternObj one step to the right
          Next
        End With
    End Function
    Here's hope, that the extensive comments help understanding this stuff a bit more.

    On cairographics.org - as well as on other cairo-related websites - you'll find a lot of tutorials and "best-practice"-hints, how to achieve certain effects with that library...

    Without (at least a rough) understanding what a Cairo-Pattern is (and does) - and without understanding how the so called "transforms" work (all those "translates, scales, rotates" which can be applied to "coordsys-matrices" on a cairo-surface-context, but also within a used cairo-patterns independently of the context this pattern is used on), one cannot write really efficient "cairo-code" for the more challenging scenarios.

    Though I'm absolutely convinced, that - if the community would invest only "half the amount of time" into "learning the cairo-lib" (instead of investing that time into GDI/GDIPlus), a whole lot of "graphics-threads" in this forum would be much shorter.

    Well, I'm here - so just ask questions about the cairo-code-snippets I'm posting, when you "got lost" on a certain line of cairo-drawing-code.

    Olaf
    Hi Olaf, your code is extremely useful. After carefully studying a few of your Cairo examples, I finally drew an adobe-like ColorWheel, although this made my brain cells died a lot. Now, I finally have some initial understanding of Cairo. Much appreciated.
    Last edited by dreammanor; Nov 11th, 2019 at 07:28 AM.

  14. #54

    Thread Starter
    Frenzied Member
    Join Date
    Sep 2012
    Posts
    1,693

    Re: How to draw a color wheel (color picker)?

    Here is the code to draw the Color Wheel:

    Code:
    Option Explicit
    
    Private Sub Form_Load()
    Dim ColorStops 'define the Colors the "Conical-Gradient will span and interpolate-between"
        ColorStops = Array(vbRed, vbYellow, vbGreen, vbCyan, vbBlue, vbMagenta, vbRed)
     
        Set Picture = CreateCircleSrf(200, 0, 100, ColorStops).Picture
    End Sub
    
    Function CreateCircleSrf(Size, RadiusInner, RadiusOuter, ColorStops) As cCairoSurface
    Dim Steps As Long, Pat As cCairoPattern, Pat2 As cCairoPattern, i As Long
    Dim TmpSrf As cCairoSurface, ColorBytes() As Byte, nColor As Long, nIdx As Long
    
        Steps = 2 * Cairo.PI * RadiusOuter 'calculate the amount of pixel-steps on the outer radius (2*PI*r)
            
        'create a linear (horizontal) gradient-pattern that matches the amount of "unrolled outer-ring-pixel-steps"
        Set Pat = Cairo.CreateLinearPattern(0, 0, Steps, 0)
        For i = 0 To UBound(ColorStops) 'now add the Color-Stops for this gradient-pattern (to interpolate between)
          Pat.AddColorStop i / UBound(ColorStops), ColorStops(i)
        Next
        
        Set TmpSrf = Cairo.CreateSurface(Steps, 1)
        TmpSrf.CreateContext.Paint 1, Pat.This
        TmpSrf.BindToArray ColorBytes
        
        Set CreateCircleSrf = Cairo.CreateSurface(Size, Size) 'create the return-value of this function
            
        With CreateCircleSrf.CreateContext 'now we can enter drawing-mode on the Srf-Context
          .SetLineCap CAIRO_LINE_CAP_ROUND 'for softer "overlapped-blending" at the line-"corner"-endpoints
          .SetLineWidth 1.8       '1.8 'oversize the drawn lines for a little bit of overlap (0.9px to the left and right)
    
          .TranslateDrawings Size / 2, Size / 2 'shift the Contexts Coord-Sys into the center of the Srf
    
          For i = 1 To Steps 'now we "walk the outer ring" (rotating a little bit after each step)
            .MoveTo 0, RadiusOuter - .GetLineWidth
            .LineTo 0, RadiusInner + .GetLineWidth
            
            nIdx = i - 1
            nColor = RGB(ColorBytes(nIdx * 4 + 2, 0), ColorBytes(nIdx * 4 + 1, 0), ColorBytes(nIdx * 4, 0))
            
            Set Pat2 = Cairo.CreateLinearPattern(0, 0, 0, RadiusOuter)
            Pat2.AddColorStop 0, vbWhite
            Pat2.AddColorStop 1, nColor
            
            .Stroke 0, Pat2 '<- Stroke the line with the current Gradient-Pattern-Color (at the current Pattern-Coord-Pos)
            
            'this prepares the two Coord-Systems for the next round of our loop...
            .RotateDrawingsDeg 360 / Steps 'increase the rotation-angle on the Context-CoordSys for our next line-drawing
          Next
        End With
        
        TmpSrf.ReleaseArray ColorBytes
    
    End Function
    Attached Images Attached Images  

  15. #55
    Frenzied Member
    Join Date
    Feb 2017
    Posts
    1,932

    Re: How to draw a color wheel (color picker)?

    dreammanor, the last image that you posted is similar to the first one you posted in the first message of the thread.

    I wonder how they are done, because one factor is the hue, that changes with the angle and that's clear in your images, but the other two factors are saturation and luminnace (or lightness).

    In my control, when going to the center, the colors are less saturated, being the center gray. (Saturation is in the distance from the center)
    The luminance is selected with the companion slider.

    Other possibility to draw the wheel is changing the luminance with the distance from the center, in that case the circle may be black in the center and light outside (see images from Elroys, in posts #13 and 16), or white in the center and dark when going outsice (the opposite), being black the portion near the circunsference.

    None of that I see in these images.

    How are these wheels drawn? (I don't mean code, but the logic).

  16. #56
    Frenzied Member
    Join Date
    Feb 2017
    Posts
    1,932

    Re: [RESOLVED] How to draw a color wheel (color picker)?

    I was able to draw the same color wheel, but used only visually, the control still works with the colors as before, because they are stored internally.

    Name:  WheelColorPicker_scr_LW.png
Views: 96
Size:  94.1 KB

    The problem with this wheel is that it doesn't have all the colors.

    I was able to draw it by setting luminance going from 240 in the center to 120 in the circumference. Saturation always at full range, constant at 240.

    I considered to change the slider, instead of selecting luminance to select saturation, but the problem is that it would be no way to select colors with luminance less than 120.

    So, what I've done is visually only, it is cheating.

    Looking for images of "color picker" in Google I found that most do this kind of color wheel.
    I acknowledge that it looks a bit more appealing visually.

    What do you think?

    The test program is attached.
    Attached Files Attached Files

  17. #57
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    5,842

    Re: [RESOLVED] How to draw a color wheel (color picker)?

    Eduardo,

    If you're going to "tint" your Lightness slider, why not "shade" your colorwheel as well, especially since you're drawing it.

    I played around with your code and made some changes to these lines:

    Code:
                    iPixelsBytes(c + 2) = iColor And 255 ' R
                    iPixelsBytes(c + 1) = (iColor \ 256) And 255 ' G
                    iPixelsBytes(c) = (iColor \ 65536) And 255 ' B
    I changed them to look like this:

    Code:
                    iPixelsBytes(c + 2) = (iColor And 255) * mL / 240 ' R
                    iPixelsBytes(c + 1) = ((iColor \ 256) And 255) * mL / 240 ' G
                    iPixelsBytes(c) = ((iColor \ 65536) And 255) * mL / 240 ' B
    And then, in the two places where you're setting mL, I followed it with a call to DrawWheel:

    Code:
                    mL = iL1: DrawWheel
    Code:
            mL = Value: DrawWheel
    The effect was pretty nice, seeing the actual wheel reflect the Lightness setting. The Lightness slider was a bit sluggish, but I suspect you could fix that, with more knowledge about how your code is working. It seemed to redraw the color wheel without issue.

    EDIT1: That color wheel tinting isn't quite right, but I'll let you work that out if you so desire. I was just inspired by what wqweto had done a few years back, and thought this could have the same effect. Wqweto actually gave us about every possible option of splitting out the third dimension of the color selection, and also tinted both the slider and the palette for whichever way you decided to do it.

    EDIT2: The problem is, is that with an HSL scheme, the middle should go to gray (&h808080) and not white (&hFFFFFF).
    Last edited by Elroy; Nov 11th, 2019 at 07:15 PM.
    Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

  18. #58

    Thread Starter
    Frenzied Member
    Join Date
    Sep 2012
    Posts
    1,693

    Re: How to draw a color wheel (color picker)?

    Quote Originally Posted by Eduardo- View Post
    dreammanor, the last image that you posted is similar to the first one you posted in the first message of the thread.

    I wonder how they are done, because one factor is the hue, that changes with the angle and that's clear in your images, but the other two factors are saturation and luminnace (or lightness).

    In my control, when going to the center, the colors are less saturated, being the center gray. (Saturation is in the distance from the center)
    The luminance is selected with the companion slider.

    Other possibility to draw the wheel is changing the luminance with the distance from the center, in that case the circle may be black in the center and light outside (see images from Elroys, in posts #13 and 16), or white in the center and dark when going outsice (the opposite), being black the portion near the circunsference.

    None of that I see in these images.

    How are these wheels drawn? (I don't mean code, but the logic).
    Hi Eduardo, I'm on a business trip, I'll reply you tomorrow.

  19. #59
    Frenzied Member
    Join Date
    Feb 2017
    Posts
    1,932

    Re: How to draw a color wheel (color picker)?

    Quote Originally Posted by dreammanor View Post
    Hi Eduardo, I'm on a business trip, I'll reply you tomorrow.
    OK, I've already figured it out, those wheels are drawn using the HSV system instead of the HSL system that I'm using.

  20. #60
    Frenzied Member
    Join Date
    Feb 2017
    Posts
    1,932

    Re: [RESOLVED] How to draw a color wheel (color picker)?

    Quote Originally Posted by Elroy View Post
    Eduardo,

    If you're going to "tint" your Lightness slider, why not "shade" your colorwheel as well, especially since you're drawing it.

    I played around with your code and made some changes to these lines:

    Code:
                    iPixelsBytes(c + 2) = iColor And 255 ' R
                    iPixelsBytes(c + 1) = (iColor \ 256) And 255 ' G
                    iPixelsBytes(c) = (iColor \ 65536) And 255 ' B
    I changed them to look like this:

    Code:
                    iPixelsBytes(c + 2) = (iColor And 255) * mL / 240 ' R
                    iPixelsBytes(c + 1) = ((iColor \ 256) And 255) * mL / 240 ' G
                    iPixelsBytes(c) = ((iColor \ 65536) And 255) * mL / 240 ' B
    And then, in the two places where you're setting mL, I followed it with a call to DrawWheel:

    Code:
                    mL = iL1: DrawWheel
    Code:
            mL = Value: DrawWheel
    The effect was pretty nice, seeing the actual wheel reflect the Lightness setting. The Lightness slider was a bit sluggish, but I suspect you could fix that, with more knowledge about how your code is working. It seemed to redraw the color wheel without issue.

    EDIT1: That color wheel tinting isn't quite right, but I'll let you work that out if you so desire. I was just inspired by what wqweto had done a few years back, and thought this could have the same effect. Wqweto actually gave us about every possible option of splitting out the third dimension of the color selection, and also tinted both the slider and the palette for whichever way you decided to do it.

    EDIT2: The problem is, is that with an HSL scheme, the middle should go to gray (&h808080) and not white (&hFFFFFF).
    I've done it that way in purpose, because I thought that a normal user, I mean someone that is not a professional designer, could wonder "where are the nice colors?", unless he sets the luminance (or lightness) to 120.

    But now I'm adding an advanced mode, that will have these features.

  21. #61

    Thread Starter
    Frenzied Member
    Join Date
    Sep 2012
    Posts
    1,693

    Re: How to draw a color wheel (color picker)?

    Quote Originally Posted by Eduardo- View Post
    dreammanor, the last image that you posted is similar to the first one you posted in the first message of the thread.

    I wonder how they are done, because one factor is the hue, that changes with the angle and that's clear in your images, but the other two factors are saturation and luminnace (or lightness).

    In my control, when going to the center, the colors are less saturated, being the center gray. (Saturation is in the distance from the center)
    The luminance is selected with the companion slider.

    Other possibility to draw the wheel is changing the luminance with the distance from the center, in that case the circle may be black in the center and light outside (see images from Elroys, in posts #13 and 16), or white in the center and dark when going outsice (the opposite), being black the portion near the circunsference.

    None of that I see in these images.

    How are these wheels drawn? (I don't mean code, but the logic).
    PhotoShop's color picker can adjust the colors of the color palette either by HSL, CMYK or by RGB. And I only took the RGB mode, I'll add the HSL mode in the future.

    When drawing a color wheel, if only three colors (Red, Green, Blue) are used, the entire color wheel is darker and less beautiful. Therefore, the color wheels on the Internet generally adopts six colors (Red, Yellow, Green, Cyan, Blue, Magenta), which makes the color wheel brighter and more beautiful.

    My algorithm is like this:
    (1) On the outermost circumference, the six colors vbRed, vbYellow, vbGreen, vbCyan, vbBlue, vbMagenta, vbRed are evenly distributed(gradient).
    (2) The color of the center of the circle is white. The above six colors are evenly gradient with the white color of the center of the circle.

    Olaf only used algorithm (1) in his example and did not use algorithm (2).

  22. #62
    Frenzied Member
    Join Date
    Feb 2017
    Posts
    1,932

    Re: [RESOLVED] How to draw a color wheel (color picker)?

    Quote Originally Posted by Eduardo- View Post
    But now I'm adding an advanced mode, that will have these features.
    Done.

Page 2 of 2 FirstFirst 12

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width