1 .我用API创建了一个位图对象,在其中画图,然后在写成位图文件,当我将位图背景色改成RGB(255, 198, 255)保存成文件后,得到的不是RGB(255, 198, 255)颜色,是不是我的颜色表有问题?
2. 还有我将它存成16位的位图后,再文件属性中得到的字段只有(文件类型=Windows 或 OS/2位图(BMP))而其他像24,32,8位时得到的都有(文件类型=Windows3.x 位图(BMP),宽度,高度,颜色深度等),这是为什么?代码如下:Private Type BITMAPFILEHEADER
bfType As Integer
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End TypePrivate Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End TypePrivate Type BITMAPINFOHEADER '40 bytes
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 TypePrivate Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors(0 To 255) As RGBQUAD
End TypePrivate Type BITMAP '14 bytes
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End TypePrivate Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function SetDIBitsToDevice 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 Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function GetDIBColorTable Lib "gdi32" (ByVal hdc As Long, ByVal un1 As Long, ByVal un2 As Long, pRGBQuad As RGBQUAD) As LongPrivate Const DIB_RGB_COLORS = 0
Private Const DIB_PAL_COLORS = 1Private Const BI_RGB = 0&
Private Sub Command1_Click()
On Error GoTo ErrorLine: CreateBMPErrorLine:
If Err.Number <> 0 Then
Err.Raise Err.Number
Err.Clear
End If
End SubPrivate Sub load256Palette(bi As BITMAPINFO)
Dim lIndex As Long For lIndex = 0 To 255
With bi.bmiColors(lIndex)
.rgbRed = CByte(lIndex)
.rgbGreen = CByte(lIndex)
.rgbBlue = CByte(lIndex)
End With
Next lIndexEnd SubPublic Sub CreateBMP()
Dim hdr As BITMAPFILEHEADER
Dim pbih As BITMAPINFO
Dim bm As BITMAPDim buf() As Byte
Dim nDC As Long
Dim nBitmap As Long
Dim nBrush As Long
Dim r As rect
Dim nRoot As Long
Dim nOldDC As Long nRoot = GetDC(0)
nDC = CreateCompatibleDC(nRoot)
nBitmap = CreateCompatibleBitmap(nRoot, 200, 200)
nOldDC = SelectObject(nDC, nBitmap)
SetRect r, 0, 0, 200, 200
nBrush = CreateSolidBrush(RGB(255, 198, 255))
FillRect nDC, r, nBrush
Call SelectObject(nDC, nOldDC)
'得到源图像结构的信息
Call GetObjectAPI(nBitmap, Len(bm), bm)
Call load256Palette(pbih)
'///////////////////////////////////////////
'设置目标位图信息头
With pbih.bmiHeader .biSize = Len(pbih.bmiHeader)
.biWidth = bm.bmWidth
.biHeight = bm.bmHeight
.biPlanes = bm.bmPlanes
.biBitCount = 8
.biCompression = BI_RGB
.biClrImportant = 0
.biClrUsed = 255
.biSizeImage = (bm.bmWidth + bm.bmWidth Mod 4) * bm.bmHeight * 3 End With
'目标位图文件信息头
hdr.bfType = &H4D42
hdr.bfSize = Len(hdr) + Len(pbih) + pbih.bmiHeader.biSizeImage
hdr.bfReserved1 = &H0
hdr.bfReserved2 = &H0
'从文件开始到位图数据开始之间的数据(bitmap data)之间的偏移量
hdr.bfOffBits = Len(hdr) + Len(pbih) '位图文件信息长度+位图信息长度
'******************
'******************
'字节存储
ReDim buf(1 To pbih.bmiHeader.biSizeImage) As Byte
'得到位图的二进制数据(pbih.bmiHeader.biHeight等于所有(扫描行数))
Call GetDIBits(nDC, nBitmap, 0, pbih.bmiHeader.biHeight, _
buf(1), pbih, DIB_RGB_COLORS)
'******************
'****************** Dim sFileName As String
sFileName = "E:\demo\CreateBitmap\15.bmp"
If GetFileAttributes(sFileName) <> -1 Then
Kill sFileName
End If
Dim fn As Long
fn = FreeFile
Open sFileName For Binary As fn
'写位图文件信息头
Put fn, , hdr
'写位图信息头
Put fn, , pbih
'位图的二进制数据
Put fn, , buf
Close fn
'******************
'******************
DeleteObject nBrush
DeleteObject (nBitmap)
DeleteDC (nDC)
ReleaseDC 0, nRoot
On Error GoTo ErrorLine:
Picture1.Picture = LoadPicture(sFileName)
ErrorLine:
If Err.Number <> 0 Then
Err.Clear
End If
End Sub
2. 还有我将它存成16位的位图后,再文件属性中得到的字段只有(文件类型=Windows 或 OS/2位图(BMP))而其他像24,32,8位时得到的都有(文件类型=Windows3.x 位图(BMP),宽度,高度,颜色深度等),这是为什么?代码如下:Private Type BITMAPFILEHEADER
bfType As Integer
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End TypePrivate Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End TypePrivate Type BITMAPINFOHEADER '40 bytes
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 TypePrivate Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors(0 To 255) As RGBQUAD
End TypePrivate Type BITMAP '14 bytes
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End TypePrivate Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function SetDIBitsToDevice 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 Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function GetDIBColorTable Lib "gdi32" (ByVal hdc As Long, ByVal un1 As Long, ByVal un2 As Long, pRGBQuad As RGBQUAD) As LongPrivate Const DIB_RGB_COLORS = 0
Private Const DIB_PAL_COLORS = 1Private Const BI_RGB = 0&
Private Sub Command1_Click()
On Error GoTo ErrorLine: CreateBMPErrorLine:
If Err.Number <> 0 Then
Err.Raise Err.Number
Err.Clear
End If
End SubPrivate Sub load256Palette(bi As BITMAPINFO)
Dim lIndex As Long For lIndex = 0 To 255
With bi.bmiColors(lIndex)
.rgbRed = CByte(lIndex)
.rgbGreen = CByte(lIndex)
.rgbBlue = CByte(lIndex)
End With
Next lIndexEnd SubPublic Sub CreateBMP()
Dim hdr As BITMAPFILEHEADER
Dim pbih As BITMAPINFO
Dim bm As BITMAPDim buf() As Byte
Dim nDC As Long
Dim nBitmap As Long
Dim nBrush As Long
Dim r As rect
Dim nRoot As Long
Dim nOldDC As Long nRoot = GetDC(0)
nDC = CreateCompatibleDC(nRoot)
nBitmap = CreateCompatibleBitmap(nRoot, 200, 200)
nOldDC = SelectObject(nDC, nBitmap)
SetRect r, 0, 0, 200, 200
nBrush = CreateSolidBrush(RGB(255, 198, 255))
FillRect nDC, r, nBrush
Call SelectObject(nDC, nOldDC)
'得到源图像结构的信息
Call GetObjectAPI(nBitmap, Len(bm), bm)
Call load256Palette(pbih)
'///////////////////////////////////////////
'设置目标位图信息头
With pbih.bmiHeader .biSize = Len(pbih.bmiHeader)
.biWidth = bm.bmWidth
.biHeight = bm.bmHeight
.biPlanes = bm.bmPlanes
.biBitCount = 8
.biCompression = BI_RGB
.biClrImportant = 0
.biClrUsed = 255
.biSizeImage = (bm.bmWidth + bm.bmWidth Mod 4) * bm.bmHeight * 3 End With
'目标位图文件信息头
hdr.bfType = &H4D42
hdr.bfSize = Len(hdr) + Len(pbih) + pbih.bmiHeader.biSizeImage
hdr.bfReserved1 = &H0
hdr.bfReserved2 = &H0
'从文件开始到位图数据开始之间的数据(bitmap data)之间的偏移量
hdr.bfOffBits = Len(hdr) + Len(pbih) '位图文件信息长度+位图信息长度
'******************
'******************
'字节存储
ReDim buf(1 To pbih.bmiHeader.biSizeImage) As Byte
'得到位图的二进制数据(pbih.bmiHeader.biHeight等于所有(扫描行数))
Call GetDIBits(nDC, nBitmap, 0, pbih.bmiHeader.biHeight, _
buf(1), pbih, DIB_RGB_COLORS)
'******************
'****************** Dim sFileName As String
sFileName = "E:\demo\CreateBitmap\15.bmp"
If GetFileAttributes(sFileName) <> -1 Then
Kill sFileName
End If
Dim fn As Long
fn = FreeFile
Open sFileName For Binary As fn
'写位图文件信息头
Put fn, , hdr
'写位图信息头
Put fn, , pbih
'位图的二进制数据
Put fn, , buf
Close fn
'******************
'******************
DeleteObject nBrush
DeleteObject (nBitmap)
DeleteDC (nDC)
ReleaseDC 0, nRoot
On Error GoTo ErrorLine:
Picture1.Picture = LoadPicture(sFileName)
ErrorLine:
If Err.Number <> 0 Then
Err.Clear
End If
End Sub
1、这代码是用于保存256色位图写的,颜色表使用了标准灰度色表,不可能表示RGB(255, 198, 255),这种色彩。
2、不知你是怎么存16位图的?这个代码肯定不行,标准位图文件没有16位的,16位DIB在内存中随设备不同,又有565与555两种格式,你用得是什么?
3、8位以上位图没有颜色表,你注意这个问题了吗?
的时候就编了一个函数,完全自己运算存储,支持1位、4位、8位,24位,还有RLE4和RLE8
的压缩处理,用设备也是用GetDIBits获得数组后直接将数组存入文件,要用的时候直接
读取数据用SetDIBits取回图像。记得搞刚开始RLE的时候还真是兴奋呢,现在想想,呵呵,
真是无聊呀。
Public Type 位图头信息
文件类型 As String * 2 '文件头标识,内容固定为“BM”
图象文件的大小 As Long
保留1 As Integer
保留2 As Integer
数据起始地址 As Long '指出图象数据的起始地址
数据结构大小 As Long '[Windows]固定为40 [OS/2]固定为12
位图宽 As Long '水平方向的点数
位图高 As Long '垂直方向的点数
图象的色彩平面数 As Integer '固定为1
存储方式 As Integer '每象数所需要的位数 [1]单色图象 [4]16色图象 [8]256色图象 [24]全彩色图象
压缩方式 As Long '压缩方式 [0]表示未压缩 [1]表示所压缩的数据是256色:RLE8压缩法 [2]表示所压缩的数据是16色:RLE4压缩法
图象数据大小 As Long 'BMP图象数据的字节大小 如:[256色]等于 宽×高=图象数据大小 [16位色]等于 宽×高×4=图象数据大小
水平方向分辨率 As Long
垂直方向分辨率 As Long
使用了几种颜色 As Long '由[存储方式]决定 例如:[16]色模式下本项是[12],表示本图象一共用了[12]种颜色。[0]则表示[16]种颜色全部使用
重要颜色 As Long '指出几种颜色重要,[0]表示全部重要
End Type
Public Type 位图调色板数据类型
蓝色 As Byte
绿色 As Byte
红色 As Byte
保留 As Byte
End Type
With pbih.bmiHeader .biSize = Len(pbih.bmiHeader)
.biWidth = bm.bmWidth
.biHeight = bm.bmHeight
.biPlanes = bm.bmPlanes '此项应为1
.biBitCount = 8 '<<=你那是16位位图吗?2^8=?256嘛!改成24吧。
.biCompression = BI_RGB
.biClrImportant = 0
.biClrUsed = 255 '如果是真彩,应赋值为0,表示"实现使用颜色数"为2的biBitCount次幂,而你那样就象是实现只使用256色!
.biSizeImage = (bm.bmWidth + bm.bmWidth Mod 4) * bm.bmHeight * 3
'这一样也有点怪,为什么不是".biWidth× .biHeight"呢?
end with