Imports System.Runtime.InteropServices
Imports System.Drawing.Imaging
Public Class Form1
Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, ByVal lpInitData As Int32) As Int32
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Integer, ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal xSrc As Integer, ByVal ySrc As Integer, ByVal dwRop As Integer) As Integer
Private picture As Bitmap = Nothing '以picture作为图片格式的声
Public Sub xianshi()
Dim bmpOrgin As Bitmap = PictureBox1.Image
Dim bmpNew As New Bitmap(zb2x - zb1x, zb2y - zb1y, PictureBox1.CreateGraphics)
Dim ee As Graphics = Graphics.FromImage(bmpNew)
' 创建要在其中绘制图像的目标矩形.指定所绘制图像的位置和大小。 将图像进行缩放以适合该矩形
Dim destRect As New Rectangle(0, 0, zb2x - zb1x, zb2y - zb1y)
' 创建要从中提取图像的一部分的源矩形.
Dim srcRect As New Rectangle(zb1x, zb1y, zb2x - zb1x, zb2y - zb1y) '原来图形(50,50)-(70,70) 这一片
ee.DrawImage(bmpOrgin, destRect, srcRect, GraphicsUnit.Pixel)
PictureBox1.Image = bmpNew
End Sub
Public Sub capture_window()
Dim capture1 As IntPtr = CreateDC("DISPLAY", Nothing, Nothing, Nothing)
Dim get1 As Graphics = Graphics.FromHdc(capture1)
'创建一个新的Graphics对象
picture = New Bitmap(Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height, get1)
'根据屏幕大小创建一个相同大小的Bitmap
Dim get2 As Graphics = Graphics.FromImage(picture)
Dim get3 As IntPtr = get1.GetHdc() '获取屏幕的句柄
Dim get4 As IntPtr = get2.GetHdc() '获取位图的句柄
BitBlt(get4, 0, 0, Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height, get3, _
0, 0, 13369376) '把当前屏幕复制到位图中
get1.ReleaseHdc(get3) '释放屏幕句柄
get2.ReleaseHdc(get4) '释放位图句柄
picture.Save("C://CapturePicture.jpg", ImageFormat.Jpeg)
'MessageBox.Show(" 已经把当前截取屏幕保存到CapturePicture.jpg，检查程序根目录")
'Me.Visible = True
Me.Top = 100
PictureBox1.Image = picture
End Sub
Private Sub 截屏ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 截屏ToolStripMenuItem.Click
'Me.Visible = False
Me.Top = -600
capture_window() '调用函数，开始捕获程序
End Sub
Private Sub 退出ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 退出ToolStripMenuItem.Click
If zb1x = 0 Then
MsgBox("请先选择要截取的范围")
Else
Dim bmpOrgin As Bitmap = PictureBox1.Image
Dim bmpNew As New Bitmap(zb2x - zb1x, zb2y - zb1y, PictureBox1.CreateGraphics)
Dim ee As Graphics = Graphics.FromImage(bmpNew)
' 创建要在其中绘制图像的目标矩形.指定所绘制图像的位置和大小。 将图像进行缩放以适合该矩形
Dim destRect As New Rectangle(0, 0, zb2x - zb1x, zb2y - zb1y)
' 创建要从中提取图像的一部分的源矩形.
Dim srcRect As New Rectangle(zb1x, zb1y, zb2x - zb1x, zb2y - zb1y) '原来图形(50,50)-(70,70) 这一片
ee.DrawImage(bmpOrgin, destRect, srcRect, GraphicsUnit.Pixel)
PictureBox1.Image = bmpNew
End If
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Me.Top = -700 '隐藏窗体
Form2.Show() '打开范围选定窗体
End Sub
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
TextBox1.Text = System.Windows.Forms.Cursor.Position.X.ToString & "," & System.Windows.Forms.Cursor.Position.Y.ToString
If z = 1 Then
capture_window()
xianshi()
End If
End Sub
'说明：打开程序之后马上把当前屏幕截屏保存
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim capture1 As IntPtr = CreateDC("DISPLAY", Nothing, Nothing, Nothing)
Dim get1 As Graphics = Graphics.FromHdc(capture1)
'创建一个新的Graphics对象
picture = New Bitmap(Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height, get1)
'根据屏幕大小创建一个相同大小的Bitmap
Dim get2 As Graphics = Graphics.FromImage(picture)
Dim get3 As IntPtr = get1.GetHdc() '获取屏幕的句柄
Dim get4 As IntPtr = get2.GetHdc() '获取位图的句柄
BitBlt(get4, 0, 0, Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height, get3, _
0, 0, 13369376) '把当前屏幕复制到位图中
get1.ReleaseHdc(get3) '释放屏幕句柄
get2.ReleaseHdc(get4) '释放位图句柄
picture.Save("C://CapturePicture.bmp", ImageFormat.Bmp)
PictureBox1.Image = picture
End Sub
End Class
Public Class Form2
Private rectList As New List(Of Rectangle)
Private pt As Point
Private bmpOld As Bitmap
Private zb1 As Point
Private zb2 As Point
Private Sub Form1_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseDown
pt.X = e.X
pt.Y = e.Y
zb1 = System.Windows.Forms.Cursor.Position
End Sub
Private Sub Form1_MouseMove(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseMove
If e.Button = Windows.Forms.MouseButtons.Left Then
Dim g As Graphics = Graphics.FromImage(Me.BackgroundImage)
'擦除之前绘制的内容
Dim brush As New SolidBrush(Me.BackColor)
g.FillRectangle(brush, Me.ClientRectangle)
brush.Dispose()
'绘制之前的，包括当前的内容
Dim x, y, w, h As Integer
x = Math.Min(pt.X, e.X)
y = Math.Min(pt.Y, e.Y)
w = Math.Abs(pt.X - e.X)
h = Math.Abs(pt.Y - e.Y)
For i As Integer = 0 To rectList.Count - 1
g.DrawRectangle(Pens.Red, rectList(i))
Next
g.DrawRectangle(Pens.Red, x, y, w, h)
g.Dispose()
g = Me.CreateGraphics()
g.DrawImage(Me.BackgroundImage, 0, 0)
g.Dispose()
End If
End Sub
Private Sub Form1_MouseUp(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseUp
zb2 = System.Windows.Forms.Cursor.Position
Dim x, y, w, h As Integer
x = Math.Min(pt.X, e.X)
y = Math.Min(pt.Y, e.Y)
w = Math.Abs(pt.X - e.X)
h = Math.Abs(pt.Y - e.Y)
rectList.Add(New Rectangle(x, y, w, h))
Form1.TextBox2.Text = zb1.X.ToString & "," & zb1.Y.ToString
Form1.TextBox3.Text = zb2.X.ToString & "," & zb2.Y.ToString
zb1x = zb1.X
zb1y = zb1.Y
zb2x = zb2.X
zb2y = zb2.Y
z = 1
Form1.Show()
Form1.Top = 100
Me.Close()
End Sub
Private Sub Form2_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'窗体距顶部和左部为0，也就是左上角开始
'透明度为70%透明
'无任何按钮
'窗体全屏幕显示
Me.Top = 0
Me.Left = 0
Me.Opacity = 0.5
Me.FormBorderStyle = Windows.Forms.FormBorderStyle.None
Me.WindowState = FormWindowState.Maximized
Me.TransparencyKey = Color.Red
Me.BackColor = Color.Blue
TextBox1.Text = My.Computer.Screen.Bounds.Width
TextBox2.Text = My.Computer.Screen.Bounds.Height
Me.BackgroundImage = New Bitmap(Width, Height)
End Sub
Private Sub Form1_ResizeEnd(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.ResizeEnd
If bmpOld Is Nothing Then Return
Me.BackgroundImage = New Bitmap(Width, Height)
Dim g As Graphics = Graphics.FromImage(Me.BackgroundImage)
g.DrawImage(bmpOld, 0, 0)
g.Dispose()
bmpOld.Dispose()
bmpOld = Nothing
End Sub
Private Sub Form1_ResizeBegin(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.ResizeBegin
If BackgroundImage Is Nothing Then Return
bmpOld = Me.BackgroundImage
End Sub
Private Sub Form1_Resize(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Resize
Me.BackgroundImage = Nothing
End Sub
Private Sub Form1_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint
If bmpOld Is Nothing Then Return
e.Graphics.DrawImage(bmpOld, 0, 0)
End Sub
End Class
Module Module1
'全局变量定义
Public zb1x As Integer = 0
Public zb1y As Integer = 0
Public zb2x As Integer = 0
Public zb2y As Integer = 0
Public z As Integer = 0 '用来设置程序自动刷新的变量，在form2跳回form1时生效
End Module
