Convert between RGB<>Long<>Hex color values

[EntityReborn]

In this project, a few things are done. Mainly and principally, the user can convert color values between Long, Hex, and RGB values, with a Shape depicting the color itself. As you change values in one valuetype, the others are automatically updated.

Some of the smaller examples in the code deal with textbox input manipulation, mainly limiting of input (both characters AND shift-insert, as well as rightclick-paste).

While I understand that this may have been done before, I wanted to write this up, as I currently needed something like this in my own current projects, as well as gain experience in the making.

Usage:
Use the sliders or relevent text boxes to input RGB values, and the Long and Hex text boxes to enter Long and Hex values respectively. Please note there is no need for &H before hexvalues.

Enjoy, and feel free to question about/comment on/rip up the code.

Update:
+Fixed the omission of Ctrl shortcuts
+Added always on top checkbox <thanks CVMichael>
+Added grabbing the pixelcolor under the mouse <once again, thanks CVMichael>
+Added polling frequency for grabbing pixel color.

Update:
+Fixed broken Ctrl/Shift blocks
+Partially removed oscillation when mouse is over the form's textboxes (timer is disabled when user clicks inside box)
+Partially made way to temporarily pause timer while mouse is in form (I need superior ideas for how to know when mouse exits form!)
*Need to remove oscillation using temporary disabling of timer.
*Need to factor out blocking code (too tired at the moment, and not sure if exporting to a single function will work.)

Update:
+Added Click Drag targeting, in place of constant monitoring
+Form now hides when targeting and mouse is over form
+Factored out blocking code
+Added zoomable review of location of mouse in targeting mode.
+Incorperated code from members of this thread(Merri, CVMichael, Si_The_Geek, etc)
*Possibly hook the textbox windows, to prevent cutting/pasting. (I have the code, just needs to be modified for more that one hook at a time)

[CVMichael]

It's nice, but I would make it remember the last position when it was closed:

Private Sub Form_Load()
    Me.Left = Val(GetSetting(App.EXEName, "Pos", "Left", Me.Left))
    Me.Top = Val(GetSetting(App.EXEName, "Pos", "Top", Me.Top))
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    SaveSetting App.EXEName, "Pos", "Left", Me.Left
    SaveSetting App.EXEName, "Pos", "Top", Me.Top
End Sub

Also, I would make it always on top ( you should find code on how to do that if you search the code bank i think)

And also, an option to "steal" a color from where the mouse is even when it's outside current window, this is easy with only a few APIs

[EntityReborn]

Thanks! I will do so, as well as patch a problem that I overlooked earlier.
EDIT: First post updated.
Quick question:

Sub FooBar
Dim strFooBar as string
strFooBar = "Yura Foo"
ProcessFooBar(strFooBar)
MsgBox strFooBar
End Function

Sub ProcessFooBar(inFooBar as string)
inFooBar = "Ima Foo"
End Sub

Would "Ima Foo" be shown, or "Yura Foo" be shown? Reguardless of Function or Sub declarations? Trying to factor out code in the textbox protection schemes.

[si_the_geek]

There's no need to use Indent tags inside Code tags, as the Code tags preserve spaces anyway (and that way don't limit the height of the code area, as seems to have happened). If you want colours or bold etc you need to use tags (as I do for comments), unless you use the Highlight tags (but they have issues, such as line numbers when doing a copy & paste).


The answer is that it will be "Yura.." due to the brackets around the variable name... as you aren't using the keyword Call with it (ie: Call ProcessFooBar(strFooBar) ) or using a function and returning the value (eg: MyVar = ProcessFooBar(strFooBar) ) you should not be using brackets - that makes the parameter you pass an expression rather than the original variable, and thus it is passed ByVal (so what the sub does has no effect on the value after).

If you remove the brackets the answer depends on which version of VB you are using.. with VB5 it defaults to ByVal (so "Yura.."), but with VB6 it defaults to ByRef (so "Ima.."). To make the behaviour consistent and clear, you should specify which you want in the function declaration, eg: Sub ProcessFooBar(ByVal inFooBar as string)

