VB編程實現圖像的漂亮效果
本文講解了如何通過VB編程實現圖像的漂亮效果。
參數表-----------------------------------------------------
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下調試通過。