save(or convert) image in monochrome bitmap [RESOLVED]

[ahfatt]

Hello friends!
i'm facing a little problem and hope you guys can help.

SITUATION

i have a monochrome bitmap file called abc.bmp
i called this file in VB6 using loadpicture() and put it in a picture box. After manipulated the picture (invert and flip vertical) to another picturebox( called picBmp2), i've called the savepicture method in VB6---SavePicture(picBmp2.Image, "c:\modified.bmp")
to save the modified picture.

the problem is :
Windows did save the file but in 24-bit bitmap. But what i desired is only a 1-bit monochrome bitmap file. The original file is also in monochrome mode. This image file will send to a thermal printer(black and white) to print out. Now i can only open the MSPAINT and manually save as monochrome the modified 24-bit bitmap. It would be great if i can straight get a monochrome bitmap.

some data:
original file---- monochrome bitmap 462 bytes
bitmapOffset=62 bytes

after save-----24 bit bitmap 6454 bytes
bitmapOffset=54 bytes



Please help.
Thank you very much.

[NoteMe]

Not sure if VB can do that....maybe there is an API for it. But if not, I don't think it is sooo hard to write your own BMP saver. The format is pretty simple.

[Electroman]

Check out: My Examples Page
The example named "Bitmap File Format Example", it will show you how to save BMP file using the Binary File access in VB. I suggest you do as you have already done then open the 24bit BMP up using this method, convert it to 1bit then save again.

If you have any trouble just give me a shout and I'll do some code for you.

[ahfatt]

Hello guys, thank you for helping. After read the above example, i tried to write a monochrome bitmap saver based on the Electroman's code but i get stucked somewhere when i want to get the image data from the picture box. Hopes you guy can give me a hand.
i post the code.

Private Sub Command2_Click()
 
Dim Pos As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim color As Long
    'this is the original file's setting
    
    Pic1bit.bmih.biSize = 40
    Pic1bit.bmih.biWidth = 42
    Pic1bit.bmih.biHeight = 50
    Pic1bit.bmih.biPlanes = 1
    Pic1bit.bmih.biBitCount = 1
    Pic1bit.bmih.biCompression = 0&  ' RGB
    Pic1bit.bmih.biSizeImage = 400
    Pic1bit.bmih.biXPelsPerMeter = 3780
    Pic1bit.bmih.biYPelsPerMeter = 3780
    Pic1bit.bmih.biClrUsed = 0
    Pic1bit.bmih.biClrImportant = 0
    
    Pic1bit.bmfh.bfOffBits = 62
    
    Pic1bit.bmfh.bfType = &H4D42
    Pic1bit.bmfh.bfSize = 462
    Pic1bit.bmfh.bfReserved1 = 0
    Pic1bit.bmfh.bfReserved2 = 0
    
    
    ReDim Pic1bit.aColors(0 To 1)
    Pic1bit.aColors(0).B = 0:   Pic1bit.aColors(0).G = 0:  Pic1bit.aColors(0).R = 0:   Pic1bit.aColors(0).Reserved = 0
    Pic1bit.aColors(1).B = 255:  Pic1bit.aColors(1).G = 255:  Pic1bit.aColors(1).R = 255:   Pic1bit.aColors(1).Reserved = 0
   
    ReDim Pic1bit.aBitmapBits(0 To Pic1bit.bmih.biSizeImage - 1)
    
    For i = 0 To Pic1bit.bmih.biSizeImage - 1
      'let say i have a picture need to be save as monochrome is loaded
      'in a picture box called picBmp.
      'i think i should grab the image data from the picture box
      ' and #put it in the binary file.
      'so i've tried like this and i got stuck here........
       For j = 0 To picBmp.ScaleWidth - 1
         For k = 0 To picBmp.ScaleHeight - 1
            color = picBmp.Point(i, j)
            'stuck here.......
         Next k
       Next j
    Next
     
    Open "C:\Temp.bmp" For Binary As #1
        Put #1, , Pic1bit.bmfh
        Put #1, , Pic1bit.bmih
        Put #1, , Pic1bit.aColors
        Put #1, , Pic1bit.aBitmapBits  ' dim as byte
    Close #1
    
 
End Sub

thank you for help.

[Electroman]

The bitmap you started with should only be Black & White yes? so if there are no other colors at all you can simpily put an if statement to check if the color is black (Color=0). Then the tricky bit is that each element in the data array is going to be representing 8 pixels, so you may need to do something where the element only chnages every 8 times and inbetween that you have a number that gets halfed starting at 256 and use OR with the data & this number. I'll write some code to explain what I mean in a minute.....

[Electroman]

Here is what I have so far but I've made an error somewhere so I'm trying to figure it out at the moment:

EDIT: Code removed, see next post

The load bitmap function is in the Example you got off my site.

[Electroman]

Here we go, Fixed it:

