Count unique colors used in an image using GDIPlus [Windows only]

[UEZ]

Here a code using GDIPlus to count the unique colors of an image.

Code: Select all

'coded by UEZ build 2017-11-27
#define WIN_INCLUDEALL
#include once "windows.bi"
#Include Once "win/gdiplus.bi"

Using GDIPLUS

Declare Function FileOpenDialog (Byref sTitle As String, Byref sDir As String = CurDir, sFilter As String = !"All Files (*.*)" + Chr(0) + "*.*" + Chr(0, 0)) As String
Declare Function _GDIPlus_ImageCountColors32(himage as any Ptr) as uInteger
Declare Function _GDIPlus_ImageCountColors24(himage as any Ptr) as UInteger
Declare function _GDIPlus_ImageCountColorsAccurat(himage as any Ptr) as uInteger
Declare function _GDIPlus_ImageCountColors24ASM(himage as any Ptr) as uInteger
Declare Function _GDIPlus_ImageGetPixelFormat(hImage as any ptr) as UInteger
Declare Sub Quicksort(Array() As uinteger, iStart As uinteger, iEnd As uinteger)

Function _GDIPlus_ImageCountColors32(himage as any Ptr) as uInteger 'slower variant but full 32-bit support
   Dim As Single iW, iH, iPixel, iRowOffset
	GdipGetImageDimension(hImage, @iW, @iH)
   Dim As BitmapData tBitmapData
   Dim As Rect tRect = Type(0, 0, iW - 1, iH - 1)
   Dim as uinteger aColors(0 to iW * iH), c = 0, iX, iY
   ? "Image dimension: " & iW & "x" & iH
   ? "Counting all 32-bit colors"
   _GDIPlus_ImageGetPixelFormat(hImage)
   GdipBitmapLockBits(hImage, Cast(Any Ptr, @tRect), ImageLockModeRead, PixelFormat32bppARGB, @tBitmapData)
   
   For iY = 0 To iH - 1
      iRowOffset = iY * iW
      For iX = 0 To iW - 1 
           aColors(c) = Cast(uInteger Ptr, tBitmapData.Scan0)[iRowOffset + iX]
           c += 1
      Next
   Next
   
   GdipBitmapUnlockBits(hImage, @tBitmapData)
   
   ? "Sorting color array"
   QuickSort(aColors(), 0, c - 1) 
   ? "Counting unique colors"
   c = 0
   For iY = 0 to Ubound(aColors) - 2
      If aColors(iY) > aColors(iY + 1) Then c += 1
   Next

   Return c
End Function

Function _GDIPlus_ImageCountColors24(himage as any Ptr) as uInteger
   Dim As Single iW, iH, iPixel, iRowOffset
	GdipGetImageDimension(hImage, @iW, @iH)
   Dim As BitmapData tBitmapData
   Dim As Rect tRect = Type(0, 0, iW - 1, iH - 1)
   Dim as uInteger c = 0, iX, iY
   Dim as UlongInt iColor
   Dim as Ubyte aColors()
   Redim aColors(0 to 256^3 + 1) 
   ? "Image dimension: " & iW & "x" & iH
   ? "Counting all 24-bit colors"
   
   GdipBitmapLockBits(hImage, Cast(Any Ptr, @tRect), ImageLockModeRead, PixelFormat32bppRGB, @tBitmapData)
   
   For iY = 0 To iH - 1
      iRowOffset = iY * iW
      For iX = 0 To iW - 1 
            iColor = Cast(uInteger Ptr, tBitmapData.Scan0)[iRowOffset + iX] and &h00FFFFFF 'read and make color value 24-bit
            If aColors(iColor) = 0 Then
               c += 1
               aColors(iColor) = 1
            Endif
      Next
   Next
   
   GdipBitmapUnlockBits(hImage, @tBitmapData)
   
   Return c
End Function

