Re: VB3 is making my head spin!

<no.addr@xxxxxx> wrote in message news:df1g9g$m05@xxxxxxxxxxxxxx

<no.addr@xxxxxx> wrote in message news:df1g9g$m05@xxxxxxxxxxxxxx

> If it is easy [reading in a *.bmp file bit by bit in VB3
> and displaying it pixel by pixel] tell me how.

Certainly. There are loads of different ways of doing it. Presumably, going by what you have
said in your previous messages, you would prefer a method that does not use any of the various
API routines? Is that the case?

> From our point of view, compactness
> of the code is more important than speed.

Okay. That's fine. But why are you particularly interested in compactness of code? You can often
speed things up (sometimes quite dramatically) by adding a bit more code, and for such tasks as
reading bitmaps the overall size of the compiled code is not going to be very large anyway.

> Besides, this code could be separate from the main large code,
> which would just call Shell convert_bmp_to_RLE.exe, where
> the conversion program could be as ugly or inefficient as it may be.

Yep. Shelling a second VB app is suitable in many cases, and it is an easy way of getting a sort
of "multithreaded" program in VB. Your current requirement appears to be to create an 8 bit RLE
compressed bitmap from an original 24 but full colour bitmap that is held on disk as a standard
..bmp file. Is that the case? Or perhaps you want to create an 8bit RLE encoded bitmap file from
an original bitmap image that has been drawn into a VB Form or Picture Box at run time by your
own VB program (in which case the colour depth of the original will be the same as the colour
depth of the display on which your app is currently running). What colour depth are you running
at by the way (32 bit full colour or 16 bit or whatever)?

By the way, although I said "reading a bitmap file from disk pixel by pixel in VB3 is easy" I
didn't necessarily mean that the entire job (creating an 8 bit RLE compressed bitmap from it)
would also be easy. Most of the steps are fairly easy, but the task of reducing the original
colours (which may be half a million or more!) to a maximum of 256 in such a way that the
picture looks as close to the original as possible can be quite complex.

In your case though you probably don't need to worry about that specific part of the task,
because I imagine that your original drawing (as currently drawn to the Form or whatever by your
exisiting VB3 app) actually contains fewer than 256 colours anyway (although of course the VB
SavePicture method will save it as a bitmap which has the same colour depth of your display,
which going by your previous messages seems to be full colour 24 bit). If, as I suspect, your
original drawn picture contains fewer than 256 colours then you can include all of the used
colours in the new 8 bit bitmap file, and you can do it quite easily. In either case, you can
save the new 8bit bitmap using only standard VB File I/O and without using the VB SavePicture
method. Post again with full details of what you are doing, what colour depth you are running at
and how many colours there are in the "drawn" bitmap, and any other information that you think
might be relevant. The job of creating an 8 bit RLE compressed bitmap from an existing full
colour 24 bit bitmap can be done without using any API routines at all, which I think is what
you are really after.

Besides, using API routines does not guarantee success, and neither does it guarantee that you
end up with fast code (although it helps of course). As an example, have a look at the code on
the following site. It shows you how to load a full colour 24bit .bmp file from disk and count
the number of unique colours it contains (one of the tasks you will probably want to carry out
in your own program). Download it and check it out.

http://www.vbaccelerator.com/home/VB/Code/vbMedia/Image_Processing/Counting_Colours/article.asp

Now don't get me wrong, I'm not "knocking" the VB Accelerator site. I wouldn't dream of doing
such a thing. It is a brilliant site from which you can get masses of great code and I
thoroughly applaud the people who run it. I'm just pointing out this specific VB Accelerator
"count the colours" code to show you that no matter how many APIs you use you still won't
guarantee success. The VB Accelerator code works fine in that it allows you to load jpeg and
bitmap files and it counts the number of unique colours they contain. The problem is that it
only works properly (and it only produces the correct answer) when the machine you are actually
running the code on is itself running its display in full colour (32 bit) mode. If you load a
jpeg or a 24bit bitmap file and your machine happens to be running at 16bit (or less) colour
depth then it will in most cases give you the wrong answer (unless the bitmap file you are
looking at just happens to have been created originally on a machine running at lower than 32
bit colour depth). Now the VB Accelerator "count the colours" program is quite complex, and it
uses loads of fairly complex API routines, but it still comes up with the wrong answer in many
cases. Also, for the specific job that it does, it is quite slow.

