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

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

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

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

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

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

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