none
Extract image data from a bitmap image in VB 6.0 HELP!!

    Question

  • Hi there, 

    I am trying to extract the image data from a bitmap file - i.e. delete the image's BMP header.

    In my project, I am able to load the bitmap image file and display its header data in TextBoxes- i.e. file size, bitmap data offset, width/height, bit count and few others... 

    However, when it comes to saving the image data, only the image's header is saved which I understand is because of the code that I am using that assigns/assumes values BUT this is the opposite outcome that I want to achieve.

    I would like to 'extract' the BMP image header and save ONLY the image data - i.e. raw image data.

    Here is the code that I am using to 'create' the new 'head-less' BMP file. I need a way of some how calling the image that is displayed in a PictureBox and try and come up with the correct code to save this bmp file without its header. 

    I thank you for your time and help in advance,

    IP

    '*************************************************************************
    ' Create a bmp file without its header
    '*************************************************************************
    Public Sub pCreateBMPImage(pstrPaletteFile As String, _
                                pstrRawData As String, _
                                pstrImageName)
    
         Dim BMPHeader As winBMPFileHeader
         Dim BMPInfo As BITMAPINFOHEADER
         Dim BMPPalette As BITMAPPalette
         Dim pbytColor As Byte
         Dim pdblCounter As Double
              
         Open pstrImageName For Binary As #2
         
         'assign values
         BMPHeader.strFileType = "BM"
         BMPHeader.lngFileSize = 0
         BMPHeader.bytReserved1 = 0
         BMPHeader.bytReserved2 = 0
         BMPHeader.lngBitmapOffset = 54
         
         BMPInfo.biSize = 40
         BMPInfo.biWidth = 10
         BMPInfo.biHeight = 10
         BMPInfo.biPlanes = 1
         BMPInfo.byBitCount = 24
         BMPInfo.biCompression = 0
         BMPInfo.biSizeImage = 0
         BMPInfo.biXPelsPerMeter = 3780
         BMPInfo.biYPelsPerMeter = 3780
         BMPInfo.biClrUsed = 0
         BMPInfo.biClrImportant = 0
              
         'save file header
         Put #2, , BMPHeader
         
         'save info header
         Put #2, , BMPInfo
              
         'it is easier for me to open the pallette file up seperately
         'the data stored in the file is 4 bytes (red, green, blue,
         'reserved) 256 times. I do have a seperate program to edit a
         'pallette file.
         'get a palette and save the palette in this new file
         
         Open fstrFileName(pstrPaletteFile) For Binary As #3
         For pdblCounter = 1 To (BMPHeader.lngBitmapOffset - 54) / Len(BMPPalette)
              Get #3, , BMPPalette
              Put #2, , BMPPalette
         Next pdblCounter
         Close #3
         
         'The raw data file contains a value for each pixel. The value corresponds
         'to the index number for the palette entry. This is the raw data I used to make
         'this image.
         Dim rawData(100, 100) As Byte
         Dim intColumn As Integer, intRow As Integer
         
         Open fstrFileName(pstrRawData) For Input As #4
         
        'Fill array with raw data
        For intRow = 1 To 100
        For intColumn = 1 To 100
        Input #4, rawData(intColumn, intRow)
            
        Next intColumn
        Next intRow
        pdblCounter = 0
        'you need to write the rows from the bottom up
        For intRow = 100 To 1 Step -1
        For intColumn = 1 To 100
        Put #2, , rawData(intColumn, intRow)
        pdblCounter = pdblCounter + 1
              
        'each row of data must be divisible by 4, if not you need to pad the row.
        If pdblCounter = BMPInfo.biWidth Then
            If BMPInfo.biWidth \ 4 <> 0 Then
              For pdblCounter = 1 To BMPInfo.biWidth Mod 4
                  pbytColor = 0
                  Put #2, , pbytColor
                  Next pdblCounter
                  pdblCounter = 0
            End If
        End If
            
        Next intColumn
        Next intRow
        Close
         
        Exit Sub
    End Sub

    Monday, February 16, 2015 3:39 PM

Answers

All replies