function _GDIPlus_ImageCountColorsAccurat(himage as any Ptr) as uInteger 'very very slow!
   Dim As Single iW, iH, iPixel, iRowOffset
	GdipGetImageDimension(hImage, @iW, @iH)
   Dim As BitmapData tBitmapData
   Dim As Rect tRect = Type(0, 0, iW - 1, iH - 1)
   Dim as uinteger aColors(0 to iW * iH), iColor, c = 0, p = 0, iX, iY, iYY
   Dim as Boolean bFound
   ? "Image dimension: " & iW & "x" & iH
   ? "Counting all 32-bit colors"
   _GDIPlus_ImageGetPixelFormat(hImage)
   GdipBitmapLockBits(hImage, Cast(Any Ptr, @tRect), ImageLockModeRead, PixelFormat32bppARGB, @tBitmapData)
   
   For iY = 0 To iH - 1
      iRowOffset = iY * iW
      For iX = 0 To iW - 1 
            iColor = Cast(uInteger Ptr, tBitmapData.Scan0)[iRowOffset + iX]
            bFound = False
            For iYY = 0 to p
               If iColor = aColors(iYY) Then
                  bFound = true
                  Exit For
               End If
            Next
            If Not bFound then
               aColors(p) = iColor
               p += 1
               c += 1
            End if
      Next
   Next

   GdipBitmapUnlockBits(hImage, @tBitmapData)
   
   Return c   
End Function

Function _GDIPlus_ImageCountColors24ASM(himage as any Ptr) as uInteger
   Dim As Single iW, iH, iPixel
	GdipGetImageDimension(hImage, @iW, @iH)
   Dim As BitmapData tBitmapData
   Dim As Rect tRect = Type(0, 0, iW - 1, iH - 1)
   Dim as uInteger c = 0, iX, iY, iPixels = iW * iH
   Dim as Byte aColors()
   Redim aColors(0 to 256^3 + 1) 
   
   ? "Image dimension: " & iW & "x" & iH
   ? "Counting all 24-bit colors"
   
   GdipBitmapLockBits(hImage, Cast(Any Ptr, @tRect), ImageLockModeRead, PixelFormat32bppARGB, @tBitmapData)
   
   Dim As Any Ptr pBmp = Cast(Any Ptr, tBitmapData.scan0)
   Dim As Byte Ptr pColors = Cast(Byte Ptr, @aColors(0))

   Asm
      mov esi, [pBmp]
      mov ecx, [iPixels]
      mov edi, [pColors]
      Xor eax, eax
      _Pixel_Count:
         mov ebx, [esi]
         and ebx, &hFFFFFF
         cmp Byte Ptr [edi + ebx], 1
         je _Next
         inc eax
         mov Byte Ptr [edi + ebx], 1
      _Next:
         add esi, 4
         dec ecx
         jnz _Pixel_Count
      mov [c], eax 
   End Asm

   GdipBitmapUnlockBits(hImage, @tBitmapData)
   Return c
End Function

Function _GDIPlus_ImageGetPixelFormat(hImage as any ptr) as UInteger
   Dim as UInteger iFormat
   GdipGetImagePixelFormat(hImage, @iFormat)
   Return iFormat
End Function

'https://en.wikibooks.org/wiki/Algorithm_Implementation/Sorting/Quicksort
Sub Quicksort(Array() As uinteger, iStart As uinteger, iEnd As uinteger)
   Dim As uInteger i = iStart, j = iEnd, iPivot = Array((i + j) Shr 1)
   While i <= j
      While Array(i) > iPivot
         i += 1
      Wend
      While Array(j) < iPivot 
         j -= 1
      Wend
      If i <= j Then 
         Swap Array(i), Array(j)
         i += 1 
         j -= 1
      End if
   Wend
   If j > iStart Then Quicksort(Array(), iStart, j)
   If i < iEnd Then Quicksort(Array(), i, iEnd)
End Sub

