一个非常简单的放大镜
一个 VB.NET 项目，展示如何构建一个简单的放大镜。
引言
终于从 VB6 迁移到 VB.NET 了，这是我的一些早期尝试，您可能会觉得有趣。在做另一个项目时，我需要一个放大镜来更仔细地检查屏幕的某些部分。我没有去网上下载现成的，而是自己做了一个，这样我就能学到一些新东西。
工作原理
主要代码
应用程序以 frmStart 开始，它只做几件事：确定放大镜的大小和放大倍数，然后打开放大镜。所以没什么代码可讲的。
Public Class frmStart
Private Sub cmdStart_Click(sender As System.Object, _
e As System.EventArgs) Handles cmdStart.Click
Me.Hide()
Dim MagnSize As Integer = Choose(lstMagnSize.SelectedIndex + 1, 48, 64, 96, 128)
frmScreenCopy.MagnSize = MagnSize
frmScreenCopy.OriSize = MagnSize \ Choose(lstMagn.SelectedIndex + 1, 2, 4, 8, 16)
frmScreenCopy.Show()
End Sub
Private Sub frmStart_Load(sender As Object, e As System.EventArgs) Handles Me.Load
lstMagnSize.SelectedIndex = 1
lstMagn.SelectedIndex = 1
End Sub
End Class
放大倍数是放大镜的大小除以原始大小（即实际被放大的部分）。
在 frmScreenCopy 中还有一些代码，这是项目的第二个也是最后一个窗体。由于 MouseMove 事件触发非常频繁，因此其中的代码应尽量少。因此，一开始所有声明都在窗体级别完成。
frmStart 设置了两个 Public 变量（见上文）。
Imports System.Drawing.Drawing2D ' graphics path needs this
Public Class frmScreenCopy
Public OriSize As Integer = 16 ' size of the original rectangle
Public MagnSize As Integer = 64 ' size of the magnification glass
Dim bmpOriCopy As Bitmap ' buffer of the original rectangle on screen
Dim bmpgrOriCopy As Graphics Dim rctOri As Rectangle ' original rectangle on screen
Dim rctOriCopy As Rectangle ' a copy of the original rectangle on screen
Dim rctMagn As Rectangle ' rectangle of the magnification glass
Dim Desktop As Image ' a backup of the screen
Dim picgr As Graphics ' pic (picturebox) graphics
Dim gpath As GraphicsPath ' used to make a round circle shaped glass
Dim rgn As Region
Dim pn As Pen = New Pen(Color.Silver, 4)
每次窗体激活时，都必须（重新）设置对象，以防放大镜的大小或原始大小发生变化。屏幕截图的捕获也必须在此事件中进行。在将屏幕截图放入 PictureBox 之前，必须调整其边界。否则，放大镜只会以 PictureBox 在设计时的大小工作。想知道我的意思，只需切换第 028 行和第 029 行。
Private Sub frmScreenCopy_Activated(sender As Object, e As System.EventArgs) Handles Me.Activated
' adjust objects to choosen sizes
bmpOriCopy = New Bitmap(OriSize, OriSize)
bmpgrOriCopy = Graphics.FromImage(bmpOriCopy)
rctOriCopy = New Rectangle(0, 0, OriSize, OriSize)
rctOri = New Rectangle(0, 0, OriSize, OriSize) 'where on screen is set later
rctMagn = New Rectangle(0, 0, MagnSize, MagnSize)
Dim SC As New ScreenShot.ScreenCapture
pic.SetBounds(0, 0, Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height)
pic.Image = SC.CaptureScreen
Desktop = pic.Image.Clone
picgr = pic.CreateGraphics
Cursor.Hide()' in the KeyDown event you can switch the cursor on/off
Cursor.Tag = "off"
End Sub
当用户通过 Escape 键停止使用放大镜时，请确保光标已返回并且可见。
Private Sub frmScreenCopy_Deactivate(sender As Object, e As System.EventArgs) Handles Me.Deactivate
Cursor.Show()
Cursor.Tag = "on"
End Sub
我知道要避免内存泄漏，应该小心地处理所有创建的对象。但我不知道应该处理到什么程度。例如，在这种情况下，当窗体被销毁时，所有对象不都会被销毁吗？为了安全起见，我在这里将它们一个接一个地处理掉了。
Private Sub frmScreenCopy_Disposed(sender As Object, e As System.EventArgs) Handles Me.Disposed
rgn.Dispose()
gpath.Dispose()
bmpgrOriCopy.Dispose()
bmpOriCopy.Dispose()
Desktop.Dispose()
picgr.Dispose()
End Sub
在 KeyDown 事件中，有比这里显示的更多的代码，但它是简单明了的代码，不需要任何解释。
Private Sub frmScreenCopy_KeyDown(sender As Object, _
e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
Select e.KeyCode
Case Keys.Escape
Me.Close()
frmStart.Show()
Case ...
End Select
End Sub
最后，这里是使放大镜工作的代码。首先，将 rctOri 矩形设置为鼠标的位置。矩形位于鼠标的中心。然后，在该屏幕部分的一个复制品被放入缓冲位图 bmpOriCopy 中。为什么这样做，我稍后解释。
Private Sub pic_MouseMove(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles pic.MouseMove
' copy part of screen under mouse original size
rctOri.X = e.X - OriSize / 2
rctOri.Y = e.Y - OriSize / 2
bmpgrOriCopy.DrawImage(pic.Image, rctOriCopy, rctOri, GraphicsUnit.Pixel)
在绘制新的放大镜之前，必须先从屏幕上移除之前的放大镜。这就是桌面图像对象的作用：它正在缓冲屏幕以供恢复。
'restore background first before putting new magn glass
picgr.DrawImage(Desktop, rctMagn, rctMagn, GraphicsUnit.Pixel)
现在我们终于可以绘制一个新的放大镜了。
068 ' put new magn glass
069 rctMagn.X = e.X - MagnSize / 2
070 rctMagn.Y = e.Y - MagnSize / 2
071 gpath = New GraphicsPath
072 gpath.AddEllipse(rctMagn)
073 rgn = New Region(gpath)
074 picgr.Clip = rgn
075
076 picgr.DrawImage(bmpOriCopy, rctMagn, rctOriCopy, GraphicsUnit.Pixel)
077 picgr.DrawEllipse(pn, rctMagn)
078
079 End Sub
080 End Class
代码注释
最简短的总结如下：
- 捕获屏幕并将其放入一个全屏大小的
PictureBox中。 - 在
PictureBox的MouseMove事件中，鼠标按钮下的一个区域被放大成圆形形状。
屏幕捕获
在 VB.NET 中捕获整个桌面屏幕与 VB6 没什么不同：只需要知道一些特殊的 API 函数，例如：
User32.GetDesktopWindow();User32.GetWindowDC();GDI32.CreateCompatibleDC();GDI32.CreateCompatibleBitmap()...
但对于项目中的屏幕捕获部分，我非常感谢 gigemboy 在 vbforums.com 上的 ScreenCapture 类，我没有更改它（其中一些函数在我的放大镜项目中没有使用，可以删除）。使用该类（第 27-29 行），屏幕捕获非常容易。
绘制透明圆形
将桌面的一份副本放入 PictureBox 后，您可以检测鼠标的位置（第 59 行），然后投影鼠标下方区域的放大版本。
基本上，放大是使用矩形形状和 DrawImage 完成的。但是放大镜应该是圆形的。
在 VB6 中，我会使用 API 函数 bitblt 或 stretchblt 和一个蒙版（黑白）图片来制作圆形。使用这些 API 函数，大致如下：
bitblt picResult.hdc, x, y, W, H, picMask.hdc,0,0,SRCINVERT
bitblt picResult.hdc, x, y, W, H, picGrad.hdc,0,0,SRCAND
bitblt picResult.hdc, x, y, W, H, picMask.hdc,0,0,SRCINVERT
在 VB.NET 中，我也可以这样做。但那样我就学不到东西了。不过，我还不确定是否能找到另一种方法，一种在 .NET 中实现的、速度与 API bitblt、stretchblt 一样快的方法。但我还是给了它一个机会，并发现 VB.NET 中确实存在这样的方法，而且它们的速度足够快。
您可以先将某些内容绘制到 GraphicsPath 中（第 71-72 行），将此路径放入 Region 对象中（第 73 行），然后使用此区域来裁剪（第 74 行）后续的图形操作（第 76-77 行）。裁剪区域就像一个蒙版。路径可以是任何您想要的。这样您就可以制作各种形状的不规则透明形状。在我的项目中，我绘制了一个圆形（~椭圆）（第 72 行），用于裁剪放大的矩形（第 76 行）。
可能在后台，这种使用区域中路径的裁剪仍然在使用上述光栅操作。我认为他们首先在黑色表面上用白色绘制以创建蒙版，然后使用蒙版进行透明绘制。
必须流畅运行
项目中最困难的部分是使事情尽可能流畅地运行。有许多不同的方法可以实现一个工作的放大镜，但它们并不总是那么流畅。MouseMove 事件中的代码会非常快速地重复。代码越少越好。例如，将 Dim 和 New 放在外部（如果可能）非常重要。在这里，Path 和 Region 每次鼠标移动时都必须重新创建。但所有其他内容都已在外部声明。
还有一些我无法解释的事情。通常少即是多。但在这个例子中不是。在下面的备用代码中，我没有为原始尺寸的矩形图像使用缓冲区，而是直接从 Desktop-image 中绘制。我也不使用 PictureBox 来工作。取而代之的是我使用 Me.BackgroundImage。结果是代码更少，计算机需要做的操作也更少。但是在此版本中，存在一定的闪烁。为什么不清楚？它应该工作得更好。
000 Imports System.Drawing.Drawing2D
001
002 Public Class frmScreenCopy
003
004 Public OriSize As Integer = 16 ' size of the original rectangle
005 Public MagnSize As Integer = 64 ' size of the magnification glass
006 Dim rctOri As Rectangle ' original rectangle on screen
007 Dim rctMagn As Rectangle ' rectangle of the magnification glass
008 Dim Desktop As Image
009 Dim picgr As Graphics
010
011 Dim gpath As GraphicsPath ' used to make a round circle shaped glass
012 Dim rgn As Region
013 Dim pn As Pen = New Pen(Color.Silver, 4)
014
015 Private Sub frmScreenCopy_Activated(sender As Object, e _
As System.EventArgs) Handles Me.Activated
016 ' adjust objects to choosen sizes
017 rctOri = New Rectangle(0, 0, OriSize, OriSize) ' where on screen is set later
018 rctMagn = New Rectangle(0, 0, MagnSize, MagnSize)
019
020 Dim SC As New ScreenShot.ScreenCapture
021 Me.SetBounds(0, 0, Screen.PrimaryScreen.Bounds.Width, _
Screen.PrimaryScreen.Bounds.Height)
022 Me.BackgroundImage = SC.CaptureScreen
023 Desktop = Me.BackgroundImage.Clone
024 picgr = Me.CreateGraphics
025
026 Cursor.Hide()
027 Cursor.Tag = "off"
028 End Sub
029
030 Private Sub frmScreenCopy_Deactivate(sender As Object, _
e As System.EventArgs) Handles Me.Deactivate
031 Cursor.Show()
032 Cursor.Tag = "on"
033 End Sub
034
035 Private Sub frmScreenCopy_Disposed(sender As Object, _
e As System.EventArgs) Handles Me.Disposed
036 rgn.Dispose()
037 gpath.Dispose()
038 Desktop.Dispose()
039 picgr.Dispose()
040 End Sub
041
042 Private Sub frmScreenCopy_KeyDown(sender As Object, _
e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
043 Select e.KeyCode
044 Case Keys.Escape
...
047 Case Keys.F2
...
061 Case Keys.F4
070 End Select
071 End Sub
072
073 Private Sub frmScreenCopy_MouseMove(sender As Object, _
e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove
074 'restore background first before putting new magn glass
075 picgr.DrawImage(Desktop, rctMagn, rctMagn, GraphicsUnit.Pixel)
076
077 ' position original and magnifying rectangle around the mouse
078 rctOri.X = e.X - OriSize / 2
079 rctOri.Y = e.Y - OriSize / 2
080 rctMagn.X = e.X - MagnSize / 2
081 rctMagn.Y = e.Y - MagnSize / 2
082
083 gpath = New GraphicsPath
084 gpath.AddEllipse(rctMagn)
085 rgn = New Region(gpath)
086 picgr.Clip = rgn
087
088 picgr.DrawImage(Desktop, rctMagn, rctOri, GraphicsUnit.Pixel)
089 picgr.DrawEllipse(pn, rctMagn)
090 End Sub
091 End Class
如果您想知道我所说的闪烁是什么意思，您将不得不尝试一下这段代码。闪烁是微妙但真实存在的，而且并不好看。
历史
这是一个可行的初稿。我可能会用更多功能来编写新版本。例如，我希望能够轻松选择屏幕的某些部分并保存它们。但那时它可能就不再简单了，而且最好是另外写一篇帖子来介绍？
更新：2012 年 1 月 23 日
我收到了 trembru 的一个非常有用的评论，他建议用以下代码替换使用 API 函数的捕获类：
Private Function CaptureScreen() As Image
Dim Img As New Bitmap(Screen.PrimaryScreen.WorkingArea.Width, _
Screen.PrimaryScreen.WorkingArea.Height)
Dim g As Graphics = Graphics.FromImage(Img)
g.CopyFromScreen(0, 0, 0, 0, Img.Size)
g.Dispose()
Return Img
End Function
当然，我更改了我的代码，因为它使代码更好、更短、更简单。我还更改了应用程序图标，因为之前的图标看起来很糟糕。结果如下：