如何捕获桌面的一部分

• 下载源代码 - 26.7 KB

引言

这是一个实用工具，你可以用它来复制桌面的一部分，然后将图像粘贴到某个地方或将其保存为图像文件。

背景

我使用这个工具来创建文档，例如。

使用代码

运行代码。按下主鼠标按钮。光标会变为一个 + 号。移动鼠标，使 + 号位于需要截取区域的左上角。在仍然按住另一个按钮的情况下，按下副鼠标按钮。拖动一个矩形并释放按钮。会弹出一个 SaveFileDialog。如果你不想保存图像，请点击取消。图像始终保存在剪贴板中，因此你可以将其粘贴到任何打开的文档中。

API 声明

Private Declare Function SetCapture Lib "user32" (ByVal hWnd As IntPtr) As Int32
Private Declare Function ReleaseCapture Lib "user32" () As Int32

Private Declare Auto Function CreateDC Lib "Gdi32" Alias "CreateDC" _
    (ByVal lpDriverName As String, _
     ByVal lpDeviceName As String, _
     ByVal lpOutput As String, _
     ByVal lpInitData As IntPtr) As IntPtr

Private Declare Function SelectObject Lib "gdi32" _
    (ByVal dc As IntPtr, ByVal hObject As Int32) As Int32

Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Int32) As Int32

Private Declare Function SetROP2 Lib "gdi32" _
    (ByVal dc As IntPtr, ByVal nDrawMode As Int32) As Int32

Private Declare Function Rectangle Lib "gdi32" _
    (ByVal dc As IntPtr, ByVal x1 As Int32, ByVal y1 As Int32, _
     ByVal X2 As Int32, ByVal Y2 As Int32) As Int32

Private Declare Function DeleteDC Lib "gdi32" (ByVal dc As IntPtr) As Int32
Private Const NULL_BRUSH As Int32 = 5
Private Const R2_NOT As Int32 = 6
Private Const R2_NOTXORPEN As Int32 = 10

Private Structure POINTAPI
    Dim X As Int32
    Dim Y As Int32
End Structure

有人知道 POINTAPI 是否包含在框架中吗？

绘制矩形

'get the cursor position
ptNow.X = Cursor.Position.X
ptNow.Y = Cursor.Position.Y
'draw the rectangle  
Rectangle(dc, ptAnchor.X, ptAnchor.Y, ptNow.X, ptNow.Y)
'remove the previous rectangle 
Rectangle(dc, ptAnchor.X, ptAnchor.Y, ptOld.X, ptOld.Y)

复制图像

Dim Image As Bitmap
Const SRCCOPY As Integer = &HCC0020
Dim sdlgImage As New SaveFileDialog

'get size of rectangle
nWidth = Math.Abs(ptAnchor.X - ptNow.X)
nHeight = Math.Abs(ptAnchor.Y - ptNow.Y)
With picImage
  'scale picture box on form
  .Width = nWidth
  .Height = nHeight

  Dim g As Graphics = .CreateGraphics
  'create an empty image of adequate size
  Image = New Bitmap(nWidth, nHeight, g)
  'create new graphics from image
  g = Graphics.FromImage(Image)
  'get the windows handle
  Dim deviceContext2 As IntPtr = g.GetHdc
  'copy the image from screen into the image variable
  BitBlt(deviceContext2, 0, 0, nWidth, nHeight, dc, _
         ptAnchor.X, ptAnchor.Y, SRCCOPY)
  'release resources
  g.ReleaseHdc(deviceContext2)
  'put the image into the picturebox
  .Image = Image
  'this might be unnecessary
  .Refresh()
  .Visible = True
  'put image into clipboard
  Clipboard.SetDataObject(.Image)
End With

Try
  With sdlgImage
    .FileName = "Image"
    .Filter = "Bitmap (*.bmp)|*.bmp|JPEG (*.jpg, *.jpeg)|*.jpg;" & _ 
              "*.jpeg|GIF (*.gif)|*.gif|TIFF (*.tif, *.tiff)|*.tif;" & _ 
              "*.tiff|PNG (*.png)|*.png"
    .AddExtension = True
    .OverwritePrompt = True
    .CheckPathExists = True
    .ValidateNames = True
    .Title = "Save Image"
    If .ShowDialog() = DialogResult.OK Then
      Dim bmp As New Bitmap(picImage.Image)
      Dim fmt As Imaging.ImageFormat
      Select Case .FilterIndex
        Case 1
              fmt = Imaging.ImageFormat.Bmp
            Case 2
              fmt = Imaging.ImageFormat.Jpeg
            Case 3
              fmt = Imaging.ImageFormat.Gif
            Case 4
              fmt = Imaging.ImageFormat.Tiff
            Case 5
              fmt = Imaging.ImageFormat.Png
            Case Else
              fmt = Imaging.ImageFormat.Bmp
          End Select
          bmp.Save(.FileName, fmt)
        End If
  End With
Catch e As Exception
  MessageBox.Show(e.Message, "Saving Image")
End Try