Colorize an image

[BasicallyPure]

Add color of a specific hue to an image.
This works with grayscale or color images.

edit: the better code for colorizing an image is further down in this topic.
http://www.purebasic.fr/english/viewtop ... 09#p482309

Code: Select all

; ColorizeImage.pb
; apply specific hue to image by BasicallyPure
; 2.02,2016
; License : Free
; Compiler: PureBasic 5.41 LTS
; OS: cross platform

EnableExplicit

   UsePNGImageDecoder()      : UsePNGImageEncoder()
   UseJPEGImageDecoder()     : UseJPEGImageEncoder()
   UseJPEG2000ImageDecoder() : UseJPEG2000ImageEncoder()

Structure HueType
   Rv.i
   Gv.i
   Bv.i
EndStructure

Declare.i ASSEMBLE_TO_PALETTE(image, Array Pallete.l(1))
Declare.i CATCH_PALETTE(*MemoryAddress.Long, NumColors.i)
Declare.I COLORIZE_IMAGE(color.i, image.i)
Declare.i COPY()
Declare.i CREATE_HUE_PALETTE(*Hue.HueType, size.i)
Declare.i EVENT_LOOP()
Declare.l FIND_NEAREST(Color.l)
Declare.i FIT_CANVAS_TO_WINDOW()
Declare.i FIT_WINDOW_TO_IMAGE(image.i)
Declare.i HANDLE_WIN_MAIN_EVENTS(event.i)
Declare.i HANDLE_WIN_HUE_EVENTS(event.i)
Declare.i LOAD_IMAGE()
Declare.i OPEN_MAIN_WINDOW()
Declare.i OPEN_HUE_WINDOW()
Declare.i PASTE()
Declare.l PointOrdDith(x.i, y.i)
Declare.i REVERT()
Declare.i SAVE_IMAGE()
Declare.i UPDATE_CANVAS(image.i)

CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
   Macro rdx : edx : EndMacro
   #x64 = #False
CompilerElse
   #x64 = #True
CompilerEndIf

#WinMain  = 0
#WinHue  = 1
#MainMenu = 0
#PopMenu  = 1

#CBcolor   = $404040 ;canvas background color

;{ enumerations
Enumeration
   #imgRef : #imgAdj : #imgHue : #imgRevert
EndEnumeration

Enumeration
   #Canvas ; for main window
   ; gadgets for hue window
   #T_Trk_Size : #T_Trk_RR    : #T_Trk_GR   : #T_Trk_BR   : #T_Combo_Presets
   #T_Btn_Test : #T_Btn_Apply : #T_Btn_Exit : #T_Frm_Size : #T_Chk_Dither
   #T_Frm_Rr   : #T_Frm_Gr    : #T_Frm_Br   : #T_iGad_hue : #T_Opt_Direct
   #T_Opt_Pal  : #T_Frm_Method
EndEnumeration

Enumeration
   #MenuItem_Load  : #MenuItem_Exit : #MenuItem_Hue : #MenuItem_Copy
   #MenuItem_Paste : #MenuItem_Save : #MenuItem_Revert
EndEnumeration : ;}

Global NewMap PresetMap.HueType()
Global Dim Hue_Palette.l(0)
Global CurrentFileName$, File$
Global Title$ = "Colorize image "
Global endProgram = #False
Global DW,DH,LinuxAdj
Global CanvasMaxWidth, CanvasMaxHeight
Global CanvasMinWidth, CanvasMinHeight
Global WinBorder_X, WinBorder_Y
Global Pan_X, Pan_Y, oversize
Global HueWindowActive
Global Dim IndexG.l(255)
Global Dim Palette.l(1)


If OPEN_MAIN_WINDOW()
   EVENT_LOOP()
EndIf

End

