PureBasic Forums - English

Code: Select all

Procedure CountColours()
;#------------------------
;by Wilbert
Protected.i x, y, max_x, max_y, c, count, m
Protected Dim m.a($1FFFFF)

               StartDrawing(ImageOutput(#Img))

               max_x = ImageWidth(#Img) - 1
               max_y = ImageHeight(#Img) - 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

Code: Select all

Procedure.a IsImageGrayscale(Img) ;/ for 24 or 32 bit images
  Protected.l X, Y,Width, Height, *pos.rgba, PixelStride = 3, isGrayscale = #True

  If Not IsImage(Img) : ProcedureReturn : EndIf
 
  StartDrawing(ImageOutput(Img))
    If (DrawingBufferPixelFormat() & #PB_PixelFormat_32Bits_RGB) > 0 Or (DrawingBufferPixelFormat() & #PB_PixelFormat_32Bits_BGR) : PixelStride = 4 : EndIf
    Width = ImageWidth(Img) - 1 : Height = ImageHeight(Img) - 1
   
    For Y = 0 To Height
      *pos = DrawingBuffer() + (Y * DrawingBufferPitch())
      For X = 0 To Width
        If *pos\r <> *pos\g Or *pos\g <> *pos\b : isGrayscale = #False : Break 2 : EndIf
        *pos + PixelStride
      Next
    Next
  StopDrawing()
  
  ProcedureReturn isGrayscale
EndProcedure

Code: Select all

Procedure.i IsImageGrayscale(Img)
  
  Structure rgba : r.a : g.a : b.a : EndStructure
  
  Protected.i X, Y, Width, Height, PixelBytes, LinePaddingBytes, isGrayscale
  Protected *pos.rgba
  
  
  If IsImage(Img)
    
    If StartDrawing(ImageOutput(Img))
      
      isGrayscale = #True
      
      PixelBytes = 3
      If DrawingBufferPixelFormat() = #PB_PixelFormat_32Bits_RGB : PixelBytes = 4 : EndIf
      If DrawingBufferPixelFormat() = #PB_PixelFormat_32Bits_BGR : PixelBytes = 4 : EndIf
      
      Width = ImageWidth(Img)
      LinePaddingBytes = DrawingBufferPitch() - (PixelBytes * Width)
      Width - 1
      Height = ImageHeight(Img) - 1
      
      *pos = DrawingBuffer()
      For Y = 0 To Height
        For X = 0 To Width
          If *pos\r <> *pos\g Or *pos\g <> *pos\b : isGrayscale = #False : Break 2 : EndIf
          *pos + PixelBytes
        Next X
        *pos + LinePaddingBytes
      Next Y
      
      StopDrawing()
    Else
      isGrayscale = - 1
    EndIf
  Else
    isGrayscale = - 1
  EndIf
  
  ProcedureReturn isGrayscale
  
EndProcedure

Code: Select all

UseJPEG2000ImageDecoder()
UseJPEG2000ImageEncoder()
UseJPEGImageDecoder()
UseJPEGImageEncoder()
UsePNGImageDecoder()
UsePNGImageEncoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()

Procedure.i IsImageGrayscale(Img)
  StartDrawing(ImageOutput(img))
  For i = 0 To ImageWidth(0)-1
    color = Point(10,i)
    If color <> 0 And color <> $FFFFFF
      flag = 1
      Break
    EndIf
  Next
  r = Red(color)
  g = Green(color)
  b = Blue(color)
  StopDrawing()
  If flag = 1 And r = g And g = b
    flag = 0
    Debug "Image is gray scaled"
  Else
    Debug "Not gray or Color = Black or White "
  EndIf
  If IsImage(0)
    FreeImage(0)
  EndIf
EndProcedure

flags = #PB_Window_SystemMenu| #PB_Window_MaximizeGadget| #PB_Window_MinimizeGadget| #PB_Window_ScreenCentered | #PB_Window_SizeGadget
OpenWindow(0,0,0,400,300,"Test",Flags)

ButtonGadget(1,10,270,60,20,"Load")

Repeat
  
  Select WaitWindowEvent()
      
    Case #PB_Event_CloseWindow
      Quit = 1 
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 1
          File$ = OpenFileRequester("Please choose file to load", "C:\image.bmp", "All files (*.*)|*.*", 0)
          If File$
            LoadImage(0,File$)
            If IsImage(0)
              IsImageGrayscale(0)
            EndIf
          EndIf
          
      EndSelect
      
  EndSelect
  
Until Quit = 1
End

Code: Select all

Structure RGBA
  r.a
  g.a
  b.a
  a.a
EndStructure


Procedure.f DetermineFileGrayscalePct(sPNGfile.s)

  Protected *inrgba.RGBA, *red.Ascii, *green.Ascii, *blue.Ascii, *alpha.Ascii, x,y
  Protected hImg, depth, ipixfmt, irowlen, steprow, width, height, bytesperpixel, pixels
  
  hImg = LoadImage(#PB_Any, sPNGfile)
  If hImg = 0
    MessageRequester("Error", "Couldnt load " + sPNGfile): End
  EndIf
  
  width = ImageWidth(hImg)
  height = ImageHeight(hImg)
  If width < 1 Or height < 1
    MessageRequester("Error", "Invalid dimensions " + Str(width) + " x " + Str(height)): End
  EndIf
  pixels = width * height
  depth = ImageDepth(hImg)
  bytesperpixel = depth >> 3
  
  If StartDrawing(ImageOutput(hImg))
    
    *inrgba = DrawingBuffer()    
    irowlen = DrawingBufferPitch()
    ipixfmt = DrawingBufferPixelFormat()
    
    If ipixfmt & #PB_PixelFormat_ReversedY  ;start from the bottom and work upwards
      steprow = (0-irowlen-irowlen) + (irowlen - (width * bytesperpixel))
      *inrgba + (irowlen * height) - irowlen
    Else  ;start from the top and work down
      steprow = (irowlen - (width * bytesperpixel)) 
    EndIf 
    
    For y = 1 To height
      For x = 1 To width        
        If (*inrgba\r = *inrgba\g) And (*inrgba\g = *inrgba\b)  ;if R=G and G=B, it's a grayscale pixel
          GrayCnt+1
        Else
          NonGray+1
        EndIf            
        *inrgba + bytesperpixel
      Next x
      *inrgba + steprow
    Next y    
    StopDrawing()
    
  EndIf
  FreeImage(hImg)
  MessageRequester("Pixels", "Pixels=" + Str(width*height) + " GrayCnt=" + Str(GrayCnt) + " Non=" + Str(Nongray))
  ProcedureReturn (NonGray/GrayCnt) * 100
EndProcedure


UsePNGImageDecoder()
sFile.s = "H:\halfgray.png"
Pct.f = DetermineFileGrayscalePct(sFile)
MessageRequester("Grayscale Detect", "This image is " + StrF(Pct,3)+"% grayscale")