noname1.vb

一个将VB转换成C#的源码

Public Function SaveBMP256(pic As PictureBox, FilePathName$) As Long
Dim bm As Bitmap, SizeOfArray As Long, fp As Long
Dim bf As BitmapFileHeader, bi As BitMapInfo256, buffer() As Byte
Dim hDC As Long, hDIB As Long, OldObj As Long
Dim i As Long, r As Integer, g As Integer, b As Integer
'
Call GetObject(pic.Picture, Len(bm), bm)
SizeOfArray = (((bm.bmWidth + 3) \ 4) * 4) * bm.bmHeight
With bf
.bfType = "BM"
.bfSize = Len(bf) + Len(bi) + SizeOfArray
.bfReserved1 = 0
.bfReserved2 = 0
.bfOffBits = Len(bf) + Len(bi)
End With
With bi
With .bmiHeader
.biSize = Len(bi.bmiHeader)
.biWidth = bm.bmWidth
.biHeight = bm.bmHeight
.biPlanes = 1
.biBitCount = 8
.biCompression = 0
.biSizeImage = SizeOfArray
End With
i = 0
For b = 0 To &HE0 Step &H20
For g = 0 To &HE0 Step &H20
For r = 0 To &HC0 Step &H40
bi.bmiColors(i) = IIf(b = &HE0, &HFF, b) * &H10000 + IIf(g = &HE0, &HFF, g) * &H100 + IIf(r = &HC0, &HFF, r)
i = i + 1
Next r
Next g
Next b
End With
ReDim buffer(0 To bi.bmiHeader.biSizeImage - 1) As Byte
hDC = CreateCompatibleDC(0&)
hDIB = CreateDIBSection256(hDC, bi, DIB_RGB_COLORS, i, 0&, 0&)
OldObj = SelectObject(hDC, hDIB)
Call BitBlt(hDC, 0&, 0&, bm.bmWidth, bm.bmHeight, pic.hDC, 0&, 0&, vbSrcCopy)
Call GetDIBits256(hDC, hDIB, 0, (bm.bmHeight), buffer(0), bi, 0)
SelectObject hDC, OldObj
DeleteDC hDC
DeleteObject hDIB
'
On Error Resume Next
Kill FilePathName
Err.Number = 0
fp = FreeFile()
Open FilePathName For Binary As #fp
If Err.Number <> 0 Then
SaveBMP256 = Err.Number
Exit Function
End If

Put #fp, 1, bf
Put #fp, , bi
Put #fp, , buffer
Close #fp
End Function