在当今这个信息爆炸的时代,经常需要从网页或软件界面中截取特定部分的屏幕图像。这可能是为了保存某个技术文档的关键信息,或是记录编程过程中的某个步骤。传统的方法可能包括保存整个网页为HTML文件,或者使用截图软件截取整个屏幕然后进行裁剪。这些方法虽然可行,但效率不高,且不够灵活。因此,设计并实现了一个屏幕截图工具,它能够快速截取屏幕的任意部分,并自动保存或复制到剪贴板,以便在其他软件中使用。
经常在网上浏览,了解新技术、学习编程技巧或寻找项目灵感。有时候,只想截取屏幕上的一小部分,而不是整个页面。传统的方法是保存整个页面,然后使用图像编辑软件进行裁剪,这不仅耗时,而且效率低下。因此,决定开发一个更高效的屏幕截图工具。
这个工具的使用非常简单。打开软件后,系统托盘会出现一个通知图标。双击该图标,选择要截取的屏幕区域,截图就会自动保存到指定的文件夹中。默认的保存路径是“图片”文件夹。
以下是用来捕获屏幕图像的代码。首先,定义一个图形对象,然后使用gp.CopyFromScreen
命令从屏幕复制图像。这里的wdh
和hgt
分别代表屏幕的宽度和高度。然后,将捕获的图像显示在frmCapture
的背景中。
Sub CaptureScreen()
Dim hgt As Integer = My.Computer.Screen.WorkingArea.Height
Dim wdh As Integer = My.Computer.Screen.WorkingArea.Width
Dim scrn As New Bitmap(wdh, hgt, Imaging.PixelFormat.Format64bppArgb)
Dim gp As Graphics = Graphics.FromImage(scrn)
gp.CopyFromScreen(0, 0, 0, 0, New Size(wdh, hgt))
frmCapture.BackgroundImage = scrn
ScreenImg = scrn
frmCapture.lblFill.BackColor = Color.FromArgb(150, Color.Silver)
frmCapture.lblFill.Visible = False
frmCapture.Location = New Point(0, 0)
frmCapture.Size = New Size(wdh, hgt)
scrn.Save("D:\a.bmp", Imaging.ImageFormat.Bmp)
End Sub
当双击通知图标时,会调用CaptureScreen
函数。这个函数定义了一个图形对象,用于编辑图像,并首先使用gp.CopyFromScreen
命令从屏幕复制图像。然后,将捕获的图像显示在frmCapture
的背景中。
接下来,需要选择要捕获的区域。这可以通过以下代码实现:
Private Sub frmCapture_MouseMove(ByVal sender As Object, ByVal e As _
System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove
Dim hgt As Integer = My.Computer.Screen.WorkingArea.Width
Dim wdh As Integer = My.Computer.Screen.WorkingArea.Width
If e.Button = Windows.Forms.MouseButtons.Left Then
lblFill.Visible = True
lblFill.Left = IIf(StPosX > e.X, e.X, StPosX)
lblFill.Top = IIf(StPosY > e.Y, e.Y, StPosY)
lblFill.Width = Math.Abs(StPosX - e.X)
lblFill.Height = Math.Abs(StPosY - e.Y)
End If
End Sub
为了选择区域,使用了一个透明的标签。当拖动鼠标时,标签会显示出来,作为选择区域的参考。
完成选择后,会执行以下事件:
Private Sub frmCapture_MouseUp(ByVal sender As Object, ByVal e As _
System.Windows.Forms.MouseEventArgs) Handles Me.MouseUp
If StPosX <> e.X And StPosY <> e.Y Then
EnPosX = e.X
EnPosY = e.Y
Dim CrpImg As Bitmap
Dim gp As Graphics
Me.Close()
If My.Settings.Title = True Then
CrpImg = New Bitmap(Math.Abs(StPosX - EnPosX), _
Math.Abs(StPosY - EnPosY) + 20, Imaging.PixelFormat.Format64bppArgb)
gp = Graphics.FromImage(CrpImg)
gp.DrawImage(ScreenImg, -IIf(StPosX > EnPosX, _
EnPosX, StPosX), -IIf(StPosY > EnPosY, EnPosY, StPosY) + 20)
Dim titl As String = InputBox("Enter Title to this Image...", _
"Title", "My Image")
gp.FillRectangle(Brushes.White, 0, 0, Math.Abs(StPosX - EnPosX), 20)
gp.DrawString(titl, My.Settings.TitleFont, Brushes.Black, 10, 3)
Else
CrpImg = New Bitmap(Math.Abs(StPosX - EnPosX), Math.Abs(StPosY - EnPosY))
gp = Graphics.FromImage(CrpImg)
gp.DrawImage(ScreenImg, -IIf(StPosX > EnPosX, EnPosX, StPosX), _
-IIf(StPosY > EnPosY, EnPosY, StPosY))
End If
Dim num As String = vbNull
If My.Settings.SaveFile Then
Dim FileList As Collections.ObjectModel.ReadOnlyCollection(Of String)
FileList = My.Computer.FileSystem.GetFiles(My.Settings.FilePath & _
"\", _
FileIO.SearchOption.SearchAllSubDirectories, My.Settings.FileName & "*.bmp")
Dim MaxFile As Integer
If FileList.Count <> 0 Then
MaxFile = CInt(Microsoft.VisualBasic.Right( _
FileList.Item(FileList.Count - 1).ToString(), 7).Replace(".bmp", ""))
Else
MaxFile = 0
End If
num = MaxFile + 1
For i As Integer = 1 To 3 - num.Length
num = "0" & num
Next
CrpImg.Save(My.Settings.FilePath & "\& My.Settings.FileName & "- " & _
num & ".bmp", Imaging.ImageFormat.Bmp)
frmDetails.NotifyIcon1.ShowBalloonTip(100, "Saved", "Your Screen Capture has been saved.", ToolTipIcon.Info)
Else
Clipboard.SetImage(CrpImg)
frmDetails.NotifyIcon1.ShowBalloonTip(100, "Saved", "Your Screen Capture has been copied to Clipboard.", ToolTipIcon.Info)
End If
Call frmDetails.ShowThumb(CrpImg, IIf(My.Settings.SaveFile, _
My.Settings.FileName & "- " & num, "Clipboard"))
End If
End Sub
首先,检查用户选择的区域是否大于零。然后创建一个新的图形对象,从frmCapture
背景图像中导入图像,并根据用户的设置直接保存或复制到剪贴板。
如果用户设置要求给图像添加标题,那么它将提示输入图像的标题。标题将赋予图像。如下图所示,“Code Project Home”是标题。
最后,有一个功能,可以查看捕获的图像,并显示捕获的总图像数量。为此,使用了创建缩略图并在listview
中显示它的命令。
Public Sub ShowThumb(ByVal Img As Image, ByVal FileName As String)
Dim thumb As New Bitmap(thumbW, thumbW)
Dim gp As Graphics = Graphics.FromImage(thumb)
gp.DrawImage(Img, New Rectangle(0, 0, IIf(Img.Width > Img.Height, _
thumbW, thumbW * Img.Width / Img.Height), IIf(Img.Width > Img.Height, _
thumbW * Img.Height / Img.Width, thumbW)))
ImageList1.Images.Add(thumb)
ListView1.Items.Add(FileName, CInt(lblCount.Text))
lblCount.Text = CInt(lblCount.Text) + 1
End Sub
缩略图将与文件名一起显示。如下图所示。
可以从“选项”对话框中编辑要赋予图像的文件名和其他设置。更改默认标题及其字体。