带范围截屏和保存图片代码

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

最后编辑于 ：
©著作权归作者所有,转载或内容合作请联系作者
平台声明：文章内容（如有图片或视频亦包括在内）由作者上传并发布，文章内容仅代表作者本人观点，简书系信息发布平台，仅提供信息存储服务。

推荐阅读更多精彩内容