Note however that ByVal/ByRef only apply to basic data types (String/Integer/Date/...), and any Object data types (such as TextBox or Recordset, or a class you have written) will always be passed as ByRef.

By making use of ByRef, you could shorten the routines like this:

Private Sub KeyPress_OnlyAllowNumeric(ByRef KeyAscii As Integer)
    'Allow only numeric keys.
    Select Case KeyAscii
        Case Asc("0") To Asc("9"), 8:
        Case Else: KeyAscii = 0
    End Select
End Sub

Private Sub txtColor_KeyPress(Index As Integer, KeyAscii As Integer)
    'Allow only numeric keys.
    KeyPress_OnlyAllowNumeric KeyAscii
End Sub
Private Sub txtLong_KeyPress(KeyAscii As Integer)
    'Allow only numeric keys.
    KeyPress_OnlyAllowNumeric KeyAscii
End Sub
...

I'm not a fan of how you did the LongToHex routine, even though it is perfectly valid. While calling the LongToRGB routine repeatedly with the same parameter is valid, I would create a variable to store the result into instead - the few bytes extra memory is completely ignorable, and it will be faster (not actually an issue here, but I prefer to always do things that way to make re-usability easier).

[Merri]

Just some other ways to do things:

Option Explicit

' 32 x 1 = 32 bits
Public Type Long32
    Value As Long
End Type

' 8 x 4 = 32 bits
Public Type RGBA
    Red As Byte
    Green As Byte
    Blue As Byte
    Alpha As Byte
End Type

Public Function ColorToHex(ByVal Color As Long) As String
    ' 12 bytes = 6 characters = 0 To 11
    Dim bytOut(11) As Byte
    ' make a character: take 4 bits, move them to be the lowest 4 bits,
    '  combine bitwise with character code 48, you will get a value from range 48 to 63 (&H30 to &H3F)
    bytOut(0) = &H30& Or ((Color And &HF0&) \ &H10&)
    ' take 4 bits and combine bitwise with 48
    bytOut(2) = &H30& Or (Color And &HF&)
    ' take 4 bits and move them to be the lowest 4 bits
    bytOut(4) = &H30& Or ((Color And &HF000&) \ &H1000&)
    ' I guess you got it by now
    bytOut(6) = &H30& Or ((Color And &HF00&) \ &H100&)
    bytOut(8) = &H30& Or ((Color And &HF00000) \ &H100000)
    bytOut(10) = &H30& Or ((Color And &HF0000) \ &H10000)
    ' because the resulting characters are until now from range
    '
    ' 0123456789:;<=>?
    '
    '  and we want them to be from range
    '
    ' 0123456789       ABCDEF
    '           ....... <- 7 characters we do not want
    '
    ' we increase character codes above 57 by 7 - this gives us a range from 48 - 57 and 65 to 70
    If bytOut(0) > &H39 Then bytOut(0) = bytOut(0) + 7
    If bytOut(2) > &H39 Then bytOut(2) = bytOut(2) + 7
    If bytOut(4) > &H39 Then bytOut(4) = bytOut(4) + 7
    If bytOut(6) > &H39 Then bytOut(6) = bytOut(6) + 7
    If bytOut(8) > &H39 Then bytOut(8) = bytOut(8) + 7
    If bytOut(10) > &H39 Then bytOut(10) = bytOut(10) + 7
    ' finally, make a real string out of the byte array
    ColorToHex = bytOut
End Function

Public Function ColorToRGB(ByVal Color As Long) As RGBA
    Dim lngRGB As Long32
    ' copy value to a User Defined Type
    lngRGB.Value = Color
    ' now we can make a direct bitwise copy to another UDT of the same size, easy as a pie!
    LSet ColorToRGB = lngRGB
End Function

