Introduction
Here is a utility with which you can copy pieces of the desktop, and either paste the image somewhere or save it as an image file.
Background
I use this utility when, for example creating, documentation.
Using the code
Run the code. Press down the primary mouse button. The cursor changes to a +. Move the mouse so that the + is positioned on the upper left corner of the area you need to capture. Press the secondary mouse button while still having the other button depressed. Drag a rectangle and let go of the buttons. A SaveFileDialog
appears. If you don't want to save the image, click Cancel. The image is always tucked in the clipboard, so you can just paste it in whatever document you have open.
API-declarations:
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
Does anyone know if POINTAPI
is in the framework?
Drawing the rectangle:
ptNow.X = Cursor.Position.X
ptNow.Y = Cursor.Position.Y
Rectangle(dc, ptAnchor.X, ptAnchor.Y, ptNow.X, ptNow.Y)
Rectangle(dc, ptAnchor.X, ptAnchor.Y, ptOld.X, ptOld.Y)
Copying the image:
Dim Image As Bitmap
Const SRCCOPY As Integer = &HCC0020
Dim sdlgImage As New SaveFileDialog
nWidth = Math.Abs(ptAnchor.X - ptNow.X)
nHeight = Math.Abs(ptAnchor.Y - ptNow.Y)
With picImage
.Width = nWidth
.Height = nHeight
Dim g As Graphics = .CreateGraphics
Image = New Bitmap(nWidth, nHeight, g)
g = Graphics.FromImage(Image)
Dim deviceContext2 As IntPtr = g.GetHdc
BitBlt(deviceContext2, 0, 0, nWidth, nHeight, dc, _
ptAnchor.X, ptAnchor.Y, SRCCOPY)
g.ReleaseHdc(deviceContext2)
.Image = Image
.Refresh()
.Visible = True
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