灯火互联
管理员
管理员
  • 注册日期2011-07-27
  • 发帖数41778
  • QQ
  • 火币41290枚
  • 粉丝1086
  • 关注100
  • 终身成就奖
  • 最爱沙发
  • 忠实会员
  • 灌水天才奖
  • 贴图大师奖
  • 原创先锋奖
  • 特殊贡献奖
  • 宣传大使奖
  • 优秀斑竹奖
  • 社区明星
阅读:9415回复:1

VB编程实现图像的漂亮效果

楼主#
更多 发布于:2014-03-24 11:09
本文讲解了如何通过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

喜欢0 评分0
李昊556
新手上路
新手上路
  • 注册日期2015-11-05
  • 发帖数3
  • QQ1986868221
  • 火币3枚
  • 粉丝0
  • 关注0
沙发#
发布于:2015-11-22 14:56
不错 谢谢分享  




★★★★  http://t.cn/RU3AFou

回复(0) 喜欢(0)     评分
游客

返回顶部