如何将HDC中的位图导出给PictureBox的Picture属性赋值用于显示和保存图片。

Question

可能是一个很简单的问题：
例如将屏幕位图复制到 Picture1.hdc 中
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public 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 Longscreendc = GetDC(0)
BitBlt Picture1.hdc, 0, 0, Screen.Width, Screen.Height, screendc, 0, 0, vbSrcCopy如何实现将Picture1.hdc 中的位图赋值给Picture1.Picture
或如何保存Picture1.hdc 中的位图到文件？请大家赐教！

Answer 1

Private Sub SavePictureToDB()
'====================================将BMP图片存入数据库========================================
On Error GoTo EH
    'cn.Open strConn
    Set stm = New ADODB.Stream
    If rs.State = adStateOpen Then
        rs.Close
        Set rs = Nothing
    End If
    rs.Open "select sbh,ImagePath,ImageValue from sbkp where sbh='" & Trim(Txtsbh.Text) & "'", con, adOpenKeyset, adLockOptimistic, 1
    'CommonDialog1.ShowOpen
    'Text1.Text = CommonDialog1.FileName
    If Text1.Text = "" Then
        Exit Sub
    End If
    With stm
        .Mode = adModeReadWrite
         .Type = adTypeBinary
         .Open
         .LoadFromFile Text1.Text
    End With
    With rs
         '.AddNew
         .Fields("ImagePath") = Text1.Text
         .Fields("ImageValue").Value = stm.Read
         .Update
    End With
    rs.Close
    Set rs = Nothing
    'cn.Close
    'Set cn = Nothing
Exit Sub
EH: MsgBox err.Description, vbInformation, "Error"
End Sub
Private Sub LoadPictureFromDB()
    'If cn.State = adStateOpen Then
        'cn.Close
        'Set cn = Nothing
   ' End If
'=====================================载数据库中读出BMP图片====================================
On Error GoTo EH
    'cn.Open strConn
    
    If rs.State = adStateOpen Then
        rs.Close
        Set rs = Nothing
    End If
    rs.CursorLocation = adUseClient
    Dim strTemp As String
    Set stm = New ADODB.Stream
    strTemp = "c:\temp.tmp" '临时文件,用来保存读出的图片
    rs.Open "select sbh,ImagePath,ImageValue  from sbkp where sbh='" & Trim(Txtsbh.Text) & "'", con, adOpenForwardOnly, adLockReadOnly, 1
    If IsNull(rs.Fields("ImageValue")) Then
        Image1.Visible = False
        Exit Sub
    Else
        Image1.Visible = True
    End If
    With stm
        .Mode = adModeReadWrite
        .Type = adTypeBinary
        .Open
        .Write rs.Fields("ImageValue")
        .SaveToFile strTemp, adSaveCreateOverWrite
        .Close
    End With
    Image1.Picture = LoadPicture(strTemp)
    Set stm = Nothing
    rs.Close
    Set rs = Nothing
    'cn.Close
    'Set cn = Nothing
Exit Sub
EH: MsgBox err.Description, vbInformation, "Error"
End Sub

Answer 2

有没有必要写那么多代码呀，呵呵
在设计时将Picture1.AutoRedraw属性设置为True
要保存时用Picture1.Image属性保存
如下保存代码:
SavePicture Picture1.Image,"C:\001.BMP"
好了，可以结贴了

Answer 3

Option Explicit
'窗体中有一commonbutton，一picturebox:
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As LongPrivate Sub Command1_Click()
      Dim hMemDc As Long
      Dim hMemBmp As Long
      
      '隐藏图体，以名使本窗体的图象也进入最终图像中
      Me.Visible = False
      DoEvents
      
      hMemDc = CreateCompatibleDC(Me.hdc)
      hMemBmp = CreateCompatibleBitmap(Me.hdc, ScaleWidth, ScaleHeight)
      DeleteObject SelectObject(hMemDc, hMemBmp)
      '将窗体图像拷贝到内存DC中：
      StretchBlt hMemDc, 0, 0, ScaleWidth, ScaleHeight, Me.hdc, 0, 0, ScaleWidth, ScaleHeight, vbSrcCopy
           
      
      Me.Visible = True
      Refresh
      '将内存DC内拷贝到picture1的DC中
      StretchBlt Picture1.hdc, 0, 0, Picture1.Width, Picture1.Height, hMemDc, 0, 0, ScaleWidth, ScaleHeight, vbSrcCopy
      
      DeleteObject hMemBmp
      DeleteDC hMemDc
      
      SavePicture Picture1.Image, "c:\myWindow.bmp"
End SubPrivate Sub Form_Load()
   Me.WindowState = vbMaximized
   Me.ScaleMode = vbPixels
   Picture1.AutoRedraw = True
   Picture1.Move 0, 0, Screen.Width \ Screen.TwipsPerPixelX, Screen.Height \ Screen.TwipsPerPixelY
   Picture1.Visible = False
End Sub