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