Public Function HexRGB(ByVal Red As Byte, ByVal Green As Byte, ByVal Blue As Byte) As String
    ' same things happening as in ColorToHex, just from a different kind of source
    ' the biggest difference is that &H30& is now &H30, we are working as 8-bit Byte and not 32-bit Long
    Dim bytOut(11) As Byte
    bytOut(0) = &H30 Or ((Red And &HF0) \ &H10)
    bytOut(2) = &H30 Or (Red And &HF)
    bytOut(4) = &H30 Or ((Green And &HF0) \ &H10)
    bytOut(6) = &H30 Or (Green And &HF)
    bytOut(8) = &H30 Or ((Blue And &HF0) \ &H10)
    bytOut(10) = &H30 Or (Blue And &HF)
    If bytOut(0) > &H39 Then bytOut(0) = bytOut(0) + 7
    If bytOut(2) > &H39 Then bytOut(2) = bytOut(2) + 7
    If bytOut(4) > &H39 Then bytOut(4) = bytOut(4) + 7
    If bytOut(6) > &H39 Then bytOut(6) = bytOut(6) + 7
    If bytOut(8) > &H39 Then bytOut(8) = bytOut(8) + 7
    If bytOut(10) > &H39 Then bytOut(10) = bytOut(10) + 7
    HexRGB = bytOut
End Function

Public Function HexToColor(ByRef HexColor As String) As Long
    ' variable size byte array
    Dim bytHex() As Byte
    ' we only accept one length, 6 characters = 12 bytes
    If LenB(HexColor) = 12 Then
        ' convert string to byte array
        bytHex = HexColor
        ' if a value is now higher than 57, we reduce it by 7
        If bytHex(0) > &H39 Then bytHex(0) = bytHex(0) - 7
        If bytHex(2) > &H39 Then bytHex(2) = bytHex(2) - 7
        If bytHex(4) > &H39 Then bytHex(4) = bytHex(4) - 7
        If bytHex(6) > &H39 Then bytHex(6) = bytHex(6) - 7
        If bytHex(8) > &H39 Then bytHex(8) = bytHex(8) - 7
        If bytHex(10) > &H39 Then bytHex(10) = bytHex(10) - 7
        ' this function is "stupid", it assumes it gets correct data...
        '  makes it faster, but you can give it any string that is 6 characters long, no error, ever!
        '  we take 4 bits for each six characters, and place it in the correct position of a Long,
        '  making up 24 bits that are required to represent a color value
        HexToColor = ((bytHex(0) And &HF&) * &H10&) Or (bytHex(2) And &HF&) _
            Or ((bytHex(4) And &HF&) * &H1000&) Or ((bytHex(6) And &HF&) * &H100&) _
            Or ((bytHex(8) And &HF&) * &H100000) Or ((bytHex(10) And &HF&) * &H10000)
    End If
End Function

Public Function HexToRGB(ByRef HexColor As String) As RGBA
    ' does the same as HexToColor and ColorToRGB
    Dim bytHex() As Byte, lngRGB As Long32
    If LenB(HexColor) = 12 Then
        bytHex = HexColor
        If bytHex(0) > &H39 Then bytHex(0) = bytHex(0) - 7
        If bytHex(2) > &H39 Then bytHex(2) = bytHex(2) - 7
        If bytHex(4) > &H39 Then bytHex(4) = bytHex(4) - 7
        If bytHex(6) > &H39 Then bytHex(6) = bytHex(6) - 7
        If bytHex(8) > &H39 Then bytHex(8) = bytHex(8) - 7
        If bytHex(10) > &H39 Then bytHex(10) = bytHex(10) - 7
        lngRGB.Value = ((bytHex(0) And &HF&) * &H10&) Or (bytHex(2) And &HF&) _
            Or ((bytHex(4) And &HF&) * &H1000&) Or ((bytHex(6) And &HF&) * &H100&) _
            Or ((bytHex(8) And &HF&) * &H100000) Or ((bytHex(10) And &HF&) * &H10000)
        LSet HexToRGB = lngRGB
    End If
End Function

Public Function RGBtoColor(ByRef RGB As RGBA) As Long
    ' does the same as ColorToRGB, just in opposite order
    Dim lngRGB As Long32
    LSet lngRGB = RGB
    RGBtoColor = lngRGB.Value
End Function

