用VB編程實現圖像的熠熠生輝效果
為了使本特效更靈活、更實用，筆者定義了幾個參數，可以通過參數對特效做調整以達到滿意的效果。
好，原理就這么多，現在我們開始動手實現吧！打開VB6.0，選擇新建標準EXE工程，在主窗口form1中繪制下表中所列控件并設置窗體和各控件的屬性。
參數表-----------------------------------------------------
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的代碼編輯窗口中添加如下代碼
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下調試通過。
本程序在Win2000+VB6.0下調試通過。