PureBasic Forums - English

Posted: **Wed Apr 23, 2008 8:36 am**

Surprisingly there doesn't seem to be anything on the forums about doing this.

Ideally I'd like to make a procedure something like:

Code: Select all

TintImage(image.l,TintColour.l,TintLevelAsPercentage.b)

Is it necessary to create the tint as a separate image and then load it as a 3D sprite, or is there a more sensible way?

Posted: **Wed Apr 23, 2008 8:42 am**

I think there's something here

http://www.purebasic.fr/english/viewtopic.php?t=8781

look at Danilo's ChangeImageColorChannel() - though I'm not sure which version of PB it's for... could be an early one

Posted: **Thu Apr 24, 2008 7:54 am**

Thanks for the pointer, CityState.

I've adapted Danilo's procedure for tinting and it seems to work - but only for the three primary colours.

For any other colour, it nearly works.

I find it very difficult to get my head around colour values and how to manipulate them, so I can't work out what I'm doing wrong!

If somebody could take a look at this and suggest improvements, I'd be very grateful.

The procedure "ChangeImageColorChannel" is unchanged from Danilo's original. The procedure where the tinting is "calculated" into values for ChangeImageColorChannel is called "TintImage".

Code: Select all

Procedure ChangeImageColorChannel(SourceImage,DestImage,Red,Green,Blue)
  ;>
  ;> OriginalImage  = number of Source Image
  ;> DestImage      = number of New Image that gets changed (must be same size!)
  ;>
  ;> Red,Green,Blue = How much change this color channel ?
  ;>                  -255 -> Reduce color completely (fade out color)
  ;>                     0 -> dont touch, change nothing
  ;>                   255 -> add color to color channel (fade in)
  ;>
  Structure _CIC_BITMAPINFO
    bmiHeader.BITMAPINFOHEADER
    bmiColors.RGBQUAD[1]
  EndStructure

  Structure _CIC_LONG
   l.l
  EndStructure

  If Not ImageID(SourceImage) Or Not ImageID(DestImage)
    ProcedureReturn 0
  EndIf

  hBmp = ImageID(SourceImage)
  hDC  = StartDrawing(ImageOutput(SourceImage))
  If hDC
    ImageWidth1  = ImageWidth(SourceImage)
    ImageHeight1 = ImageHeight(SourceImage)
    mem = GlobalAlloc_(#GMEM_FIXED|#GMEM_ZEROINIT,ImageWidth1*ImageHeight1*4)
    If mem
      bmi._CIC_BITMAPINFO
      bmi\bmiHeader\biSize   = SizeOf(BITMAPINFOHEADER)
      bmi\bmiheader\biWidth  = ImageWidth1
      bmi\bmiheader\biHeight = ImageHeight1
      bmi\bmiheader\biPlanes = 1
      bmi\bmiheader\biBitCount = 32
      bmi\bmiheader\biCompression = #BI_RGB
      If GetDIBits_(hDC,hBmp,0,ImageHeight1,mem,bmi,#DIB_RGB_COLORS) <> 0
        StopDrawing()
        hBmp = ImageID(DestImage)
        hDC = StartDrawing(ImageOutput(DestImage))
        If hDC
            
           *pixels._CIC_LONG = mem
           For a = 1 To ImageWidth1*ImageHeight1
              
             RED2  = (*pixels\l >>16) & $FF
             GREEN2= (*pixels\l >> 8) & $FF
             BLUE2 = (*Pixels\l     ) & $FF
              
             If RED2 < RED And RED>0
               RED2 = RED
             ElseIf RED<0
               RED2 = RED2+RED
               If RED2<0:RED2=0:EndIf
             EndIf

             If GREEN2 < GREEN And GREEN>0
               GREEN2 = GREEN
             ElseIf GREEN<0
               GREEN2 = GREEN2+GREEN
               If GREEN2<0:GREEN2=0:EndIf
             EndIf

             If BLUE2 < BLUE And BLUE>0
               BLUE2 = BLUE
             ElseIf BLUE<0
               BLUE2 = BLUE2+BLUE
               If BLUE2<0:BLUE2=0:EndIf
             EndIf

             *pixels\l = (RED2<<16)|(GREEN2<<8)|(BLUE2)
             *pixels + 4
           Next a

          If SetDIBits_(hDC,hBmp,0,ImageHeight1,mem,bmi,#DIB_RGB_COLORS) <> 0
            Result = 1
          EndIf
        EndIf
        StopDrawing()
      EndIf
      GlobalFree_(mem)
    Else
      StopDrawing()
    EndIf
  Else
    StopDrawing()
  EndIf
  
  ProcedureReturn Result
  
EndProcedure




Procedure ShowDyeColour(gad,pic.l,colour.l)
  
  StartDrawing(ImageOutput(pic))
  Box(0,0,50,250,colour)
  StopDrawing()
  
  SetGadgetState(gad,ImageID(pic))
  
EndProcedure




Procedure.l TintImage(image.l,dye.l,level.f)
  
  r.f = Red(dye)
  g.f = Green(dye)
  b.f = Blue(dye)
  
  
  ; implement "level" of dyeing
  r = r/255*level
  g = g/255*level
  b = b/255*level
  
  If Not r
      r = -level
  EndIf
  
  If Not g
      g = -level
  EndIf
  
  If Not b
      b = -level
  EndIf
  
  output = CopyImage(image,#PB_Any)
  
  ChangeImageColorChannel(image,output,r,g,b)
  
  ProcedureReturn output
  
EndProcedure




;- PROGRAM START

UseJPEGImageDecoder()
UsePNGImageDecoder()
UseTIFFImageDecoder()
UseTGAImageDecoder()
FileName$ = OpenFileRequester("SELECT IMAGE","","Image Files|*.bmp;*.jpg;*.jpeg;*.png;*.tiff;*.tga|All Files|*.*",0)

img = LoadImage(#PB_Any,FileName$)
ImageWidth  = ImageWidth(img)
ImageHeight = ImageHeight(img)
If ImageWidth>800:ImageWidth=800:Resize=1:EndIf
If ImageHeight>600:ImageHeight=600:Resize=1:EndIf
If Resize
    ResizeImage(img,ImageWidth,ImageHeight)
EndIf

CreateImage(2,ImageWidth,ImageHeight)
WinWidth  = ImageWidth+140
WinHeight = ImageHeight : If WinHeight < 300:WinHeight=300:EndIf
win = OpenWindow(#PB_Any,0,0,WinWidth,WinHeight,"Image",#PB_Window_ScreenCentered|#PB_Window_SystemMenu|#PB_Window_Invisible)
CreateGadgetList(WindowID(win))
tk = TrackBarGadget(#PB_Any,ImageWidth+10,20,40,250,0,255,#PB_TrackBar_Vertical)
SetGadgetState(tk,1)
tx = TextGadget(#PB_Any,ImageWidth+10,270,75,20,"AMOUNT: 1")

colpic = CreateImage(#PB_Any,50,ImageHeight-20)
colimgad = ImageGadget(#PB_Any,ImageWidth+80,20,50,ImageHeight-20,ImageID(colpic))
dye = #Blue
ShowDyeColour(colimgad,colpic,dye)
amount=1

display = ImageGadget(#PB_Any,0,0,WinWidth-140,ImageHeight,ImageID(img))
HideWindow(win,0):SetForegroundWindow_(WindowID(win))


;- PROGRAM EVENT LOOP
Repeat
    Select WaitWindowEvent()
        Case #PB_Event_CloseWindow
            End
        Case #PB_Event_Gadget
            eg = EventGadget()
            Select eg
                Case tk
                    amount = GetGadgetState(tk)
                    SetGadgetText(tx,"AMOUNT: "+(Str(amount)))
                    tinted = TintImage(img,dye,amount)
                    SetGadgetState(display,ImageID(tinted))
                Case colimgad
                    dye = ColorRequester()
                    ShowDyeColour(colimgad,colpic,dye)
                    tinted = TintImage(img,dye,amount)
                    SetGadgetState(display,ImageID(tinted))
            EndSelect
    EndSelect
Until GetAsyncKeyState_(#VK_ESCAPE)

Posted: **Thu Apr 24, 2008 9:09 am**

The code below is what I have been using for image tinting. It doesn't shift color channels; it's actually a multiply filter. As such, the amount of tint is controlled by the value of the multiply color. This example operates on an image in-place, but modifying it to return a new image would be trivial. Also, this only works on 24/32-bit images. I wrote a version which works on 16-bit also, but I seem to have misplaced it

Code: Select all

Macro _rmul(a,b)
  ((Red(a) * Red(b)) / 255)
EndMacro

Macro _gmul(a,b)
  ((Green(a) * Green(b)) / 255)
EndMacro

Macro _bmul(a,b)
  ((Blue(a) * Blue(b)) / 255)
EndMacro

Macro _mul(colora, colorb)
  RGB(_rmul(colora,colorb), _gmul(colora,colorb), _bmul(colora,colorb))
EndMacro

ProcedureDLL TintImage(Image.l, Color.l)
  Protected bpp.b = 0
  Protected px.l, pixel.l, newcolor.l
  Protected ctr.l
  
  If ImageDepth(Image) < 24
    ProcedureReturn
  EndIf
  
  GetObject_(ImageID(Image), SizeOf(BITMAP), @bm.BITMAP)

  Select bm\bmBitsPixel
    Case 24: bpp = 3
    Case 32: bpp = 4
  EndSelect
  
  GlobalLock_(bm\bmBits)
  For i = 0 To bm\bmHeight - 1
    px = 0
    ctr = 0
    While (px < bm\bmWidthBytes) And (ctr < bm\bmWidth)
      pixel = bm\bmBits + (i * bm\bmWidthBytes) + px
      pixb = (PeekB(pixel + (bpp-1)) & $FF)
      pixg = (PeekB(pixel + (bpp-2)) & $FF)
      pixr = (PeekB(pixel + (bpp-3)) & $FF)
      pixrgb = RGB(pixr, pixg, pixb)
      
      newcolor = _mul(pixrgb, Color)

      PokeB(pixel + (bpp - 1), Red(newcolor))
      PokeB(pixel + (bpp - 2), Green(newcolor))
      PokeB(pixel + (bpp - 3), Blue(newcolor))

      px + bpp
      ctr + 1
    Wend
  Next
  GlobalUnlock_(bm\bmBits)
EndProcedure

Posted: **Thu Apr 24, 2008 12:55 pm**

Thanks, RHyde, but that isn't what I need. I can't see how to adapt that to straightforward superimposing instead of Multiplying. And also, I really need to be able to control the level of tinting.

Posted: **Thu Apr 24, 2008 6:02 pm**

It's still possible, you just need to work in HSV color space instead of RGB. In HSV, the hue and saturation will control the color of the tint, and the value will control the amount. The only problem is that PureBasic doesn't provide primitives for working with colors in HSV-space, so you need to roll your own. If I get time in the next few days, I'll post an example.

Posted: **Sat Apr 26, 2008 12:54 am**

I was slightly wrong about the color space - the best space to work in is HSL, which is similar to HSV but provides more explicit control of a color's "whiteness". Since this is a multiply filter, the closer to white the tint color is the less it will affect the target image. Here is an example of how to use an HSL color transform to vary the intensity of the tint color by changing the lightness channel:

Code: Select all

; save this file as tint.pbi 

;==================================================== 
; Image tinting and HSL<->RGB color transformation 
; ©2008 By Roger Hyde.  All rights reserved 
;------------------------------------------------------------------- 
;  This software is distributed in the hope that it will be 
;  useful, but With NO WARRANTY OF ANY KIND. 
;  No author or distributor accepts responsibility to anyone for the 
;  consequences of using this software, or for whether it serves any 
;  particular purpose or works at all, unless he or she says so in 
;  writing.  Everyone is granted permission to copy, modify And 
;  redistribute this source code, For commercial or non-commercial 
;  purposes, with the following restrictions: (1) the origin of this 
;  source code must not be misrepresented; (2) modified versions must 
;  be plainly marked As such; and (3) this notice may not be removed 
;  or altered from any source or modified source distribution. 
;------------------------------------------------------------------- 
; Thanks go to Rescator for the min/max macros :o) 
;==================================================== 

Structure HSLColor 
  H.f 
  S.f 
  L.f 
EndStructure 

Macro _rmul(a,b) 
  (Red(a) * (Red(b) / 255.0)) 
EndMacro 

Macro _gmul(a,b) 
  (Green(a) * (Green(b) / 255.0)) 
EndMacro 

Macro _bmul(a,b) 
  (Blue(a) * (Blue(b) / 255.0)) 
EndMacro 

Macro _mul(colora, colorb) 
  RGB(_rmul(colora,colorb), _gmul(colora,colorb), _bmul(colora,colorb)) 
EndMacro 

Macro Min(a,b) 
  ((Not a<b)*b)|((Not b<a)*a) 
EndMacro 

Procedure.l Min3(a, b, c) 
  temp = Min(a, b) 
  ProcedureReturn Min(temp, c) 
EndProcedure 

Procedure.f MinF(a.f, b.f) 
  If a < b 
    ProcedureReturn a 
  Else 
    ProcedureReturn b 
  EndIf 
EndProcedure 

Procedure.f MaxF(a.f, b.f) 
  If a > b 
    ProcedureReturn a 
  Else 
    ProcedureReturn b 
  EndIf 
EndProcedure 

Procedure.f Min3F(a.f, b.f, c.f) 
  ProcedureReturn MinF(MinF(a, b), MinF(b, c)) 
EndProcedure 

Procedure.f Max3F(a.f, b.f, c.f) 
  ProcedureReturn MaxF(MaxF(a, b), MaxF(b, c)) 
EndProcedure 

Procedure.l HSL2RGB(*hsl.HSLColor) 
  Protected r.f, g.f, b.f, h.f, s.f, l.f 
  Protected temp1.f, temp2.f 
  Dim t3.d(2) 
  Dim clr.d(2) 
  
  h = *hsl\H / 360.0 
  s = *hsl\S / 100.0 
  l = *hsl\L / 100.0 
  
  If l = 0 
    r = 0 : g = 0 : b = 0 
  Else 
    If s = 0 
      r = l : g = l : b = l 
    Else 
      If l <= 0.5 
        temp2 = l * (1.0 + s) 
      Else 
        temp2 = l + s - (l * s) 
      EndIf 
      temp1 = 2.0 * l - temp2 
      t3(0) = h + 1.0 / 3.0 
      t3(1) = h 
      t3(2) = h - 1.0 / 3.0 

      For i = 0 To 2 
        If t3(i) < 0 : t3(i) + 1.0 : EndIf 
        If t3(i) > 1 : t3(i) - 1.0 : EndIf 
        If 6.0 * t3(i) < 1.0 
          clr(i) = temp1 + (temp2 - temp1) * t3(i) * 6.0 
        ElseIf 2.0 * t3(i) < 1.0 
          clr(i) = temp2 
        ElseIf 3.0 * t3(i) < 2.0 
          clr(i) = (temp1 + (temp2 - temp1) * ((2.0 / 3.0) - t3(i)) * 6.0) 
        Else 
          clr(i) = temp1 
        EndIf 
      Next 
      
      r = clr(0) 
      g = clr(1) 
      b = clr(2) 
      
    EndIf 
    
  EndIf 
  
  ProcedureReturn RGB(Min3((r*255), 255, 255), Min3((g*255), 255, 255), Min3((b*255), 255, 255)) 
EndProcedure 

Procedure RGB2HSL(color.l, *hsl.HSLColor) 
  r.f = Red(color) / 255.0 
  g.f = Green(color) / 255.0 
  b.f = Blue(color) / 255.0 
  
  min.f = Min3F(r, g, b) 
  max.f = Max3F(r, g, b) 
  delta.f = max - min 
  
  *hsl\L = (max + min) / 2.0 
  
  If  delta = 0 
     *hsl\H = 0.0 
     *hsl\S = 0.0 
  Else 
    If *hsl\L < 0.5 
    *hsl\S = delta / (max + min) 
    Else 
      *hsl\S = delta / (2.0 - delta) 
    EndIf 
      
    dr.f = (((max - r) / 6.0) + (delta / 2.0)) / delta 
    dg.f = (((max - g) / 6.0) + (delta / 2.0)) / delta 
    db.f = (((max - b) / 6.0) + (delta / 2.0)) / delta 
    
    If r = max 
      *hsl\H = db - dg 
    ElseIf g = max 
      *hsl\H = (1.0 / 3.0) + dr - db 
    ElseIf b = max 
      *hsl\H = (2.0 / 3.0) + dg - dr 
    EndIf 
    
    If *hsl\H < 0 : *hsl\H + 1 : EndIf 
    If *hsl\H > 1 : *hsl\H - 1 : EndIf 
    *hsl\H * 360.0 
    *hsl\S * 100.0 
    *hsl\L * 100.0 
  EndIf 
EndProcedure 

ProcedureDLL TintImage(Image.l, Color.l) 
  Protected bpp.b = 0 
  Protected px.l, pixel.l, newcolor.l 
  Protected ctr.l 
  
  If ImageDepth(Image) < 24 
    ProcedureReturn 
  EndIf 
  
  GetObject_(ImageID(Image), SizeOf(BITMAP), @bm.BITMAP) 

  Select bm\bmBitsPixel 
    Case 24: bpp = 3 
    Case 32: bpp = 4 
  EndSelect 
  
  GlobalLock_(bm\bmBits) 
  For i = 0 To bm\bmHeight - 1 
    px = 0 
    ctr = 0 
    While (px < bm\bmWidthBytes) And (ctr < bm\bmWidth) 
      pixel = bm\bmBits + (i * bm\bmWidthBytes) + px 
      pixb = (PeekB(pixel + (bpp-1)) & $FF) 
      pixg = (PeekB(pixel + (bpp-2)) & $FF) 
      pixr = (PeekB(pixel + (bpp-3)) & $FF) 
      pixrgb = RGB(pixr, pixg, pixb) 
      
      newcolor = _mul(pixrgb, Color) 

      PokeB(pixel + (bpp - 1), Red(newcolor)) 
      PokeB(pixel + (bpp - 2), Green(newcolor)) 
      PokeB(pixel + (bpp - 3), Blue(newcolor)) 

      px + bpp 
      ctr + 1 
    Wend 
  Next 
  GlobalUnlock_(bm\bmBits) 
EndProcedure 

ProcedureDLL TintImageNew(Image.l, Color.l) 
  Protected bpp.b = 0 
  Protected px.l, pixel.l, newcolor.l 
  Protected ctr.l, newimage 
  
  GetObject_(ImageID(Image), SizeOf(BITMAP), @bm.BITMAP) 
  newimage = CreateImage(#PB_Any, bm\bmWidth, bm\bmHeight, bm\bmBitsPixel) 
  *bits = AllocateMemory(bm\bmHeight * bm\bmWidthBytes) 
  GetBitmapBits_(ImageID(Image), bm\bmHeight * bm\bmWidthBytes, *bits) 
  SetBitmapBits_(ImageID(newimage), bm\bmHeight * bm\bmWidthBytes, *bits) 
  FreeMemory(*bits) 
  GetObject_(ImageID(newimage), SizeOf(BITMAP), @bm2.BITMAP) 
    
  Select bm2\bmBitsPixel 
    Case 24: bpp = 3 
    Case 32: bpp = 4 
    Default: ProcedureReturn 
  EndSelect 
  
  GlobalLock_(bm2\bmBits) 
  For i = 0 To bm2\bmHeight - 1 
    px = 0 
    ctr = 0 
    While (px < bm2\bmWidthBytes) And (ctr < bm2\bmWidth) 
      pixel = bm2\bmBits + (i * bm2\bmWidthBytes) + px 
      pixr = (PeekB(pixel + (bpp-1)) & $FF) 
      pixg = (PeekB(pixel + (bpp-2)) & $FF) 
      pixb = (PeekB(pixel + (bpp-3)) & $FF) 
      pixrgb = RGB(pixr, pixg, pixb) 
      
      newcolor = _mul(pixrgb, Color) 

      PokeB(pixel + (bpp - 1), Red(newcolor)) 
      PokeB(pixel + (bpp - 2), Green(newcolor)) 
      PokeB(pixel + (bpp - 3), Blue(newcolor)) 

      px + bpp 
      ctr + 1 
    Wend 
  Next 
  GlobalUnlock_(bm2\bmBits) 
  ProcedureReturn newimage 
EndProcedure

Code: Select all

; save this file in the same folder where you saved tint.pbi 

IncludeFile "tint.pbi" 

Global hsl.HSLColor 
hsl\H = 50.0 
hsl\S = 50.0 
hsl\L = 50.0 
Global baseColor.l = HSL2RGB(@hsl) 
Global tintColor.l = HSL2RGB(@hsl) 
Global tintImage.l 

Enumeration 
  #MainWindow 
  #ScrollArea 
  #Image 
  #Button 
  #ColorPicker 
  #TrackBar 
  #cpImage 
  #tmpImage 
EndEnumeration 

Procedure UpdateCPImage() 
  StartDrawing(ImageOutput(#cpImage)) 
    Box(0, 0, 25, 25, baseColor) 
    DrawingMode(#PB_2DDrawing_Outlined) 
    Box(0, 0, 25, 25, #Black) 
  StopDrawing() 
  SetGadgetState(#ColorPicker, ImageID(#cpImage)) 
EndProcedure 

Procedure OpenMainWindow() 
  CreateImage(#cpImage, 25, 25) 
  If OpenWindow(#MainWindow, 359, 105, 607, 485, "Window_0", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget) 
    If CreateGadgetList(WindowID(#MainWindow)) 
      ScrollAreaGadget(#ScrollArea, 0, 0, 570, 485, 500, 400, 10, #PB_ScrollArea_Single) 
        ImageGadget(#Image, 0, 0, 100, 100, 0) 
      CloseGadgetList() 
      ButtonGadget(#Button, 575, 5, 25, 20, "...") 
      ImageGadget(#ColorPicker, 575, 30, 25, 25, ImageID(#cpImage)) 
      TrackBarGadget(#TrackBar, 580, 60, 20, 405, 0, 50, #PB_TrackBar_Ticks|#PB_TrackBar_Vertical) 
      SetGadgetState(#TrackBar, hsl\L) 
      UpdateCPImage() 
    EndIf 
  EndIf 
EndProcedure 

UseJPEGImageDecoder() 
UsePNGImageDecoder() 
OpenMainWindow() 

Repeat 
  Event = WaitWindowEvent() 
  Select Event 
    Case #PB_Event_Gadget 
      Select EventGadget() 
        Case #Button 
          pattern$ = "Bitmap (*.bmp)|*.bmp|Jpeg (*.jpg, *.jpeg)|*.jpg;*.jpeg|PNG (*.png)|*.png" 
          file$ = OpenFileRequester("Select an image", "", pattern$, 0) 
          If file$ <> "" 
            LoadImage(#tmpImage, file$) 
            If IsImage(#tmpImage) 
              tintImage = TintImageNew(#tmpImage, tintColor) 
              If IsImage(tintImage) 
                SetGadgetState(#Image, ImageID(tintImage)) 
              Else 
                MessageRequester("Error", "Could not tint image") 
              EndIf 
            EndIf 
          EndIf 
        Case #ColorPicker 
          If EventType() = #PB_EventType_LeftClick 
            clr = ColorRequester(baseColor) 
            If clr >= 0 
              baseColor = clr 
              RGB2HSL(clr, @hsl) 
              hsl\L = 100 - GetGadgetState(#TrackBar) 
              ;hsl\S = GetGadgetState(#TrackBar) 
              tintColor.l = HSL2RGB(@hsl) 
              UpdateCPImage() 
              If IsImage(#tmpImage) 
                tintImage = TintImageNew(#tmpImage, tintColor) 
                SetGadgetState(#Image, ImageID(tintImage)) 
              EndIf 
            EndIf 
          EndIf 
        Case #TrackBar 
          hsl\L = 100 - GetGadgetState(#TrackBar) 
          ;hsl\S = GetGadgetState(#TrackBar) 
          tintColor = HSL2RGB(@hsl) 
          If IsImage(#tmpImage) 
            tintImage = TintImageNew(#tmpImage, tintColor) 
            SetGadgetState(#Image, ImageID(tintImage)) 
          EndIf 
      EndSelect 

    Case #PB_Event_CloseWindow 
      EventWindow = EventWindow() 
      If EventWindow = #MainWindow 
        CloseWindow(#MainWindow) 
        Break 
      EndIf 
  EndSelect 
ForEver

That's the basic idea. I hope it's useful to you Seymour; if not maybe others will find some use for it.

PureBasic Forums - English

Tinting an image?

Tinting an image?