|
-
Oct 14th, 2001, 12:01 PM
#1
Thread Starter
Frenzied Member
Error!!!
Hey every1,
I'm haveing a problem with this code:
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
I get a 'bad record number error' on the line marked error in bold...
THanx for any help!!!
Squirrly1
Now happily married and still crankin' away at the keyboard.  Life is grand for a coder, no?
-
Oct 14th, 2001, 12:03 PM
#2
PowerPoster
You need to put hash marks (#) before every occurance of intBMPFile, except when in something like lof, .e.g
VB Code:
Open strFileName For Binary Access Read Lock Write As [b]#intBMPFile[/b]
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|