用VB编程实现图像的熠熠生辉效果

　　一道炫目的闪光在图像上从左至右徐徐掠过，相信如果把这样的特效应用到程序的界面上一定能为你的程序增色不少。这样的特效到底是怎样实现的呢？让我们一起来分析一下，这是本特效在某一瞬间的截图，可以看出沿着一条倾斜的扫描线，它周围的象素都按照近强远弱（距扫描线）的规律增强亮度（当然，扫描线并不显示出来，它只是一个抽象的概念，以方便我们的编程工作）。当扫描线从图像最左端平滑地移动到图像最右端的时候，由于视觉暂留作用，看起来就会有熠熠生辉的效果。那么怎样加强像素的亮度呢？可不能直接增大像素的颜色值，因为像素的颜色值是一个长整形数值，使用4个字节表示，最高位的字节的值为0，其它3个字节依次是B、G、R值，所以要加强像素的亮度，就要分别增加B、G、R值的大小。由于这是个动态特效，静态图片很难表达清楚，读者可先运行一下代码以帮助理解。

　　为了使本特效更灵活、更实用，笔者定义了几个参数，可以通过参数对特效做调整以达到满意的效果。

　　　　参数表-----------------------------------------------------

　　Angle 光照倾角，取值0到90之间，以角度为单位

　　WidthOfArea 光照区宽度，取值大于1的整数，以像素为单位

　　Speed 光照区运动速度，取值大于1的整数

　　EnhanceRatio 光照强度参数，取值大于1的整数

　　

　　-----------------------------------------------------

　　

　　好，原理就这么多，现在我们开始动手实现吧！打开VB6.0，选择新建标准EXE工程，在主窗口form1中绘制下表中所列控件并设置窗体和各控件的属性。

　　



　　生成最后的窗体。

　　

　　在form1的代码编辑窗口中添加如下代码

　　

　　Option Explicit

　　

　　Const pi = 3.1415926

　　

　　'api函数声明------------------------------------------------------------

　　Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _

　　(Destination As Any, Source As Any, ByVal Length As Long) '拷贝内存

　　

　　Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, _

　　ByVal X As Long, ByVal Y As Long) As Long '取像素值

　　

　　Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, _

　　ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long '设置像素值

　　

　　Private Sub cmd1_Click()

　　cmd1.Enabled = False

　　MakeSpark txtA, txtW, txtS, 0, txtE, 65, 10

　　cmd1.Enabled = True

　　End Sub

　　

　　Private Sub MakeSpark(Angle As Long, WidthOfArea As Long, _

　　Speed As Long, MaskColor As Long, _

　　EnhanceRatio As Single, OffsetX As Long, OffsetY As Long)

　　'熠熠生辉效果

　　'参数表-----------------------------------------------------

　　'Angle 光照倾角

　　'WidthOfArea 光照区宽度

　　'Speed 光照区运动速度

　　'MaskColor 主体图的屏蔽色

　　'EnhanceRatio 光照强度参数

　　'OffsetX 主体图叠加到目标图时的 X 偏移

　　'OffsetY 主体图叠加到目标图时的 Y 偏移

　　

推荐文章：电眼美女林熙蕾火辣激情壁纸　　少儿止步 性感壁纸欣赏

　　Dim i&, X&, Y&, L&, Color&, EnhanceValue&

　　Dim R As Byte, G As Byte, B As Byte

　　

　　With picSource

　　

　　 For i = 0 To .Width + .Height * Tan(Angle * pi / 180) + WidthOfArea _

　　 Step Speed

　　 '扫描主体图

　　 For X = 0 To .Width - 1

　　 For Y = 0 To .Height - 1

　　 Color = GetPixel(.hdc, X, Y)

　　 '遍历主体图的像素

　　

　　 If Color = MaskColor Then

　　 'skip跳过

　　 Else

　　 L = Abs(X - (i - Y * Tan(Angle * pi / 180)))

　　 '计算当前像素于扫描线的 X 方向距离

　　

　　 If L <= WidthOfArea Then '如果当前像素在光照范围内

　　

　　 R = ExtractR(Color) '取 R,G,B 值

　　 G = ExtractG(Color)

　　 B = ExtractB(Color)

　　

　　 EnhanceValue = EnhanceRatio * (WidthOfArea - L)

　　 '算出要增强的亮度值

　　

　　 '加强亮度，但不能超过最大值 255

　　 R = IIf(R + EnhanceValue > 255, 255, R + EnhanceValue)

　　 G = IIf(G + EnhanceValue > 255, 255, G + EnhanceValue)

　　 B = IIf(B + EnhanceValue > 255, 255, B + EnhanceValue)

　　

　　 Color = RGB(R, G, B) '算出加强亮度后的颜色值

　　 End If

　　 SetPixel picDest.hdc, X + OffsetX, Y + OffsetY, Color

　　 '拷贝像素到目标图

　　 End If

　　 Next Y

　　 Next X

　　

　　 picDest.Refresh '一帧已处理完，显示

　　 DoEvents

　　 Next i

　　

　　　End With

　　End Sub

　　

　　Private Function ExtractR(Col As Long) As Byte

　　

　　'提取一个颜色值的红色分量值，红色分量位于这个颜色值的最低字节

　　Dim tmp As Byte

　　CopyMemory tmp, ByVal VarPtr(Col), 1

　　ExtractR = tmp

　　End Function

　　Private Function ExtractG(Col As Long) As Byte

　　'提取一个颜色值的绿色分量值，绿色分量的位置比红色分量高一字节

　　Dim tmp As Byte

　　CopyMemory tmp, ByVal VarPtr(Col) + 1, 1

　　ExtractG = tmp

　　End Function

　　Private Function ExtractB(Col As Long) As Byte

　　'提取一个颜色值的蓝色分量值，蓝色分量的位置比绿色分量高一字节

　　Dim tmp As Byte

　　CopyMemory tmp, ByVal VarPtr(Col) + 2, 1

　　ExtractB = tmp

　　End Function

　　本程序在Win2000+VB6.0下调试通过。


推荐文章：电眼美女林熙蕾火辣激情壁纸　　少儿止步 性感壁纸欣赏