[推荐]VB编程实现图像的漂亮效果

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