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