In contrast, have a look at the following code. I wrote it in such a way that it doesn't use any
API routines (one of your original requirements) and at the moment it isn't really complete.
What I mean is that at the moment it handles only 24bit bmp files. It can easily be modified of
course so that it handles other formats, but at the moment it only deals with 24bit files.
Actually, the code does use a few APIs to deal with the timing, but these are not an intrinsic
part of the program (insofar as they are not necessary for it to perform its task) and they are
there simply to give you more accurate "time this code" results than you could otherwise get
using the native VB timer functions. Start a new VB project and place one List Box and two
Command Buttons on the Form. Then paste in the following code (message continues at the end of
the following code block):

' ********** FORM CODE STARTS **********
Option Explicit
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 Command1_Click()
Dim z As Long, t1 As Long, t2 As Long
Dim s1 As String, s2 As String
s1 = "c:\bitmapsamples\tulips.bmp"
t1 = timeGetTime
z = Load24bitBmpDataVB6(s1)
t2 = timeGetTime
' Note that (as is always the case when loading files from
' disk) the speed of the second and subsequent runs is
' always faster than the first run. This is because after
' the first run the required data is usually already in the
' drive's cache.
If z = 0 Then
MsgBox "not a 24 bit full colour bitmap"
Else
s2 = "Time to load bitmap into an array of Longs = " _
& Format(t2 - t1) & " milliseconds. " _
& "Number of scan lines = " & Format(z)
MsgBox s2, vbInformation
End If
End Sub

Private Sub Command2_Click()
Dim z As Long, t1 As Long, t2 As Long
Dim s1 As String, s2 As String
s1 = "c:\bitmapsamples\tulips1280 x 1024.bmp"
t1 = timeGetTime
z = countcolours(s1)
t2 = timeGetTime
If z = 0 Then
MsgBox "You must first load a bitmap by clicking Command1"
Else
s2 = "Time to count colours = " _
& Format(t2 - t1) & " milliseconds. " _
& "Number of unique colours used = " & Format(z)
MsgBox s2, vbInformation
End If
End Sub

Private Sub Form_Load()
timeBeginPeriod 1
End Sub

Private Sub Form_Unload(Cancel As Integer)
timeEndPeriod 1
End Sub
' ********** FORM CODE ENDS **********

Now add a standard code module to your VB6 project and paste the following code into the module:

' ********** MODULE CODE STARTS **********
Option Explicit
' Note(1): The bfType (integer) in the following Type
' definition actually uses 4 bytes (rather than 2).
' This is because VB5/VB6 always align Longs in a UDT
' onto 4 byte boundaries. However, the VB5/VB6 Put and
' Get statements will only write / read 2 bytes to / from
' disk.
' Note(2): The Len function will return the "length on disk"
' of the UDT (14 bytes in this case) but the LenB function
' will return the data length of the UDT (which is 16 bytes
' in this case)
Type BITMAPFILEHEADER
bfType As Integer
bfSize As Long ' do not rely on this value (use LOF instead)
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type
Type BITMAPINFOHEADER '40 bytes
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long ' do not rely on this value
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Dim fileheader As BITMAPFILEHEADER
Dim infoheader As BITMAPINFOHEADER
Dim scanlines As Long, pixwide As Long
Dim scanbytes As Long
Dim longdata() As Long
Dim allclrs(0 To 2 ^ 21 - 1) As Byte ' 24 bit "colour used" flags
Dim pixdatabytes() As Byte