Public Function RGBtoHex(ByRef RGB As RGBA) As String
    ' same things happening as in ColorToHex, just from a different kind of source
    ' the biggest difference is that &H30& is now &H30, we are working as 8-bit Byte and not 32-bit Long
    Dim bytOut(11) As Byte
    bytOut(0) = &H30 Or ((RGB.Red And &HF0) \ &H10)
    bytOut(2) = &H30 Or (RGB.Red And &HF)
    bytOut(4) = &H30 Or ((RGB.Green And &HF0) \ &H10)
    bytOut(6) = &H30 Or (RGB.Green And &HF)
    bytOut(8) = &H30 Or ((RGB.Blue And &HF0) \ &H10)
    bytOut(10) = &H30 Or (RGB.Blue And &HF)
    If bytOut(0) > &H39 Then bytOut(0) = bytOut(0) + 7
    If bytOut(2) > &H39 Then bytOut(2) = bytOut(2) + 7
    If bytOut(4) > &H39 Then bytOut(4) = bytOut(4) + 7
    If bytOut(6) > &H39 Then bytOut(6) = bytOut(6) + 7
    If bytOut(8) > &H39 Then bytOut(8) = bytOut(8) + 7
    If bytOut(10) > &H39 Then bytOut(10) = bytOut(10) + 7
    RGBtoHex = bytOut
End Function

Note that I called Long methods by Color for clarity, because LongToHex would result in a string that is 8 characters long. ColorToHex gives the expected six characters.

[EntityReborn]

Thanks, si and Merri! I will make the noted changes asap.
Merry, could you explain what is happening in your code? I know you loop through the string, but I do not understand the hex values you use, the use of the Or statement (I believe this is a bytewise statement, rather than a logic statement correct?). Suffice it to say, I don't understand your code at all. Sorry

[Merri]

I've now commented the code, should make things easier to figure out.

It isn't necessary to use my code, but it simply shows how to do what is required with a nearly minimal effort for the CPU.

[EntityReborn]

I see. As it is, that style of coding is as yet beyond me, but I will adapt it.
I also have other changes planned, such as click-drag targeting, instead of constant poll, as well as viewing in the shape a zoomed version of where the cursor is while dragging. We'll see how that turns out :P

[Merri]

I guess you need to know a few things:

• How strings are internally stored in memory (BSTR format)
• Character codes
• Byte arrays "as strings"
• Byte and Long datatypes and how to write not-a-variable code using those datatypes (the difference of &HFF and &HFF&, 255 and 255&)
• How colors are stored in memory (kinda like &H00BBGGRR)
• A bit math: "bitshifting" in VB, how to get the values you need
• Hex numbers
• A bit of problem solving: how to limit values to what you just need and how to keep any errors away (these things often have something in common: limiting possible values reduces the amount of error detection you need, LenB usage for an example)

Most of this will be valid with other programming languages as well. There are a few VB specific things, such as using the LSet trick to copy data that in other programming languages don't often require a trick (I think it was called "casting"). Other than that you'd be pretty much doing the same thing with other languages, of course accounting for their possible limitations.

[EntityReborn]

If you could point me out to some papers about those subjects, I'd be downright pleased. As is with my learning style, I have gaps in understanding in regards to detail stuff like that.

[Merri]

Google results:

ASCII table

Optimize string handling in Visual Basic 6

Byte arrays in VB6

VB6 naming conventions & datatypes

Wikipedia: Color depth

Wikipedia: Hexadecimal

[EntityReborn]

Thanks for those links. Very interesting and informative reading!

New updates! Include:
-Click drag targeting to select color
-Updated code by thread members
-Selectable zoom for the preview window

Notes: I feel the offsetting code for the preview window is a little inaccurate, and I would like to put crosshairs in the window, but due to the inaccuracy, its against usability at this point.

First post updated.


EDIT: no one has even downloaded the code to try it out???

[Divran]

Awesome program. Maybe you guys can help me with changing RGB into Hex?
I posted here for help:
http://www.vbforums.com/showpost.php...15&postcount=8