PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Calculate and display color image histograms

https://www.purebasic.fr/english/viewtopic.php?t=57992

Page 1 of 1

Calculate and display color image histograms

Posted: Thu Jan 16, 2014 5:16 am
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

Re: Calculate and display color image histograms

Posted: Thu Jan 16, 2014 5:37 am
by Poshu
Damn, I was doing one after reading wilbert's post on color counting. Very nice effort, thanks ^^

Re: Calculate and display color image histograms

Posted: Thu Jan 16, 2014 6:47 am
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 ****

Re: Calculate and display color image histograms

Posted: Thu Jan 16, 2014 7:22 am
by BasicallyPure
That is a great improvement in speed Wilbert.
Thanks a lot!!!

I have updated the code above.

BP

Re: Calculate and display color image histograms

Posted: Thu Jan 16, 2014 10:08 am
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)

Re: Calculate and display color image histograms

Posted: Thu Jan 16, 2014 12:11 pm
by davido
Very nice. Thank you for sharing. :D

Re: Calculate and display color image histograms

Posted: Thu Jan 16, 2014 2:09 pm
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:
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited