＋设为首页 ＋添加到收藏夹
也就是自己编程序如何把图形写入bmp文件
zyl910 (910：分儿，我又来了！) 写的：
Private Declare Function GetDIBits Lib "gdi32" (ByVal hDC As Long, ByVal hBitMap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFOHEADER, ByVal wUsage As Long) As Long
Private Const DIB_RGB_COLORS = 0
Private Type BITMAPFILEHEADER
bfType(0 To 1) As Byte
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type
Private 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 Long
End Type
Private Declare Function GetCurrentObject Lib "gdi32" (ByVal hDC As Long, ByVal uObjectType As Long) As Long
Private Const OBJ_BITMAP = 7
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Public Function SaveBMP(ByVal hDC As Long, FileName As String) As Boolean
Dim hBitMap As Long
hBitMap = GetCurrentObject(hDC, OBJ_BITMAP) 取得位图
If hBitMap = 0 Then Exit Function
Dim bm As BITMAP
If GetObject(hBitMap, Len(bm), bm) = 0 Then Exit Function 得到位图信息
Dim bmih As BITMAPINFOHEADER
bmih.biSize = Len(bmih)
bmih.biWidth = bm.bmWidth
bmih.biHeight = bm.bmHeight
bmih.biBitCount = 24
bmih.biPlanes = 1
bmih.biSizeImage = ((bmih.biWidth * 3 + 3) And &H7FFFFFFC) * bmih.biHeight 计算大小
ReDim MapData(1 To bmih.biSizeImage) As Byte
If GetDIBits(hDC, hBitMap, 0, bmih.biHeight, MapData(1), bmih, DIB_RGB_COLORS) = 0 Then Exit Function 取得位图数据
Dim hF As Integer
hF = FreeFile(1)
On Error Resume Next
Open FileName For Binary As hF
If Err.Number Then hF = -1
On Error GoTo 0
If hF = -1 Then Exit Function
Dim bmfh As BITMAPFILEHEADER
bmfh.bfType(0) = Asc("B")
bmfh.bfType(1) = Asc("M")
bmfh.bfOffBits = Len(bmfh) + Len(bmih)
Put hF, , bmfh
Put hF, , bmih
Put hF, , MapData
Close hF
SaveBMP = True
End Function
Private Sub Picture1_Click()
SaveBMP Picture1.hDC, "c:\Debug.bmp"
End Sub
参考：
http://expert.csdn.net/Expert/topic/1538/1538596.xml?temp=.7407648
