分享
 
 
 

用VB编程实现图像的熠熠生辉效果

王朝c#·作者佚名  2006-12-17
窄屏简体版  字體: |||超大  

用VB编程实现图像的熠熠生辉效果

用VB编程实现图像的熠熠生辉效果 用VB编程实现图像的熠熠生辉效果

一道炫目的闪光在图像上从左至右徐徐掠过,相信如果把这样的特效应用到程序的界面上一定能为你的程序增色不少。这样的特效到底是怎样实现的呢?让我们一起来分析一下,这是本特效在某一瞬间的截图,可以看出沿着一条倾斜的扫描线,它周围的象素都按照近强远弱(距扫描线)的规律增强亮度(当然,扫描线并不显示出来,它只是一个抽象的概念,以方便我们的编程工作)。当扫描线从图像最左端平滑地移动到图像最右端的时候,由于视觉暂留作用,看起来就会有熠熠生辉的效果。那么怎样加强像素的亮度呢?可不能直接增大像素的颜色值,因为像素的颜色值是一个长整形数值,使用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下调试通过。

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有