请问在vb中如何将bitmap结构存盘？

[littleM]

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

我想在两个vb程序中交换位图数据，实现拷贝\粘贴位图的功能，但又不想使用剪贴板，因此想让程序A存盘，程序B使用loadpicture读取图形。
请大家帮忙！谢谢

[seraph2]

谢了,上家,我现在明白我的程序中的问题了!虽然借了楼主的光,也谢谢楼主啊!
呵呵

[rainstormmaster]

使用savepicture语句保存图片就可以了

savepicture picture1.picture,"c:\test.bmp"
或
savepicture picture1.image,"c:\test.bmp"

如果使用的是image控件的话，就：
savepicture image1.picture,"c:\test.bmp"

如果，实际工作中必须根据bmp文件格式保存文件的话，可以参考：
http://search.csdn.net/expert/topic/51/5104/2003/3/17/1538596.htm

[littleM]

谢谢rainstormmaster(rainstormmaster) ，不过我的位图是自己绘制的，不是stdpicture对象，你给我的网页上不去。

[rainstormmaster]

//不过我的位图是自己绘制的
那就：
savepicture picture1.image,"c:\test.bmp"
//你给我的网页上不去
代码我给你贴上：
已知hDC，保存BMP的方法
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

[flc]

关注
学习

[liyan010]

up