'code by KristopherWindsor -> https://www.freebasic.net/forum/viewtopic.php?f=7&t=10981&hilit=FileOpenDialog
Function FileOpenDialog (Byref sTitle As String, Byref sDir As String = CurDir, sFilter As String = !"All Files (*.*)" + Chr(0) + "*.*" + Chr(0, 0)) As String
  Dim oFilename As OPENFILENAME
  Dim sFilename As Zstring * (MAX_PATH + 1)
  Dim Title As Zstring * 32 => sTitle
  Dim sInitialDir As Zstring * 256 => sDir
  
  With oFilename
    .lStructSize       = SizeOf(OPENFILENAME)
    .hwndOwner         = NULL
    .hInstance         = GetModuleHandle(NULL)
                        '"All Files, (*.*)"
                        '"*.*"
                        '"Bas Files, (*.BAS)"
                        '"*.bas"
    '.lpstrFilter       = Strptr(!"All Files, (*.*)\0*.*\0Bas Files, (*.BAS)\0*.bas\0\0")
    .lpstrFilter       = Strptr(sFilter)
    .lpstrCustomFilter = NULL
    .nMaxCustFilter    = 0
    .nFilterIndex      = 1
    .lpstrFile         = @sFilename
    .nMaxFile          = SizeOf(sFilename)
    .lpstrFileTitle    = NULL
    .nMaxFileTitle     = 0
    .lpstrInitialDir   = @sInitialDir
    .lpstrTitle        = @Title
    .Flags             = OFN_EXPLORER Or OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST
    .nFileOffset       = 0
    .nFileExtension    = 0
    .lpstrDefExt       = NULL
    .lCustData         = 0
    .lpfnHook          = NULL
    .lpTemplateName    = NULL
  End With

  If (GetOpenFileName(@oFilename) = FALSE) Then Return ""
  Return sFilename
End Function

Dim GDIPlusStartupInput As GDIPLUSSTARTUPINPUT 
Dim As ULONG_PTR GDIPlusToken 

GDIPlusStartupInput.GdiplusVersion = 1 
If (GdiplusStartup(@GDIPlusToken, @GDIPlusStartupInput, NULL) <> 0) Then 
   End 'FAILED TO INIT GDI+!
EndIf
   
Dim as String sImgFile

sImgFile = FileOpenDialog("Select an image file to load...", "", "Image Files (*.bmp;*.jpg;*.png;*.gif)" + Chr(0) + "*.bmp;*.jpg;*.png;*.gif" + Chr(0))
? "Loading image"
Dim As Integer iStatus
Dim as any Ptr hImage
iStatus = GdipLoadImageFromFile(sImgFile, @hImage)
If iStatus <> 0 Then 
   GdiplusShutdown(GDIPlusToken)
   End
End if

Dim as Double fTimer 
fTimer = Timer
If (_GDIPlus_ImageGetPixelFormat(hImage) and PixelFormatAlpha) Then 'check if image has alpha channel
      ? "Unique color count: " & _GDIPlus_ImageCountColors32(hImage)
   Else
      ? "Unique color count: " & _GDIPlus_ImageCountColors24ASM(hImage)
End If
? (Timer - fTimer) * 1000 & " ms"

GdipDisposeImage(hImage)
GdiplusShutdown(GDIPlusToken)
Sleep

GDIPlus can handle these image formats: BMP, ICON, GIF, JPEG, Exif, PNG, TIFF, WMF, and EMF (MSDN).

Might be useful...

[counting_pine]

If you assume 24-bit RGB, there's a range of 16.7 million possible colours.
Nowadays, in most cases you could easily get away with using a 16-megabit array (2MiB) to track which colours have been seen, and count them that way.

Unfortunately, for me the code crashes on win7-64 after I choose a file. I'm not sure why..
But otherwise, potentially an interesting example of GDIPlus in action.

[UEZ]

If you assume 24-bit RGB, there's a range of 16.7 million possible colours.
Nowadays, in most cases you could easily get away with using a 16-megabit array (2MiB) to track which colours have been seen, and count them that way.

Unfortunately, for me the code crashes on win7-64 after I choose a file. I'm not sure why..
But otherwise, potentially an interesting example of GDIPlus in action.

Well, imho spending e.g. 100 MB memory for an array is nowadays not a problem anymore. What other technique I can use with FB? Scripting.Dictionary might be an option but I need to check out how to use it with FB first.

