您现在的位置: 天下网吧 >> 网吧天地 >> 天下码农 >> 编程界 >> 正文

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

2008-11-6天极网佚名

  本文讲解了如何通过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下调试通过。

欢迎访问最专业的网吧论坛,无盘论坛,网吧经营,网咖管理,网吧专业论坛 https://bbs.txwb.com

关注天下网吧微信/下载天下网吧APP/天下网吧小程序,一起来超精彩

本文来源:天极网 作者:佚名

声明
声明:本站所发表的文章、评论及图片仅代表作者本人观点,与本站立场无关。若文章侵犯了您的相关权益,请及时与我们联系,我们会及时处理,感谢您对本站的支持!联系邮箱:support@txwb.com,系统开号,技术支持,服务联系QQ:1175525021本站所有有注明来源为天下网吧或天下网吧论坛的原创作品,各位转载时请注明来源链接!
天下网吧 网吧天下