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

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

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

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

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

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

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

　　Control控件 属性 设置

　　Form1 Name Form1

　　ScaleMode 3-pixel

　　PictureBox Name PicDest

　　ScaleMode 3-pixel

　　Picture 背景图

　　PictureBox Name PicSource

　　ScaleMode 3-pixel

　　Picture 主体图

　　Label Name LblA

　　Caption 角度

　　Textbox Name TxtA

　　Text 30

　　Label Name LblW

　　Caption 宽度

　　Textbox Name TxtW

　　Text 15

　　Label Name LblE

　　Caption 强度

　　Textbox Name TxtE

　　Text 15

　　Label Name LblS

　　Caption 速度

　　Textbox Name TxtS

　　Text 1

　　CommandButton Name Cmd1

　　Caption 开始特效

　　生成最后窗体

　　在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, OffX As Long, OffY As Long)
　　’熠熠生辉效果
　　’参数表-----------------------------------------------------
　　’Angle 光照倾角
　　’WidthOfArea 光照区宽度
　　’Speed 光照区运动速度
　　’MaskColor 主体图屏蔽色
　　’EnhanceRatio 光照强度参数
　　’OffX 主体图叠加到目标图时 X 偏移
　　’OffY 主体图叠加到目标图时 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 + OffX, Y + OffY, 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下调试通过