Regarding the crash: for really large images (e.g. 17 mpx) it also crashes on my machine (Win10 x64) with the QuickSort function. I don't now why yet.

Edit:
Unhandled exception at 0x00401978 in _GDIPlus_ImageCountColors.exe: 0xC0000005: Access violation reading location 0x1087FFFC.

00401955 jb 00401967
00401957 ja 0040195D
00401959 cmp dword ptr [ebx],ecx
0040195B jbe 00401967
0040195D add dword ptr [ebp-8],1
00401961 adc dword ptr [ebp-4],0
00401965 jmp 00401941
00401967 mov ecx,dword ptr [ebp-10h]
0040196A shl ecx,3
0040196D mov eax,dword ptr [ebp+8]
00401970 add ecx,dword ptr [eax]
00401972 mov ebx,dword ptr [ebp-18h]
00401975 mov eax,dword ptr [ebp-14h]
-=>00401978 cmp dword ptr [ecx+4],eax
0040197B ja 0040198D
0040197D jb 00401983
0040197F cmp dword ptr [ecx],ebx
00401981 jae 0040198D
00401983 add dword ptr [ebp-10h],0FFFFFFFFh
00401987 adc dword ptr [ebp-0Ch],0FFFFFFFFh
0040198B jmp 00401967
0040198D mov eax,dword ptr [ebp-10h]
00401990 mov ebx,dword ptr [ebp-0Ch]
00401993 cmp dword ptr [ebp-4],ebx

Might be a problem with the stack of the recursive QuickSort function for huge arrays...

[dodicat]

Not so much counting colours, but it could be used as a bload functions for image files other than bitmaps.
Condensed to function Pload:

Code: Select all

'coded by UEZ build 2017-10-05

#if sizeof(integer)=8
#include "windows.bi"
#endif
#Include  "win/gdiplus.bi"

screen 20,32

Function Pload(Picture as String,byref i as any ptr=0) as long
   Dim As uinteger TMP 
   GDIPLUS.GdiplusStartup(@TMP,@type<GDIPLUS.GDIPLUSSTARTUPINPUT>(1),0)
   Dim as any Ptr Img
   if GDIPLUS.GdipLoadImageFromFile(Picture,@Img)>0 then return 0
   Dim As Single w,h
   GDIPLUS.GdipGetImageDimension(Img,@w,@h)
   if w*h=0 then return 0
   Dim As GDIPLUS.BitmapData Pdata
   Dim As Rect R=Type(0,0,w-1,h-1)
   GDIPLUS.GdipBitmapLockBits(Img,Cast(Any Ptr,@R),GDIPLUS.ImageLockModeRead,PixelFormat32bppARGB,@Pdata)
   For y as long = 0 To h-1
      For x as long = 0 To w-1 
           pset i,(x,y),Cast(ulong Ptr,Pdata.Scan0)[y*w+x]
      Next
   Next
return w*h
End Function

sub getsize(picture as string,byref w as single,byref h as single) 
    Dim As uinteger TMP 
   GDIPLUS.GdiplusStartup(@TMP,@type<GDIPLUS.GDIPLUSSTARTUPINPUT>(1),0)
   Dim as any Ptr Img
   if GDIPLUS.GdipLoadImageFromFile(Picture,@Img)>0 then exit sub
   GDIPLUS.GdipGetImageDimension(Img,@w,@h)
    end sub

dim as string file="new.jpg"


if Pload(file) =0  then print "unable to load"


dim as single w,h
getsize(file,w,h)
dim as any ptr i=imagecreate(w,h)

Pload(file,i)
put(500,300),i,pset

sleep 

[St_W]

Might be a problem with the stack of the recursive QuickSort function for huge arrays...

Have you tried increasing the stack size?

[UEZ]

Might be a problem with the stack of the recursive QuickSort function for huge arrays...

Have you tried increasing the stack size?

Thanks for the hint. It works now with -t 8192 also for huge images. :-)

My guess was right...

^^

[dodicat]

You don't need quicksort to count the colours:
WORKAROUND:

