首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

求解,VB二进制形式写24位BMP图片的那点事

2012-07-28 
求解,VB二进制方式写24位BMP图片的那点事。小弟最近研究BMP的读写问题。读目前已经解决了,但是写的话有一点

求解,VB二进制方式写24位BMP图片的那点事。
小弟最近研究BMP的读写问题。
读目前已经解决了,但是写的话有一点问题。特来请教各位前辈。
下面是我目前的代码。

VB code
Private Type BITMAPFILEHEADER    bfType   As Integer    bfSize   As Long    bfReserved1   As Integer    bfReserved2   As Integer    bfOffBits As LongEnd TypePrivate 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 LongEnd TypePrivate Type BmpPix    B As Byte    G As Byte    R As ByteEnd TypePrivate Sub Command1_Click()Dim data() As Variantdata = GetBmp("c:\2.bmp", 0)SetBMP "c:\1.bmp", data, 0End SubFunction SetBMP(filename As Variant, data As Variant, mose As Variant) As VariantDim BmpData As BmpPixDim BmpOne As BITMAPFILEHEADERDim BmpTow As BITMAPINFOHEADERDim i As Long, o As Long, Tmp As Variant, u As Long, out As Byteout = 0BmpTow.biSize = 40BmpTow.biWidth = UBound(data, 1) + 1BmpTow.biHeight = UBound(data, 2) + 1BmpTow.biPlanes = 1BmpTow.biBitCount = 24BmpTow.biCompression = 0BmpTow.biSizeImage = 0BmpTow.biXPelsPerMeter = 0BmpTow.biYPelsPerMeter = 0BmpTow.biClrUsed = 0BmpTow.biClrImportant = 0i = BmpTow.biWidth * 3While i Mod 4 <> 0    i = i + 1    u = u + 1WendBmpOne.bfType = &H4D42BmpOne.bfReserved1 = 0BmpOne.bfReserved2 = 0BmpOne.bfOffBits = LenB(BmpOne) + LenB(BmpTow)BmpOne.bfSize = i * BmpTow.biHeight + BmpOne.bfOffBitsOpen filename For Binary As #1Put #1, , BmpOnePut #1, , BmpTowFor o = UBound(data, 2) To 0 Step -1    For i = 0 To UBound(data, 1)        Tmp = data(i, o)        If mose = 0 Then            BmpData.R = CLng("&H" + Mid(Tmp, 1, 2))            BmpData.G = CLng("&H" + Mid(Tmp, 3, 2))            BmpData.B = CLng("&H" + Mid(Tmp, 5, 2))        Else            BmpData.B = CLng("&H" + Mid(Tmp, 1, 2))            BmpData.G = CLng("&H" + Mid(Tmp, 3, 2))            BmpData.R = CLng("&H" + Mid(Tmp, 5, 2))        End If        Put #1, , BmpData    Next    For i = 1 To u        Put #1, , out    NextNextClose #1End FunctionPublic Function GetBmp(file As Variant, mose As Variant) As VariantDim BMPWidth As LongDim BMPHeight As LongDim LineWidth As LongDim ArrByte(0 To 2) As ByteDim i As LongDim o As LongDim temp As StringDim tempR As StringDim tempG As StringDim tempB As StringOpen file For Binary As #1Get #1, 19, BMPWidthGet #1, 23, BMPHeightReDim rgb_s(0 To BMPWidth - 1, 0 To BMPHeight - 1) As VariantSelect Case (BMPWidth * 3) Mod 4Case 0LineWidth = BMPWidth * 3Case 1LineWidth = BMPWidth * 3 + 3Case 2LineWidth = BMPWidth * 3 + 2Case 3LineWidth = BMPWidth * 3 + 1End SelectFor i = 0 To BMPWidth - 1For o = 0 To BMPHeight - 1Get #1, FindByte(LineWidth, BMPHeight, i, o), ArrBytetempR = Hex(ArrByte(2)): tempG = Hex(ArrByte(1)): tempB = Hex(ArrByte(0))If Len(tempR) = 1 Then tempR = "0" + tempRIf Len(tempG) = 1 Then tempG = "0" + tempGIf Len(tempB) = 1 Then tempB = "0" + tempBIf mose = 0 Then    rgb_s(i, o) = tempR + tempG + tempBElseIf mose = 1 Then    rgb_s(i, o) = tempB + tempG + tempREnd IfNextNextClose #1GetBmp = rgb_sEnd FunctionPrivate Function FindByte(ByVal LineWidth As Long, ByVal LineCount As Long, ByVal x As Long, ByVal y As Long) As LongFindByte = (55 + (LineCount - y - 1) * LineWidth + 3 * x)End Function


以上代码读出来的图像会有颜色错误,以及图像扭曲等问题。
请各位前辈指正

[解决办法]

热点排行