在现代的软件开发中，屏幕保护程序不仅是一种视觉享受，也是展示软件个性化和创新的一种方式。本文将介绍如何使用VB.NET创建一个个性化的屏幕保护程序，具体是一个气泡效果的屏幕保护程序，它能够在Windows 7操作系统中运行。用户还可以利用此代码创建具有透明效果的窗体。
此前，曾尝试创建类似于Windows 7超级任务栏的Super Bar。在这个过程中，获得了使窗体透明化的代码。随后，决定利用这段代码来创建一个令人惊叹的屏幕保护程序。
首先，将讨论如何创建一个透明的窗体。使用了从CodePlex上的Sbar库中获取的PerPixelFrom库来创建一个透明的窗体。
Imports System.Windows.Forms
Imports System.Runtime.InteropServices
Imports Screen_Saver.Win32
Public Class PerPixelAlphaForm
Inherits Form
Public StartLeft As Integer
Public StartTop As Integer
Public Ang As Double
WithEvents tim As New Timer
Public Sub New()
MyBase.FormBorderStyle = Windows.Forms.FormBorderStyle.None
MyBase.ShowInTaskbar = False
End Sub
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
MyBase.Dispose(disposing)
GC.Collect()
GC.WaitForPendingFinalizers()
End Sub
Public Sub SetBitmap(ByVal bitmap As Bitmap)
Me.SetBitmap(bitmap, &HFF)
GC.Collect()
GC.WaitForPendingFinalizers()
End Sub
Public Sub SetBitmap(ByVal bitmap As Bitmap, ByVal opacity As Byte)
If bitmap.PixelFormat <> Imaging.PixelFormat.Format32bppArgb Then
Throw New ApplicationException("The bitmap must be 32bpp with alpha-channel.")
End If
Dim screenDc As IntPtr = Win32.GetDC(IntPtr.Zero)
Dim memDc As IntPtr = Win32.CreateCompatibleDC(screenDc)
Dim hBitmap As IntPtr = IntPtr.Zero
Dim oldBitmap As IntPtr = IntPtr.Zero
Try
hBitmap = bitmap.GetHbitmap(Color.FromArgb(0))
oldBitmap = Win32.SelectObject(memDc, hBitmap)
Dim size As New Size(bitmap.Width, bitmap.Height)
Dim pointSource As New Point(0, 0)
Dim topPos As New Point(MyBase.Left, MyBase.Top)
Dim blend As New BLENDFUNCTION
blend.BlendOp = 0
blend.BlendFlags = 0
blend.SourceConstantAlpha = opacity
blend.AlphaFormat = 1
Win32.UpdateLayeredWindow(MyBase.Handle, screenDc, topPos, size, memDc, pointSource, 0, blend, 2)
Finally
Win32.ReleaseDC(IntPtr.Zero, screenDc)
If hBitmap <> IntPtr.Zero Then
Win32.SelectObject(memDc, oldBitmap)
Win32.DeleteObject(hBitmap)
End If
Win32.DeleteDC(memDc)
Win32.DeleteDC(screenDc)
Win32.DeleteObject(oldBitmap)
Win32.DeleteObject(screenDc)
Win32.DeleteObject(memDc)
GC.Collect()
GC.WaitForPendingFinalizers()
End Try
End Sub
Protected Overrides ReadOnly Property CreateParams() As CreateParams
Get
Dim cp As CreateParams = MyBase.CreateParams
cp.ExStyle = (cp.ExStyle Or &H80000)
cp.ExStyle = (cp.ExStyle Or &H80)
Return cp
End Get
End Property
End Class
对于任何窗体，可以使用这段代码使其透明：
VB.NET
Dim frm As New PerPixelAlphaForm
frm.SetBitmap(My.Resources.Blue)
frm.Show()
这段代码使frm（窗体）像上面的蓝色气泡图像一样透明。
首先，定义了一个随机数。然后根据它，可以为气泡设置不同的图像。当Timer1触发时，生成一个随机数，一个气泡就出现了。将它们组合起来，在timer1_tick代码中关闭屏幕保护程序时，鼠标指针移动。
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
If MposL <> System.Windows.Forms.Cursor.Position.X Or MposT <> System.Windows.Forms.Cursor.Position.Y Then
Timer1.Enabled = False
Me.Close()
Exit Sub
End If
k = New PerPixelAlphaForm
Dim a As New System.Random
Select Case a.NextDouble
Case Is < 0.1
k.SetBitmap(My.Resources.Blue)
Case Is < 0.2
k.SetBitmap(My.Resources.Green)
Case Is < 0.3
k.SetBitmap(My.Resources.Orange)
Case Is < 0.4
k.SetBitmap(My.Resources.Other1)
Case Is < 0.5
k.SetBitmap(My.Resources.Other2)
Case Is < 0.6
k.SetBitmap(My.Resources.Pink)
Case Is < 0.7
k.SetBitmap(My.Resources.Red)
Case Is < 0.8
k.SetBitmap(My.Resources.Violate)
Case Else
k.SetBitmap(My.Resources.Yellow)
End Select
If TotalBub < txtBubbles.Text Then
k.Ang = 1.57 * a.NextDouble
k.Show()
TotalBub += 1
End If
k = Nothing
End Sub
现在，困难是如何将气泡发送到不同的方向，并在它们与屏幕边缘碰撞时让它们返回。再次，使用了一个随机数和一些数学函数将它们发送到不同的角度，当位置超出屏幕宽度时，它们就朝其他方向移动。在PerPixelAlphaForm.vb中添加了一个Timer来获取位置和角度。
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tim.Tick
If Me.Left < 0 Or Me.Top < 0 Or Me.Left > Screen.PrimaryScreen.WorkingArea.Width - 185 Or Me.Top > Screen.PrimaryScreen.WorkingArea.Height - 185 Then
Ang += 1.57 * Date.Now.Millisecond / 1000
If Me.Left < 0 Then Me.Left = 0
If Me.Top < 0 Then Me.Top = 0
If Me.Right > Screen.PrimaryScreen.WorkingArea.Width Then Me.Left = Screen.PrimaryScreen.WorkingArea.Width - 185
If Me.Bottom > Screen.PrimaryScreen.WorkingArea.Height Then Me.Top = Screen.PrimaryScreen.WorkingArea.Height - 185
Else
Me.Left += Math.Cos(Ang) * 10
Me.Top -= Math.Sin(Ang) * 10
End If
End Sub
Private Sub PerPixelAlphaForm_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
tim.Enabled = True
tim.Interval = 2
Me.Top = Screen.PrimaryScreen.WorkingArea.Height - 200
Me.Left = 0
End Sub