Code: Select all

 'coded by UEZ build 2017-10-05
#define WIN_INCLUDEALL
#include once "windows.bi"
#Include Once "win/gdiplus.bi"

Using GDIPLUS

Declare Function FileOpenDialog (Byref sTitle As String, Byref sDir As String = CurDir, sFilter As String = !"All Files (*.*)" + Chr(0) + "*.*" + Chr(0, 0)) As String
Declare Function _GDIPlus_ImageCountColors(sFile as WString) as uInteger
Declare Sub Quicksort(array() As UInteger, iStart As UInteger, iEnd As UInteger)

Function _GDIPlus_ImageCountColors(sFile as WString) as uInteger
   Dim GDIPlusStartupInput As GDIPLUSSTARTUPINPUT 
   Dim As ULONG_PTR GDIPlusToken 

   GDIPlusStartupInput.GdiplusVersion = 1 
   If (GdiplusStartup(@GDIPlusToken, @GDIPlusStartupInput, NULL) <> 0) Then 
      Return 0 'FAILED TO INIT GDI+!
   EndIf
  
   Dim As Integer iStatus
   Dim as any Ptr hImage
   iStatus = GdipLoadImageFromFile(sFile, @hImage)
   If iStatus <> 0 Then Return 0
   
   Dim As Single iW, iH, iPixel, iRowOffset
   GdipGetImageDimension(hImage, @iW, @iH)
   Dim As BitmapData tBitmapData
   Dim As Rect tRect = Type(0, 0, iW - 1, iH - 1)
  ' Dim as UInteger aColors(0 to iW * iH), c = 0, iX, iY
   
   GdipBitmapLockBits(hImage, Cast(Any Ptr, @tRect), ImageLockModeRead, PixelFormat32bppARGB, @tBitmapData)
   dim as longint maxc=-2*rgb(255,255,255),minc=-maxc,tmp,flag,c
   For iY as long= 0 To iH - 1
      iRowOffset = iY * iW
      For iX as long = 0 To iW - 1 
           tmp = Cast(long Ptr, tBitmapData.Scan0)[iRowOffset + iX]
           if tmp=0 then flag=1
           if maxc<tmp then maxc=tmp
           if minc>tmp then minc=tmp
      Next
   Next
   
   redim as longint acolors(minc to maxc)
   For iY as long = 0 To iH - 1
      iRowOffset = iY * iW
      For iX as long = 0 To iW - 1 
            tmp = Cast(long Ptr, tBitmapData.Scan0)[iRowOffset + iX]
          acolors(tmp)+=1
      Next
   Next
   GdipBitmapUnlockBits(hImage, @tBitmapData)
   GdipDisposeImage(hImage)
   GdiplusShutdown(GDIPlusToken)

   'QuickSort(aColors(), 0, c - 1) 

   c = 0
   For iY as longint = lbound(acolors) to Ubound(aColors)
      If aColors(iY) then c+=1
   Next

   Return c+flag
End Function

'https://en.wikibooks.org/wiki/Algorithm_Implementation/Sorting/Quicksort
Sub Quicksort(Array() As UInteger, iStart As UInteger, iEnd As UInteger)
   Dim As UInteger i = iStart, j = iEnd, iPivot = Array((i + j) Shr 1)
   While i <= j
      While Array(i) > iPivot
         i += 1
      Wend
      While Array(j) < iPivot 
         j -= 1
      Wend
      If i <= j Then 
         Swap Array(i), Array(j)
         i += 1 
         j -= 1
      End if
   Wend
   If j > iStart Then Quicksort(Array(), iStart, j)
   If i < iEnd Then Quicksort(Array(), i, iEnd)
End Sub

