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

[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