count colors in bitmap
in [Visual Basic]
|
From: Mike Williams on 16 Jul 2010 04:13 "Ulrich Korndoerfer" <ulrich_wants_nospam(a)prosource.de> wrote in message news:i1o9t9$el4$1(a)online.de... > I did not test on a 3200x2400 bitmap. That should not be > necessary, because a 1024x768 bitmap fulfills the same > condition. So if your suspection, that this causes a crash > when accessing the last pixel without taking special mesures, > it should crash on 1024x768 bitmaps too. But on my own two machines your code DOES crash on a 1024 x 768 bitmap! I specifically mentioned that size (and various other sizes, including a 3200 x 2400 bitmap) in my very first post about the crashing of your code. And it also DOES crashes on a 3200 x 2400 pixel bitmap. I am not a fool, Ulrich, and I am NOT lying about the crashes! I just happened to have tested it on a 3200 x 2400 bitmap when I sent the message to which you have just responded, and it CRASHED on that bitmap, so i asked you to test it on such a sized bitmap. Also, on both of my own machines your app CRASHES on both a 1024 x 768 bitmap and on a 3200 x 2400 pixel bitmap. In fact I am on my Vista 32 bit desktop machine at the moment and I have just this minute downloaded a fresh copy of your code from the link you provided and all I did was replace your own small testpic.bmp with a newly created 1024 x 768 pixel bitmap that I created in MS Paint. I then ran your code simply by double clicking your own compiled exe, just to make sure that I was running exactly what you had compiled yourself, and it CRASHED. I then created two different 1024 x 768 pixel bitmaps in two other quite different programs and I tried it with those. Again, in both cases, it CRASHED. I then repeated all those tests on a 3200 x 2400 pixel bitmap, and in all cases it CRASHED AGAIN. I am NOT lying about this, Ulrich! Why don't you just believe me, and check things out further yourself, perhaps on the machines of other people you might know, specifically on machines that might be differently configured and running different vesions of the OS than your own. My own originally posted code (copy of which is below my signature) works fine on both of those sizes of bitmap. Anyone who is interested can paste my own code (below my signature) into a VB Form containing a Command Button and change the hard coded path to a 3200 x 2400 pixel .bmp file and compile it to a native code exe (using the same advanced optimizations of remove array bounds and overflow checks that you are using yourself) and check it out. Then, if they wish, they can go to your own provided link and download your own code and replace the testpic.bmp file in your TestPics folder with a 3200 x 2400 pixel .bmp file of their own and they can run your own compilex exe (or alternatively compile an exe of their own and run that) and check out the results. Here is the link to your code again: http://www.prosource.de/Temp/CountUniqueColors.zip I have not looked in detail at your own code (in fact I have just given it a cursory glance really) and so I have not myself investigated in any detail the possible reasons for the crash. That is your job. I suspect (since it only appears to crash on bitmaps that exactly fill to a 4KB boundary) that it is a problem with your code inadvertently accessing a memory byte just outside the last byte of the actual DIB data, causing a read outside the boundary of the allocated memory, but of course I am not totally sure of that and I have not investigated this memory allocation thing in depth yet and there may be other problems in your code that is causing it to crash. But one thing is certain, and that is the fact that on both my machines your code exactly as downloaded from the link you provided crashes on both a 1024 x 768 and a 3200 x 2400 pixel bitmap. If you are saying that using your own code as in the link you provided on those two pixel size bitmaps works fine on your own machine without crashing, and if you are telling the truth (which I assume you are) then perhaps there is something different about the memory allocation or something else connected with it on your own machine. Or perhaps there are some other differences, perhaps some problems in your code that may not even be related to memory allocation (my suggestion about your code accessing data outside the allocated area of memory being the problem was simply what I deduced from the fact that it seems to crash so far only on bitmaps that exactly fill to a 4KB boundary, and that needs checking out). But, whatever the reason, your code crashes here and surely you owe it to yourself to check it out on other machines Ulrich. In fact in my previous postings I have specifically invited others here in the group to download your code from your own provided link and to check it out with those size of bitmaps on their own machines. I cannot be fairer than that. Unfortunately (mostly through my own fault I will admit, because of my overly aggressive arguments with micro$oft and with dotnet evangelists) I seem to have run out of friends here in the group over the last couple of years and so nobody has yet responded (and my enemies are hardly likely to report a crash!), but hopefully some people will respond eventually. But, in the meantime, you can take it as 100 per cent that I am NOT lying about this crashing matter on both of my own machines, Ulrich, and I really do think you would be wise to check out your own code in more detail, and on as many other differently configured machines as possible. All I can say for definite is that it very definitely DOES crash here, both on my laptop and on my desktop machines, when it is dealing with either a 1024 x 768 pixel bitmap or a 3200 x 2400 pixel bitmap. It works fine on your own small bitmap you included with your code, but it crashes on the sizes of bitmap I have mentioned (and quite probably on the other bitmap sizes I have previously mentioned). In fact I have my daughter's laptop here with me for repairs, so when I have got it up and running for her I will test your code on that machine as well. Also I purchased a new desktop machine for my wife only a couple of days ago, one of those HP touchscreen all-in-one desktop machines. It is running Windows 7 64 bit (whereas my other two machines are running XP and Vista, both 32 bit). Unfortunately there is a permanently lit pixel problem on the new HP so I will be taking it back to the shop today, but when I get the replacement (after a great deal of argument, I would think!) I will test your code on that machine as well. Perhaps it might not crash on a 64 bit Win7 machine? Only time will tell. I won't be able to get round to that any time soon because of needing to get my newly purchased machine and my daughter's laptop sorted out, but I will definitelt try it out when I get the time. Anyway, here is my own code (below my signature) for pasting into a Form with a Command button, and here, again, is the link to your code, Ulrich. My code should be compiled to a native code exe using Remove array Bounds Checks and Integer Overflow Checks options (so as to make it the equivalent of your own compiled exe) and both execs (my own and yours) should be run on a 1024 x 768 and on a 3200 x 2400 pixel test bitmap. (By the way, just in case anyone is thinking it, your own code crashes whether it uses advanced compile optimizations or not). http://www.prosource.de/Temp/CountUniqueColors.zip Mike Option Explicit 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 GetObject Lib "gdi32" _ Alias "GetObjectA" (ByVal hObject As Long, _ ByVal nCount As Long, lpObject As Any) As Long Private Declare Function DeleteObject Lib "gdi32" _ (ByVal hObject As Long) As Long Private Declare Function VarPtrArray Lib "msvbvm60.dll" _ Alias "VarPtr" (Ptr() As Any) As Long Private Declare Sub CopyMemory Lib "kernel32" _ Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, _ ByVal ByteLen As Long) Private Const IMAGE_BITMAP = 0 Private Const LR_LOADFROMFILE = &H10 Private Const LR_CREATEDIBSECTION As Long = &H2000 Private Const LR_VGACOLOR As Long = &H80 Private Type SAFEARRAY1D cDims As Integer fFeatures As Integer cbElements As Long cLocks As Long pvData As Long cElements As Long lLbound As Long End Type 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 SourceWidth As Long, SourceHeight As Long Private clrs(0 To 2 ^ 21 - 1) As Byte Private TwoToThePowerOf(0 To 7) As Byte Private Declare Function timeGetTime _ Lib "winmm.dll" () As Long Private Declare Function timeBeginPeriod _ Lib "winmm.dll" (ByVal uPeriod As Long) As Long Private Declare Function timeEndPeriod _ Lib "winmm.dll" (ByVal uPeriod As Long) As Long Private Sub Form_Load() timeBeginPeriod 1 ' set timer resolution Dim n As Long For n = 0 To 7 TwoToThePowerOf(n) = 2 ^ n Next n End Sub Private Function CountColours(bmpFile As String) As Long ' Note: This task can be done using just a very small ' fraction of the declarations and the code used here, ' but it is actually faster (at least in VB6) to do it ' this much more code heavy way. ' This original testbed code specifically for use on ' full colour .bmp files and should be run as a native ' code compiled exe). Dim n As Long Dim j As Long, p As Long, used As Long Dim allclrsByte As Long, bitmask As Byte Dim myDIB As Long, bmpInf As BITMAP Dim sa1 As SAFEARRAY1D, sa2 As SAFEARRAY1D Dim sa3 As SAFEARRAY1D, sa4 As SAFEARRAY1D Dim sa5 As SAFEARRAY1D, bytePos As Long Dim SourceArray1() As Long, SourceArray2() As Long Dim SourceArray3() As Long, SourceArray4() As Long Dim sourcearray5() As Byte, done As Boolean Dim z As Byte, scanline As Long, LastLine As Boolean Dim bmpLongs As Long, oddPixels As Long, scanLongs As Long Dim twelves As Long ' number of blocks of 4 pixels (12 bytes) Dim fours As Long, offset As Long ' Note: We can save about 20 milliseconds (on a 4800x3600 bmp) ' or about a millisecond or so on a 1024x768 bmp) by loading ' the data into a VB Byte array rather than using LoadImage. ' (Might do that later). myDIB = LoadImage(0&, bmpFile, _ IMAGE_BITMAP, 0, 0, _ LR_LOADFROMFILE Or LR_CREATEDIBSECTION) GetObject myDIB, Len(bmpInf), bmpInf If myDIB = 0 Or bmpInf.bmBitsPixel <> 24 Then MsgBox "Not a valid full colour 24 bit .bmp file" Exit Function End If Erase clrs() ' clear the array that tracks each colour used GetObject myDIB, Len(bmpInf), bmpInf SourceWidth = bmpInf.bmWidth SourceHeight = bmpInf.bmHeight bmpLongs = (bmpInf.bmWidthBytes \ 4) * SourceHeight ' get data for a single scanline (first just 4 pixel blocks) twelves = ((SourceWidth * 3) \ 12) ' blocks of 12 bytes fours = twelves * 3 ' blocks of 4 bytes scanLongs = bmpInf.bmWidthBytes \ 4 oddPixels = SourceWidth - twelves * 4 ' Note: Instead of using a simple array of Longs on bitmap ' data returned by GetDIBits or a Byte array on the bitmap ' data directly using three Byte reads per pixel, this ' method points four separate arrays of Longs directly at ' slightly different positions in the same single block of ' bitmap data so that we can get at each pixel (3 bytes) ' with a single read. It's a bit unusual (a lot unusual) ' in that it reads Longs from the data at positions that ' do not start on a word boundary (the 3, 6, 9 stuff below) ' but it works very well and despite all the extra required ' code it is quite fast. This method uses a lot of code to ' do what would otherwise be a simple task, and so it is ' designed to run as a native code compiled exe (as is ' standard anyway with VB6) and such code will run very ' slowly in the VB6 IDE. On Error GoTo finish With sa1 .cDims = 1 ' one dimension .cbElements = 4 ' four bytes per element (array of Longs) .lLbound = 0 ' lBound .cElements = bmpLongs ' number of elements .pvData = bmpInf.bmBits ' point array1 (Longs) at DIB data byte zero End With ' the following arrangement of SAFEARRAY structures complicates ' matters but it enables us to deal with most of the RGB pixel ' data of each horizontal scanline in groups of twelve bytes ' (4 pixels) addressing each set of pixel data as a Long, which ' speeds up the code (the remaining odd pixels of each scanline, ' those not in a group of 12 bytes, are dealt with separately) LSet sa2 = sa1: sa2.pvData = sa1.pvData + 3 ' point array2 at byte 3 LSet sa3 = sa1: sa3.pvData = sa1.pvData + 6 ' point array3 at byte 6 LSet sa4 = sa1: sa4.pvData = sa1.pvData + 9 ' point array4 at byte 9 CopyMemory ByVal VarPtrArray(SourceArray1), VarPtr(sa1), 4 ' set up CopyMemory ByVal VarPtrArray(SourceArray2), VarPtr(sa2), 4 ' arrays CopyMemory ByVal VarPtrArray(SourceArray3), VarPtr(sa3), 4 ' as above CopyMemory ByVal VarPtrArray(SourceArray4), VarPtr(sa4), 4 LSet sa5 = sa1: sa5.cbElements = 1: sa5.cElements = bmpLongs * 4 CopyMemory ByVal VarPtrArray(sourcearray5), VarPtr(sa5), 4 ' j = red : j+1 = green : j+2 = blue For scanline = 0 To SourceHeight - 1 If scanline = (SourceHeight - 1) Then LastLine = True End If ' The following block contains an identical code block ' repeated numerous times simply because for this ' type of code a call to a function would waste a lot ' of time. Also, it adds extra logic to a specific ' task that would otherwise be a simple one liner ' because it uses bits rather than bytes or booleans ' to store each used colour. This additional logic ' slows the code down, but the slowdown is more than ' offset by the speed gained from having a much ' smaller block of flag data to access so that the ' data is usually read more quickly For j = 0 To fours - 3 Step 3 p = SourceArray1(j + offset) And &HFFFFFF allclrsByte = p \ 8 bitmask = TwoToThePowerOf(7 - p Mod 8) z = clrs(allclrsByte) If (z And bitmask) = 0 Then used = used + 1 clrs(allclrsByte) = z Or bitmask End If p = SourceArray2(j + offset) And &HFFFFFF allclrsByte = p \ 8 bitmask = TwoToThePowerOf(7 - p Mod 8) z = clrs(allclrsByte) If (z And bitmask) = 0 Then used = used + 1 clrs(allclrsByte) = z Or bitmask End If p = SourceArray3(j + offset) And &HFFFFFF allclrsByte = p \ 8 bitmask = TwoToThePowerOf(7 - p Mod 8) z = clrs(allclrsByte) If (z And bitmask) = 0 Then used = used + 1 clrs(allclrsByte) = z Or bitmask End If ' Check if on last Long of last scanline because if we ' address that location as a Long using the method we ' are using to address the three bytes of data the ' last byte of the Long will be one byte outside the ' area containing the DIB, which would cause serious ' problems (we won't need to bother with this if we ' later change to loading the bmp file straight into ' a VB array instead of using the LoadImage GDI ' function because we can then load it into a slightly ' larger data area). If LastLine = True And j = (fours - 3) Then bytePos = (j + offset) * 4 + 9 p = &H10000 * sourcearray5(bytePos + 2) _ + &H100& * sourcearray5(bytePos + 1) _ + sourcearray5(bytePos) allclrsByte = p \ 8 bitmask = TwoToThePowerOf(7 - p Mod 8) z = clrs(allclrsByte) If (z And bitmask) = 0 Then used = used + 1 clrs(allclrsByte) = z Or bitmask End If Else p = SourceArray4(j + offset) And &HFFFFFF allclrsByte = p \ 8 bitmask = TwoToThePowerOf(7 - p Mod 8) z = clrs(allclrsByte) If (z And bitmask) = 0 Then used = used + 1 clrs(allclrsByte) = z Or bitmask End If End If ' Next j If oddPixels > 0 Then ' here we need to do the odd pixels (not in groups ' of 12) at end of each scanline ' the number of of pixels is in the variable oddPixels bytePos = (j + offset + 3) * 4 For n = 0 To oddPixels - 1 p = &H10000 * sourcearray5(bytePos + 2) _ + &H100& * sourcearray5(bytePos + 1) _ + sourcearray5(bytePos) allclrsByte = p \ 8 bitmask = TwoToThePowerOf(7 - p Mod 8) z = clrs(allclrsByte) If (z And bitmask) = 0 Then used = used + 1 clrs(allclrsByte) = z Or bitmask End If bytePos = bytePos + 3 Next n End If Next j offset = offset + scanLongs ' offset next scanline Next scanline CountColours = used: done = True finish: ' release arrays CopyMemory ByVal VarPtrArray(SourceArray1), 0&, 4 CopyMemory ByVal VarPtrArray(SourceArray2), 0&, 4 CopyMemory ByVal VarPtrArray(SourceArray3), 0&, 4 CopyMemory ByVal VarPtrArray(SourceArray4), 0&, 4 CopyMemory ByVal VarPtrArray(sourcearray5), 0&, 4 DeleteObject myDIB If Not done Then CountColours = 0 End Function Private Sub Command1_Click() Dim tStart As Long, tFinish As Long Dim s1 As String, UniqueColours As Long tStart = timeGetTime UniqueColours = CountColours("c:\temp\testpic.bmp") tFinish = timeGetTime If UniqueColours > 0 Then s1 = Format(SourceWidth) & " x " & Format(SourceHeight) _ & " pixel bmp file containing " & Format(UniqueColours) _ & " unique colours (" & Format(tFinish - tStart, "0.0") _ & " milliseconds)" MsgBox s1 Else MsgBox "Error dealing with bmp file" End If End Sub
From: Ulrich Korndoerfer on 16 Jul 2010 06:02 Mike Williams schrieb: > > "Ulrich Korndoerfer" <ulrich_wants_nospam(a)prosource.de> wrote in message > news:i1o9t9$el4$1(a)online.de... > >> I did not test on a 3200x2400 bitmap. That should not be >> necessary, because a 1024x768 bitmap fulfills the same >> condition. So if your suspection, that this causes a crash >> when accessing the last pixel without taking special mesures, >> it should crash on 1024x768 bitmaps too. > > But on my own two machines your code DOES crash on a 1024 x 768 bitmap! > I specifically mentioned that size (and various other sizes, including a > 3200 x 2400 bitmap) in my very first post about the crashing of your > code. And it also DOES crashes on a 3200 x 2400 pixel bitmap. I am not a > fool, Ulrich, and I am NOT lying about the crashes! > > I just happened to have tested it on a 3200 x 2400 bitmap when I sent > the message to which you have just responded, and it CRASHED on that > bitmap, so i asked you to test it on such a sized bitmap. Also, on both > of my own machines your app CRASHES on both a 1024 x 768 bitmap and on a > 3200 x 2400 pixel bitmap. In fact I am on my Vista 32 bit desktop > machine at the moment and I have just this minute downloaded a fresh > copy of your code from the link you provided and all I did was replace > your own small testpic.bmp with a newly created 1024 x 768 pixel bitmap > that I created in MS Paint. I then ran your code simply by double > clicking your own compiled exe, just to make sure that I was running > exactly what you had compiled yourself, and it CRASHED. I then created > two different 1024 x 768 pixel bitmaps in two other quite different > programs and I tried it with those. Again, in both cases, it CRASHED. I > then repeated all those tests on a 3200 x 2400 pixel bitmap, and in all > cases it CRASHED AGAIN. I am NOT lying about this, Ulrich! Why don't you > just believe me, and check things out further yourself, perhaps on the > machines of other people you might know, specifically on machines that > might be differently configured and running different vesions of the OS > than your own. > > My own originally posted code (copy of which is below my signature) > works fine on both of those sizes of bitmap. Anyone who is interested > can paste my own code (below my signature) into a VB Form containing a > Command Button and change the hard coded path to a 3200 x 2400 pixel > .bmp file and compile it to a native code exe (using the same advanced > optimizations of remove array bounds and overflow checks that you are > using yourself) and check it out. Then, if they wish, they can go to > your own provided link and download your own code and replace the > testpic.bmp file in your TestPics folder with a 3200 x 2400 pixel .bmp > file of their own and they can run your own compilex exe (or > alternatively compile an exe of their own and run that) and check out > the results. Here is the link to your code again: > > http://www.prosource.de/Temp/CountUniqueColors.zip > > I have not looked in detail at your own code (in fact I have just given > it a cursory glance really) and so I have not myself investigated in any > detail the possible reasons for the crash. That is your job. I suspect > (since it only appears to crash on bitmaps that exactly fill to a 4KB > boundary) that it is a problem with your code inadvertently accessing a > memory byte just outside the last byte of the actual DIB data, causing a > read outside the boundary of the allocated memory, but of course I am > not totally sure of that and I have not investigated this memory > allocation thing in depth yet and there may be other problems in your > code that is causing it to crash. But one thing is certain, and that is > the fact that on both my machines your code exactly as downloaded from > the link you provided crashes on both a 1024 x 768 and a 3200 x 2400 > pixel bitmap. > > If you are saying that using your own code as in the link you provided > on those two pixel size bitmaps works fine on your own machine without > crashing, and if you are telling the truth (which I assume you are) then > perhaps there is something different about the memory allocation or > something else connected with it on your own machine. Or perhaps there > are some other differences, perhaps some problems in your code that may > not even be related to memory allocation (my suggestion about your code > accessing data outside the allocated area of memory being the problem > was simply what I deduced from the fact that it seems to crash so far > only on bitmaps that exactly fill to a 4KB boundary, and that needs > checking out). But, whatever the reason, your code crashes here and > surely you owe it to yourself to check it out on other machines Ulrich. > > In fact in my previous postings I have specifically invited others here > in the group to download your code from your own provided link and to > check it out with those size of bitmaps on their own machines. I cannot > be fairer than that. Unfortunately (mostly through my own fault I will > admit, because of my overly aggressive arguments with micro$oft and with > dotnet evangelists) I seem to have run out of friends here in the group > over the last couple of years and so nobody has yet responded (and my > enemies are hardly likely to report a crash!), but hopefully some people > will respond eventually. But, in the meantime, you can take it as 100 > per cent that I am NOT lying about this crashing matter on both of my > own machines, Ulrich, and I really do think you would be wise to check > out your own code in more detail, and on as many other differently > configured machines as possible. All I can say for definite is that it > very definitely DOES crash here, both on my laptop and on my desktop > machines, when it is dealing with either a 1024 x 768 pixel bitmap or a > 3200 x 2400 pixel bitmap. It works fine on your own small bitmap you > included with your code, but it crashes on the sizes of bitmap I have > mentioned (and quite probably on the other bitmap sizes I have > previously mentioned). > > In fact I have my daughter's laptop here with me for repairs, so when I > have got it up and running for her I will test your code on that machine > as well. Also I purchased a new desktop machine for my wife only a > couple of days ago, one of those HP touchscreen all-in-one desktop > machines. It is running Windows 7 64 bit (whereas my other two machines > are running XP and Vista, both 32 bit). Unfortunately there is a > permanently lit pixel problem on the new HP so I will be taking it back > to the shop today, but when I get the replacement (after a great deal of > argument, I would think!) I will test your code on that machine as well. > Perhaps it might not crash on a 64 bit Win7 machine? Only time will > tell. I won't be able to get round to that any time soon because of > needing to get my newly purchased machine and my daughter's laptop > sorted out, but I will definitelt try it out when I get the time. > > Anyway, here is my own code (below my signature) for pasting into a Form > with a Command button, and here, again, is the link to your code, > Ulrich. My code should be compiled to a native code exe using Remove > array Bounds Checks and Integer Overflow Checks options (so as to make > it the equivalent of your own compiled exe) and both execs (my own and > yours) should be run on a 1024 x 768 and on a 3200 x 2400 pixel test > bitmap. (By the way, just in case anyone is thinking it, your own code > crashes whether it uses advanced compile optimizations or not). > > http://www.prosource.de/Temp/CountUniqueColors.zip > > Mike > > Option Explicit > 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 GetObject Lib "gdi32" _ > Alias "GetObjectA" (ByVal hObject As Long, _ > ByVal nCount As Long, lpObject As Any) As Long > Private Declare Function DeleteObject Lib "gdi32" _ > (ByVal hObject As Long) As Long > Private Declare Function VarPtrArray Lib "msvbvm60.dll" _ > Alias "VarPtr" (Ptr() As Any) As Long > Private Declare Sub CopyMemory Lib "kernel32" _ > Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, _ > ByVal ByteLen As Long) > Private Const IMAGE_BITMAP = 0 > Private Const LR_LOADFROMFILE = &H10 > Private Const LR_CREATEDIBSECTION As Long = &H2000 > Private Const LR_VGACOLOR As Long = &H80 > Private Type SAFEARRAY1D > cDims As Integer > fFeatures As Integer > cbElements As Long > cLocks As Long > pvData As Long > cElements As Long > lLbound As Long > End Type > 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 SourceWidth As Long, SourceHeight As Long > Private clrs(0 To 2 ^ 21 - 1) As Byte > Private TwoToThePowerOf(0 To 7) As Byte > Private Declare Function timeGetTime _ > Lib "winmm.dll" () As Long > Private Declare Function timeBeginPeriod _ > Lib "winmm.dll" (ByVal uPeriod As Long) As Long > Private Declare Function timeEndPeriod _ > Lib "winmm.dll" (ByVal uPeriod As Long) As Long > > Private Sub Form_Load() > timeBeginPeriod 1 ' set timer resolution > Dim n As Long > For n = 0 To 7 > TwoToThePowerOf(n) = 2 ^ n > Next n > End Sub > > Private Function CountColours(bmpFile As String) As Long > ' Note: This task can be done using just a very small > ' fraction of the declarations and the code used here, > ' but it is actually faster (at least in VB6) to do it > ' this much more code heavy way. > ' This original testbed code specifically for use on > ' full colour .bmp files and should be run as a native > ' code compiled exe). > Dim n As Long > Dim j As Long, p As Long, used As Long > Dim allclrsByte As Long, bitmask As Byte > Dim myDIB As Long, bmpInf As BITMAP > Dim sa1 As SAFEARRAY1D, sa2 As SAFEARRAY1D > Dim sa3 As SAFEARRAY1D, sa4 As SAFEARRAY1D > Dim sa5 As SAFEARRAY1D, bytePos As Long > Dim SourceArray1() As Long, SourceArray2() As Long > Dim SourceArray3() As Long, SourceArray4() As Long > Dim sourcearray5() As Byte, done As Boolean > Dim z As Byte, scanline As Long, LastLine As Boolean > Dim bmpLongs As Long, oddPixels As Long, scanLongs As Long > Dim twelves As Long ' number of blocks of 4 pixels (12 bytes) > Dim fours As Long, offset As Long > ' Note: We can save about 20 milliseconds (on a 4800x3600 bmp) > ' or about a millisecond or so on a 1024x768 bmp) by loading > ' the data into a VB Byte array rather than using LoadImage. > ' (Might do that later). > myDIB = LoadImage(0&, bmpFile, _ > IMAGE_BITMAP, 0, 0, _ > LR_LOADFROMFILE Or LR_CREATEDIBSECTION) > GetObject myDIB, Len(bmpInf), bmpInf > If myDIB = 0 Or bmpInf.bmBitsPixel <> 24 Then > MsgBox "Not a valid full colour 24 bit .bmp file" > Exit Function > End If > Erase clrs() ' clear the array that tracks each colour used > GetObject myDIB, Len(bmpInf), bmpInf > SourceWidth = bmpInf.bmWidth > SourceHeight = bmpInf.bmHeight > bmpLongs = (bmpInf.bmWidthBytes \ 4) * SourceHeight > ' get data for a single scanline (first just 4 pixel blocks) > twelves = ((SourceWidth * 3) \ 12) ' blocks of 12 bytes > fours = twelves * 3 ' blocks of 4 bytes > scanLongs = bmpInf.bmWidthBytes \ 4 > oddPixels = SourceWidth - twelves * 4 > ' Note: Instead of using a simple array of Longs on bitmap > ' data returned by GetDIBits or a Byte array on the bitmap > ' data directly using three Byte reads per pixel, this > ' method points four separate arrays of Longs directly at > ' slightly different positions in the same single block of > ' bitmap data so that we can get at each pixel (3 bytes) > ' with a single read. It's a bit unusual (a lot unusual) > ' in that it reads Longs from the data at positions that > ' do not start on a word boundary (the 3, 6, 9 stuff below) > ' but it works very well and despite all the extra required > ' code it is quite fast. This method uses a lot of code to > ' do what would otherwise be a simple task, and so it is > ' designed to run as a native code compiled exe (as is > ' standard anyway with VB6) and such code will run very > ' slowly in the VB6 IDE. > On Error GoTo finish > With sa1 > .cDims = 1 ' one dimension > .cbElements = 4 ' four bytes per element (array of Longs) > .lLbound = 0 ' lBound > .cElements = bmpLongs ' number of elements > .pvData = bmpInf.bmBits ' point array1 (Longs) at DIB data byte zero > End With > ' the following arrangement of SAFEARRAY structures complicates > ' matters but it enables us to deal with most of the RGB pixel > ' data of each horizontal scanline in groups of twelve bytes > ' (4 pixels) addressing each set of pixel data as a Long, which > ' speeds up the code (the remaining odd pixels of each scanline, > ' those not in a group of 12 bytes, are dealt with separately) > LSet sa2 = sa1: sa2.pvData = sa1.pvData + 3 ' point array2 at byte 3 > LSet sa3 = sa1: sa3.pvData = sa1.pvData + 6 ' point array3 at byte 6 > LSet sa4 = sa1: sa4.pvData = sa1.pvData + 9 ' point array4 at byte 9 > CopyMemory ByVal VarPtrArray(SourceArray1), VarPtr(sa1), 4 ' set up > CopyMemory ByVal VarPtrArray(SourceArray2), VarPtr(sa2), 4 ' arrays > CopyMemory ByVal VarPtrArray(SourceArray3), VarPtr(sa3), 4 ' as above > CopyMemory ByVal VarPtrArray(SourceArray4), VarPtr(sa4), 4 > LSet sa5 = sa1: sa5.cbElements = 1: sa5.cElements = bmpLongs * 4 > CopyMemory ByVal VarPtrArray(sourcearray5), VarPtr(sa5), 4 > ' j = red : j+1 = green : j+2 = blue > For scanline = 0 To SourceHeight - 1 > If scanline = (SourceHeight - 1) Then > LastLine = True > End If > ' The following block contains an identical code block > ' repeated numerous times simply because for this > ' type of code a call to a function would waste a lot > ' of time. Also, it adds extra logic to a specific > ' task that would otherwise be a simple one liner > ' because it uses bits rather than bytes or booleans > ' to store each used colour. This additional logic > ' slows the code down, but the slowdown is more than > ' offset by the speed gained from having a much > ' smaller block of flag data to access so that the > ' data is usually read more quickly > For j = 0 To fours - 3 Step 3 > p = SourceArray1(j + offset) And &HFFFFFF > allclrsByte = p \ 8 > bitmask = TwoToThePowerOf(7 - p Mod 8) > z = clrs(allclrsByte) > If (z And bitmask) = 0 Then > used = used + 1 > clrs(allclrsByte) = z Or bitmask > End If > p = SourceArray2(j + offset) And &HFFFFFF > allclrsByte = p \ 8 > bitmask = TwoToThePowerOf(7 - p Mod 8) > z = clrs(allclrsByte) > If (z And bitmask) = 0 Then > used = used + 1 > clrs(allclrsByte) = z Or bitmask > End If > p = SourceArray3(j + offset) And &HFFFFFF > allclrsByte = p \ 8 > bitmask = TwoToThePowerOf(7 - p Mod 8) > z = clrs(allclrsByte) > If (z And bitmask) = 0 Then > used = used + 1 > clrs(allclrsByte) = z Or bitmask > End If > ' Check if on last Long of last scanline because if we > ' address that location as a Long using the method we > ' are using to address the three bytes of data the > ' last byte of the Long will be one byte outside the > ' area containing the DIB, which would cause serious > ' problems (we won't need to bother with this if we > ' later change to loading the bmp file straight into > ' a VB array instead of using the LoadImage GDI > ' function because we can then load it into a slightly > ' larger data area). > If LastLine = True And j = (fours - 3) Then > bytePos = (j + offset) * 4 + 9 > p = &H10000 * sourcearray5(bytePos + 2) _ > + &H100& * sourcearray5(bytePos + 1) _ > + sourcearray5(bytePos) > allclrsByte = p \ 8 > bitmask = TwoToThePowerOf(7 - p Mod 8) > z = clrs(allclrsByte) > If (z And bitmask) = 0 Then > used = used + 1 > clrs(allclrsByte) = z Or bitmask > End If > Else > p = SourceArray4(j + offset) And &HFFFFFF > allclrsByte = p \ 8 > bitmask = TwoToThePowerOf(7 - p Mod 8) > z = clrs(allclrsByte) > If (z And bitmask) = 0 Then > used = used + 1 > clrs(allclrsByte) = z Or bitmask > End If > End If > ' Next j > If oddPixels > 0 Then > ' here we need to do the odd pixels (not in groups > ' of 12) at end of each scanline > ' the number of of pixels is in the variable oddPixels > bytePos = (j + offset + 3) * 4 > For n = 0 To oddPixels - 1 > p = &H10000 * sourcearray5(bytePos + 2) _ > + &H100& * sourcearray5(bytePos + 1) _ > + sourcearray5(bytePos) > allclrsByte = p \ 8 > bitmask = TwoToThePowerOf(7 - p Mod 8) > z = clrs(allclrsByte) > If (z And bitmask) = 0 Then > used = used + 1 > clrs(allclrsByte) = z Or bitmask > End If > bytePos = bytePos + 3 > Next n > End If > Next j > offset = offset + scanLongs ' offset next scanline > Next scanline > CountColours = used: done = True > finish: > ' release arrays > CopyMemory ByVal VarPtrArray(SourceArray1), 0&, 4 > CopyMemory ByVal VarPtrArray(SourceArray2), 0&, 4 > CopyMemory ByVal VarPtrArray(SourceArray3), 0&, 4 > CopyMemory ByVal VarPtrArray(SourceArray4), 0&, 4 > CopyMemory ByVal VarPtrArray(sourcearray5), 0&, 4 > DeleteObject myDIB > If Not done Then CountColours = 0 > End Function > > Private Sub Command1_Click() > Dim tStart As Long, tFinish As Long > Dim s1 As String, UniqueColours As Long > tStart = timeGetTime > UniqueColours = CountColours("c:\temp\testpic.bmp") > tFinish = timeGetTime > If UniqueColours > 0 Then > s1 = Format(SourceWidth) & " x " & Format(SourceHeight) _ > & " pixel bmp file containing " & Format(UniqueColours) _ > & " unique colours (" & Format(tFinish - tStart, "0.0") _ > & " milliseconds)" > MsgBox s1 > Else > MsgBox "Error dealing with bmp file" > End If > End Sub > > > Sorry, but this discussion gets rather annoying. You should cure your paranoia. All I said, was, that my code, if it is compiled with LASTPIXELSPECIALTREATMENT set to 1, such treating the last pixel access not special, does not crash on 1024x768 bitmaps on my system. I did not call you a lyer and had no reason to SHOUT. This is my last post to you. EOT -- Ulrich Korndoerfer VB tips, helpers, solutions -> http://www.prosource.de/Downloads/ MS Newsgruppen Alternativen -> http://www.prosource.de/ms-ng-umzug.html
From: senn on 16 Jul 2010 06:21 "Mike Williams" <Mike(a)WhiskyAndCoke.com> skrev i en meddelelse news:i1p4c2$d1s$1(a)speranza.aioe.org... > > "Ulrich Korndoerfer" <ulrich_wants_nospam(a)prosource.de> wrote in message > news:i1o9t9$el4$1(a)online.de... > >> I did not test on a 3200x2400 bitmap. That should not be >> necessary, because a 1024x768 bitmap fulfills the same >> condition. So if your suspection, that this causes a crash >> when accessing the last pixel without taking special mesures, >> it should crash on 1024x768 bitmaps too. > > But on my own two machines your code DOES crash on a 1024 x 768 bitmap! I > specifically mentioned that size (and various other sizes, including a > 3200 x 2400 bitmap) in my very first post about the crashing of your code. > And it also DOES crashes on a 3200 x 2400 pixel bitmap. I am not a fool, > Ulrich, and I am NOT lying about the crashes! > > I just happened to have tested it on a 3200 x 2400 bitmap when I sent the > message to which you have just responded, and it CRASHED on that bitmap, > so i asked you to test it on such a sized bitmap. Also, on both of my own > machines your app CRASHES on both a 1024 x 768 bitmap and on a 3200 x 2400 > pixel bitmap. In fact I am on my Vista 32 bit desktop machine at the > moment and I have just this minute downloaded a fresh copy of your code > from the link you provided and all I did was replace your own small > testpic.bmp with a newly created 1024 x 768 pixel bitmap that I created in > MS Paint. I then ran your code simply by double clicking your own compiled > exe, just to make sure that I was running exactly what you had compiled > yourself, and it CRASHED. I then created two different 1024 x 768 pixel > bitmaps in two other quite different programs and I tried it with those. > Again, in both cases, it CRASHED. I then repeated all those tests on a > 3200 x 2400 pixel bitmap, and in all cases it CRASHED AGAIN. I am NOT > lying about this, Ulrich! Why don't you just believe me, and check things > out further yourself, perhaps on the machines of other people you might > know, specifically on machines that might be differently configured and > running different vesions of the OS than your own. > > My own originally posted code (copy of which is below my signature) works > fine on both of those sizes of bitmap. Anyone who is interested can paste > my own code (below my signature) into a VB Form containing a Command > Button and change the hard coded path to a 3200 x 2400 pixel .bmp file and > compile it to a native code exe (using the same advanced optimizations of > remove array bounds and overflow checks that you are using yourself) and > check it out. Then, if they wish, they can go to your own provided link > and download your own code and replace the testpic.bmp file in your > TestPics folder with a 3200 x 2400 pixel .bmp file of their own and they > can run your own compilex exe (or alternatively compile an exe of their > own and run that) and check out the results. Here is the link to your code > again: > > http://www.prosource.de/Temp/CountUniqueColors.zip > > I have not looked in detail at your own code (in fact I have just given it > a cursory glance really) and so I have not myself investigated in any > detail the possible reasons for the crash. That is your job. I suspect > (since it only appears to crash on bitmaps that exactly fill to a 4KB > boundary) that it is a problem with your code inadvertently accessing a > memory byte just outside the last byte of the actual DIB data, causing a > read outside the boundary of the allocated memory, but of course I am not > totally sure of that and I have not investigated this memory allocation > thing in depth yet and there may be other problems in your code that is > causing it to crash. But one thing is certain, and that is the fact that > on both my machines your code exactly as downloaded from the link you > provided crashes on both a 1024 x 768 and a 3200 x 2400 pixel bitmap. > > If you are saying that using your own code as in the link you provided on > those two pixel size bitmaps works fine on your own machine without > crashing, and if you are telling the truth (which I assume you are) then > perhaps there is something different about the memory allocation or > something else connected with it on your own machine. Or perhaps there are > some other differences, perhaps some problems in your code that may not > even be related to memory allocation (my suggestion about your code > accessing data outside the allocated area of memory being the problem was > simply what I deduced from the fact that it seems to crash so far only on > bitmaps that exactly fill to a 4KB boundary, and that needs checking out). > But, whatever the reason, your code crashes here and surely you owe it to > yourself to check it out on other machines Ulrich. > > In fact in my previous postings I have specifically invited others here in > the group to download your code from your own provided link and to check > it out with those size of bitmaps on their own machines. I cannot be > fairer than that. Unfortunately (mostly through my own fault I will admit, > because of my overly aggressive arguments with micro$oft and with dotnet > evangelists) I seem to have run out of friends here in the group over the > last couple of years and so nobody has yet responded (and my enemies are > hardly likely to report a crash!), but hopefully some people will respond > eventually. But, in the meantime, you can take it as 100 per cent that I > am NOT lying about this crashing matter on both of my own machines, > Ulrich, and I really do think you would be wise to check out your own code > in more detail, and on as many other differently configured machines as > possible. All I can say for definite is that it very definitely DOES crash > here, both on my laptop and on my desktop machines, when it is dealing > with either a 1024 x 768 pixel bitmap or a 3200 x 2400 pixel bitmap. It > works fine on your own small bitmap you included with your code, but it > crashes on the sizes of bitmap I have mentioned (and quite probably on the > other bitmap sizes I have previously mentioned). > > In fact I have my daughter's laptop here with me for repairs, so when I > have got it up and running for her I will test your code on that machine > as well. Also I purchased a new desktop machine for my wife only a couple > of days ago, one of those HP touchscreen all-in-one desktop machines. It > is running Windows 7 64 bit (whereas my other two machines are running XP > and Vista, both 32 bit). Unfortunately there is a permanently lit pixel > problem on the new HP so I will be taking it back to the shop today, but > when I get the replacement (after a great deal of argument, I would > think!) I will test your code on that machine as well. Perhaps it might > not crash on a 64 bit Win7 machine? Only time will tell. I won't be able > to get round to that any time soon because of needing to get my newly > purchased machine and my daughter's laptop sorted out, but I will > definitelt try it out when I get the time. > > Anyway, here is my own code (below my signature) for pasting into a Form > with a Command button, and here, again, is the link to your code, Ulrich. > My code should be compiled to a native code exe using Remove array Bounds > Checks and Integer Overflow Checks options (so as to make it the > equivalent of your own compiled exe) and both execs (my own and yours) > should be run on a 1024 x 768 and on a 3200 x 2400 pixel test bitmap. (By > the way, just in case anyone is thinking it, your own code crashes whether > it uses advanced compile optimizations or not). > > http://www.prosource.de/Temp/CountUniqueColors.zip > > Mike Your code runs fine here on my XP-Pro machine/graphics card Asus EAH5850 installed with vb5. On those: 640 x 480 pixel bmp file containing 63963 unique colours ( 53.0 milliseconds ) 1360 x 938 pixel bmp file containing 6420 unique colours ( 127.0 milliseconds ) 1680 x 1050 pixel bmp file containing 141879 unique colours ( 184.0 milliseconds ) I have no bipmaps of the sizes you requested. Even though easy manageable, did not make them. I does not run Ulrichs. His code requires conversion to vb5. Won't spend any time on this. /se > > Option Explicit > 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 GetObject Lib "gdi32" _ > Alias "GetObjectA" (ByVal hObject As Long, _ > ByVal nCount As Long, lpObject As Any) As Long > Private Declare Function DeleteObject Lib "gdi32" _ > (ByVal hObject As Long) As Long > Private Declare Function VarPtrArray Lib "msvbvm60.dll" _ > Alias "VarPtr" (Ptr() As Any) As Long > Private Declare Sub CopyMemory Lib "kernel32" _ > Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, _ > ByVal ByteLen As Long) > Private Const IMAGE_BITMAP = 0 > Private Const LR_LOADFROMFILE = &H10 > Private Const LR_CREATEDIBSECTION As Long = &H2000 > Private Const LR_VGACOLOR As Long = &H80 > Private Type SAFEARRAY1D > cDims As Integer > fFeatures As Integer > cbElements As Long > cLocks As Long > pvData As Long > cElements As Long > lLbound As Long > End Type > 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 SourceWidth As Long, SourceHeight As Long > Private clrs(0 To 2 ^ 21 - 1) As Byte > Private TwoToThePowerOf(0 To 7) As Byte > Private Declare Function timeGetTime _ > Lib "winmm.dll" () As Long > Private Declare Function timeBeginPeriod _ > Lib "winmm.dll" (ByVal uPeriod As Long) As Long > Private Declare Function timeEndPeriod _ > Lib "winmm.dll" (ByVal uPeriod As Long) As Long > > Private Sub Form_Load() > timeBeginPeriod 1 ' set timer resolution > Dim n As Long > For n = 0 To 7 > TwoToThePowerOf(n) = 2 ^ n > Next n > End Sub > > Private Function CountColours(bmpFile As String) As Long > ' Note: This task can be done using just a very small > ' fraction of the declarations and the code used here, > ' but it is actually faster (at least in VB6) to do it > ' this much more code heavy way. > ' This original testbed code specifically for use on > ' full colour .bmp files and should be run as a native > ' code compiled exe). > Dim n As Long > Dim j As Long, p As Long, used As Long > Dim allclrsByte As Long, bitmask As Byte > Dim myDIB As Long, bmpInf As BITMAP > Dim sa1 As SAFEARRAY1D, sa2 As SAFEARRAY1D > Dim sa3 As SAFEARRAY1D, sa4 As SAFEARRAY1D > Dim sa5 As SAFEARRAY1D, bytePos As Long > Dim SourceArray1() As Long, SourceArray2() As Long > Dim SourceArray3() As Long, SourceArray4() As Long > Dim sourcearray5() As Byte, done As Boolean > Dim z As Byte, scanline As Long, LastLine As Boolean > Dim bmpLongs As Long, oddPixels As Long, scanLongs As Long > Dim twelves As Long ' number of blocks of 4 pixels (12 bytes) > Dim fours As Long, offset As Long > ' Note: We can save about 20 milliseconds (on a 4800x3600 bmp) > ' or about a millisecond or so on a 1024x768 bmp) by loading > ' the data into a VB Byte array rather than using LoadImage. > ' (Might do that later). > myDIB = LoadImage(0&, bmpFile, _ > IMAGE_BITMAP, 0, 0, _ > LR_LOADFROMFILE Or LR_CREATEDIBSECTION) > GetObject myDIB, Len(bmpInf), bmpInf > If myDIB = 0 Or bmpInf.bmBitsPixel <> 24 Then > MsgBox "Not a valid full colour 24 bit .bmp file" > Exit Function > End If > Erase clrs() ' clear the array that tracks each colour used > GetObject myDIB, Len(bmpInf), bmpInf > SourceWidth = bmpInf.bmWidth > SourceHeight = bmpInf.bmHeight > bmpLongs = (bmpInf.bmWidthBytes \ 4) * SourceHeight > ' get data for a single scanline (first just 4 pixel blocks) > twelves = ((SourceWidth * 3) \ 12) ' blocks of 12 bytes > fours = twelves * 3 ' blocks of 4 bytes > scanLongs = bmpInf.bmWidthBytes \ 4 > oddPixels = SourceWidth - twelves * 4 > ' Note: Instead of using a simple array of Longs on bitmap > ' data returned by GetDIBits or a Byte array on the bitmap > ' data directly using three Byte reads per pixel, this > ' method points four separate arrays of Longs directly at > ' slightly different positions in the same single block of > ' bitmap data so that we can get at each pixel (3 bytes) > ' with a single read. It's a bit unusual (a lot unusual) > ' in that it reads Longs from the data at positions that > ' do not start on a word boundary (the 3, 6, 9 stuff below) > ' but it works very well and despite all the extra required > ' code it is quite fast. This method uses a lot of code to > ' do what would otherwise be a simple task, and so it is > ' designed to run as a native code compiled exe (as is > ' standard anyway with VB6) and such code will run very > ' slowly in the VB6 IDE. > On Error GoTo finish > With sa1 > .cDims = 1 ' one dimension > .cbElements = 4 ' four bytes per element (array of Longs) > .lLbound = 0 ' lBound > .cElements = bmpLongs ' number of elements > .pvData = bmpInf.bmBits ' point array1 (Longs) at DIB data byte zero > End With > ' the following arrangement of SAFEARRAY structures complicates > ' matters but it enables us to deal with most of the RGB pixel > ' data of each horizontal scanline in groups of twelve bytes > ' (4 pixels) addressing each set of pixel data as a Long, which > ' speeds up the code (the remaining odd pixels of each scanline, > ' those not in a group of 12 bytes, are dealt with separately) > LSet sa2 = sa1: sa2.pvData = sa1.pvData + 3 ' point array2 at byte 3 > LSet sa3 = sa1: sa3.pvData = sa1.pvData + 6 ' point array3 at byte 6 > LSet sa4 = sa1: sa4.pvData = sa1.pvData + 9 ' point array4 at byte 9 > CopyMemory ByVal VarPtrArray(SourceArray1), VarPtr(sa1), 4 ' set up > CopyMemory ByVal VarPtrArray(SourceArray2), VarPtr(sa2), 4 ' arrays > CopyMemory ByVal VarPtrArray(SourceArray3), VarPtr(sa3), 4 ' as above > CopyMemory ByVal VarPtrArray(SourceArray4), VarPtr(sa4), 4 > LSet sa5 = sa1: sa5.cbElements = 1: sa5.cElements = bmpLongs * 4 > CopyMemory ByVal VarPtrArray(sourcearray5), VarPtr(sa5), 4 > ' j = red : j+1 = green : j+2 = blue > For scanline = 0 To SourceHeight - 1 > If scanline = (SourceHeight - 1) Then > LastLine = True > End If > ' The following block contains an identical code block > ' repeated numerous times simply because for this > ' type of code a call to a function would waste a lot > ' of time. Also, it adds extra logic to a specific > ' task that would otherwise be a simple one liner > ' because it uses bits rather than bytes or booleans > ' to store each used colour. This additional logic > ' slows the code down, but the slowdown is more than > ' offset by the speed gained from having a much > ' smaller block of flag data to access so that the > ' data is usually read more quickly > For j = 0 To fours - 3 Step 3 > p = SourceArray1(j + offset) And &HFFFFFF > allclrsByte = p \ 8 > bitmask = TwoToThePowerOf(7 - p Mod 8) > z = clrs(allclrsByte) > If (z And bitmask) = 0 Then > used = used + 1 > clrs(allclrsByte) = z Or bitmask > End If > p = SourceArray2(j + offset) And &HFFFFFF > allclrsByte = p \ 8 > bitmask = TwoToThePowerOf(7 - p Mod 8) > z = clrs(allclrsByte) > If (z And bitmask) = 0 Then > used = used + 1 > clrs(allclrsByte) = z Or bitmask > End If > p = SourceArray3(j + offset) And &HFFFFFF > allclrsByte = p \ 8 > bitmask = TwoToThePowerOf(7 - p Mod 8) > z = clrs(allclrsByte) > If (z And bitmask) = 0 Then > used = used + 1 > clrs(allclrsByte) = z Or bitmask > End If > ' Check if on last Long of last scanline because if we > ' address that location as a Long using the method we > ' are using to address the three bytes of data the > ' last byte of the Long will be one byte outside the > ' area containing the DIB, which would cause serious > ' problems (we won't need to bother with this if we > ' later change to loading the bmp file straight into > ' a VB array instead of using the LoadImage GDI > ' function because we can then load it into a slightly > ' larger data area). > If LastLine = True And j = (fours - 3) Then > bytePos = (j + offset) * 4 + 9 > p = &H10000 * sourcearray5(bytePos + 2) _ > + &H100& * sourcearray5(bytePos + 1) _ > + sourcearray5(bytePos) > allclrsByte = p \ 8 > bitmask = TwoToThePowerOf(7 - p Mod 8) > z = clrs(allclrsByte) > If (z And bitmask) = 0 Then > used = used + 1 > clrs(allclrsByte) = z Or bitmask > End If > Else > p = SourceArray4(j + offset) And &HFFFFFF > allclrsByte = p \ 8 > bitmask = TwoToThePowerOf(7 - p Mod 8) > z = clrs(allclrsByte) > If (z And bitmask) = 0 Then > used = used + 1 > clrs(allclrsByte) = z Or bitmask > End If > End If > ' Next j > If oddPixels > 0 Then > ' here we need to do the odd pixels (not in groups > ' of 12) at end of each scanline > ' the number of of pixels is in the variable oddPixels > bytePos = (j + offset + 3) * 4 > For n = 0 To oddPixels - 1 > p = &H10000 * sourcearray5(bytePos + 2) _ > + &H100& * sourcearray5(bytePos + 1) _ > + sourcearray5(bytePos) > allclrsByte = p \ 8 > bitmask = TwoToThePowerOf(7 - p Mod 8) > z = clrs(allclrsByte) > If (z And bitmask) = 0 Then > used = used + 1 > clrs(allclrsByte) = z Or bitmask > End If > bytePos = bytePos + 3 > Next n > End If > Next j > offset = offset + scanLongs ' offset next scanline > Next scanline > CountColours = used: done = True > finish: > ' release arrays > CopyMemory ByVal VarPtrArray(SourceArray1), 0&, 4 > CopyMemory ByVal VarPtrArray(SourceArray2), 0&, 4 > CopyMemory ByVal VarPtrArray(SourceArray3), 0&, 4 > CopyMemory ByVal VarPtrArray(SourceArray4), 0&, 4 > CopyMemory ByVal VarPtrArray(sourcearray5), 0&, 4 > DeleteObject myDIB > If Not done Then CountColours = 0 > End Function > > Private Sub Command1_Click() > Dim tStart As Long, tFinish As Long > Dim s1 As String, UniqueColours As Long > tStart = timeGetTime > UniqueColours = CountColours("c:\temp\testpic.bmp") > tFinish = timeGetTime > If UniqueColours > 0 Then > s1 = Format(SourceWidth) & " x " & Format(SourceHeight) _ > & " pixel bmp file containing " & Format(UniqueColours) _ > & " unique colours (" & Format(tFinish - tStart, "0.0") _ > & " milliseconds)" > MsgBox s1 > Else > MsgBox "Error dealing with bmp file" > End If > End Sub > > >
From: senn on 16 Jul 2010 06:31 "Ulrich Korndoerfer" <ulrich_wants_nospam(a)prosource.de> skrev i en meddelelse news:i1pann$41o$1(a)online.de... > Sorry, but this discussion gets rather annoying. You should cure your > paranoia. > > All I said, was, that my code, if it is compiled with > LASTPIXELSPECIALTREATMENT set to 1, such treating the last pixel access > not special, does not crash on 1024x768 bitmaps on my system. I did not > call you a lyer and had no reason to SHOUT. > > This is my last post to you. EOT > > -- > Ulrich Korndoerfer > > VB tips, helpers, solutions -> http://www.prosource.de/Downloads/ > MS Newsgruppen Alternativen -> http://www.prosource.de/ms-ng-umzug.html In this case, the paranoia came from you, quite clear. More than this; you're the SHOUTER !. /se
From: senn on 16 Jul 2010 06:42
Forgot: Raned it not compiled. The CPU is an E8600 3.3GHz. |