'code by KristopherWindsor -> https://www.freebasic.net/forum/viewtopic.php?f=7&t=10981&hilit=FileOpenDialog
Function FileOpenDialog (Byref sTitle As String, Byref sDir As String = CurDir, sFilter As String = !"All Files (*.*)" + Chr(0) + "*.*" + Chr(0, 0)) As String
  Dim oFilename As OPENFILENAME
  Dim sFilename As Zstring * (MAX_PATH + 1)
  Dim Title As Zstring * 32 => sTitle
  Dim sInitialDir As Zstring * 256 => sDir
  
  With oFilename
    .lStructSize       = SizeOf(OPENFILENAME)
    .hwndOwner         = NULL
    .hInstance         = GetModuleHandle(NULL)
                        '"All Files, (*.*)"
                        '"*.*"
                        '"Bas Files, (*.BAS)"
                        '"*.bas"
    '.lpstrFilter       = Strptr(!"All Files, (*.*)\0*.*\0Bas Files, (*.BAS)\0*.bas\0\0")
    .lpstrFilter       = Strptr(sFilter)
    .lpstrCustomFilter = NULL
    .nMaxCustFilter    = 0
    .nFilterIndex      = 1
    .lpstrFile         = @sFilename
    .nMaxFile          = SizeOf(sFilename)
    .lpstrFileTitle    = NULL
    .nMaxFileTitle     = 0
    .lpstrInitialDir   = @sInitialDir
    .lpstrTitle        = @Title
    .Flags             = OFN_EXPLORER Or OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST
    .nFileOffset       = 0
    .nFileExtension    = 0
    .lpstrDefExt       = NULL
    .lCustData         = 0
    .lpfnHook          = NULL
    .lpTemplateName    = NULL
  End With

  If (GetOpenFileName(@oFilename) = FALSE) Then Return ""
  Return sFilename
End Function

Dim as WString * 256 sImgFile

sImgFile = FileOpenDialog("Select an image file to load...", CurDir, "Image Files (*.bmp;*.jpg;*.png;*.gif)" + Chr(0) + "*.bmp;*.jpg;*.png;*.gif" + Chr(0))
Dim as Double fTimer 
fTimer = Timer
? "Unique color count: " & _GDIPlus_ImageCountColors(sImgFile)
? Timer - fTimer & " ms"
Sleep  

[UEZ]

@dodicat: smart idea to count the colors in an array and it is faster for really huge images compared to the QuickSort variant.

Nowadays such kind of memory usage should be a problem anymore. ^^

Thanks.

[grindstone]

With a few changes it runs about 35% faster.

Code: Select all

Function _GDIPlus_ImageCountColors(sFile as WString) as uInteger
   Dim GDIPlusStartupInput As GDIPLUSSTARTUPINPUT
   Dim As ULONG_PTR GDIPlusToken

   GDIPlusStartupInput.GdiplusVersion = 1
   If (GdiplusStartup(@GDIPlusToken, @GDIPlusStartupInput, NULL) <> 0) Then
      Return 0 'FAILED TO INIT GDI+!
   EndIf
 
   Dim As Integer iStatus
   Dim as any Ptr hImage
   iStatus = GdipLoadImageFromFile(sFile, @hImage)
   If iStatus <> 0 Then Return 0
   
   Dim As Single iW, iH, iPixel, iRowOffset
   GdipGetImageDimension(hImage, @iW, @iH)
   Dim As BitmapData tBitmapData
   Dim As Rect tRect = Type(0, 0, iW - 1, iH - 1)
  ' Dim as UInteger aColors(0 to iW * iH), c = 0, iX, iY
   
   GdipBitmapLockBits(hImage, Cast(Any Ptr, @tRect), ImageLockModeRead, PixelFormat32bppARGB, @tBitmapData)
   dim as longint maxc=-2*rgb(255,255,255),minc=-maxc,tmp,flag,c
   For iY as long= 0 To iH - 1
      iRowOffset = iY * iW
      For iX as long = 0 To iW - 1
           tmp = Cast(long Ptr, tBitmapData.Scan0)[iRowOffset + iX]
           if tmp=0 then flag=1
           if maxc<tmp then maxc=tmp
           if minc>tmp then minc=tmp
      Next
   Next
   
   redim as longint acolors(minc to maxc)
   For iY as long = 0 To iH - 1
      iRowOffset = iY * iW
      For iX as long = 0 To iW - 1
            tmp = Cast(long Ptr, tBitmapData.Scan0)[iRowOffset + iX]
          If acolors(tmp) = 0 Then '<<<<<<<<<<<<<<<
          	acolors(tmp) = 1       '<<<<<<<<<<<<<<<
          	c += 1                 '<<<<<<<<<<<<<<<
          EndIf                    '<<<<<<<<<<<<<<<
          'acolors(tmp)+=1         '<<<<<<<<<<<<<<<
      Next
   Next
   GdipBitmapUnlockBits(hImage, @tBitmapData)
   GdipDisposeImage(hImage)
   GdiplusShutdown(GDIPlusToken)

   'QuickSort(aColors(), 0, c - 1)

   'c = 0                                                  '<<<<<<<<<<<<<<<
   'For iY as longint = lbound(acolors) to Ubound(aColors) '<<<<<<<<<<<<<<<
   '   If aColors(iY) then c+=1                            '<<<<<<<<<<<<<<<
   'Next                                                   '<<<<<<<<<<<<<<<

   Return c+flag
