As only a casual plinker when it comes to graphics programming many things elude me. Color spaces are something I don't have my head around.
I was toying with some code to re-color bitmaps to be used as parts of user interfaces, basically small icons. I thought that simply changing "hue" would be 95% of the job. Sadly though I had an easy success with my first attempt I quickly realized I am off in the weeds somewhere.
In this sample Project I can change the target bitmap hue from original RED... to BLUE or to GREEN or back to RED, or even to CYAN... but the other colors all give me a RED result:
There may just be a glaring coding error that I can't see, or I may have a complete misunderstanding of color spaces.
The program works by (1.) converting a new color from RGB to HSV components, then (2.) changing every pixel from RGB to HSV, then back to RGB swapping in the new hue value.
Also - and i haven't scrutinised your code - be aware that if you've cobbled this together from a variety of sources, some implementations will wrap around the 'colour circle' at 360*, whilst others may do so at another angle, e.g. Red would typically be at 360* but I've seen code where it is elsewhere. Daresay Tanner will be able to tell you the why's and the wherefore's...
If you don't know where you're going, any road will take you there...
If anybody is interested, I wrote a ColourPicker recently. It uses vbRichClient but I guess it could be adapted to not have that dependency if anybody is so-inclined. Shout here and I'll put it in the Codebank...
If you don't know where you're going, any road will take you there...
If anybody is interested, I wrote a ColourPicker recently. It uses vbRichClient but I guess it could be adapted to not have that dependency if anybody is so-inclined. Shout here and I'll put it in the Codebank...
I like it, and it's always good to have vbRichClient alternatives in the codebank. Please do
Gray does not exist on the colour circle. All grays exhibit the absence of a hue; rather, they are degrees of saturation of white, I believe (dredging this up from recent memory but that aint so good, these days!)
Anyway, I believe it shows blue because the ColorHLSToRGB algo attempts to find the nearest match in terms of RGB (there are more RGB combinations than there are HLS, incidentally, so there are other conversions that end up being a little 'off'), and defaults to blue in that one single case. I experienced the same thing in my ColourPicker, too. Anyway, I ended up handling the grays as exceptions and just made sure that the RGB values were equal, IIRC.
I'll post my ColourPicker into the Codebank and you can take a look at it - obviously ignoring the vbRichClient5 reference, which I'm pretty sure you won't have
If you don't know where you're going, any road will take you there...
@dilettante: I believe there is a typo in your Rgb2Hsv function. Line 73 says:
Code:
Hue = ((G - B) * HUE_DEGREE) \ Delta
Change it to this and it should work:
Code:
Hue = ((G - B) * 60& * HUE_DEGREE) \ Delta
As Colin says, gray still won't work with this method as "gray" has an undefined hue. (When saturation = 0, there is no way to calculate a corresponding hue.)
You could work around it by specially detecting the "If (originalSaturation = 0)" case and manually enforcing a new saturation of 0 in the new pixels - not particularly elegant, but that's the only real workaround in an HSV space...
1. A typo slipped through when I translated from C to VB6. I tried to proofread it several times and never did see that flaw.
2. Expecting to select a non-saturated "color" by changing hue alone is patently absurd. I wasn't thinking at all on that one. This isn't "color change" but merely "hue change."
Thanks, I was going in circles. Still not sure why white gets turned black without the hack when using the SHLWAPI.DLL calls though.
Last edited by dilettante; Jul 28th, 2017 at 05:44 PM.
Well by "copying" over the new saturation as well as hue the grey colors work fine.
This was a degenerate situation where all colors in the target image are meant to vary only in their luminance ("brightness") anyway. Most of the time a hue change for more generalized images would probably "move" the hue of each pixel "around the circle" by a common value rather than simply replacing the hue of each pixel by a fixed hue value.
Here is a version that ought to be a little quicker though it uses more RAM.
Even though the GetDIBits/SetDIBits docs don't say you can do it, requesting 32bpp works fine and reduces the array indexing operations by a factor of 3 by working on Long pixels.
They still have the OS/2 bitmap bits format so the bytes must be swapped to/from COLORREF format. Raymond Chen also said this is why most bitmaps are bottom-up - a legacy of OS/2.
For those who use the RichClient already, such a re-colorizing (from a given resource-image)
can be done this way:
Code:
Function GetReColorizedSurface(Src As cCairoSurface, ByVal NewColor As Long) As cCairoSurface
Set GetReColorizedSurface = Src.CreateSimilar(, , , True) 'make a copy of the Src into the target-surface
With GetReColorizedSurface.CreateContext
.Operator = CAIRO_OPERATOR_HSL_HUE 'influence only the HUE-ColorTone of the target
.SetSourceColor NewColor 'set the new Source-Color
.MaskSurface Src 'restrict the recolorizing-op only to Pixels which have Alpha>0
End With
End Function
The above takes a Resource-Surface and returns a HUE-wise re-colorized copy of it.
(useful for dynamic overlays on MouseOver on e.g. a ToolBar or something).
What it does respect as well (which is currently not covered by the Pixel-Loop in dils example),
is the Alpha-Channel of the Resource-Image, which becomes important, when the target-background is not a solid color.
Here's what I mean (using the same GIF-Resource-image which was included in dils example, placing it in "C:\temp\").
Into a Form (project needs a reference to vbRichClient5):
Code:
Option Explicit
Private ResSrf As cCairoSurface
Private Sub Form_Load() 'load the resource-surface and (since it's a GIF) blur it a bit for nicer downscaling
Set ResSrf = Cairo.ImageList.AddImage("Test", "C:\temp\Test.gif").GaussianBlur(0.8)
End Sub
Function GetReColorizedSurface(Src As cCairoSurface, ByVal NewColor As Long) As cCairoSurface
Set GetReColorizedSurface = Src.CreateSimilar(, , , True) 'make a copy of the Src into the target-surface
With GetReColorizedSurface.CreateContext
.Operator = CAIRO_OPERATOR_HSL_HUE 'influence only the HUE-ColorTone of the target
.SetSourceColor NewColor 'set the new Source-Color
.MaskSurface Src 'restrict the recolorizing-op only to Pixels which have Alpha>0
End With
End Function
Private Sub Form_Click()
Dim CC As cCairoContext, TB As cCairoPattern, i As Long, NewColor As Long
Set CC = Cairo.CreateSurface(1024, 64).CreateContext
Set TB = Cairo.CreateLinearPattern(0, 0, 0, CC.Surface.Height)
TB.AddGaussianStops_TwoColors vbWhite, &HCCCCCC
CC.Paint 1, TB 'render the ToolBar-Pattern
CC.TranslateDrawings 6, 6 'define the TopLeft-Shift where the Icon-Rendering starts
For i = 1 To 7
NewColor = Choose(i, vbBlue, vbRed, vbGreen, vbCyan, vbMagenta, vbYellow, vbWhite)
CC.RenderSurfaceContent GetReColorizedSurface(ResSrf, NewColor), 0, 0, 52, 52
CC.TranslateDrawings 60, 0 'shift 60 Pixels to the right for the next Icon
Next
Set Picture = CC.Surface.Picture
End Sub
Private Sub Form_Terminate()
New_c.CleanupRichClientDll
End Sub
Here's what it puts out, rendering the re-colorized Icons onto a simple ToolBar-Gradient-BackGround.
Still not sure why white gets turned black without the hack when using the SHLWAPI.DLL calls though.
It's entirely possible I'm misunderstanding, but for some reason, I don't require the "hack" line of code on my local PC (Win 10 1703). The SHLWAPI functions produce correct results even without that...? (Weird??)
My personal (unwarranted!) opinion is that the SHLWAPI functions - while convenient - should probably be avoided. Besides potentially changing behavior between Windows versions, they unnecessarily restrict their output range to [0, 240], which causes additional precision loss when round-tripping from between RGB and HSL coords.
There are dozens of HSL transform functions in the wild that offer more precise results and better performance, and as an added bonus, you're guaranteed identical behavior across all Windows versions, past and present. Given that these functions typically aren't more than a few dozen lines of code, I think they're a preferable solution. My $0.02.
(Thanks to everyone for the follow-up information, too! All good stuff.)
I'm confused now myself, the hack doesn't seem to be needed for either version: 24 bit or 32 bit. Chalk it up to another dumb mistake somewhere that has been corrected since then. I can't reproduce the original problem.
Regarding the range... if the SHLWAPI is good enough then I see no problem. Or if you need a finer range there are options out there... as long as you don't break them like I did with typos or transcription errors.
Another example of my muddled thinking was using gray as a hue-source. Obviously for such a purpose it is the same as white which makes more sense in this role.
There is a lot of code already given above so I'm not sure what you are after.
As for color pickers, you could just use the system dialog:
Code:
Option Explicit
Private Const CC_ANYCOLOR = &H100
Private Const CC_RGBINIT = &H1
Private Const CC_FULLOPEN = &H2
Private Type CHOOSECOLOR
lStructSize As Long
hwndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As Long
Flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Declare Function ChooseColorAPI Lib "comdlg32" Alias "ChooseColorW" ( _
ByRef CHOOSECOLOR As CHOOSECOLOR) As Long
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private CHOOSECOLOR As CHOOSECOLOR
Private CustomColors(0 To 15) As Long 'Buffer to retain user's settings.
Private Function ShowColor(ByVal CurrColor As OLE_COLOR) As Long
'Returns -1 on Cancel or error.
With CHOOSECOLOR
.lStructSize = LenB(CHOOSECOLOR)
.hwndOwner = hWnd
.Flags = CC_ANYCOLOR Or CC_RGBINIT Or CC_FULLOPEN
.lpCustColors = VarPtr(CustomColors(0))
If CurrColor < 0 Then
.rgbResult = GetSysColor(CurrColor And &HFFFF&)
Else
.rgbResult = CurrColor
End If
End With
If ChooseColorAPI(CHOOSECOLOR) <> 0 Then
ShowColor = CHOOSECOLOR.rgbResult
Else
ShowColor = -1
End If
End Function
Private Sub Label_Click(Index As Integer)
Dim NewColor As Long
NewColor = ShowColor(Label(Index).BackColor)
If NewColor >= 0 Then Label(Index).BackColor = NewColor
End Sub
Here (i.e. in this demo Form) there are some Label controls you can click on to pick new background colors to apply to them.
Last edited by dilettante; Aug 6th, 2017 at 04:19 AM.
Reply With Quote
Originally Posted by ColinE66
