15 Replies Latest reply on Jan 15, 2015 9:44 AM by Kelson Lachance

    Want to count colour in a Saved out Bitmap

    Kelson Lachance

      I am still using the VB editor that came with Solidworks.

       

      I think I don't have the correct reference libraries.

       

      Just trying to save out a bitmap and count the number of pixels of a certain color.  This was the start; but it doesn't recognize the Bitmap calls?

       

      Dim swApp As Object

      Option Explicit
      ' Dim swApp As SldWorks.SldWorks
      Dim swModel As SldWorks.ModelDoc2
      Dim returnVal As Boolean
      Dim fileName As String
      Sub main()
          Set swApp = Application.SldWorks
          Set swModel = swApp.ActiveDoc
          fileName = "c:\temp\cstick.bmp"
          ' Save as bitmap and use current window size
          returnVal = swModel.SaveBMP(fileName, 0, 0)
          getAverageColor ("c:\temp\cstick.bmp")
         
      End Sub

      Private Function getAverageColor(ByVal imageFilePath As String)
          Dim bmp As Bitmap
          Dim totalR As Integer
          Dim totalG As Integer
          Dim totalB As Integer
          Dim x As Integer
          Dim y As Integer
          Dim pixel As ColorTable
          Dim totalPixels As Integer
          Dim averageR As Integer
          Dim averageg As Integer
          Dim averageb As Integer
         
          'Set bmp = Bitmap(imageFilePath)
          For x = 0 To bmp.Width - 1
              For y = 0 To bmp.Height - 1
                  pixel = bmp.GetPixel(x, y)
                  totalR = pixel.R
                  totalG = pixel.G
                  totalB = pixel.B
              Next
          Next
          totalPixels = bmp.Height * bmp.Width
          averageR = totalR \ totalPixels
          averageg = totalG \ totalPixels
          averageb = totalB \ totalPixels
          Debug.Print averageR
          Debug.Print averageg
          Debug.Print averageb
          'Return Color.FromArgb(averageR, averageg, averageb)
      End Function

        • Re: Want to count colour in a Saved out Bitmap
          Daniel Andersson

          Looks like you are trying to do things that is possible in VB/C++/C#.

           

          I hope that someone comes to prove me wrong, but this is my experience so far...

           

          The GetPixel method in System.Drawing is not exposed in VBA. The methods you are trying to use is available in VB or C++/C#. If you press F2 you will see the exposed methods and objects for the current loaded references in the VBA editor.

           

          I was facing a similar issue in the past and found no better way than make a small application in VB Express that gave me what I needed in that case.

          You could also look into to use ImageMagic dlls.

           

          I have also been trying to get my head to figure out how to use the GDI+, so far this is what I got... for some reasons the RGB values do not match properly.

          It returns RGB(0,242,0) when it should be RGB(255,242,0) or... RGB(0,1,255) when it should be RGB(255,0,255). Not sure what this is due to.

          I have also looked around but not figured out how to instantiate a Color object in VBA.

           

          Perhaps this could give you a start to something that works out in the end... It would also be much better from a performance point of view to use LockBits, but I'm not sure if that is possible with VBA.

           

          Here is the documentation for GDI+ Flat API

           

          You could try to ask this question at stackoverflow.com since it is VBA specific and not related to SolidWorks.

           

          Private Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long

          Private Declare Function GdipCreateBitmapFromFile Lib "gdiplus" (ByVal filename As Long, bitmap As Long) As Long

          Private Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus" (ByVal bitmap As Long, hbmReturn As Long, ByVal background As Long) As Long

          Private Declare Function GdipBitmapGetPixel Lib "gdiplus" (ByVal bitmap As Long, ByVal x As Long, ByVal y As Long, color As Long) As Long

          Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As Long

          Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As Long

           

          Private Declare Function GdipGetImageHeight Lib "gdiplus" (ByVal image As Long, Height As Long) As Long

          Private Declare Function GdipGetImageWidth Lib "gdiplus" (ByVal image As Long, Width As Long) As Long

           

          Option Explicit

           

          'Declare a UDT to store the GDI+ Startup information

          Private Type GdiplusStartupInput

              GdiplusVersion As Long

              DebugEventCallback As Long

              SuppressBackgroundThread As Long

              SuppressExternalCodecs As Long

          End Type

           

          Sub main()

           

          LoadPictureGDI "E:\test.bmp"

           

          End Sub

           

          Public Function LoadPictureGDI(ByVal sFilename As String) As IPicture

              Dim uGdiInput As GdiplusStartupInput

              Dim hGdiPlus As Long

              Dim lResult As Long

              Dim hGdiImage As Long

              Dim hBitmap As Long

           

              Dim xPos As Integer

              Dim yPos As Integer

              Dim lRGB As Long

              Dim lHeight, lWidth As Long

              Dim R, G, B As Long

           

              xPos = 1

              yPos = 0

           

              'Initialize GDI+

              uGdiInput.GdiplusVersion = 1

              lResult = GdiplusStartup(hGdiPlus, uGdiInput)

           

          If lResult = 0 Then

           

              'Load image from file

              lResult = GdipCreateBitmapFromFile(StrPtr(sFilename), hGdiImage)

             

              If lResult = 0 Then

                  lResult = GdipBitmapGetPixel(hGdiImage, xPos, yPos, lRGB)

                  lResult = GdipGetImageHeight(hGdiImage, lHeight)

                  lResult = GdipGetImageWidth(hGdiImage, lWidth)

                 

                  B = lRGB And 255

                  G = (lRGB \ 256) And 255

                  R = (lRGB \ 65536) And 255

                 

                  Debug.Print "RGB as Long: " & lRGB

                  Debug.Print "Image size [px]: " & lHeight & "x" & lWidth

                  Debug.Print "RGB(" & R; "," & G & "," & B & ") @ (" & xPos & "," & yPos & ")"

               

                  'Dispose image from memory

                  GdipDisposeImage hGdiImage

              End If

           

              'Shutdown

              GdiplusShutdown hGdiPlus

             

          End If

          End Function

          • Re: Want to count colour in a Saved out Bitmap
            Daniel Andersson

            AH! I did not give up and found a alternative way of and use of gdi32 instead. I have tried to find out the difference between gdiplus calls and gdi32. Seems like it is just to dig into the MSDN site and get some understanding of the C++ syntaxes for the functions.

             

            Found some of the code and modified it to do what you are looking for.

            This code do give the correct RGB values compared to the attempt above with GDI+.

             

            Const IMAGE_BITMAP = &O0

            Const LR_LOADFROMFILE = 16

            Const LR_CREATEDIBSECTION = 8192

             

            Private Type BITMAP

               bmType As Long

               bmWidth As Long

               bmHeight As Long

               bmWidthBytes As Long

               bmPlanes As Integer

               bmBitsPixel As Integer

               bmBits As Long

            End Type

             

            Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long

            Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long

            Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

            Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

            Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

            Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

            Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

             

             

            Sub main()

            Dim averageR As Integer

            Dim averageG As Integer

            Dim averageB As Integer

             

            GetAverageRGB "E:\test.bmp", averageR, averageG, averageB

             

            Debug.Print averageR

            Debug.Print averageG

            Debug.Print averageB

             

            End Sub

             

            Public Function GetAverageRGB(ByVal FileName As String, R As Integer, G As Integer, B As Integer)

            Dim hBitmap As Long

            Dim lBMDC As Long

            Dim sBitmapInfo As BITMAP

             

            Dim lRGB As Long

            Dim xPos As Long

            Dim yPos As Long

            Dim intR As Integer

            Dim intG As Integer

            Dim intB As Integer

            Dim totalR As Long

            Dim totalG As Long

            Dim totalB As Long

            Dim totalPixels As Long

             

            'Load the bitmap

            hBitmap = LoadImage(0, FileName, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)

            'make sure the call succeeded

            If (hBitmap = 0) Then

               MsgBox "Error, Unable To Load Bitmap", vbOKOnly, "Bitmap Load Error"

               Exit Function

            End If

             

            'Create new Device Context

            lBMDC = CreateCompatibleDC(0)

             

            'make sure the call succeeded

            If (lBMDC = 0) Then

               MsgBox "Error, Unable To Create Device Context", vbOKOnly, "Device Context Error"

               Exit Function

            End If

             

            'attach the bitmap to the device context just created

            SelectObject lBMDC, hBitmap

             

            'get the information about this image

            GetObject hBitmap, Len(sBitmapInfo), sBitmapInfo

             

            totalPixels = sBitmapInfo.bmWidth * sBitmapInfo.bmHeight

             

            For yPos = 0 To sBitmapInfo.bmHeight - 1

                For xPos = o To sBitmapInfo.bmWidth - 1

                    lRGB = GetPixel(lBMDC, xPos, yPos)

                    getRGB lRGB, intR, intG, intB

                    totalR = totalR + intR

                    totalG = totalG + intG

                    totalB = totalB + intB

                Next xPos

            Next yPos

             

            R = totalR / totalPixels

            G = totalG / totalPixels

            B = totalB / totalPixels

             

            DeleteDC lBMDC

            DeleteObject hBitmap

             

            End Function

             

            Private Function getRGB(ByVal lngRGB As Long, R As Integer, G As Integer, B As Integer)

                    R = lngRGB And 255

                    G = (lngRGB \ 256) And 255

                    B = (lngRGB \ 65536) And 255

            End Function

              • Re: Want to count colour in a Saved out Bitmap
                Kelson Lachance

                Wow the effort here is outstanding.  I have been in meeting so I apologize for the delay.  I tried the first this morning to see but had a problem with the gdiplus initializing. 

                I am still using VBA on a 64 bit machine, so do I have to find and add the user32 and gdi32 dll as resource library for this code to work?

                 

                The sad truth is; is that I have been working on solving the original problem for 6 years; using this bitmap method may be the answer; so I am eager.

                 

                kelson

                  • Re: Want to count colour in a Saved out Bitmap
                    Daniel Andersson

                    I created the macro in 64-bit, Windows 7. You do not have to add any references in the macro (tried macro in SolidWorks and Excel and it works fine in both). Just copy and paste it.

                    I would recommend that you run the macro that uses gdi32 methods instead. Since the one with gdiplus gives wrong RGB values, still have not figured out why... perhaps it is due to bits and bytes... :S

                      • Re: Want to count colour in a Saved out Bitmap
                        Kelson Lachance

                        Ok-  I appreciate you help with my obsession.  Strange don't understand but it does work when I loaded into Excel.

                        I had to change some variable to Long; I think it was because my bitmap was large.

                         

                        The count seems to be off on the RGB values returned.

                        My understanding is that this function will return a 1 for one of the R, G, B variables during each loop.  I guess I don't understand the lngRGB as long;

                         

                        Private Function getRGB(ByRef lngRGB As Long, R As Integer, G As Integer, B As Integer)

                                R = lngRGB And 255

                                G = (lngRGB \ 256) And 255

                                B = (lngRGB \ 65536) And 255

                        End Function

                            

                        Can you help me with my understanding.  The internet suggest the RGD is a hexadecimal format.  You have been more than helpful so if you want to just point me in the right direction; I will understand.

                          • Re: Want to count colour in a Saved out Bitmap
                            Daniel Andersson

                            Found out that these should be long... otherwise the variables will overflow.

                            Dim totalR As Long

                            Dim totalG As Long

                            Dim totalB As Long

                            Dim totalPixels As Long

                             

                            The function getRGB returns the R, G and B values as integers from a long (RGB) value.

                            R = lngRGB And 255 'The AND is a bit operation since the values are numeric, I do not have the right level of knowledge to explain this. You find better answers if you google.

                             

                             

                            For yPos = 0 To sBitmapInfo.bmHeight - 1

                                For xPos = o To sBitmapInfo.bmWidth - 1

                                    lRGB = GetPixel(lBMDC, xPos, yPos) 'Gets the long value for of RGB for specified pixel.

                                    getRGB lRGB, intR, intG, intB 'Funtion getRGB, the lRGB is passed to the function and it returns values to intR, intG, intB.

                                    totalR = totalR + intR 'Summarize the total R values for the complete bitmap.

                                    totalG = totalG + intG '.....

                                    totalB = totalB + intB '....

                                Next xPos

                            Next yPos

                             

                            RGB can be in decimal form (R,G,B) hexadecimal and hexadecimal can be converted to long values. In this case I chose to split up the lRGB into integers for R, G and B. Reason for integer is that a RGB value can not be a decimal. E.g. you can not set RGB(242.2, 1.5, 175.4)

                             

                            As an example, the attached 2x2 bitmap image have three black RGB(0,0,0) pixels and one red RGB(255,0,0) pixel.

                            This will return a average RGB value of RGB(64,0,0) for the complete bitmap. Since R = 255/4 = 63,75, G = 0 / 4, B = 0 / 4.

                            The values that is printed in the immediate window is just these average RGB values.

                             

                            What do you see as off in the RGB values that is returned? Reversed order of RGB (coming as BGR)? Or is it that the function seems to round off the values for each pixel?

                            Would it be possible for you to attach a bitmap that I could test with?

                              • Re: Want to count colour in a Saved out Bitmap
                                Kelson Lachance

                                You are exactly right.  Your explanation were clear for a notice like me.  This is just fantastic.  I got this to work and completely understand. 

                                Works perfectly within Excel.  Once again thanks for your help.  This solve a problem I have honestly been working on for a long time.

                                • Re: Want to count colour in a Saved out Bitmap
                                  Kelson Lachance

                                  I am having problem with is running in Solidworks; which uses the VBA 7 versus 6 in Excel

                                  For some reason it is forcing me to use the prtsafe  when declaring functions but does not seem to work; which is one of difference in the versions.

                                   

                                  I don't think it is loading or initializing the Functions.

                                   

                                  Any ideas?  Frustrated as I am so close.

                                    • Re: Want to count colour in a Saved out Bitmap
                                      Simon Turner

                                      You do need to add PtrSafe to all the Declare statements. And any variable that refers to a memory pointer needs to be changed from Long to LongPtr

                                      Google "Declare functionname VBA7" and you should find the syntax you need. For example:

                                       

                                      Private Declare PtrSafe Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As LongPtr, hbmReturn As LongPtr, ByVal background As Long) As LongPtr

                                        • Re: Want to count colour in a Saved out Bitmap
                                          Kelson Lachance

                                          Yes thank you.  I did start to change the code last night with respect to what you are suggesting.  It is shown below, I have tried many combinations changing what I believe to be memory pointer to the LongPtr as well.  I just think I am missing something obvious to a trained eye.

                                           

                                           

                                          Const IMAGE_BITMAP = &O0
                                          Const LR_LOADFROMFILE = 16
                                          Const LR_CREATEDIBSECTION = 8192

                                          Private Type BITMAP
                                             bmType As Long
                                             bmWidth As Long
                                             bmHeight As Long
                                             bmWidthBytes As Long
                                             bmPlanes As Integer
                                             bmBitsPixel As Integer
                                             bmBits As Long
                                          End Type

                                          '__________


                                          Private Declare PtrSafe Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As LongPtr
                                          Private Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As LongPtr) As Long
                                          Private Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hdc As LongPtr, ByVal hObject As LongPtr) As Long
                                          Private Declare PtrSafe Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As LongPtr, ByVal nCount As LongPtr, lpObject As Any) As Long
                                          Private Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hdc As LongPtr) As Long
                                          Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
                                          Private Declare PtrSafe Function GetPixel Lib "gdi32" (ByVal hdc As LongPtr, ByVal x As Long, ByVal y As Long) As Long





                                          Sub main()
                                          Dim averageR As Integer
                                          Dim averageG As Integer
                                          Dim averageB As Integer

                                          GetAverageRGB "C:\test.bmp", averageR, averageG, averageB

                                          Debug.Print averageR
                                          Debug.Print averageG
                                          Debug.Print averageB

                                          End Sub

                                          Public Function GetAverageRGB(ByRef FileName As String, R As Integer, G As Integer, B As Integer)
                                          Dim hBitmap As LongPtr
                                          Dim lBMDC As LongPtr
                                          Dim sBitmapInfo As BITMAP

                                          Dim lRGB As Long
                                          Dim xPos As Long
                                          Dim yPos As Long
                                          Dim intR As Integer
                                          Dim intG As Integer
                                          Dim intB As Integer
                                          Dim totalR As Long
                                          Dim totalG As Long
                                          Dim totalB As Long
                                          Dim totalPixels As Long
                                          Dim totalred As Long
                                          Dim totalblack As Long
                                          Dim maxboxlength As Long
                                          Dim largestmaxboxlength As Long
                                          Dim previouspixelred As Boolean


                                          'Load the bitmap
                                          hBitmap = LoadImage(0, FileName, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)
                                          'make sure the call succeeded
                                          If (hBitmap = 0) Then
                                             MsgBox "Error, Unable To Load Bitmap", vbOKOnly, "Bitmap Load Error"
                                             Exit Function
                                          End If

                                          'Create new Device Context
                                          lBMDC = CreateCompatibleDC(0)

                                          'make sure the call succeeded
                                          If (lBMDC = 0) Then
                                             MsgBox "Error, Unable To Create Device Context", vbOKOnly, "Device Context Error"
                                             Exit Function
                                          End If

                                          'attach the bitmap to the device context just created
                                          SelectObject lBMDC, hBitmap

                                          'get the information about this image
                                          GetObject hBitmap, Len(sBitmapInfo), sBitmapInfo

                                          totalPixels = sBitmapInfo.bmWidth * sBitmapInfo.bmHeight

                                          Debug.Print sBitmapInfo.bmWidth & " " & sBitmapInfo.bmHeight
                                          Debug.Print totalPixels

                                          previouspixred = False
                                          largestmaxboxlength = 0

                                          For yPos = 0 To sBitmapInfo.bmHeight - 1
                                              For xPos = o To sBitmapInfo.bmWidth - 1
                                                  lRGB = GetPixel(lBMDC, xPos, yPos)
                                                 
                                                  'Debug.Print xPos & " " & yPos
                                                 
                                                  getRGB lRGB, intR, intG, intB
                                                  totalR = totalR + intR
                                                  totalG = totalG + intG
                                                  totalB = totalB + intB
                                                 
                                                  If intR > 175 And intG < 50 And intB < 50 And previouspixelred = True Then
                                                    maxboxlength = maxboxlength + 1
                                                  End If
                                                 
                                                  If intR > 175 And intG < 50 And intB < 50 Then
                                                    totalred = totalred + 1
                                                    previouspixelred = True
                                                  End If
                                                 
                                                  If intR < 40 And intG < 40 And intB < 40 Then
                                                    totalblack = totalblack + 1
                                                    previouspixelred = False
                                                  End If
                                                                
                                              Next xPos
                                              Debug.Print xPos & " " & yPos
                                                If maxboxlength > largestmaxboxlength Then
                                                  largestmaxboxlength = maxboxlength
                                                End If
                                              maxboxlength = 0
                                          Next yPos

                                          R = totalR / totalPixels
                                          G = totalG / totalPixels
                                          B = totalB / totalPixels

                                          'R = totalR / 1
                                          'G = totalG / 1
                                          'B = totalB / 1

                                          Debug.Print "TotalPixels" & " " & totalPixels
                                          Debug.Print "Red Pixels" & "  " & totalred
                                          'Debug.Print "Total Area" & "  " & totalred
                                          Debug.Print "Total Black" & " " & totalblack
                                          Debug.Print "Total Picture Pixels " & " " & totalblack + totalred
                                          Debug.Print "Number of pixel in Red row" & "  " & largestmaxboxlength

                                          DeleteDC lBMDC
                                          DeleteObject hBitmap

                                          End Function

                                          Private Function getRGB(ByRef lngRGB As Long, R As Integer, G As Integer, B As Integer)
                                                  R = lngRGB And 255
                                                  G = (lngRGB \ 256) And 255
                                                  B = (lngRGB \ 65536) And 255
                                          End Function

                                            • Re: Want to count colour in a Saved out Bitmap
                                              Simon Turner

                                              This is a good site to refer to: http://www.cadsharp.com/docs/Win32API_PtrSafe.txt

                                               

                                              Using that, you can see that the hInst argument of LoadImage should be LongPtr.

                                              I'll paste in all the declares you need below:

                                               

                                              Declare PtrSafe Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As LongPtr, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As LongPtr

                                              Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" Alias "CreateCompatibleDC" (ByVal hdc As LongPtr) As LongPtr

                                              Declare PtrSafe Function SelectObject Lib "gdi32" Alias "SelectObject" (ByVal hdc As LongPtr, ByVal hObject As LongPtr) As LongPtr

                                              Declare PtrSafe Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As LongPtr, ByVal nCount As Long, lpObject As Any) As Long

                                              Declare PtrSafe Function DeleteDC Lib "gdi32" Alias "DeleteDC" (ByVal hdc As LongPtr) As Long

                                              Declare PtrSafe Function DeleteObject Lib "gdi32" Alias "DeleteObject" (ByVal hObject As LongPtr) As Long

                                              Declare PtrSafe Function GetPixel Lib "gdi32" Alias "GetPixel" (ByVal hdc As LongPtr, ByVal x As Long, ByVal y As Long) As Long

                                               

                                              Simon