VBspeed / Bits / LongToRGBHex
VBspeed © 2000-10, updated: 12-Oct-2001
LongToRGBHex


Function LongToRGBHex
Converts color Longs to RGB hexadecimal color representations, aka color triplets as known from HTML coding (eg. white=#FFFFFF, the general formula being #RRGGBB).
The process involves reversing the byte order, ignoring the 4th byte (highest byte), and padding zeroes to fill up 6 hex digits.

Examples:
   LongToRGBHex(&H0) -> "000000"
   LongToRGBHex(&H87654321) -> "214365"

Compare the latter to the related function LongToHexRev:
   LongToHexRev(&H87654321) => "21436587"

Use this function (VB5/6-compatible) to verify the correctness of your code.
Code
LongToRGBHex01
Private Declare Sub RtlMoveMemory Lib "kernel32" ( _
    Dst As Any, Src As Any, ByVal nBytes&)

Public Function LongToRGBHex01(lLong As Long) As String ' by Donald, donald@xbeat.net, 20010910 Dim bCol(3) As Byte Dim lLongRev As Long Dim i As Long ' reverse byte order (0,1,2 to 3,2,1) For i = 0 To 2 RtlMoveMemory bCol(3 - i), ByVal VarPtr(lLong) + i, 1 Next RtlMoveMemory lLongRev, bCol(1), 3 ' to hex, left-padd zeroes LongToRGBHex01 = Right$("00000" & Hex$(lLongRev), 6) End Function
LongToRGBHex02
Private Declare Sub RtlMoveMemory Lib "kernel32" ( _
    Dst As Any, Src As Any, ByVal nBytes&)

Public Function LongToRGBHex02(lLong As Long) As String ' by Donald, donald@xbeat.net, 20010910 Dim bCol(3) As Byte Dim lLongRev As Long Dim i As Long ' extract color bytes bCol(3) = lLong And &HFF& 'red bCol(2) = (lLong And &HFF00&) \ &H100& 'green bCol(1) = (lLong And &HFF0000) \ &H10000 'blue ' reverse byte order (0,1,2 to 3,2,1) RtlMoveMemory lLongRev, bCol(1), 3 ' to hex, left-padd zeroes LongToRGBHex02 = Right$("00000" & Hex$(lLongRev), 6) End Function
LongToRGBHex03
Public Function LongToRGBHex03(lLong As Long) As String
' by Donald, donald@xbeat.net, 20010910
  Dim lLongRev As Long
  Dim HiWord As Integer
  Dim LoWord As Integer
  ' mask out highest byte
  lLong = lLong And &HFFFFFF
  ' extract hiword and loword inline
  HiWord = (lLong And &HFFFF0000) \ &H10000
  If lLong And &H8000& Then
    LoWord = lLong Or &HFFFF0000
  Else
    LoWord = lLong And &HFFFF&
  End If
  ' swap bytes
  HiWord = ByteSwap01(HiWord)
  LoWord = ByteSwap01(LoWord)
  ' swap words
  lLongRev = (LoWord * &H10000) Or (HiWord And &HFFFF&)
  ' right-shift 2 pos, to hex, left-padd zeroes
  LongToRGBHex03 = Right$("00000" & Hex$(lLongRev \ &H100), 6)
End Function

Public Function ByteSwap01(w As Integer) As Integer ' by Donald, donald@xbeat.net, 20010910 Dim LoByte As Byte Dim HiByte As Byte LoByte = w And &HFF HiByte = (w And &HFF00&) \ &H100 If LoByte And &H80 Then ByteSwap01 = ((LoByte * &H100&) Or HiByte) Or &HFFFF0000 Else ByteSwap01 = (LoByte * &H100) Or HiByte End If End Function
LongToRGBHex04
Public Function LongToRGBHex04(ByVal lLong As Long) As String
' by Donald, donald@xbeat.net, 20010910
  Dim bRed As Long
  Dim bGreen As Long
  Dim bBlue As Long
  ' mask out highest byte
  lLong = lLong And &HFFFFFF
  ' extract color bytes
  bRed = lLong And &HFF
  bGreen = (lLong \ &H100) And &HFF
  bBlue = (lLong \ &H10000) And &HFF
  ' reverse bytes
  lLong = bRed * &H10000 + bGreen * &H100 + bBlue
  ' to hex, left-padd zeroes
  ' the string op is the bottleneck of this procedure, and since in real
  ' world most colors have a red-part >= 16, it's a good idea to check if
  ' we really need the string op
  If bRed < &H10 Then
    LongToRGBHex04 = Right$("00000" & Hex$(lLong), 6)
  Else
    LongToRGBHex04 = Hex$(lLong)
  End If
End Function
LongToRGBHex05
Private Type T1Long
  lDWord As Long
End Type
Private Type T4Byte
  bByte1 As Byte  'lo
  bByte2 As Byte
  bByte3 As Byte
  bByte4 As Byte  'hi
End Type

Public Function LongToRGBHex05(ByVal lLong As Long) As String ' by Donald, donald@xbeat.net, 20010912 Dim u4Byte As T4Byte Dim u1Long As T1Long ' extract color bytes u1Long.lDWord = lLong LSet u4Byte = u1Long ' reverse bytes lLong = &H10000 * u4Byte.bByte1 + &H100& * u4Byte.bByte2 + u4Byte.bByte3 ' to hex, left-padd zeroes ' the string op is the bottleneck of this procedure, and since in real ' world most colors have a red-part >= 16, it's a good idea to check if ' we really need the string op If u4Byte.bByte1 < &H10 Then LongToRGBHex05 = Right$("00000" & Hex$(lLong), 6) Else LongToRGBHex05 = Hex$(lLong) End If End Function
LongToRGBHex06
Doping: needs reference to StringHelpers typelib Split03.tlb (by Egbert Nierop)
Download TLB_Split03.zip (3KB zipped, VB5-compatible).
WrapUp: download the complete code wrapped in module modLongToRGBHex_Paul (2KB zipped, VB5-compatible).

Private lHexLookup(255) As Long
Public Function LongToRGBHex06(ByVal lLong As Long) As String ' by Paul, wpsjr1@syix.com, 20011012 Static lHex(2) As Long Static i As Long If i Then Else i = 1 InitHexLookup End If lLong = lLong And &HFFFFFF lHex(0) = lHexLookup(lLong And 255) lHex(1) = lHexLookup((lLong \ 256) And 255) lHex(2) = lHexLookup((lLong \ 65536) And 255) LongToRGBHex06 = StringHelpers.SysAllocStringLen(lHex(0), 6) End Function
Private Sub InitHexLookup() lHexLookup(0) = 3145776 lHexLookup(1) = 3211312 lHexLookup(2) = 3276848 lHexLookup(3) = 3342384 ... ... lHexLookup(255) = 4587590 End Sub
LongToRGBHex07
Doping: needs reference to StringHelpers typelib Split03.tlb (by Egbert Nierop)
Download TLB_Split03.zip (3KB zipped, VB5-compatible).

Public Function LongToRGBHex07(ByVal lLong As Long) As String ' by Donald, donald@xbeat.net, 20011012 ' heavily inspired by Paul's LongToRGBHex06 Const cHEX = "0123456789ABCDEF" Static lHexLookup(255) As Long Static lHex(2) As Long Static fDone As Boolean Dim i1 As Long, i2 As Long If Not fDone Then For i1 = 1 To 16 For i2 = 1 To 16 lHexLookup((i1 - 1) * 16 + i2 - 1) = Asc(Mid$(cHEX, i2)) * &H10000 _ + Asc(Mid$(cHEX, i1)) Next Next fDone = True End If lLong = lLong And &HFFFFFF lHex(0) = lHexLookup(lLong And &HFF&) lHex(1) = lHexLookup((lLong \ &H100&) And &HFF&) lHex(2) = lHexLookup((lLong \ &H10000) And &HFF&) LongToRGBHex07 = StringHelpers.SysAllocStringLen(lHex(0), 6&) End Function
Calls
1sRet = LongToRGBHex(&H000C98EC) --> "EC980C"
2sRet = LongToRGBHex(&H0000000C) --> "0C0000"
Charts
 VB5 Charts
CodeAuthorDopingNotes
LongToRGBHex01 DonaldAPI 
LongToRGBHex02 DonaldAPI 
LongToRGBHex03 Donald  
LongToRGBHex04 Donald  
LongToRGBHex05 Donald  
LongToRGBHex06 PaulTLB 
LongToRGBHex07 DonaldTLB 
Call 1
710.2510.374Ás
69.369.466Ás
53.733.775Ás
31.401.416Ás
41.621.637Ás
11.001.012Ás
21.031.042Ás
Call 2
710.2310.330Ás
69.249.331Ás
43.603.636Ás
33.383.413Ás
53.623.653Ás
11.001.010Ás
21.031.044Ás
 VB6 Charts
CodeAuthorDopingNotes
LongToRGBHex01 DonaldAPI 
LongToRGBHex02 DonaldAPI 
LongToRGBHex03 Donald  
LongToRGBHex04 Donald  
LongToRGBHex05 Donald  
LongToRGBHex06 PaulTLB 
LongToRGBHex07 DonaldTLB 
Call 1
79.7710.332Ás
68.328.791Ás
53.944.164Ás
31.561.649Ás
41.721.823Ás
11.001.057Ás
21.011.069Ás
Call 2
79.7410.141Ás
68.208.539Ás
53.773.926Ás
33.643.789Ás
43.733.880Ás
11.001.041Ás
21.021.065Ás
Conclusions
The cool idea of LongToRGBHex06: Lookup array replaces the Hex$ function.
The cool idea of LongToRGBHex07: imitate LongToRGBHex06, put the list into a box, and write your own name on top of it. Harhar. Pity that it is not faster.
Got comments? How to read all those numbers

top




VBspeed © 2000-10 by Donald Lessau