Public Function Load24bitBmpDataVB6(fname As String) As Long
' Note 1: This function loads a 24 bit .bmp file from disk
' and stores the pixel data in an array of Longs. I have
' deliberately written it without using any API functions
' so that you can more easily see how such a file is
' formatted and how easy it is to read the data.
' Note 2: We really need to add code to check if the file
' exists, but I'll leave that for the time being.
' Copyright © 2005 Mike Williams
' Note 3: For maximum speed compile to native code and also
' tick the "remove array bounds check" box under advanced
' optimizations under Project / Properties / Compile.
Dim n As Long, j As Long, p As Long
Dim m1 As Long, m2 As Long, z As Long, clrsused As Long
Dim allclrsByte As Long, bitmask As Byte
Dim TwoToThePowerOf(0 To 7) As Byte
Open fname For Binary As 1
Get 1, 1, fileheader
Get 1, Len(fileheader) + 1, infoheader
If fileheader.bfType <> &H4D42 Or infoheader.biBitCount <> 24 Then
Close 1
Load24bitBmpDataVB6 = 0
Exit Function
End If
' Make the correct entry in the file size and data
' size entries, which are not always reliable.
fileheader.bfSize = LOF(1) ' maybe do this differently later
infoheader.biSizeImage = LOF(1) - fileheader.bfOffBits
'
Form1.List1.Clear
Form1.List1.AddItem "Type " & Chr$(9) & Hex(fileheader.bfType)
Form1.List1.AddItem "FileSize " & Chr$(9) & fileheader.bfSize
Form1.List1.AddItem "Pixel Width " & Chr$(9) & infoheader.biWidth
Form1.List1.AddItem "Pixel Height " & Chr$(9) & infoheader.biHeight
Form1.List1.AddItem "Bits per Pixel " & Chr$(9) & infoheader.biBitCount
Form1.List1.AddItem "Compression " & Chr$(9) & infoheader.biCompression
Form1.List1.AddItem "Bitmap Data Size " & Chr$(9) & infoheader.biSizeImage
Form1.List1.AddItem "H Pels Per Metre " & Chr$(9) & infoheader.biXPelsPerMeter
Form1.List1.AddItem "V Pels Per Metre " & Chr$(9) & infoheader.biYPelsPerMeter
Form1.List1.AddItem "Colors Used " & Chr$(9) & infoheader.biClrUsed
Form1.List1.AddItem "Important Colors " & Chr$(9) & infoheader.biClrImportant
'
scanlines = infoheader.biHeight
pixwide = infoheader.biWidth
scanbytes = pixwide * 3 ' 3 bytes per pixel
' now "round up" the value to a whole multiple of 4
' bytes (because the bmp file format does the same)
scanbytes = (Int((scanbytes - 1) / 4) + 1) * 4
Form1.List1.AddItem " "
Form1.List1.AddItem "Length of pixeldata string " & scanbytes
Form1.List1.AddItem " "
Form1.List1.AddItem "Top Left Corner Pixel Colours:"
ReDim longdata(1 To pixwide, 1 To scanlines)
' create and clear a byte array sufficient to hold one
' complete scanline of bitmap pixel data
ReDim pixdatabytes(1 To scanbytes)
m1 = &H10000
m2 = &H100
For n = 0 To 7
TwoToThePowerOf(n) = 2 ^ n
Next n
For n = 1 To scanlines
Get 1, , pixdatabytes
z = 0
For j = 1 To pixwide * 3 - 2 Step 3
z = z + 1
' convert the 3 bytes (bitmap pixel colour) into
' the equivalent Long colour
p = m1 * pixdatabytes(j) _
+ m2 * pixdatabytes(j + 1) _
+ pixdatabytes(j + 2)
longdata(z, n) = p
Next j
Next n
Form1.List1.AddItem "Blue " & Chr$(9) & _
Format(pixdatabytes(1))
Form1.List1.AddItem "Green " & Chr$(9) & _
Format(pixdatabytes(2))
Form1.List1.AddItem "Red " & Chr$(9) & _
Format(pixdatabytes(3))
Form1.List1.AddItem Hex$(longdata(scanlines, 1))
' this part displays in the ListBox the first pixel colour
' in the *last* scanline we got from the file (which is
' the *first* scanline in the actual bitmap.
Close 1
' Note(1) In the .bmp file each "horizontal scan line" of
' the bitmap pixel data is aligned on a four byte boundary
' so (for example) a full colour bitmap that is 99 pixels
' wide will need 99 * 3 = 297 bytes and each line will
' therefore use 300 bytes (to the next "four byte" boundary)
' Note (2) In the .bmp file the "horizontal scan lines" are
' stored in "upside down" order, so the first in a 24 bit
' bitmap three bytes of the first data line specify the
' colour of the first (leftmost) pixel on the *bottom* line
' of the bitmap picture.
Load24bitBmpDataVB6 = scanlines
End Function