Procedure.i ASSEMBLE_TO_PALETTE(image.i, Array palette.l(1))
   Protected.i h, w, x, y, dither = GetGadgetState(#T_Chk_Dither)
   
   CATCH_PALETTE(@palette(), ArraySize(palette())+1)
   
   If StartDrawing(ImageOutput(Image))
         h = OutputHeight()
         w = OutputWidth()
         If dither
            While y < h
               x = 0
               While x < w
                  Plot(x, y, FIND_NEAREST(PointOrdDith(x, y)))
                  x + 1
               Wend
               y + 1
            Wend
         Else
            While y < h
               x = 0
               While x < w
                  Plot(x, y, FIND_NEAREST(Point(x, y)))
                  x + 1
               Wend
               y + 1
            Wend
         EndIf
      StopDrawing()
   EndIf
   
EndProcedure
Procedure.i CANVAS_CALLBACK()
   Static drag, Xorg, Yorg, iw, ih, ow, oh, Llim, Rlim, Tlim, Blim
   Protected mx, my, x, y
   Select EventType()
      Case #PB_EventType_RightButtonUp : PostEvent(#PB_Event_RightClick)
      ; triggers a '#PB_Event_RightClick' for pop-up menu activation
      ; just like right clicking on the main window.
      Case #PB_EventType_LeftButtonDown
         If oversize : drag = #True
            Xorg = GetGadgetAttribute(#Canvas,#PB_Canvas_MouseX)
            Yorg = GetGadgetAttribute(#Canvas,#PB_Canvas_MouseY)
               ow = GadgetWidth(#Canvas)  : iw = ImageWidth(#imgRef)
               oh = GadgetHeight(#Canvas) : ih = ImageHeight(#imgRef)
               
               Llim = ow-iw : If Llim > 0 : Llim = 0 : EndIf
               Rlim = ow-iw : If Rlim < 0 : Rlim = 0 : EndIf
               
               Tlim = oh-ih : If Tlim > 0 : Tlim = 0 : EndIf
               Blim = oh-ih : If Blim < 0 : Blim = 0 : EndIf
         EndIf
      Case #PB_EventType_MouseMove
         If drag
            mx = GetGadgetAttribute(#Canvas,#PB_Canvas_MouseX)
            my = GetGadgetAttribute(#Canvas,#PB_Canvas_MouseY)
            
            Pan_X + (mx - Xorg) : Xorg = mx
            Pan_Y + (my - Yorg) : Yorg = my
            
            ; pan canvas image
            StartDrawing(CanvasOutput(#Canvas))
               Box(0,0,ow,oh,#CBcolor)
               
               x = Pan_X + (ow - iw) / 2
               y = Pan_Y + (oh - Ih) / 2
               
               If x < Llim : Pan_X + (Llim - x) : x = Llim : EndIf
               If x > Rlim : Pan_X - (x - Rlim) : x = Rlim : EndIf
               If y < Tlim : Pan_Y + (Tlim - y) : y = Tlim : EndIf
               If y > Blim : Pan_Y - (y - Blim) : y = Blim : EndIf
               
               If HueWindowActive
                  DrawImage(ImageID(#ImgAdj),x,y)
               Else
                  DrawImage(ImageID(#imgRef),x,y)
               EndIf
            StopDrawing()
         EndIf
         
      Case #PB_EventType_LeftButtonUp : drag = #False
         
   EndSelect
EndProcedure
Procedure.i CATCH_PALETTE(*MemoryAddress.Long, NumColors.i)
   ; Catch a palette from memory
   Protected.i i, j = 1
   ReDim Palette(NumColors + 1)
   Palette(0) = 0 : Palette(NumColors + 1) = 0
   For i = 1 To NumColors
      Palette(i) = $ff000000 | *MemoryAddress\l
      *MemoryAddress + 4
   Next
   SortStructuredArray(Palette(), 0, 0, #PB_Unicode, 1, NumColors)
   For i = 0 To 255
      IndexG(i) = j
      While ((Palette(j) >> 8) & $ff) = i And j < NumColors
         j + 1
      Wend
      IndexG(i) = (IndexG(i) + j) >> 1
   Next
EndProcedure
Procedure COLORIZE_IMAGE(color.i, image.i)
   Protected c, i, x, y, xMax, yMax
   Protected.d r, g, b

   r = Red(color)   / 1785
   g = Green(color) / 1785
   b = Blue(color)  / 1785
   
   
   If IsImage(image)
      
      StartDrawing(ImageOutput(image))
         xMax = OutputWidth()  - 1
         yMax = OutputHeight() - 1
         
         For y = 0 To yMax
            For x = 0 To xMax
               c = Point(x, y)
               
               i = (c & $FF) << 1 : c >> 8
               i + (C & $FF) << 2 : c >> 8
               i + (C & $FF)
               
               Plot(x, y, RGB(r*i, g*i, b*i))
            Next x
         Next y
      StopDrawing()
      
   EndIf 
EndProcedure
Procedure.i COPY()
   ; copy active image to clipboard
   Protected timeout, img, msgWin, x, y, t$ = "copied to clipboard."
   
   SetClipboardImage(#imgRef)
   
   x = ImageWidth(#imgRef)/2 + 30 + WindowX(#WinMain)
   y = ImageHeight(#imgRef)/2 - 15 + WindowY(#WinMain)
   
   msgWin = OpenWindow(#PB_Any,x,y,200,30,"",#PB_Window_BorderLess)
   TextGadget(#PB_Any,0,5,200,25,t$,#PB_Text_Center)
   timeout = ElapsedMilliseconds() + 1250
   
   While ElapsedMilliseconds() < timeout
      While WindowEvent() : Wend
      Delay(10)
   Wend
   
   CloseWindow(msgWin)
EndProcedure
Procedure.i CREATE_HUE_PALETTE(*Hue.HueType, size.i)
   Protected.f inc, total, Rr, Gr, Br, Mr
   Protected.i max, sum, idx, r, g, b
   
   sum = *hue\Rv + *hue\Gv + *hue\Bv
   max = *hue\Gv
   If *hue\Rv > max : max = *hue\Rv : EndIf
   If *hue\Bv > max : max = *hue\Bv : EndIf
   
   inc = max  / (size - 1)
   Rr = *hue\Rv / sum
   Gr = *hue\Gv / sum
   Br = *hue\Bv / sum
   Mr = max / sum
   ReDim Hue_Palette(size - 1)
   
   For idx = 0 To size - 1
      total = (max - inc * idx) / Mr ; calc' R+G+B total
      r = Round(total * Rr, #PB_Round_Nearest)
      g = Round(total * Gr, #PB_Round_Nearest)
      b = Round(total * Br, #PB_Round_Nearest)
      Hue_Palette(idx) = (r + g<<8 + b<<16)
   Next idx
   
EndProcedure
Procedure.i EVENT_LOOP()
   Protected event
   
   Repeat
      event = WaitWindowEvent()
      Select EventWindow()
         Case #WinMain : HANDLE_WIN_MAIN_EVENTS(event)
         Case #WinHue  : HANDLE_WIN_HUE_EVENTS(event)
      EndSelect
   Until endProgram = #True
   
EndProcedure
Procedure.l FIND_NEAREST(Color.l)
   ; Taken from NearestColor module by Wilbert
   ; Latest updated : Jan 27, 2016
   ; Color distance formula based on:
   ; http://www.compuphase.com/cmetric.htm

   EnableASM
   
   Macro M_FindNearest(i, st)
      !nearestcolor.findnearest#i#_loop:
      !mov ecx, [p.v_c#i#]
      !test ecx, ecx
      !jz nearestcolor.findnearest#i#_cont2
      !movzx eax, byte [p.v_Color + 1]
      !movzx ecx, ch
      !sub eax, ecx
      !imul eax, eax
      !shl eax, 11
      !cmp eax, [p.v_bestd]
      !jnc nearestcolor.findnearest#i#_cont1
      !mov [p.v_d], eax
      !movzx eax, byte [p.v_Color]
      !movzx ecx, byte [p.v_c#i#]
      !lea edx, [eax + ecx]   ; edx = rsum
      !sub eax, ecx
      !imul eax, eax          ; eax = r*r
      !lea ecx, [edx + 0x400] ; ecx = $400 + rsum
      !imul eax, ecx          ; eax = ($400+rsum)*r*r
      !add [p.v_d], eax
      !movzx eax, byte [p.v_Color + 2]
      !movzx ecx, byte [p.v_c#i# + 2]
      !sub eax, ecx
      !imul eax, eax          ; eax = b*b
      !neg edx
      !add edx, 0x5fe         ; edx = $5fe - rsum
      !imul eax, edx          ; eax = ($5fe-rsum)*b*b
      !add eax, [p.v_d]
      !cmp eax, [p.v_bestd]
      !jnc nearestcolor.findnearest#i#_cont0
      !mov [p.v_bestd], eax
      !mov eax, [p.v_c#i#]
      !mov [p.v_c], eax
      !nearestcolor.findnearest#i#_cont0:
      mov rdx, *p#i
      add rdx, st
      mov *p#i, rdx
      mov eax, [rdx]
      !mov [p.v_c#i#], eax
      CompilerIf i = 1
         !jmp nearestcolor.findnearest0_loop
      CompilerElse
         !jmp nearestcolor.findnearest1_loop
      CompilerEndIf
      !nearestcolor.findnearest#i#_cont1:
      !mov dword [p.v_c#i#], 0
      !nearestcolor.findnearest#i#_cont2:
      CompilerIf i = 1
         !cmp dword [p.v_c0], 0
         !jnz nearestcolor.findnearest0_loop
      CompilerEndIf
   EndMacro
   
   ; Find the nearest color
   Protected.l c, c0, c1, d, bestd = $12000000
   Protected.Long *p0, *p1
   !movzx eax, byte [p.v_Color + 1]
   !mov [p.v_d], eax
   *p1 = @Palette(IndexG(d)) : *p0 = *p1 - 4
   c0 = *p0\l : c1 = *p1\l
   M_FindNearest(0, -4)
   M_FindNearest(1, 4)
   DisableASM
   ProcedureReturn c
EndProcedure
Procedure.i FIT_CANVAS_TO_WINDOW()
   ; handle main window resize event
   ; resize canvas to fit window
   
   Protected ww = WindowWidth(#WinMain,#PB_Window_InnerCoordinate)
   Protected wh = WindowHeight(#WinMain,#PB_Window_InnerCoordinate) - MenuHeight()
   Protected iw = ImageWidth(#imgRef)
   Protected ih = ImageHeight(#imgRef)
   Protected cw, ch
   
   ResizeGadget(#Canvas, 0, 0, ww, wh-LinuxAdj) ;<-- -4 for Linux
   
    ;Pan_X = 0 : Pan_Y = 0
    
    cw = GadgetWidth(#Canvas)
    ch = GadgetHeight(#Canvas)
    
    If iw > ww Or ih > wh
       oversize = #True
    Else
       oversize = #False
    EndIf
    
    ; set canvas cursor
    If oversize = #True
       CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
          SetGadgetAttribute(#Canvas,#PB_Canvas_Cursor , #PB_Cursor_Hand)
       CompilerElse
          SetGadgetAttribute(#Canvas,#PB_Canvas_Cursor , #PB_Cursor_Arrows)
       CompilerEndIf
    Else
       SetGadgetAttribute(#Canvas,#PB_Canvas_Cursor , #PB_Cursor_Default)
    EndIf
   
    If HueWindowActive
       UPDATE_CANVAS(#imgAdj)
    Else
       UPDATE_CANVAS(#imgRef)
    EndIf

EndProcedure
Procedure.i FIT_WINDOW_TO_IMAGE(image.i)
   Protected iw = ImageWidth(image)
   Protected ih = ImageHeight(image)
   
   If GetWindowState(#WinMain) <> #PB_Window_Maximize
      If iw > CanvasMaxWidth  : iw = CanvasMaxWidth  : EndIf
      If iw < CanvasMinWidth  : iw = CanvasMinWidth  : EndIf
      If ih > CanvasMaxHeight : ih = CanvasMaxHeight : EndIf
      If ih < CanvasMinHeight : ih = CanvasMinHeight : EndIf
      
      ih + MenuHeight() + LinuxAdj ;<-- +4 for Linux
      
      ResizeWindow(#WinMain,(DW-iw-WinBorder_X)/2,(DH-ih-WinBorder_Y)/2,iw,ih)
   EndIf
   
   FIT_CANVAS_TO_WINDOW()

EndProcedure
Procedure.i HANDLE_WIN_MAIN_EVENTS(event.i)
   Select event
      Case #PB_Event_CloseWindow
         endProgram = #True
      Case #PB_Event_SizeWindow    : FIT_CANVAS_TO_WINDOW()
      Case #PB_Event_RestoreWindow : FIT_WINDOW_TO_IMAGE(#imgRef)
      Case #PB_Event_RightClick    : DisplayPopupMenu(#PopMenu,WindowID(#WinMain))
      Case #PB_Event_Menu
         Select EventMenu()
            Case #MenuItem_Load    : LOAD_IMAGE()
            Case #MenuItem_Save    : SAVE_IMAGE()
            Case #MenuItem_Copy    : COPY()
            Case #MenuItem_Paste   : PASTE()
            Case #MenuItem_Exit    : endProgram = #True
            Case #MenuItem_Hue     : OPEN_HUE_WINDOW()
            Case #MenuItem_Revert  : REVERT()
         EndSelect
      Case #PB_Event_Gadget
         Select EventGadget()
               
         EndSelect
   EndSelect
EndProcedure
Procedure.i HANDLE_WIN_HUE_EVENTS(event.i)
   Static hue.HueType
   Static.i size = 6, preset = 2, dither = #False
   Static.i sum, i, createPalette, xMax, yMax
   Static.i countdown, altered, method = #T_Opt_Direct
   Static.f inc, y, r, g, b
   Static.s presetName$
   
   Macro DisplayRatios()
      sum = hue\Rv + hue\Gv + hue\Bv
      SetGadgetText(#T_Frm_Rr,"Red ratio = "   + StrF(hue\Rv/sum,3))
      SetGadgetText(#T_Frm_Gr,"Green ratio = " + StrF(hue\Gv/sum,3))
      SetGadgetText(#T_Frm_Br,"Blue ratio = "  + StrF(hue\Bv/sum,3))
   EndMacro
   
   Macro StartCountdown()
      createPalette = #True
      countdown = ElapsedMilliseconds() + 300
   EndMacro
   
   Select event
      Case #PB_Event_CloseWindow
         If IsImage(#imgHue) : FreeImage(#imgHue) : EndIf
         preset = GetGadgetState(#T_Combo_Presets)
         If altered : UPDATE_CANVAS(#imgRef) : altered = 0 : EndIf
         HueWindowActive = #False
         CloseWindow(#WinHue)
      Case #PB_Event_Gadget
         Select EventGadget()
            Case #T_Combo_Presets
               presetName$ = GetGadgetText(#T_Combo_Presets)
               If presetName$ <> "manual"
                  hue\Rv   = PresetMap(presetName$)\Rv
                  hue\Gv   = PresetMap(presetName$)\Gv
                  hue\Bv   = PresetMap(presetName$)\Bv
               EndIf
               SetGadgetState(#T_Trk_RR,hue\Rv)
               SetGadgetState(#T_Trk_GR,hue\Gv)
               SetGadgetState(#T_Trk_BR,hue\Bv)
               DisplayRatios()
               createPalette = #True
               
            Case #T_Trk_Size
               size = GetGadgetState(#T_Trk_Size)
               SetGadgetText(#T_Frm_Size,"Palette size = " + Str(size))
               StartCountdown()
            Case #T_Trk_RR
               hue\Rv = GetGadgetState(#T_Trk_RR)
               DisplayRatios()
               SetGadgetState(#T_Combo_Presets,0)
               StartCountdown()
            Case #T_Trk_GR
               hue\Gv = GetGadgetState(#T_Trk_GR)
               DisplayRatios()
               SetGadgetState(#T_Combo_Presets,0)
               StartCountdown()
            Case #T_Trk_BR
               hue\Bv = GetGadgetState(#T_Trk_BR)
               DisplayRatios()
               SetGadgetState(#T_Combo_Presets,0)
               StartCountdown()
            Case #T_Btn_Apply
               CopyImage(#ImgAdj,#imgRef)
               UPDATE_CANVAS(#imgRef)
               altered = #False
               PostEvent(#PB_Event_CloseWindow,#WinHue,#PB_Ignore)
            Case #T_Btn_Test
               CopyImage(#imgRef,#ImgAdj)
               DisableGadget(#T_Btn_Apply,0)
               If method =  #T_Opt_Pal
                  ASSEMBLE_TO_PALETTE(#ImgAdj, Hue_Palette())
               Else
                  COLORIZE_IMAGE(RGB(Hue\Rv,Hue\Gv,Hue\Bv), #imgAdj)
               EndIf
               UPDATE_CANVAS(#ImgAdj)
               altered = #True
            Case #T_Btn_Exit
               PostEvent(#PB_Event_CloseWindow,#WinHue,#PB_Ignore)
            Case #T_Opt_Direct
               method =  #T_Opt_Direct : createPalette = #True
            Case #T_Opt_Pal
               method =  #T_Opt_Pal : createPalette = #True
            Case #T_Chk_Dither
               DisableGadget(#T_Btn_Apply,1)
               dither = GetGadgetState(#T_Chk_Dither)
         EndSelect
      Case #PB_Event_Menu ; initalize controls
         CopyImage(#imgRef,#ImgAdj)
         SetGadgetState(#T_Trk_Size,size)
         SetGadgetState(#T_Chk_Dither,dither)
         SetGadgetState(method, 1)
         SetGadgetText(#T_Frm_Size,"Palette size = " + Str(size))
         SetGadgetState(#T_Combo_Presets,preset)
         PostEvent(#PB_Event_Gadget,#WinHue,#T_Combo_Presets)
   EndSelect
   
   If createPalette = #True
      If ElapsedMilliseconds() > countdown
         createPalette = #False
         
         ; *** display the hue palette ***
         If method = #T_Opt_Pal
            CREATE_Hue_Palette(@Hue, size)
            StartDrawing(ImageOutput(#imgHue))
               inc = OutputHeight() / size
               y = 0
               For i = 0 To size - 1
                  Box(0,y,150,Round(inc,#PB_Round_Up),Hue_Palette(i))
                  y + inc
               Next i
            StopDrawing()
         Else
            StartDrawing(ImageOutput(#imgHue))
               xMax = OutputWidth()  - 1
               yMax = OutputHeight() - 1
               inc = OutputHeight() / 256
               r = hue\Rv / yMax
               g = hue\Gv / yMax
               b = hue\Bv / yMax
               
               y = 0
               Repeat
                  i = yMax - y
                  LineXY(0, y, xMax, y, RGB(r*i, g*i, b*i))
                  y + inc
               Until y > yMax
            StopDrawing()
         EndIf
         
         SetGadgetState(#T_iGad_hue,ImageID(#imgHue))
         ;
         DisableGadget(#T_Btn_Apply,1)
      EndIf
   EndIf
EndProcedure
Procedure.i LOAD_IMAGE()
   Static Path$, pattern, firstRun = #True
   Protected Pattern$ = "all supported formats|*.png;*.jpg;*.jpeg;*.jp2;;*.bmp|*.png|*.png|*.jpg, *.jpeg"+
                        "|*.jpg;*.jpeg|*.jpeg2000|*.jp2|*.bmp|*.bmp|all files|*.*"
   Protected F$, text$, h, w, aw, ah, x, y
   
   If firstRun = #True : firstRun = #False
      Path$ = GetPathPart(File$)
   EndIf

   F$ = OpenFileRequester("Select image to process", Path$, Pattern$, pattern)
   
   If F$
      File$ = F$ ; for global use
      pattern = SelectedFilePattern()
      CurrentFileName$ = GetFilePart(F$,#PB_FileSystem_NoExtension) ; for global use
      Path$ = GetPathPart(F$)
      
      If LoadImage(#imgRef, F$)
         CopyImage(#imgRef,#imgRevert)
         F$ = GetFilePart(File$) + "  |  (" + ImageWidth(#imgRef) + " x " + ImageHeight(#imgRef) + ")"
         SetWindowTitle(#WinMain,Title$ + "| " + F$)
         FIT_WINDOW_TO_IMAGE(#imgRef)
      EndIf
   EndIf
   
EndProcedure
Procedure.i OPEN_MAIN_WINDOW()
   Protected result, w = 800, h = 450
   Protected flags = #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_SizeGadget |
                     #PB_Window_MaximizeGadget | #PB_Window_ScreenCentered
   
   result = OpenWindow(#WinMain,0,0,w,h,Title$,flags)
   If result
      
      ExamineDesktops()
      DW = DesktopWidth(0)
      DH = DesktopHeight(0)
      
      CanvasMinHeight = h
      CanvasMinWidth = w
      
      WinBorder_X = WindowWidth(#WinMain,#PB_Window_FrameCoordinate) - WindowWidth(#WinMain)
      WinBorder_Y = WindowHeight(#WinMain,#PB_Window_FrameCoordinate) - WindowHeight(#WinMain)
      
      CompilerIf #PB_Compiler_OS = #PB_OS_Linux
         LinuxAdj = 4
         h + MenuHeight() + LinuxAdj
      CompilerEndIf
      
      WindowBounds(#WinMain,w,h,#PB_Ignore,#PB_Ignore)
      
      CreateMenu(#MainMenu,WindowID(#WinMain))
      MenuTitle("File")
         MenuItem(#MenuItem_Load,"Load image" + Chr(9) + "Ctrl+L")
         MenuItem(#MenuItem_Save,"Save image" + Chr(9) + "Ctrl+S")
         MenuItem(#MenuItem_Exit,"Exit")
      
      MenuBar()
      
      MenuTitle("Edit")
         MenuItem(#MenuItem_Hue,"Apply hue...")
         MenuItem(#MenuItem_Copy,"Copy to clipboard" + Chr(9) + "Ctrl+C")
         MenuItem(#MenuItem_Paste,"Paste from clipboard" + Chr(9) + "Ctrl+V")
         MenuItem(#MenuItem_Revert,"Revert" + Chr(9) + "Ctrl+R")
      
      CreatePopupMenu(#PopMenu)
      OpenSubMenu("File...")
         MenuItem(#MenuItem_Load,"Load image" + Chr(9) + "Ctrl+L")
         MenuItem(#MenuItem_Save,"Save image" + Chr(9) + "Ctrl+S")
         MenuItem(#MenuItem_Exit,"Exit")
      CloseSubMenu()
   
      MenuBar()
         OpenSubMenu("Edit...")
            MenuItem(#MenuItem_Hue,"Apply hue...")
            MenuItem(#MenuItem_Copy,"Copy to clipboard" + Chr(9) + "Ctrl+C")
            MenuItem(#MenuItem_Paste,"Paste from clipboard" + Chr(9) + "Ctrl+V")
            MenuItem(#MenuItem_Revert,"Revert" + Chr(9) + "Ctrl+R")
         CloseSubMenu()
      
      AddKeyboardShortcut(#WinMain, #PB_Shortcut_L | #PB_Shortcut_Control , #MenuItem_Load)
      AddKeyboardShortcut(#WinMain, #PB_Shortcut_S | #PB_Shortcut_Control , #MenuItem_Save)
      AddKeyboardShortcut(#WinMain, #PB_Shortcut_C | #PB_Shortcut_Control , #MenuItem_Copy)
      AddKeyboardShortcut(#WinMain, #PB_Shortcut_V | #PB_Shortcut_Control , #MenuItem_Paste)
      AddKeyboardShortcut(#WinMain, #PB_Shortcut_R | #PB_Shortcut_Control , #MenuItem_Revert)
      
      CanvasMaxWidth  = DW - WinBorder_X
      CanvasMaxHeight = DH - WinBorder_Y - MenuHeight()
      
      h - MenuHeight() - LinuxAdj
      
      CanvasGadget(#Canvas,0,0,w,h,#PB_Canvas_ClipMouse)
      BindGadgetEvent(#Canvas,@CANVAS_CALLBACK())
      CreateImage(#imgRef,w,h,24,#CBcolor)
      UPDATE_CANVAS(#imgRef)
      
      CompilerIf #PB_Compiler_OS = #PB_OS_Windows
         File$ = GetHomeDirectory() + "Pictures\"
      CompilerElse
         File$ = GetHomeDirectory() + "Pictures/"
      CompilerEndIf
      
      File$ + "no_image_loaded"
      SetWindowTitle(#WinMain,Title$ + "| " + "no_image_loaded")
   EndIf
   
   ProcedureReturn result
EndProcedure
Procedure.i OPEN_HUE_WINDOW()
   Static flags = #PB_Window_Tool|#PB_Window_ScreenCentered|#PB_Window_ScreenCentered|#PB_Window_SystemMenu
   Protected color, presetName$
   
   If IsWindow(#WinHue) = 0
      OpenWindow(#WinHue,0,0,445,380,"Apply Hue",flags,WindowID(#WinMain))
      HueWindowActive = #True
      SetWindowColor(#WinHue,$CECE9D)
      
      FrameGadget(#PB_Any,280,10,156,60,"Presets")
      ComboBoxGadget(#T_Combo_Presets,288,30,140,30)
      
      ClearMap(PresetMap())
      AddGadgetItem(#T_Combo_Presets,-1,"manual")
      Restore HueData
      Read.s presetName$
      While presetName$ <> "End_Data"
         AddGadgetItem(#T_Combo_Presets,-1,presetName$)
         PresetMap(presetName$)
         Read.i color
         PresetMap()\Bv = Blue(color)
         PresetMap()\Gv = Green(color)
         PresetMap()\Rv = Red(color)
         Read.s presetName$
      Wend
      SetGadgetState(#T_Combo_Presets,0)
      
      FrameGadget(#T_Frm_Size,5,10,266,60,"Palette size = ")
      TrackBarGadget(#T_Trk_Size,10,30,256,35,2,256)
      
      FrameGadget(#T_Frm_Rr,5,80,266,60,"Red ratio = ")
      TrackBarGadget(#T_Trk_RR,10,100,256,35,0,255)
      
      FrameGadget(#T_Frm_Gr,5,150,266,60,"Green ratio = ")
      TrackBarGadget(#T_Trk_GR,10,170,256,35,0,255)
      
      FrameGadget(#T_Frm_Br,5,220,266,60,"Blue ratio = ")
      TrackBarGadget(#T_Trk_BR,10,240,256,35,0,255)
      
      FrameGadget(#T_Frm_Method,5,290,266,50,"Method")
      OptionGadget(#T_Opt_Direct,15,310,65,25,"direct")
      OptionGadget(#T_Opt_Pal,90,310,85,25,"use palette")
      CheckBoxGadget(#T_Chk_Dither,190,310,75,25,"Dither")
      
      ButtonGadget(#T_Btn_Test,005,350,115,25,"Preview")
      ButtonGadget(#T_Btn_Apply,165,350,115,25,"Apply")
      ButtonGadget(#T_Btn_Exit,320,350,115,25,"Close")
      DisableGadget(#T_Btn_Apply,1)
      
      
      CreateImage(#imgHue,150,256)
      ImageGadget(#T_iGad_hue,282,80,150,256,ImageID(#imgHue),#PB_Image_Border)
      
      PostEvent(#PB_Event_Menu,#WinHue,#PB_Ignore) ;trigger init
   EndIf
EndProcedure
Procedure.i PASTE()
   Protected F$
   If GetClipboardImage(#imgRef,32)
      CopyImage(#imgRef, #imgRevert)
      CurrentFileName$ = "NewImage"
      File$ = GetPathPart(File$) + CurrentFileName$
      F$ = CurrentFileName$ + "  |  (" + ImageWidth(#imgRef) + " x " + ImageHeight(#imgRef) + ")"
      SetWindowTitle(#WinMain,Title$ + "| " + F$)
      FIT_WINDOW_TO_IMAGE(#imgRef)
   EndIf
EndProcedure
Procedure.l PointOrdDith(x.i, y.i)
   ;this procedure was borrowed from Wilbert's Neuquant module
   EnableASM
   Point(x, y) 
   !movd xmm0, eax
   !mov al, [p.v_x]
   !mov ah, [p.v_y]
   !shl al, 6
   !and eax, 0x3c0
   !shr ax, 3
   !punpcklbw xmm0, xmm0
   CompilerIf #x64
      !lea rdx, [nearest.l_pointorddith]
      !movq xmm1, [rdx + rax]
   CompilerElse
      !movq xmm1, [nearest.l_pointorddith + eax]
   CompilerEndIf
   !psrlw xmm0, 8
   !paddw xmm0, xmm1
   !packuswb xmm0, xmm0
   !movd eax, xmm0
   ProcedureReturn
   !nearest.l_pointorddith:
   !dq 0xfff9fff9fff9, 0x000100010001, 0xfffbfffbfffb, 0x000300030003
   !dq 0x000500050005, 0xfffdfffdfffd, 0x000700070007, 0xffffffffffff
   !dq 0xfffcfffcfffc, 0x000400040004, 0xfffafffafffa, 0x000200020002
   !dq 0x000800080008, 0x000000000000, 0x000600060006, 0xfffefffefffe
   DisableASM
EndProcedure  
Procedure.i REVERT()
   CopyImage(#imgRevert,#imgRef)
   UPDATE_CANVAS(#imgRef)
EndProcedure
Procedure.i SAVE_IMAGE()
   Static YesNo = #PB_MessageRequester_YesNo, Yes = #PB_MessageRequester_Yes
   Static Pattern$ = "image.png|*.png|image.jpg|*.jpg|image.jpeg|*.jpeg|image.jpeg2000|*.jp2|image.bmp|*.bmp"
   Static lastPattern = 1, firstRun = #True
   Protected F$, p, cancel = #False
   
   Select LCase(GetExtensionPart(File$))
      Case "png" : lastPattern = 0
      Case "jpg" : lastPattern = 1
      Case "jpeg": lastPattern = 2
      Case "jpeg2000" : lastPattern = 3
      Case "bmp" : lastPattern = 4
   EndSelect
   
   F$ = SaveFileRequester("Save image",  GetPathPart(File$)+CurrentFileName$, Pattern$, lastPattern)
   
   If F$
      lastPattern = SelectedFilePattern()
      
      ; remove any existing file extension
      p = FindString(ReverseString(F$),".")
      If p
         F$ = Left(F$,Len(F$)-p)
      EndIf
      
      Select SelectedFilePattern()
         Case 0 : F$ + ".png"
         Case 1 : F$ + ".jpg"
         Case 2 : F$ + ".jpeg"
         Case 3 : F$ + ".jp2"
         Case 4 : F$ + ".bmp"
      EndSelect
      
      If FileSize(F$) <> -1 ; file exists
         If MessageRequester("File Exists!", "Do you wish to overwrite?", YesNo) <> Yes
            cancel = #True
         EndIf
      EndIf
      
      If cancel = #False
         Select SelectedFilePattern()
            Case 0 : SaveImage(#imgRef, F$, #PB_ImagePlugin_PNG)
            Case 1 : SaveImage(#imgRef, F$, #PB_ImagePlugin_JPEG,8)
            Case 2 : SaveImage(#imgRef, F$, #PB_ImagePlugin_JPEG,8)
            Case 3 : SaveImage(#imgRef, F$, #PB_ImagePlugin_JPEG2000,3)
            Case 4 : SaveImage(#imgRef, F$, #PB_ImagePlugin_BMP)
         EndSelect
         
         File$ = F$ ; for global use
         F$ = GetFilePart(File$) + "  |  (" + ImageWidth(#imgRef) + " x " + ImageHeight(#imgRef) + ")"
         SetWindowTitle(#WinMain,Title$ + "| " + F$)
      EndIf
   EndIf
EndProcedure
Procedure.i UPDATE_CANVAS(image.i)
   Protected x, y, iw, ih, ow, oh, Llim, Rlim, Tlim, Blim, text$
   
   If IsImage(image)
      StartDrawing(CanvasOutput(#Canvas))
         ow = OutputWidth()  : iw = ImageWidth(image)
         oh = OutputHeight() : ih = ImageHeight(image)
         
         Box(0,0,ow,oh,#CBcolor)
         
         x = (ow - iw) / 2 + Pan_X
         y = (oh - Ih) / 2 + Pan_Y
         
         DrawImage(ImageID(image),x,y)
      StopDrawing()
   EndIf
EndProcedure

;{ Preset Hue data
DataSection
   HueData:
   ; Legend: "Preset name"    : Ratio  Blue , Green, Red
   Data.s "gray scale"        : Data.i $FFFFFF
   Data.s "Aquamarine"        : Data.i $7FFFD4
   Data.s "Average skin"      : Data.i $A3B6FF
   Data.s "Baby blue"         : Data.i $F0CF89
   Data.s "Bitter lime"       : Data.i $00FFBF
   Data.s "Blond"             : Data.i $BEF0FA
   Data.s "Carnation pink"    : Data.i $C9A6FF
   Data.s "Celeste"           : Data.i $FFFFB2
   Data.s "Champagne"         : Data.i $CEE7F7
   Data.s "Chartreuse"        : Data.i $00FFDF
   Data.s "Chlorophyll"       : Data.i $00FF4A
   Data.s "Cinnabar"          : Data.i $3442E3
   Data.s "Corn"              : Data.i $5DECFB
   Data.s "Deep peach"        : Data.i $A4CBFF
   Data.s "Diamond"           : Data.i $FFF289
   Data.s "Feldspar"          : Data.i $B1D5FD
   Data.s "Gangrene"          : Data.i $B4FF40
   Data.s "Guppie green"      : Data.i $7FFF00
   Data.s "Heat wave"         : Data.i $007AFF
   Data.s "Icterine"          : Data.i $5EF7FC
   Data.s "Jasmine"           : Data.i $7EDEF8
   Data.s "Laser lemon"       : Data.i $66FFFF
   Data.s "Laventer blue"     : Data.i $FFCCCC
   Data.s "Lavender indigo"   : Data.i $EB5794
   Data.s "Light apricot"     : Data.i $B1FDD5
   Data.s "Mac & cheese"      : Data.i $88BDFF
   Data.s "Mango tango"       : Data.i $4382FF
   Data.s "Mauve"             : Data.i $FFB0E0
   Data.s "Medium red"        : Data.i $5555FF
   Data.s "Medium green"      : Data.i $80FF80
   Data.s "Medium blue"       : Data.i $FF9966
   Data.s "Mustard"           : Data.i $58DBFF
   Data.s "Neanderthal"       : Data.i $6E8BFF
   Data.s "Neon fuchsia"      : Data.i $6441FE
   Data.s "Nyanza"            : Data.i $DBFFE9
   Data.s "Orange"            : Data.i $00A5FF
   Data.s "Pale red"          : Data.i $8080FF
   Data.s "Pale green"        : Data.i $BFFFBF
   Data.s "Pale blue"         : Data.i $FFDF9F
   Data.s "Pale yellow"       : Data.i $C0FFFF
   Data.s "Pale cyan"         : Data.i $FFFFC0
   Data.s "Pale magenta"      : Data.i $FFC0FF
   Data.s "Pastel blue"       : Data.i $CFC6AE
   Data.s "Persian rose"      : Data.i $A228FE
   Data.s "Pink"              : Data.i $AA00FF
   Data.s "Portland orange"   : Data.i $365AFF
   Data.s "Salmon"            : Data.i $9991FF
   Data.s "Sepia"             : Data.i $2E96FF
   Data.s "Shampoo"           : Data.i $F1CFFF
   Data.s "Sky blue"          : Data.i $FFFFB2
   Data.s "Tea green"         : Data.i $C0F0D0
   Data.s "Topaz"             : Data.i $7CC8FF
   Data.s "yellow_green"      : Data.i $2FFFE3
   Data.s "End_Data"
EndDataSection : ;}

[davido]

@BasicallyPure,
Very nice.
Thank you for making work on the Mac, too.

[BasicallyPure]

This will be included as a new feature when I release the next version of "CQ_image_editor".
It may be some time before the next release of CQ so I wanted to make this public now.
Also, I probably will not release the source code for next version of CQ.

[wilbert]

Nice work !
The combination of 16 tones with dither looks a bit like an old photo

[walbus]

Very good and usefull !

[Andre]

Cool!

Any chance to get also a 'lighten' function (for watermarks or similar, the opposite of the 'dark' function) included?

[wilbert]

Any chance to get also a 'lighten' function (for watermarks or similar, the opposite of the 'dark' function) included?

Multiply might also be an option for a watermark.

[BasicallyPure]

Sorry for the delay in responding.
I have been hard at work on an update. (first post updated)

Any chance to get also a 'lighten' function (for watermarks or similar, the opposite of the 'dark' function) included?

No, it's not within the scope of this topic but it might be a possibility for a new feature in my 'CQ image editor'.

I noticed that on some images even with dithering and a 256 palette there were some visible artifacts.
I did a comparison test with GIMP 'colorify' and was disappointed that my results were not as good.
After pondering the problem for a while I realized colorization of an image did not have to result in a palette count
of 256 or less. I know that is what you get when you convert to grayscale but it was wrong thinking
on my part.

After much flailing about with code I finally came up with a simple procedure that will directly colorize
an image without the hassle of first creating a palette and then finding the nearest color.
It's fast, simple, and really sweet! It also gives excellent grayscale result.
It gives a result that looks almost exactly like the GIMP result for 'colorify'.
It is now part of the code in the first post so you can compare both methods.
For now I will leave it to you to ponder how it works.

Code: Select all

Procedure COLORIZE_IMAGE(color.i, image.i)
   Protected c, i, x, y, xMax, yMax
   Protected.d r, g, b

   r = Red(color)   / 1785
   g = Green(color) / 1785
   b = Blue(color)  / 1785
   
   If IsImage(image)
      
      StartDrawing(ImageOutput(image))
         xMax = OutputWidth()  - 1
         yMax = OutputHeight() - 1
         
         For y = 0 To yMax
            For x = 0 To xMax
               c = Point(x, y)
               
               i = (c & $FF) << 1 : c >> 8
               i + (C & $FF) << 2 : c >> 8
               i + (C & $FF)
               
               Plot(x, y, RGB(r*i, g*i, b*i))
            Next x
         Next y
      StopDrawing()
      
   EndIf 
EndProcedure

I will be happy to try and explain how it works but would anyone like to hazard a guess?

[wilbert]

I will be happy to try and explain how it works but would anyone like to hazard a guess?

You compute the intensity (luma) for each pixel with a simplified formula of luma = (2*red + 4*green + blue) / 7 .
The target color that is supplied to the procedure is multiplied by this luma value.
It's indeed a simple and decent way to colorize the image.

You might want to consider a duotone effect as well.
Like this ...
http://manytools.org/image/colorize-filter/
It looks quite nice in a lot of cases I think.

[BasicallyPure]

@Wilbert
I knew you could do it!

The scale factor '1785' is 255 * 7.
This eliminates the need to divide by 7 later when the luminance is calculated.
It's a cheat but not much of one.
The usual values for luminance conversion as you know are as follows:
R=0.299, G=0.587, B=0.114.
Using sevenths you get 2/7=0.286, 4/7=0.571, 1/7=0.143.
It's close enough that you don't really notice the difference.

You might want to consider a duotone effect as well.

That looks interesting but I have no idea how it is done.

[wilbert]

That looks interesting but I have no idea how it is done.

Assume intensity has a range of 0.0 - 1.0
What you are doing is replacing the 1.0 intensity with the chosen color so the output ranges from [black - chosen color].
The duotone effect on that page, replaces the 0.5 intensity with the chosen color so the output ranges from [black - chosen color - white].
The screen effect on that page, replaces the 0.0 intensity with the chosen color so the output ranges from [chosen color - white].

[BasicallyPure]

OK, I'm getting some ideas.

I'll be back... (eventually)

[wilbert]

OK, I'm getting some ideas.

Maybe I'll try myself also to see if I can get something similar to work.

[wilbert]

I posted a module to colorize an image.
http://www.purebasic.fr/english/viewtop ... 12&t=64761
It was quite a bit of work to get it working. Hopefully it is useful to someone.

[BasicallyPure]

The duotone effect on that page, replaces the 0.5 intensity with the chosen color so the output ranges from [black - chosen color - white].

I tried to produce this by a simple modification to my previous COLORIZE_IMAGE(color.i, image.i) procedure.

Code: Select all

Procedure.i DUOTONE_IMAGE(color.i, image.i)
   Protected.i c, i, x, y, xMax, yMax
   Protected.d r, g, b, bw = $FF/1785
   
   r = Red(color)   / 1785
   g = Green(color) / 1785
   b = Blue(color)  / 1785
   
   If IsImage(image)
      
      StartDrawing(ImageOutput(image))
         xMax = OutputWidth()  - 1
         yMax = OutputHeight() - 1
         
         For y = 0 To yMax
            For x = 0 To xMax
               c = Point(x, y)
               
               i = (c & $FF) << 1 : c >> 8
               i + (C & $FF) << 2 : c >> 8
               i + (C & $FF)
               
               If i > 595 And i < 1190
                  Plot(x, y, RGB(r*i, g*i, b*i))
               Else
                  Plot(x, y, RGB(bw*i, bw*i, bw*i))
               EndIf
               
            Next x
         Next y
      StopDrawing()
      
   EndIf 
EndProcedure

The results were not that impressive.

I posted a module to colorize an image.viewtopic.php?f=12&t=64761

I have tested your module. To me the results look exactly like my COLORIZE_IMAGE() procedure.
I'm not seeing any indication of duotone effect.
Using the code from the first post above with your module included, I changed the
HANDLE_WIN_HUE_EVENTS() as follows:

Code: Select all

            Case #T_Btn_Test
               CopyImage(#imgRef,#ImgAdj)
               DisableGadget(#T_Btn_Apply,0)
               If method =  #T_Opt_Pal
                  ;ASSEMBLE_TO_PALETTE(#ImgAdj, Hue_Palette())
                  Colorize::ColorizeImage(#imgAdj, RGB(Hue\Rv,Hue\Gv,Hue\Bv), Colorize::#Multiply)
                  ;DUOTONE_IMAGE(RGB(Hue\Rv,Hue\Gv,Hue\Bv), #imgAdj)
               Else
                  COLORIZE_IMAGE(RGB(Hue\Rv,Hue\Gv,Hue\Bv), #imgAdj)
               EndIf

By choosing the 'palette' option your module is used.
By choosing the 'direct' option my procedure is used.
The results look the same to me.
Am I using your module wrong or do you agree that they both give the same results?

my COLORIZE_IMAGE() module with #Multiply option
module with #Overlay option module with #Screen option

I found these images on the internet. This is what I think duotone should look like.
Many other images I saw that claim to be duotone look like monotone to me.
I have no idea how to reproduce this effect.