本文讲解了如何通过VB编程实现图像的漂亮效果。
- o$ O+ |% f9 A3 s8 G' O9 c1 J
\0 N- |7 n H 参数表-----------------------------------------------------
" }6 ?; A* g: v9 s( ?( c
9 Y) I8 D6 U" {5 M Angle 光照倾角，取值0到90之间，以角度为单位
( D% w& j h$ u$ d+ v, L! r# ^. t0 a8 @' f6 |& J
WidthOfArea 光照区宽度，取值大于1的整数，以像素为单位
7 i% d7 t6 a3 o) _" i* O. a1 z ?+ L1 r4 I6 s
Speed 光照区运动速度，取值大于1的整数
6 d$ Y; x. q; r$ d8 J! I) e+ i2 j" z3 e" X0 p& y
EnhanceRatio 光照强度参数，取值大于1的整数
5 J' f& N- \1 c; D: p" n& g- Z8 ~6 f5 q) }( Q- t
-----------------------------------------------------
7 n8 O% \5 f" V! L) B
2 E2 ]; e& X4 z# F6 ~- F; g6 k& \. t
好，原理就这么多，现在我们开始动手实现吧!打开VB6.0，选择新建标准EXE
工程，在主窗口form1中绘制下表中所列控件并设置窗体和各控件的属性。
! |$ `7 ~9 s; w/ I& a! Z3 P, Y) M+ |( c$ u
控件 属性 设置
! e# J! \; J" c& E2 R1 O- f
7 z; i! B; D. T" x Form1 Name Form1
" s4 \& \0 I+ r
! n! R# i. [6 f, B* m* B
ScaleMode 3-pixel
. q3 Z2 e6 @* ]# }4 T+ U" o
9 o. b: s% D9 @/ U PictureBox Name PicDest
2 t8 m/ U4 M/ B) f6 p" k' b% X
# e4 Y7 A0 B! x% [' P& V
ScaleMode 3-pixel
W7 Q; [2 ^8 i# c9 j" Z/ p" p+ @1 S
Picture 背景图
9 f5 b8 w3 B! ]8 d; F) R2 C: o' u; `
PictureBox Name PicSource
2 ]1 Y4 R; \: |2 E. V* t1 C4 r- y
; q+ f: F7 D( [2 z$ {
ScaleMode 3-pixel
' j5 t* v! C9 L, _/ r
( d2 [$ Z* K5 O( W/ k0 D! O Picture 主体图
+ z. t+ |2 x) {4 K
. p6 e0 J' Q+ N3 b Label Name LblA
9 i; ]7 ~4 [/ l8 g6 u& I. C n$ T+ ~0 @3 @0 _; F
Caption 角度
* G4 K9 T" m' q- {; \3 V
' g' G4 o1 v6 h( x( H' p& N Textbox Name TxtA
# a6 L5 I' h8 g4 _5 o
5 z) ]$ p# b3 q
Text 30
' x7 X% _: ~1 f7 T7 p" H3 S$ t$ v) y1 I8 h& g
Label Name LblW
2 ?# w2 a% k' e! T: O
6 ~4 ~' L% |: h' o$ q9 d) ^ Caption 宽度
% U8 l$ Q1 ~0 [7 X7 d8 y* O3 o
8 _) x1 T. L& b7 h* a Textbox Name TxtW
1 ~' u" @/ m( _- F% a9 M6 e, u6 x, z m
) U, _5 {( Q$ ^; D8 R7 y Text 15
; D: E2 B) P$ X) m1 _. z& F
) C; W. L2 m- f' c Label Name LblE
8 ]% D! z |6 ^7 A T* }
e) o: q+ A) |0 l
Caption 强度
& o! z! L( H( p) u) n( C; V
" {2 L2 Q* w3 r8 l Textbox Name TxtE
" g: T4 \! S/ P0 ~/ ~8 Q6 B! ~) T
/ C r) O; Q: s, G/ ^3 x S) o& q% O Text 15
! n' s6 _7 F, c: P7 U' J! C& C: ?4 P
- K( r4 g+ P4 d% d Label Name LblS
' j& Y0 l) j& a7 k/ l0 W2 C. Z0 E; Y# @! E/ Q# |+ Q
Caption 速度
9 K9 G1 Z- K! H) \2 X) e6 K0 v5 ?( s+ i+ x3 g6 N4 F) ~. e
Textbox Name TxtS
' o$ r/ `- \8 s2 o- r3 e- t/ F" m2 K4 M
2 }+ W; \7 I8 l" m4 ? Text 1
# e7 U) }2 d$ Q. j% c
, _5 M. e" i3 K/ L; K- o CommandButton Name Cmd1
( e) ?7 Z% {: C' R
! V& x& z- Q$ ]' X; @
Caption 开始特效
' [1 B2 O, r- b
# r/ U& P0 `( B+ o# e3 O# T 生成最后的窗体。
, B( L! R$ f% Q; X, G" N0 t1 |. W* s; W( r) T( ]
在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
