如何截屏并保存为文件

 一。要实现的效果：用户在屏幕上拖动鼠标，产生框选区域；释放鼠标时被框选区域的屏幕图像被保存为
bmp文件

二。工程有一个borderstyle=none、scalemode=pixels的窗体，窗体上放置一个visible=false的shape控件，用于鼠标选取屏幕区域时的选框。

三。实现大致过程：用户按F10[再次按F10恢复窗体]，隐藏窗体，将屏幕图像放在内存DC中，最大化本窗体，显示窗体，将内存DC中屏幕图像拷贝到窗体上。用户在窗体上按下鼠标时，记录下该位置为起点位置；用户拖动窗体时通过改变虚框的位置也大小来反映被选取的区域；用户释放鼠标时将框选区域的图像保存到文件中。

四。关键点有二：1，将屏幕图像拷贝到最大化后的窗体上前要隐藏“本”窗体以名其进入最后屏幕图像中；2，根据窗体[其实包括任何有hwnd的对象]的句柄来保存窗体图像。

五。示例代码
'[为简单起见，所有代码都放在了一个窗体中]
Option Explicit
Private blnMaximized As Boolean
Private intOldx      As Integer
Private intOldy      As Integer

Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
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 hhdc 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 Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
'ShowWindow之nCmdShow参数可选顶
Const SW_MAXIMIZE = 3
Const SW_RESTORE = 9

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type
Private Type PicBmp
    Size As Long
    Type As Long
    hBmp As Long
    hPal As Long
    Reserved As Long
End Type

Function hDCToPicture(ByVal hDCSrc As Long, ByVal LeftSrc As Long, ByVal TopSrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long) As Picture
    '要确保参数LeftSrc、TopSrc、WidthSrc、HeightSrc的单位为像素!!
   
    Dim hDCMemory As Long, hBmp As Long
    Dim hPal As Long
    Dim Pic As PicBmp, IPic As IPicture, IID_IDispatch As GUID
   
    hDCMemory = CreateCompatibleDC(hDCSrc)
    hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
    DeleteObject SelectObject(hDCMemory, hBmp)

    'Copy the source image to our compatible device context
    StretchBlt hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, WidthSrc, HeightSrc, vbSrcCopy

    With IID_IDispatch
        .Data1 = &H20400
        .Data4(0) = &HC0
        .Data4(7) = &H46
    End With

    'Fill picture info
    With Pic
        .Size = Len(Pic)         ' Length of structure
        .Type = vbPicTypeBitmap  ' Type of Picture (bitmap)
        .hBmp = hBmp             ' Handle to bitmap
        .hPal = 0
    End With

    'Create the picture
    OleCreatePictureIndirect Pic, IID_IDispatch, 1, IPic

    DeleteDC hDCMemory
    'DeleteObject hBmp
   
    Set hDCToPicture = IPic
End Function

Private Sub Form_DblClick()
  '提供一关闭窗体的方法
   End
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
   If KeyCode = vbKeyF10 Then
      blnMaximized = Not blnMaximized
      If blnMaximized Then
         Me.Visible = False
         DoEvents
         ShowWindow Me.hWnd, SW_MAXIMIZE
 
        '屏幕图像拷贝到窗体上 
        ScreenToForm
         Me.Visible = True
      Else
         ShowWindow Me.hWnd, SW_RESTORE
         Cls
      End If
   End If
End Sub

Private Sub ScreenToForm()
   Dim hBitMap      As Long
   Dim hMemDC       As Long
   Dim W As Integer
   Dim H As Integer
  
   W = Screen.Width / Screen.TwipsPerPixelX
   H = Screen.Height / Screen.TwipsPerPixelY
  
   hBitMap = CreateCompatibleBitmap(hdc, W, H)
   DeleteObject SelectObject(hMemDC, hBitMap)

   StretchBlt hdc, 0, 0, W, H, GetDC(0), 0, 0, W, H, vbSrcCopy
  
   DeleteDC hMemDC
   DeleteObject hBitMap
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
   If blnMaximized = True Then
      intOldx = x
      intOldy = y
      sp1.Visible = True
   End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
   If blnMaximized = False Then Exit Sub
   If Button Then
      sp1.Left = IIf(intOldx > x, x, intOldx)
      sp1.Top = IIf(intOldy > y, y, intOldy)
      sp1.Width = Abs(intOldx - x)
      sp1.Height = Abs(intOldy - y)
   End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
   If blnMaximized = False Then Exit Sub
  
   Dim hPic As Picture
   Dim strFile As String
  
   '隐藏虚框，以免其进入载图中
   sp1.Visible = False
   strFile = "E:/picFiles/" & Format(Time, "hhmmss") & ".bmp"
   '将选定区域的图像放在picture对象中
   Set hPic = hDCToPicture(hdc, sp1.Left, sp1.Top, sp1.Width, sp1.Height)
   '保存picture对象为文件
   SavePicture hPic, strFile
   Set hPic = Nothing
  
   sp1.Width = 0
   sp1.Height = 0
  
   '恢复窗体原形
   Cls
   ShowWindow Me.hWnd, SW_RESTORE
  
   blnMaximized = False
End Sub