Hey every1,
I'm haveing a problem with this code:
I get a 'bad record number error' on the line marked error in bold...Code:Option Explicit 'API Declare Function StretchDIBits Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal wSrcWidth As Long, ByVal wSrcHeight As Long, lpBits As Any, lpBitsInfo As BITMAPINFO, ByVal wUsage As Long, ByVal dwRop As Long) As Long Global Const SRCCOPY = &HCC0020 Global Const DIB_RGB_COLORS = 0 'Bitmap file format structures Type BITMAPFILEHEADER bfType As Integer bfSize As Long bfReserved1 As Integer bfReserved2 As Integer bfOffBits As Long End Type Type BITMAPINFOHEADER biSize As Long biWidth As Long biHeight As Long biPlanes As Integer biBitCount As Integer biCompression As Long biSizeImage As Long biXPelsPerMeter As Long biYPelsPerMeter As Long biClrUsed As Long biClrImportant As Long End Type Type RGBQUAD rgbBlue As Byte rgbGreen As Byte rgbRed As Byte rgbReserved As Byte End Type Type BITMAPINFO bmiHeader As BITMAPINFOHEADER bmiColors(0 To 255) As RGBQUAD End Type Global gudtBMPFileHeader As BITMAPFILEHEADER 'Holds the file header Global gudtBMPInfo As BITMAPINFO 'Holds the bitmap info Global gudtBMPData() As Byte 'Holds the pixel data Sub ExtractData(strFileName As String, lngOffset As Long) Dim intBMPFile As Integer Dim i As Integer 'Init variables Erase gudtBMPInfo.bmiColors 'Open the bitmap intBMPFile = FreeFile() Open strFileName For Binary Access Read Lock Write As intBMPFile 'Fill the File Header structure error: Get intBMPFile, lngOffset, gudtBMPFileHeader 'Fill the Info structure Get intBMPFile, , gudtBMPInfo.bmiHeader If gudtBMPInfo.bmiHeader.biClrUsed <> 0 Then For i = 0 To gudtBMPInfo.bmiHeader.biClrUsed - 1 Get intBMPFile, , gudtBMPInfo.bmiColors(i).rgbBlue Get intBMPFile, , gudtBMPInfo.bmiColors(i).rgbGreen Get intBMPFile, , gudtBMPInfo.bmiColors(i).rgbRed Get intBMPFile, , gudtBMPInfo.bmiColors(i).rgbReserved Next i ElseIf gudtBMPInfo.bmiHeader.biBitCount = 8 Then Get intBMPFile, , gudtBMPInfo.bmiColors End If 'Size the BMPData array If gudtBMPInfo.bmiHeader.biBitCount = 8 Then ReDim gudtBMPData(FileSize(gudtBMPInfo.bmiHeader.biWidth, gudtBMPInfo.bmiHeader.biHeight)) Else ReDim gudtBMPData(gudtBMPInfo.bmiHeader.biSizeImage - 1) End If 'Fill the BMPData array Get intBMPFile, , gudtBMPData 'Ensure info is correct If gudtBMPInfo.bmiHeader.biBitCount = 8 Then gudtBMPFileHeader.bfOffBits = 1078 gudtBMPInfo.bmiHeader.biSizeImage = FileSize(gudtBMPInfo.bmiHeader.biWidth, gudtBMPInfo.bmiHeader.biHeight) gudtBMPInfo.bmiHeader.biClrUsed = 0 gudtBMPInfo.bmiHeader.biClrImportant = 0 gudtBMPInfo.bmiHeader.biXPelsPerMeter = 0 gudtBMPInfo.bmiHeader.biYPelsPerMeter = 0 End If Close intBMPFile End Sub Private Function FileSize(lngWidth As Long, lngHeight As Long) As Long 'Return the size of the image portion of the bitmap If lngWidth Mod 4 > 0 Then FileSize = ((lngWidth \ 4) + 1) * 4 * lngHeight - 1 Else FileSize = lngWidth * lngHeight - 1 End If End Function
THanx for any help!!!
Squirrly1![]()





Life is grand for a coder, no?
Reply With Quote