Rank: Advanced Member
Groups: Guest
Joined: 3/9/2008(UTC) Posts: 554
Was thanked: 1 time(s) in 1 post(s)
|
Suppose, you have color RGB picture and you want to convert it to a red-white, yellow-white or blue-white (and so on) image analogous to standard grayscale one. As a solution I suggest the following algorithm for each pixel: - Get the values of channels (R,G,B) in source bitmap.
- Calculate lightness.
- Compose HSL (Hue, Saturation, Lightness) color. Lightness of this pixel equals to the value calculated on the previous step. H and S values are defined as input values fixing monochrome color.
- Convert from HSL to RGB.
- Write down pixel into new bitmap.
The following code represents the algorithm above. Take into account h and s parameters passed to this function forms monochrome color (in HSL format, L channel is omitted) we transform the image to. Code:Private Function HslToRgb(ByVal h As Double, ByVal s As Double, _
ByVal bmp As Aurigma.GraphicsMill.Bitmap) As Aurigma.GraphicsMill.Bitmap
Dim bitmapData As Aurigma.GraphicsMill.BitmapData = bmp.LockBits()
Dim stride As Integer = bitmapData.Stride
Dim pointer As IntPtr = bitmapData.Scan0
Dim pixelSize As Integer = bitmapData.BitsPerPixel / 8
Dim newBmp As New Aurigma.GraphicsMill.Bitmap(bmp.Width, _
bmp.Height, Aurigma.GraphicsMill.PixelFormat.Format24bppRgb)
Dim newBitmapData As Aurigma.GraphicsMill.BitmapData = newBmp.LockBits()
Dim newPointer As IntPtr = newBitmapData.Scan0
Dim newStride As Integer = newBitmapData.Stride
Dim colors(pixelSize - 1) As Byte
Dim lChannel As Double
Dim hChannel As Double
Dim sChannel As Double
Dim j As Integer = 0
For i As Integer = 0 To bitmapData.Height - 1
j = 0
Do While j < bmp.Width
System.Runtime.InteropServices.Marshal.Copy(IntPtr.op_Explicit(pointer.ToInt32()+ _
i * stride + j * pixelSize), colors, 0, pixelSize)
Dim blue As Byte = colors(0)
Dim green As Byte = colors(1)
Dim red As Byte = colors(2)
Dim lightness As Byte = (30 * blue + 59 * green + 11 * red) / 100
lChannel = lightness / 255.0
hChannel = h
sChannel = s
Dim v, r, g, b As Double
r = lChannel ' default to gray
g = lChannel
b = lChannel
v = IIf((lChannel <= 0.5), (lChannel * (1.0 + sChannel)), _
(lChannel + sChannel - lChannel * sChannel))
If v > 0 Then
Dim m, fract, vsf, mid1, mid2, sv As Double
Dim sextant As Integer
m = lChannel + lChannel - v
sv = (v - m) / v
hChannel *= 6.0
sextant = CInt(hChannel)
fract = hChannel - sextant
vsf = v * sv * fract
mid1 = m + vsf
mid2 = v - vsf
Select Case (sextant)
Case 0
r = v
g = mid1
b = m
Case 1
r = mid2
g = v
b = m
Case 2
r = m
g = v
b = mid1
Case 3
r = m
g = mid2
b = v
Case 4
r = mid1
g = m
b = v
Case 5
r = v
g = m
b = mid2
End Select
End If
colors(2) = Convert.ToByte(r * 255.0F)
colors(1) = Convert.ToByte(g * 255.0F)
colors(0) = Convert.ToByte(b * 255.0F)
System.Runtime.InteropServices.Marshal.Copy(colors, 0, _
IntPtr.op_Explicit(newPointer.ToInt32() + i * newStride + j * pixelSize), pixelSize)
j = j + 1
Loop
Next i
bmp.UnlockBits(bitmapData)
newBmp.UnlockBits(newBitmapData)
Return newBmp
End Function
See also:Edited by moderator Monday, May 28, 2012 8:31:38 PM(UTC)
| Reason: Not specified |