Public Function countcolours(fname As String) As Long
Dim n As Long, j As Long, k As Long, p As Long
Dim x As Long, y As Long
Dim m1 As Long, m2 As Long, z As Long, clrsused As Long
Dim allclrsByte As Long, bitmask As Byte
Dim TwoToThePowerOf(0 To 7) As Byte
If scanlines < 1 Then
countcolours = 0
Exit Function
End If
' set all the 24 bit colour used flags to zero
Erase allclrs()
m1 = &H10000
m2 = &H100
For n = 0 To 7
TwoToThePowerOf(n) = 2 ^ n
Next n
' read each Long in the pixel data array and count the
' number of unique colours
For y = 1 To scanlines
' Note that accessing the contents of a VB array "row by
' row" as done here (with x rather than y as the inner
' loop) is *very* much faster than accessing it "column
' by column". This is because at each "read" there is a
' much greater chance of the data already being in the
' processor's data cache.
For x = 1 To pixwide
' get the pixel colour
p = longdata(x, y)
' calculate the byte number of that colour
' in the "allclrs" array of bit flags (an array
' of bytes where we use each byte to hold eight
' flags)
allclrsByte = p \ 8
' calculate a mask for the bit position in that byte
' (Note that using a 2 ^ n look up table is *very*
' much faster than actually performing 2 ^ n
bitmask = TwoToThePowerOf(7 - p Mod 8)
' check to see if the relevant bit is already set
If (allclrs(allclrsByte) And bitmask) = 0 Then
' the bit is not set, so the colour has not yet been
' counted as "used". Therefore we need to increment
' the clrsused variable . . .
clrsused = clrsused + 1
' . . . and then set the flag to 1
allclrs(allclrsByte) = allclrs(allclrsByte) Or bitmask
End If
Next x
Next y
countcolours = clrsused
End Function
' ********** MODULE CODE ENDS **********

As you can see, I've placed quite a few comments in the code so that you can see what is going
on. Before you compile the code use the Project / Project Properties menu and click the Compile
tab. Place a tick in the box against "Compile to Native Code" and "Optimize for Fast Code".
Also (on the same "Compile tab") click the Advanced Optimizations button and place a tick
against "Remove Array Bounds Checks" (you can tick other things as well here if you wish). This
stuff places the compile options of your VB6 app so that they are the same as the compile
settings of the VB Accelerator app, so that we can get a good comparison.

Oh. One more thing. Alter the "hard coded" file name / path in the Command1 Click event to point
to a full colour 24bit .bmp file that exists on your own machine. Then compile to an exe on your
desktop.

Now try compiling and running the VB Accelerator example using a reasonably large bitmap (1280 x
1024 for example) that contains lots of different colours (use a standard "digital photo" saved
as a 24 bit bitmap, for example). Check how long it takes to perform the "count the colours"
code (add some of your own timing code if you wish). Then run the compiled exe of the code that
I have posted here (using the same bitmap) and see how long it takes. I think you'll find that
as well as my own code always giving the correct result under all circumstances it also runs at
least twenty times faster than the VB Accleerator offering. Now I'm not saying that my own
method is the best way of doing the job. I'm posting the code really just so that you can see
that it is indeed possible to do such jobs without using AI functions, and that if you write
your code well you can still get acceptable speed. Once again, I'd like to point out that I am
in no way "knocking" the really excellent VB Accelerator people. They can certainly do more with
VB than I can! I'm just using one of their own code samples (which uses lots of API routines)
and showing you an alternative way of doing things which does not use any APIs at all (at least
for this very specific job). And I'm only doing that because you have said a few times in this
and other threads that you would be happier with a "non API" solution.

Obviously the above code was written using VB6 (because I don't have VB3), so it will need
modifying quite a bit to get it going in VB3, but I know that you also have VB6 yourself so you
should be able to try it out. As for converting it to VB3, you could use strings instead of Byte
arrays to load the individual scan lines (or you could use Integers and use them in a quite
different way), and you could use an array of Integers (instead of an array of Bytes) to hold
the "colour has been used" flags (although you'd have to write that part of your code in such a
way that it avoided overflow errors, because VB6 Bytes are not signed, whereas VB3 Integers are.

Anyway, check it out and if you think this is the way you would like to go then post again with
the information that I have asked for.

Now, after all that typing, it's time for a nice, cool rum and Coke®. I'm sure I saw a few
whisps of smoke drifting up from this keyboard just then ;-)

Mike




.