Calculate and display color image histograms

Share your advanced PureBasic knowledge/code with the community.
Post Reply
User avatar
BasicallyPure
Enthusiast
Enthusiast
Posts: 539
Joined: Thu Mar 24, 2011 12:40 am
Location: Iowa, USA

Calculate and display color image histograms

Post by BasicallyPure »

Code: Select all

; Histogram.pbi
; calculate and display color histograms
; by BasicallyPure
; 1.15.2014
; PB 5.21 LTS
;
; Syntax: DISPLAY_HISTOGRAM(image.i)
; A small window will be created to display the histogram.
; If the image.i parameter is negative or omitted, the
; histogram window will be closed.

Structure HistogramType
   Pwin.i ; parent window number
   Hwin.i ; histogram window number
   Himg.i ; source image number of histogram
   R.i[256]
   G.i[256]
   B.i[256]
   maxR.i
   maxG.i
   maxB.i
   ChkR.i  ; red checkbox gadget number
   ChkG.i  ; green checkbox gadget number
   ChkB.i  ; blue checkbox gadget number
   ChkEx.i ; exclude checkbox gadget number
EndStructure

Global Hist.HistogramType
Hist\Hwin  = -1

Declare HISTOGRAM_EVENT_HANDLER()

Procedure DISPLAY_HISTOGRAM(image.i = -1)
   ; call this procedure with no parameter to close the histogram window
   Static igad, HisImg
   Static flags = #PB_Window_WindowCentered | #PB_Window_SystemMenu
   Protected h = 128 ;graph height
   Protected yScale.f,Xmax,Ymax,c,r,g,b,n,x,y,rc,gc,bc
   
   If image < 0
      If IsWindow(Hist\Hwin) <> 0
         FreeImage(HisImg)
         CloseWindow(Hist\Hwin)
         Hist\Hwin = -1
      EndIf
      ProcedureReturn #True
   EndIf
   
   If IsImage(image)
      Hist\Himg = image
      
      If IsWindow(Hist\Hwin) = #False
         Hist\Pwin = GetActiveWindow()
         Hist\Hwin = OpenWindow(#PB_Any,0,0,340,h+10,"Histogram",flags,WindowID(Hist\Pwin))
         If Hist\Hwin = 0 : ProcedureReturn #False : EndIf
         
         igad = ImageGadget(#PB_Any,5,5,256,h,0)
         Hist\ChkR  = CheckBoxGadget(#PB_Any, 270,010,50,25,"RED")
         Hist\ChkG  = CheckBoxGadget(#PB_Any, 270,040,50,25,"GRN")
         Hist\ChkB  = CheckBoxGadget(#PB_Any, 270,070,50,25,"BLU")
         Hist\ChkEx = CheckBoxGadget(#PB_Any,270,100,50,25,"ExEx")
         GadgetToolTip(Hist\ChkEx,"Exclude Extremes")
         
         SetGadgetState(Hist\ChkR,#True)
         SetGadgetState(Hist\ChkG,#True)
         SetGadgetState(Hist\ChkB,#True)
         
         BindGadgetEvent(Hist\ChkR, @HISTOGRAM_EVENT_HANDLER())
         BindGadgetEvent(Hist\ChkG, @HISTOGRAM_EVENT_HANDLER())
         BindGadgetEvent(Hist\ChkB, @HISTOGRAM_EVENT_HANDLER())
         BindGadgetEvent(Hist\ChkEx,@HISTOGRAM_EVENT_HANDLER())
         
         HisImg = CreateImage(#PB_Any,256,h)
      EndIf
      
      ;{ COMPUTE HISTOGRAM ****
      With Hist
         For x = 0 To 255 : \R[x]=0 : \G[x]=0 : \B[x]=0 : Next x
         \maxR = 0 : \maxG = 0 : \maxB = 0
         
         StartDrawing(ImageOutput(image))
         Xmax = OutputWidth() - 1
         Ymax = OutputHeight() - 1
         
         For y = 0 To Ymax
            For x = 0 To Xmax
               c = Point(x, y)
               \R[c & $FF] + 1 : c >> 8
               \G[c & $FF] + 1 : c >> 8
               \B[c & $FF] + 1
            Next x
         Next y
         
         If GetGadgetState(\ChkEx) ; exclude bins 0 and 255
            For x = 1 To 254
               If \R[x] > \maxR : \maxR = \R[x] : EndIf
               If \G[x] > \maxG : \maxG = \G[x] : EndIf
               If \B[x] > \maxB : \maxB = \B[x] : EndIf
            Next
         Else
            For x = 0 To 255
               If \R[x] > \maxR : \maxR = \R[x] : EndIf
               If \G[x] > \maxG : \maxG = \G[x] : EndIf
               If \B[x] > \maxB : \maxB = \B[x] : EndIf
            Next
         EndIf
         StopDrawing()
      EndWith : ;} END COMPUTE HISTOGRAM ****
      
      StartDrawing(ImageOutput(HisImg))
         Box(0,0,256,h,0)
         DrawingMode(#PB_2DDrawing_XOr)
         
         If GetGadgetState(Hist\ChkR) : rc = $0000FF
            yScale = Hist\maxR
         EndIf
         If GetGadgetState(Hist\ChkG) : gc = $00FF00
            If Hist\maxG > yScale : yScale = Hist\maxG : EndIf
         EndIf
         If GetGadgetState(Hist\ChkB) : bc = $FF0000
            If Hist\maxB > yScale : yScale = Hist\maxB : EndIf
         EndIf
         
         yScale = h / yScale : h - 1
         
         For x = 0 To 255
            LineXY(x, h, x, h - Hist\R[x] * yScale, rc)
            LineXY(x, h, x, h - Hist\G[x] * yScale, gc)
            LineXY(x, h, x, h - Hist\B[x] * yScale, bc)
         Next x
      StopDrawing()
      
      SetGadgetState(igad,ImageID(HisImg))
   EndIf
   
   ProcedureReturn #True
EndProcedure

Procedure HISTOGRAM_EVENT_HANDLER()
   DISPLAY_HISTOGRAM(Hist\Himg)
EndProcedure
here is an example.

Code: Select all

; image histogram demo
; by BasicallyPure
; 1.15.2014
; PB 5.21 LTS

EnableExplicit

XIncludeFile "Histogram.pbi"

UsePNGImageDecoder()  : UsePNGImageEncoder()
UseJPEGImageDecoder() : UseJPEGImageEncoder()

Declare COUNT_COLORS(image.i)
Declare LOAD_IMAGE()

#Mwin = 0
#image = 0
#Status = 0

; gadgets
Enumeration
   #Btn_Load : #Canvas : #ScrollArea : #CC : #Chk_Hist
EndEnumeration

ExamineDesktops()
Define h = DesktopHeight(0) * 0.75
Define w = h / 0.75 ;DesktopWidth(0) * 0.75
Define flags = #PB_Window_ScreenCentered | #PB_Window_SystemMenu |
               #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget

If OpenWindow(#Mwin,0,0,w+130,h+10,"Histogram Demo",flags)
   SetWindowColor(#Mwin,$F6EAC3)
   CreateStatusBar(#status,WindowID(#Mwin))
   AddStatusBarField(#PB_Ignore)
   ResizeWindow(#Mwin,WindowX(#Mwin),WindowY(#Mwin),w+130,h+StatusBarHeight(#status)+10)
   
   ButtonGadget(#Btn_Load,10,10,75,25,"load image")
   CheckBoxGadget(#Chk_Hist,10,45,75,25,"Histogram")
   DisableGadget(#Chk_Hist,#True)
   
   ScrollAreaGadget(#ScrollArea,125,5,w,h,w-4,h-4,#PB_Ignore,#PB_ScrollArea_BorderLess)
   CanvasGadget(#Canvas,0,0,w,h)
   CloseGadgetList()
   
   FrameGadget(#PB_Any,5,85,110,50,"Unique colors")
      TextGadget(#cc,10,105,100,20,"")
   
   Global SourceFileName$
   
   Repeat ; event loop
      Select WaitWindowEvent()
         Case #PB_Event_CloseWindow
            Select EventWindow()
               Case #Mwin : Break
               Case Hist\Hwin
                  SetGadgetState(#Chk_Hist, #False)
                  DISPLAY_HISTOGRAM() ;no param = close histogram window
            EndSelect
         Case #PB_Event_Gadget
            Select EventGadget()
               Case #Btn_Load  : LOAD_IMAGE()
               Case #Chk_Hist
                  If GetGadgetState(#Chk_Hist)
                     DISPLAY_HISTOGRAM(#Image)
                  Else
                     DISPLAY_HISTOGRAM() ; close histogram window
                  EndIf
            EndSelect
      EndSelect
   ForEver
   
EndIf

Procedure COUNT_COLORS(image.i); count colors (24 bit)
   ; stole this from wilbert
   Protected.i x, y, max_x, max_y, c, count, m
   Dim m.a($1FFFFF)
   StartDrawing(ImageOutput(image))
      max_x = ImageWidth(image) - 1
      max_y = ImageHeight(image) - 1
      For y = 0 To max_y
         For x = 0 To max_x
            c = Point(x, y) & $FFFFFF
            If m(c >> 3) & 1 << (c & 7) = 0
               m(c >> 3) | 1 << (c & 7)
               count + 1
            EndIf
         Next
      Next
   StopDrawing()
   ProcedureReturn count
EndProcedure


Procedure LOAD_IMAGE()
   Static m = #PB_Gadget_ContainerCoordinate
   Protected FileName$ = GetHomeDirectory() + "MyPictures\"
   Protected Pattern$ = "image (*.png, *.jpg, *.bmp)|*.png;*.jpg;*.bmp|image *.*|*.*"
   Protected File$
   
   File$ = OpenFileRequester("Select image to process", FileName$, Pattern$, 0)
   
   If File$
      SourceFileName$ = GetFilePart(File$,#PB_FileSystem_NoExtension)
      If IsImage(#Image) : FreeImage(#Image) : EndIf
      
      If LoadImage(#Image, File$)
         
         ResizeGadget(#Canvas,0,0,ImageWidth(#Image),ImageHeight(#Image))
         StartDrawing(CanvasOutput(#Canvas))
            DrawImage(ImageID(#Image),0,0)
         StopDrawing()
         
         SetGadgetAttribute(#ScrollArea,#PB_ScrollArea_InnerWidth,ImageWidth(#Image))
         SetGadgetAttribute(#ScrollArea,#PB_ScrollArea_InnerHeight,ImageHeight(#Image))
         SetGadgetText(#cc,Str(COUNT_COLORS(#Image)))
         StatusBarText(#status, 0, File$)
         
         DisableGadget(#Chk_Hist, #False)
         
         If GetGadgetState(#Chk_Hist) : DISPLAY_HISTOGRAM(#image) : EndIf
      EndIf
   EndIf
EndProcedure
Last edited by BasicallyPure on Thu Jan 16, 2014 5:51 pm, edited 2 times in total.
BasicallyPure
Until you know everything you know nothing, all you have is what you believe.
Top
Poshu
Enthusiast
Enthusiast
Posts: 459
Joined: Tue Jan 25, 2005 7:01 pm
Location: Canada

Re: Calculate and display color image histograms

Post by Poshu »

Damn, I was doing one after reading wilbert's post on color counting. Very nice effort, thanks ^^
Top
wilbert
PureBasic Expert
PureBasic Expert
Posts: 3942
Joined: Sun Aug 08, 2004 5:21 am
Location: Netherlands

Re: Calculate and display color image histograms

Post by wilbert »

Very nice :)

It's faster to compute the max values after counting instead of while counting.
This also has the benefit that it doesn't make any difference in speed if you exclude the extremes.

Code: Select all

      ;{ COMPUTE HISTOGRAM ****
      With Hist
         For x = 0 To 255 : \R[x]=0 : \G[x]=0 : \B[x]=0 : Next x
         \maxR = 0 : \maxG = 0 : \maxB = 0
         
         StartDrawing(ImageOutput(image))
         Xmax = OutputWidth() - 1
         Ymax = OutputHeight() - 1
         
         For y = 0 To Ymax
            For x = 0 To Xmax
               c = Point(x, y)
               \R[c & $FF] + 1 : c >> 8
               \G[c & $FF] + 1 : c >> 8
               \B[c & $FF] + 1
            Next x
         Next y
         
         If GetGadgetState(\ChkEx) ; exclude bins 0 and 255
            For x = 1 To 254
               If \R[x] > \maxR : \maxR = \R[x] : EndIf
               If \G[x] > \maxG : \maxG = \G[x] : EndIf
               If \B[x] > \maxB : \maxB = \B[x] : EndIf
            Next
         Else
            For x = 0 To 255
               If \R[x] > \maxR : \maxR = \R[x] : EndIf
               If \G[x] > \maxG : \maxG = \G[x] : EndIf
               If \B[x] > \maxB : \maxB = \B[x] : EndIf
            Next
         EndIf
         StopDrawing()
      EndWith : ;} END COMPUTE HISTOGRAM ****
Windows (x64)
Raspberry Pi OS (Arm64)
Top
User avatar
BasicallyPure
Enthusiast
Enthusiast
Posts: 539
Joined: Thu Mar 24, 2011 12:40 am
Location: Iowa, USA

Re: Calculate and display color image histograms

Post by BasicallyPure »

That is a great improvement in speed Wilbert.
Thanks a lot!!!

I have updated the code above.

BP
BasicallyPure
Until you know everything you know nothing, all you have is what you believe.
Top
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5494
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Calculate and display color image histograms

Post by Kwai chang caine »

Cool !!!! Works perfectly 8)

I don't know the utility, surely for analyse picture.
I search to compare two picture since numerous time, perhaps this code can be useful ?
If i already understand how compare or better substract two histograms :oops: :lol:

Again thanks for the job, and further for sharing. 8)
ImageThe happiness is a road...
Not a destination
Top
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: Calculate and display color image histograms

Post by davido »

Very nice. Thank you for sharing. :D
DE AA EB
Top
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5494
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Calculate and display color image histograms

Post by Kwai chang caine »

If someone can explain to me...
An histogram like that...is for all the information of the image....or only for the color like the title of this thread say "Calculate and display color image histograms" ?? :oops:
And if the picture rotate, or move a little bit, or change of size...is it always the same histogram ?? :oops:
ImageThe happiness is a road...
Not a destination
Top
Post Reply

Return to “Tricks 'n' Tips”