劉慈欣談ChatGPT：人類的無能反而 劉慈欣談ChatGPT：人類的無能反而
OpenAI 因使用“竊取”的個人數據 OpenAI 因使用“竊取”的個人數據
搜狐回應員工遭遇工資補助詐騙： 搜狐回應員工遭遇工資補助詐騙：

軟件測試 > 測試開發技術 > 軟件測試開發語言 > VB >

用VB編程實現圖像的熠熠生輝效果

發表于：2007-05-25來源：作者：點擊數： 標簽：編程熠熠生輝效果圖像實現
一道炫目的閃光在圖像上從左至右徐徐掠過，相信如果把這樣的特效應用到程序的界面上一定能為你的程序增色不少。這樣的特效到底是怎樣實現的呢？讓我們一起來分析一下，這是本特效在某一瞬間的截圖，可以看出沿著一條傾斜的掃描線，它周圍的象素都按照近強遠
　一道炫目的閃光在圖像上從左至右徐徐掠過，相信如果把這樣的特效應用到程序的界面上一定能為你的程序增色不少。這樣的特效到底是怎樣實現的呢？讓我們一起來分析一下，這是本特效在某一瞬間的截圖，可以看出沿著一條傾斜的掃描線，它周圍的象素都按照近強遠弱（距掃描線）的規律增強亮度（當然，掃描線并不顯示出來，它只是一個抽象的概念，以方便我們的編程工作）。當掃描線從圖像最左端平滑地移動到圖像最右端的時候，由于視覺暫留作用，看起來就會有熠熠生輝的效果。那么怎樣加強像素的亮度呢？可不能直接增大像素的顏色值，因為像素的顏色值是一個長整形數值，使用4個字節表示，最高位的字節的值為0，其它3個字節依次是B、G、R值，所以要加強像素的亮度，就要分別增加B、G、R值的大小。由于這是個動態特效，靜態圖片很難表達清楚，讀者可先運行一下代碼以幫助理解。
 
 

 
 

 


　　為了使本特效更靈活、更實用，筆者定義了幾個參數，可以通過參數對特效做調整以達到滿意的效果。
 
 

　　參數表-----------------------------------------------------

 
 

　　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下調試通過。

原文轉自：http://www.anti-gravitydesign.com

相關文章

軟件測試沙龍 More>>

新浪微博More>>

...

熱門標簽

国产97人人超碰caoprom_尤物国产在线一区手机播放_精品国产一区二区三_色天使久久综合给合久久97