如何将截取的桌面处理成256色图以便远程共享
大家好,我这里想做一个远程共享桌面的程序,因为考虑到带宽的问题,想把桌面图片转化为256色后再进行传输。
在网上查找了一些资料,好像通过CreateDIBSection和GetDIBits函数可以实现,具体也不不太理解。还有的使用CreateDIBSection256和GetDIBits256函数
这里设置了先设置BitmapFileHeader,BitmapInfoHeader,但RGBQUAD不太懂怎么搞,下面是我照葫芦画瓢写的一段程序,总是直接报VB错误。请大家帮忙看看,是不是就是因为 RGBQUAD的问题,如何改正。谢谢!
'程序还没涉及网络传输,仅仅考虑如何转换为256色并保存到256_2.bmp查看
Private Type BitmapFileHeader
bfType As String * 2 '位图文件的类型,必须为BMP
bfSize As Long '位图文件的大小,以字节为单位
bfReserved1 As Integer '位图文件保留字,必须为0
bfReserved2 As Integer '位图文件保留字,必须为0
bfOffBits As Long '位图数据的起始位置,以相对于位图
End Type
Private Type BitmapInfoHeader
biSize As Long '本结构所占用字节数
biWidth As Long '位图的宽度
biHeight As Long '位图的高度
biPlanes As Integer '目标设备的级别,必须为1
biBitCount As Integer ' 每个像素所需的位数,决定是几位色图,如为8就8位图,256色图
biCompression As Long '位图压缩类型,0表示不压缩
biSizeImage As Long '位图的大小
biXPelsPerMeter As Long '位图水平分辨率,每米像素数
biYPelsPerMeter As Long '位图垂直分辨率,每米像素数
biClrUsed As Long '位图实际使用的颜色表中的颜色数
biClrImportant As Long '位图显示过程中重要的颜色数
End Type
Private Type RGBQUAD
rgbBlue As Byte '蓝色的亮度(值范围为0-255)
rgbGreen As Byte '绿色的亮度(值范围为0-255)
rgbRed As Byte '红色的亮度(值范围为0-255)
rgbReserved As Byte '保留
End Type
Private Type BITMAPINFO
bmiHeader As BitmapInfoHeader
bmiColors As RGBQUAD
End Type
Private 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 Type
Const DIB_RGB_COLORS = 0&
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetDC Lib "user32 " (ByVal hwnd As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByVal lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
Private 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 Sub Command6_Click()
Call SaveBMP256_2(Me, App.Path & "\256_2.bmp")
End Sub
Public Function SaveBMP256_2(pic As Form, FilePathName$) As Long
Dim bm As Bitmap, SizeOfArray As Long, fp As Long
Dim bf As BitmapFileHeader, bi As BITMAPINFO, 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.Image, 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
End With
i = 256
ReDim Preserve buffer(0 To bi.bmiHeader.biSizeImage - 1) As Byte
hdc = CreateCompatibleDC(0&)
'这里直接报VB出错,是不是要设置RGBGUAD结构?
hDIB = CreateDIBSection(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 GetDIBits(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_2 = Err.Number
Exit Function
End If
Put #fp, 1, bf
Put #fp, , bi
Put #fp, , buffer
Close #fp
End Function