End Function

[counting_pine]

It seems like you're rejecting the 2MB array idea because it's too small?
Here's roughly what it would look like anyway:

Code: Select all

   GdipBitmapLockBits(hImage, Cast(Any Ptr, @tRect), ImageLockModeRead, PixelFormat32bppARGB, @tBitmapData)
   
   redim as ulongint acolors(0 to (2^24) \ 64 - 1)
   For iY as long = 0 To iH - 1
      iRowOffset = iY * iW
      For iX as long = 0 To iW - 1
          dim as ulong tmp = Cast(ulong Ptr, tBitmapData.Scan0)[iRowOffset + iX] and &hffffff
          If (acolors(tmp \ 64) and 1ull shl (tmp mod 64)) = 0 Then
             acolors(tmp \ 64) or= 1ull shl (tmp mod 64)
             c += 1
          EndIf
      Next
   Next
   
   GdipBitmapUnlockBits(hImage, @tBitmapData)
   GdipDisposeImage(hImage)
   GdiplusShutdown(GDIPlusToken)

Looking up bits in an array is a little more complex, but I think worth it for the space savings.

Otherwise, the previous suggestion could be made to use less RAM by using a ubyte array instead of a longint array.
I would also get rid of the minc/maxc calculations. They add more time and complexity to the code, and will not save any space in the common case that the image includes black and white pixels. Changing the array datatype is a much better way of saving space.

[grindstone]

Otherwise, the previous suggestion could be made to use less RAM by using a ubyte array instead of a longint array.

You're right, but then, from the logic point of view, the type should be boolean instead of ubyte.

[counting_pine]

You're right, since the boolean type is 1 byte, there is no reason not to use it over a ubyte.
I'm still of the opinion that it's bloated to use 8 bits instead of 1, but it might be slightly faster in practice, and makes for more readable code.

[UEZ]

Can somebody explain me the idea of

Code: Select all

Dim as ulongint t
For x as ulong = &h1FFFC0 to &h1FFFFF
   t = (x \ 64)
   t or= 1ull shl (x mod 64)
   ? (x mod 64), Hex(x \ 64), Hex((x \ 64) and 1ull shl (x mod 64)), Hex(t), Hex(1ull shl (x mod 64)) 
Next

Sleep

which has counting_pine used?

Thx.

[counting_pine]

I don’t recognise all of that code..
But basically, ‘if a and (1 shl n)’ is a way of testing the nth bit of a, whether it is set or not.

There are 64 bits in a ulongint, so you need (N/64) ulongints to store N bits. (Note that if N doesn’t divide 64, the result is rounded up.)

The nth bit can found in the (n\64)th element in a ulongint array. The position it can be found in is (n mod 64).

Note that for this to make sense, it is probably important to understand that floor(n \ 64) * 64 + (n mod 64) is equal to n.

[fxm]

But basically, ‘if a and (1 shl n)’ is a way of testing the nth bit of a, whether it is set or not.

Or use 'if bit(a, n)'