刘慈欣谈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.ltesting.net

相关文章

软件测试沙龙 More>>

新浪微博More>>

...

热门标签