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