如何在Picture控件中保存绘制的图像

Question

我通过代码在Picture控件中绘制出了一些图形，想要保存到文件中能用如Windows的绘图程序等进行查看。
请众大虾,介绍详细过程。
谢谢！

Answer 1

刚刚把Zyl910写的翻出来了：
http://expert.csdn.net/Expert/topic/1538/1538596.xml?temp=1.997012E-02
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 TypePrivate Declare Function GetCurrentObject Lib "gdi32" (ByVal hDC As Long, ByVal uObjectType As Long) As Long
Private Const OBJ_BITMAP = 7Private 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 TypePublic 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

Answer 2

我试过了，并不成功，
我需要保存的是执行代码在Picture控件上产生的图象
请帮帮忙

Answer 3

Private Sub Picture1_Click()
Picture1.AutoRedraw = True
Picture1.Line (0, 0)-(1000, 1000), vbRed
Picture1.Refresh
SavePicture Picture1.Image, "c:\1.bmp"
End Sub

Answer 4

将picture控件的autoredraw属性设成ture
SavePicture picture1.Image, "d:\pic.bmp"

Answer 5

谢谢，可以了。
但我是在一个父Picture控件中放了一个子Picture控件，
并在子Picture控件上绘图，
在父picture控件上设置坐标刻度，
如何能让这个父控件中的所有图形都显示在一个图像文件中呢？

Answer 6

保存子Picture的图形，然后ｌｏａｄ到父Picture中对应的位置，画刻度，再保存

Answer 7

wxy_xiaoyu()的变通办法好啊，一定是个聪明人，呵呵。

Answer 8

用Load可以将图像显示在指定的位置上吗？
请问语法是什么？

Answer 9

http://www.china-askpro.com/msg2/qa05.shtml

Answer 10

http://www.china-askpro.com/msg31/qa27.shtml