用VB编程实现图像的熠熠生辉效果 |
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
为了使本特效更灵活、更实用，笔者定义了几个参数，可以通过参数对特效做调整以达到满意的效果。 参数表----------------------------------------------------- Angle 光照倾角，取值0到90之间，以角度为单位 WidthOfArea 光照区宽度，取值大于1的整数，以像素为单位 Speed 光照区运动速度，取值大于1的整数 EnhanceRatio 光照强度参数，取值大于1的整数 ----------------------------------------------------- 好，原理就这么多，现在我们开始动手实现吧！打开VB6.0，选择新建标准EXE工程，在主窗口form1中绘制下表中所列控件并设置窗体和各控件的属性。
生成最后的窗体。 在form1的代码编辑窗口中添加如下代码 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下调试通过。 |