Private Sub Convert24BitTo1Bit(ByVal iFileName As String)
Dim Bitmap24 As BITMAPFILE24Bit
Dim Bitmap As BITMAPFILE
Dim sFormat As String
Dim ScanLineLen As Long
Dim ScanLine24Len As Long
Dim Pos As Integer
Dim R As Integer
Dim G As Integer
Dim B As Integer
Dim x As Integer
Dim y As Integer
Dim CurBit As Byte
Dim TmpByte As Byte
    
    LoadBitmap iFileName, Bitmap, Bitmap24, sFormat
    
    If sFormat <> "24Bit" Then Exit Sub
    
    
    Bitmap.bmih.biSize = Len(Bitmap.bmih)
    Bitmap.bmih.biWidth = Bitmap24.bmih.biWidth
    Bitmap.bmih.biHeight = Bitmap24.bmih.biHeight
    Bitmap.bmih.biPlanes = Bitmap24.bmih.biPlanes
    Bitmap.bmih.biBitCount = 1
    Bitmap.bmih.biCompression = 0&  ' RGB
    ScanLineLen = (RoundUp((Bitmap.bmih.biWidth / 8) / 4) * 4)
    ScanLine24Len = (RoundUp((Bitmap.bmih.biWidth * 3) / 4) * 4)
    Bitmap.bmih.biSizeImage = ScanLineLen * Bitmap.bmih.biHeight
    Bitmap.bmih.biXPelsPerMeter = Bitmap24.bmih.biXPelsPerMeter
    Bitmap.bmih.biYPelsPerMeter = Bitmap24.bmih.biYPelsPerMeter
    Bitmap.bmih.biClrUsed = 2
    Bitmap.bmih.biClrImportant = 2
    
    
    Bitmap.bmfh.bfOffBits = Len(Bitmap.bmfh) + Len(Bitmap.bmih) + (Len(Bitmap.aColors(0)) * Bitmap.bmih.biClrUsed)
    
    Bitmap.bmfh.bfType = &H4D42
    Bitmap.bmfh.bfSize = Bitmap.bmfh.bfOffBits + Bitmap.bmih.biSizeImage
    Bitmap.bmfh.bfReserved1 = 0
    Bitmap.bmfh.bfReserved2 = 0
    
    
    ReDim Bitmap.aColors(0 To Bitmap.bmih.biClrUsed - 1)
    Bitmap.aColors(0).B = 0:    Bitmap.aColors(0).G = 0:    Bitmap.aColors(0).R = 0:     Bitmap.aColors(0).Reserved = 0
    Bitmap.aColors(1).B = 255:  Bitmap.aColors(1).G = 255:  Bitmap.aColors(1).R = 255:   Bitmap.aColors(1).Reserved = 0
    
    ReDim Bitmap.aBitmapBits(0 To Bitmap.bmih.biSizeImage - 1)
    
    For y = 0 To Bitmap.bmih.biHeight - 1
        
        Pos = y * ScanLineLen
        CurBit = 128
        
        For x = 0 To Bitmap.bmih.biWidth - 1
            'For every pixel in the file (x,y)...
            
            B = Bitmap24.aBitmapBits((y * ScanLine24Len) + (x * 3))
            G = Bitmap24.aBitmapBits((y * ScanLine24Len) + (x * 3) + 1)
            R = Bitmap24.aBitmapBits((y * ScanLine24Len) + (x * 3) + 2)
            
            If R = 0 And G = 0 And B = 0 Then
                'This pixel is black...
                
                'We dont really need to do this bit because by default the bits will
                'already be set to zero. I thought I'd show you how to anyway...
                
                TmpByte = 255 Xor CurBit
                Bitmap.aBitmapBits(Pos) = Bitmap.aBitmapBits(Pos) And TmpByte
                
            Else
                'This pixel is none black so we assume its white...
                
                Bitmap.aBitmapBits(Pos) = Bitmap.aBitmapBits(Pos) Or CurBit
                
            End If
            
            If CurBit = 1 Then
                CurBit = 128
                Pos = Pos + 1
            Else
                CurBit = CurBit / 2
            End If
        Next
    Next
    
    'Delete the file becuase the one we create is smaller...
    '--------------------------------------
    Kill iFileName
    '--------------------------------------
    
    Open iFileName For Binary As #1
        Put #1, , Bitmap.bmfh
        Put #1, , Bitmap.bmih
        Put #1, , Bitmap.aColors
        Put #1, , Bitmap.aBitmapBits
    Close #1
    
End Sub

[ahfatt]

Thank you a thousand times, Electroman.
Because of this problem i can't sleep well for a few nights.....
i gained quite a lot of knowledge here.
here is a bow from me....
thank you.

[Electroman]

Posted by ahfatt
Thank you a thousand times, Electroman.
Because of this problem i can't sleep well for a few nights.....
i gained quite a lot of knowledge here.
here is a bow from me....
thank you.

No worries mate .